mtasc-1.14/0000750000175000017500000000000011155145511011174 5ustar pabspabsmtasc-1.14/ChangeLog0000640000175000017500000013722211155145506012762 0ustar pabspabs2009-03-01 21:01 ncannasse * swflib/as3parse.ml: bugfix : write uint list 2008-12-07 00:55 ncannasse * swflib/as3hlparse.ml: fixed mutual infinite recursions in "flatten" 2008-11-21 05:15 ncannasse * swflib/: as3.mli, as3code.ml, as3hlparse.ml, as3parse.ml: added flash10 vmem opcodes 2008-11-01 01:02 ncannasse * swflib/swfPic.ml: minor cleanup 2008-10-04 04:27 ncannasse * swflib/: as3code.ml, as3hlparse.ml: flash10 fixes 2008-09-23 16:34 ncannasse * mtasc/std/TopLevel.as: fixed targetPath 2008-08-31 19:20 ncannasse * mtasc/doc/Future.txt: minor 2008-08-31 19:15 ncannasse * mtasc/doc/CHANGES.txt: v1.14 2008-08-31 19:14 ncannasse * mtasc/: doc/CHANGES.txt, main.ml, std8/Stage.as: minor fixes 2008-08-31 19:06 ncannasse * mtasc/genSwf.ml: fix FSCommand2 stack 2008-08-26 22:49 ncannasse * swflib/: as3.mli, as3code.ml, as3hl.mli, as3hlparse.ml: added missing opcodes 2008-08-01 16:25 ncannasse * swflib/: as3hl.mli, as3hlparse.ml: allowed const block vars 2008-07-22 21:57 ncannasse * swflib/: swf.ml, swfParser.ml: added four additional tags (patch by Nikolay Krasko) 2008-07-10 23:55 ncannasse * swflib/as3hlparse.ml: fix for stable sort when methods eq. 2008-07-10 23:52 ncannasse * swflib/: as3hl.mli, as3hlparse.ml: fixes : ensure that classes and methods are kept sorted during parse/flatten process 2008-06-06 22:06 ncannasse * swflib/as3hlparse.ml: don't display misaligned jump 2008-06-06 22:03 ncannasse * swflib/: as3hl.mli, as3parse.ml: minor changes 2008-05-30 03:49 ncannasse * swflib/: as3.mli, as3code.ml, as3hl.mli, as3hlparse.ml, as3parse.ml: fp10 support 2008-02-17 22:38 ncannasse * swflib/as3code.ml: debugreg index fix 2008-02-17 22:25 ncannasse * swflib/: as3.mli, as3hl.mli, as3hlparse.ml, as3parse.ml: optional parameter name 2008-01-20 21:57 ncannasse * swflib/as3hlparse.ml: switch bugfix + recover on invalid jump 2007-12-19 02:55 ncannasse * swflib/: as3code.ml, as3hlparse.ml, as3parse.ml: switchs 2007-12-19 01:20 ncannasse * swflib/: as3hl.mli, as3hlparse.ml: gpl headers 2007-12-19 01:18 ncannasse * swflib/: as3hl.mli, as3hlparse.ml: optional function (interfaces constructors) 2007-12-19 00:24 ncannasse * swflib/: as3code.ml, as3hl.mli, as3hlparse.ml: moved stack_delta, try_catch remapping, added HMPath 2007-12-18 21:06 ncannasse * swflib/: as3.mli, as3code.ml, as3hl.mli, as3hlparse.ml, as3parse.ml: use arrays for code added jump relocation in hl layer 2007-12-18 03:26 ncannasse * swflib/: as3hl.mli, as3hlparse.ml: completed 2007-12-15 01:20 ncannasse * swflib/: swf.ml, swfParser.ml: fixed TEnableDebugger2 2007-12-15 00:02 ncannasse * swflib/: as3.mli, as3code.ml, as3hl.mli, as3hlparse.ml, install.bat, swflib.vcproj: updated added hl layer 2007-12-14 19:38 ncannasse * swflib/swfParser.ml: added force_as3_parsing 2007-11-11 18:11 ncannasse * swflib/: swf.ml, swfParser.ml: TEnableDebugger2 support 2007-07-13 22:07 ncannasse * swflib/as3code.ml: INeg fix 2007-07-12 06:09 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: use int and not index for slots 2007-07-12 05:54 ncannasse * swflib/as3code.ml: fix 2007-07-11 16:56 ncannasse * mtasc/std/TopLevel.as: added setTimeout/clearTimeout 2007-07-10 18:55 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: updated with correct naming 2007-07-06 02:28 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: update for as3 bytecode 2007-06-20 00:24 ncannasse * mtasc/: doc/CHANGES.txt, std8/MovieClip.as: fix 2007-06-12 00:12 ncannasse * swflib/: swf.ml, swfParser.ml: added f8 lines properties 2007-05-09 16:20 ncannasse * mtasc/std8/: MovieClip.as, Stage.as, flash/display/BitmapData.as: flash9 changes 2007-05-06 17:20 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt, std/TopLevel.as: added stopAllSounds support. 2007-05-04 18:13 ncannasse * mtasc/std8/flash/geom/Matrix.as: fix 2007-04-13 15:58 ncannasse * mtasc/std/TextSnapshot.as: added missing method 2007-03-05 20:09 ncannasse * extc/extc_stubs.c: limits.h for linux + osx 2007-03-05 19:55 ncannasse * extc/extc_stubs.c: added limits.h on OSX 2007-02-26 22:00 ncannasse * extc/: extc.ml, extc.mli, extc_stubs.c: added get_full_path 2007-02-15 23:41 ncannasse * extc/: Makefile, zlib/README.txt, zlib/zconf.h, zlib/zlib.h, zlib/zlib.lib: added zlib 2007-02-05 01:34 ncannasse * mtasc/std/System/capabilities.as: fixed 2007-02-04 22:57 ncannasse * mtasc/doc/CHANGES.txt: v1.13 2007-02-04 22:57 ncannasse * mtasc/: std/Date.as, std/ExtendedKey.as, std/SharedObject.as, std/Video.as, std/System/capabilities.as, std8/Video.as: Flash Lite 2.x 2007-02-04 22:56 ncannasse * mtasc/typer.ml: minor fixes 2007-02-04 22:56 ncannasse * mtasc/parser.ml: changed % priority 2007-02-04 22:55 ncannasse * mtasc/main.ml: 1.13 always remove "add" from keywords 2007-02-04 22:55 ncannasse * mtasc/genSwf.ml: trim exclude lines don't allow more than 250 registers 2007-01-28 01:12 ncannasse * extc/extc_stubs.c: minor 2007-01-09 00:31 ncannasse * extc/extc_stubs.c: fixed signedness warnings 2006-12-21 02:27 ncannasse * swflib/: swf.ml, swfParser.ml: fix lines. 2006-12-21 01:50 ncannasse * swflib/: swf.ml, swfParser.ml: correct support for line style version 4. 2006-10-01 21:09 ncannasse * mtasc/genSwf.ml: FSCommand2 fix ? 2006-10-01 21:09 ncannasse * mtasc/doc/CHANGES.txt: updated 2006-08-24 00:00 ncannasse * swflib/swfParser.ml: write id infos. 2006-08-24 00:00 ncannasse * swflib/as3parse.ml: no id in write 2006-08-23 23:42 ncannasse * swflib/: swf.ml, swfParser.ml: added f9scene 2006-08-23 23:05 ncannasse * swflib/install.bat: clean ending 2006-08-23 23:04 ncannasse * swflib/install.bat: clean first 2006-08-23 23:03 ncannasse * swflib/: swf.ml, swfParser.ml: TSwf9Name -> TF9Classes 2006-08-14 18:51 ncannasse * swflib/: swf.ml, swfParser.ml: sandbox 2006-08-14 16:27 ncannasse * swflib/: as3.mli, as3parse.ml: mt3_new_block 2006-08-14 16:05 ncannasse * swflib/: as3.mli, as3code.ml: getscope0 2006-08-11 22:51 ncannasse * mtasc/std/NetStream.as: +onPlayStatus 2006-08-11 21:15 ncannasse * swflib/as3code.ml: fix 2006-08-11 20:36 ncannasse * swflib/as3code.ml: assume ints everywhere 2006-08-10 20:35 ncannasse * swflib/: as3.mli, as3code.ml: new opcode, length fix for debug infos. 2006-08-10 00:15 ncannasse * swflib/as3.mli: minor 2006-08-09 19:04 ncannasse * swflib/: as3.mli, as3code.ml: ops renaming function has index_nz 2006-08-09 16:54 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: more strict-typed bytecode. 2006-08-08 23:54 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: differenciated getscope0 from getscope 0 (for size checking) 2006-08-08 21:27 ncannasse * swflib/: as3.mli, as3code.ml: block get/set => slots 2006-08-08 20:25 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: scopes ! 2006-08-08 16:44 ncannasse * swflib/: as3.mli, as3parse.ml: stack size 2006-08-08 16:44 ncannasse * swflib/install.bat: copy as3code 2006-08-07 21:41 ncannasse * swflib/swflib.vcproj: files 2006-08-07 19:00 ncannasse * swflib/: as3.mli, as3parse.ml: no original data 2006-08-07 17:11 ncannasse * swflib/: swf.ml, swfParser.ml: fixed swf9name 2006-08-05 06:59 ncannasse * mtasc/mtasc.vcproj: upd 2006-08-05 06:11 ncannasse * swflib/install.bat: install 2006-08-05 01:06 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: completed opcodes. 2006-08-04 18:21 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: local functions support 2006-08-04 16:23 ncannasse * swflib/: as3.mli, as3code.ml: fixed jumps semantic 2006-08-04 02:27 ncannasse * swflib/: as3.mli, as3parse.ml: method debug name is optional 2006-08-04 01:18 ncannasse * swflib/as3code.ml: marked not-debug opcodes. 2006-08-04 00:28 ncannasse * swflib/: as3.mli, as3code.ml, as3parse.ml: more work on opcodes. 2006-08-03 00:00 ncannasse * swflib/: as3.mli, as3parse.ml, as3code.ml, swfParser.ml: added basic opcodes. 2006-08-03 00:00 ncannasse * mtasc/doc/install.ml: updated 2006-07-22 00:25 ncannasse * swflib/: swf.ml, swfParser.ml: added AS3 support 2006-07-13 19:39 ncannasse * swflib/: as3.mli, as3parse.ml: removed as3_id 2006-07-13 18:45 ncannasse * mtasc/doc/CHANGES.txt: updated 2006-07-13 18:32 ncannasse * swflib/: swf.ml, swfParser.ml: dummy as3 support. allowed button filters. 2006-06-18 22:59 ncannasse * swflib/: as3.mli, as3parse.ml: added functions base 2006-06-18 21:39 ncannasse * swflib/: as3.mli, as3parse.ml: inits were fields ! 2006-06-18 20:55 ncannasse * swflib/: as3.mli, as3parse.ml: getter/setter metadatas plain asc output 2006-06-18 08:12 ncannasse * swflib/: as3.mli, as3parse.ml: completed method_type separated values bug fixes. 2006-06-18 05:10 ncannasse * swflib/as3parse.ml: remove log 2006-06-18 05:08 ncannasse * swflib/: as3.mli, as3parse.ml: added namespace value. 2006-06-18 04:36 ncannasse * swflib/: as3.mli, as3parse.ml: added override and inits. 2006-06-18 03:38 ncannasse * swflib/: as3.mli, as3parse.ml: opt super, const, fix class-object ref. more dump 2006-06-18 03:03 ncannasse * swflib/: as3.mli, as3parse.ml: fixed methods, super added values 2006-06-18 01:27 ncannasse * swflib/: as3.mli, as3parse.ml: base structure parse/write/dump ok. need more tests to check each index. 2006-06-10 02:02 ncannasse * swflib/: as3.mli, as3parse.ml: base 2006-05-18 05:19 ncannasse * mtasc/doc/CHANGES.txt: updated 2006-05-18 05:18 ncannasse * mtasc/typer.ml: fixed multivars declarations 2006-05-17 18:45 ncannasse * mtasc/doc/CHANGES.txt: updated 2006-05-17 18:40 ncannasse * mtasc/genSwf.ml: fixed 2006-05-12 18:33 ncannasse * mtasc/std/NetStream.as: added onCuePoint. 2006-05-06 16:46 ncannasse * mtasc/std8/System/security.as: added 2006-03-19 20:46 ncannasse * mtasc/doc/: Makefile, mtasc.1: added 2006-03-19 19:51 ncannasse * mtasc/doc/HelloWorld.as: [no log message] 2006-03-16 06:18 ncannasse * mtasc/doc/install.ml: mt extlib mirror. 2006-03-14 21:25 ncannasse * mtasc/std/Array.as: api fix 2006-02-24 14:10 ncannasse * mtasc/doc/Future.txt: added 2006-02-20 11:31 ncannasse * swflib/swfParser.ml: fixed shape5 2006-02-19 17:15 ncannasse * mtasc/genSwf.ml: minor fix 2006-02-19 13:25 ncannasse * mtasc/typer.ml: have -> has 2006-02-10 21:45 ncannasse * swflib/: swf.ml, swfParser.ml: added gradient flags (new in Flash8). 2006-02-09 20:12 ncannasse * mtasc/doc/CHANGES.txt: update 2006-02-09 20:12 ncannasse * mtasc/std8/Video.as: added 2006-02-09 20:11 ncannasse * mtasc/std/NetStream.as: dynamic 2006-02-07 22:39 ncannasse * swflib/: swf.ml, swfParser.ml: minimal TShape5 support. 2006-02-01 21:44 ncannasse * mtasc/doc/install.ml: minor. 2006-02-01 02:03 ncannasse * mtasc/doc/CHANGES.txt: update 2006-02-01 02:02 ncannasse * mtasc/: genSwf.ml, std/TopLevel.as: added FSCommand2 support. 2006-02-01 02:02 ncannasse * swflib/: actionScript.ml, swf.ml: added FSCommand2 opcode (FlashLite) 2006-01-31 23:16 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.12 2006-01-31 01:25 ncannasse * mtasc/genSwf.ml: use faster swf parsing. 2006-01-31 01:14 ncannasse * swflib/: swf.ml, swfParser.ml: handled jpeg tables. 2006-01-27 19:16 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: allowed access to private variables inside local defined functions 2006-01-27 18:59 ncannasse * mtasc/std/Object.as: fixed registerClass. 2006-01-27 18:52 ncannasse * mtasc/doc/CHANGES.txt: updated 2006-01-27 18:52 ncannasse * mtasc/typer.ml: classes statics are also dynamic. 2006-01-27 18:51 ncannasse * mtasc/genSwf.ml: don't allow -keep + -header. 2006-01-24 01:13 ncannasse * swflib/: swf.ml, swfParser.ml: added partial TextInfo support (new in flash8) added support for Radial Gradients with displacement (new shape fill style in flash8). 2006-01-01 01:10 ncannasse * mtasc/std8/TextFormat.as: added missing field 2005-12-20 19:36 ncannasse * mtasc/std/: Number.as, String.as: added valueOf. 2005-12-07 16:36 ncannasse * swflib/: swf.ml, swfParser.ml: use big_rect for text (1 case found where needed 31bits bounds) 2005-12-01 16:59 ncannasse * mtasc/typer.ml: fixed warn_imports flag usage. 2005-11-30 00:19 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-11-30 00:18 ncannasse * mtasc/typer.ml: fixed resolve path for typed Arrays. allowed new and literal Array init for typed Arrays. 2005-11-29 18:55 ncannasse * mtasc/typer.ml: enable -infer + -strict 2005-11-29 18:36 ncannasse * mtasc/doc/Readme.txt: updated 2005-11-29 18:28 ncannasse * mtasc/main.ml: 1.11 2005-11-29 18:28 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-11-29 18:28 ncannasse * mtasc/typer.ml: added error on same field field (both static and member) fixed bug with with. 2005-11-29 18:20 ncannasse * mtasc/genSwf.ml: fixed bug : package name used as local. 2005-11-29 00:26 ncannasse * mtasc/genSwf.ml: fixed duplicate main calls when registerClass calls found 2005-11-26 06:54 ncannasse * mtasc/: class.ml, genSwf.ml, typer.ml: fixed Y warnings. 2005-11-26 06:48 ncannasse * swflib/swfParser.ml: fixed Y warnings. 2005-11-25 17:14 ncannasse * swflib/swfPic.ml: allowed dots in file path. 2005-11-23 00:35 ncannasse * swflib/: swf.ml, swfParser.ml, swfPic.ml: added TPlaceObject3 / F8 filters support. 2005-11-22 22:25 ncannasse * swflib/: swf.ml, swfParser.ml, swfPic.ml: added Shape4 support. 2005-11-03 08:13 ncannasse * mtasc/doc/CHANGES.txt: added some forgoten 1.10 changes 2005-10-29 01:54 ncannasse * mtasc/std8/TextFormat.as: added 2005-10-04 13:38 ncannasse * mtasc/std8/flash/geom/ColorTransform.as: added greenMultiplier. 2005-10-04 13:38 ncannasse * mtasc/doc/CHANGES.txt: update 2005-09-30 16:28 ncannasse * mtasc/doc/CHANGES.txt: update 2005-09-30 16:28 ncannasse * mtasc/genSwf.ml: catched errors in swf parsing. 2005-09-21 03:31 ncannasse * mtasc/: main.ml, typer.ml, doc/CHANGES.txt: warning imports disabled by default. 2005-09-19 21:29 ncannasse * mtasc/: std/MovieClip.as, std8/MovieClip.as, std8/System/IME.as, std8/flash/display/BitmapData.as, std8/flash/filters/BevelFilter.as, std8/flash/filters/BlurFilter.as, std8/flash/filters/ColorMatrixFilter.as, std8/flash/filters/ConvolutionFilter.as, std8/flash/filters/DisplacementMapFilter.as, std8/flash/filters/DropShadowFilter.as, std8/flash/filters/GlowFilter.as, std8/flash/filters/GradientBevelFilter.as, std8/flash/filters/GradientGlowFilter.as: some fixes 2005-09-19 20:09 ncannasse * mtasc/std/ArrayPoly.as: fixed return types (for MMC compatibility which returns Object). 2005-09-18 18:04 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: no casts when compiling for flash6 2005-09-17 23:29 ncannasse * mtasc/typer.ml: minor fix. 2005-09-17 23:22 ncannasse * mtasc/: parser.ml, typer.ml, doc/CHANGES.txt, std/ArrayParam.as, std/ArrayPoly.as: added typed arrays. 2005-09-15 17:34 ncannasse * swflib/: swf.ml, swfParser.ml: added some Flash8 tags. 2005-09-14 21:41 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.10b 2005-09-14 21:36 ncannasse * mtasc/genSwf.ml: fixed switch bug. 2005-09-13 23:34 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.10 2005-09-13 23:33 ncannasse * mtasc/: doc/CHANGES.txt, std/Button.as, std/Key.as, std/MovieClip.as, std/TextField.as, std/XMLNode.as, std8/Button.as, std8/Key.as, std8/MovieClip.as, std8/TextField.as, std8/XMLNode.as: flash8 changes. 2005-09-13 23:29 ncannasse * mtasc/main.ml: flash8 hacks. 2005-09-13 23:27 ncannasse * mtasc/std8/flash/: display/BitmapData.as, filters/DisplacementMapFilter.as: fixes 2005-09-13 23:14 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed stack problem with "for" 2005-09-13 23:08 ncannasse * mtasc/: std/Button.as, std/Key.as, std/MovieClip.as, std/XMLNode.as, std8/flash/display/BitmapData.as, std8/flash/external/ExternalInterface.as, std8/flash/filters/BevelFilter.as, std8/flash/filters/BlurFilter.as, std8/flash/filters/ColorMatrixFilter.as, std8/flash/filters/ConvolutionFilter.as, std8/flash/filters/DisplacementMapFilter.as, std8/flash/filters/DropShadowFilter.as, std8/flash/filters/GlowFilter.as, std8/flash/filters/GradientBevelFilter.as, std8/flash/filters/GradientGlowFilter.as, std8/flash/geom/Matrix.as, std8/flash/geom/Point.as, std8/flash/geom/Rectangle.as, std8/flash/geom/Transform.as, std8/flash/net/FileReference.as, std8/flash/net/FileReferenceList.as, std8/flash/text/TextRenderer.as: flash8 update. 2005-09-12 19:38 ncannasse * mtasc/std/XMLNode.as: added missing functions. 2005-09-12 15:49 ncannasse * mtasc/std/MovieClip.as: fixed f8. 2005-09-09 17:02 ncannasse * mtasc/doc/CHANGES.txt: update 2005-09-09 17:02 ncannasse * mtasc/typer.ml: fixed typing of ?: 2005-09-09 00:59 ncannasse * mtasc/: expr.ml, lexer.mll, parser.ml: removed get / set keywords. 2005-09-08 23:25 ncannasse * mtasc/genSwf.ml: fixed default cases in switch. 2005-09-05 21:20 ncannasse * mtasc/doc/CHANGES.txt: update 2005-09-05 21:19 ncannasse * mtasc/: expr.ml, genSwf.ml, parser.ml, typer.ml: changed switch implementation. 2005-09-05 21:08 ncannasse * swflib/: swf.ml, swfParser.ml: added flag for FrameLabel 2005-09-05 20:49 ncannasse * mtasc/genSwf.ml: fixed break with several stacked for..in 2005-09-05 20:39 ncannasse * mtasc/genSwf.ml: fixed stack corruption in new var(expr). 2005-09-05 20:15 ncannasse * mtasc/genSwf.ml: changed -main : now in DoAction and not InitAction. 2005-09-05 19:34 ncannasse * mtasc/genSwf.ml: fixed problem in class replace when not -keep and -mx. 2005-08-22 16:14 ncannasse * mtasc/genSwf.ml: fixed bug with trace escape sequences. 2005-08-20 00:00 ncannasse * mtasc/std8/flash/geom/Point.as: comment "add". 2005-08-20 00:00 ncannasse * mtasc/std/TopLevel.as: fixed delete and getVersion. 2005-08-19 23:59 ncannasse * mtasc/typer.ml: minor additional checks. 2005-08-19 23:59 ncannasse * mtasc/parser.ml: more syntax checks. 2005-08-19 23:58 ncannasse * mtasc/doc/CHANGES.txt: update 2005-08-19 23:58 ncannasse * mtasc/genSwf.ml: added getVersion. 2005-08-19 23:27 ncannasse * mtasc/genSwf.ml: fixed utf8 and octal escapes sequences. 2005-08-19 22:41 ncannasse * mtasc/parser.ml: fixed && and || precedence. 2005-08-19 22:17 ncannasse * mtasc/genSwf.ml: fixed escape sequences in strings. 2005-08-19 21:40 ncannasse * mtasc/: genSwf.ml, std/TopLevel.as: change in TRACE. 2005-08-19 21:40 ncannasse * mtasc/parser.ml: as keywords. fixed parsing lists. 2005-08-19 21:39 ncannasse * mtasc/: expr.ml, lexer.mll, typer.ml: as keywords. 2005-08-19 21:17 ncannasse * mtasc/genSwf.ml: added exclude wildcards. 2005-08-03 06:58 ncannasse * mtasc/typer.ml: added -infer parameter. fixed bug with += in with properties. 2005-08-03 06:57 ncannasse * mtasc/main.ml: added -infer parameter. 2005-07-29 14:40 ncannasse * mtasc/std8/flash/external/ExternalInterface.as: changed XmlNode to XMLNode. 2005-07-22 16:24 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: fixed small problem with class case and import wildcards 2005-07-18 17:25 ncannasse * mtasc/: std/Button.as, std/Key.as, std/MovieClip.as, std8/flash/display/BitmapData.as, std8/flash/external/ExternalInterface.as, std8/flash/geom/Matrix.as, std8/flash/geom/Transform.as, std8/flash/net/FileReference.as, std8/flash/net/FileReferenceList.as: new flash8 features. 2005-07-15 13:51 ncannasse * mtasc/std/MovieClip.as: added cacheAsBitmap. 2005-07-15 01:49 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-07-15 01:46 ncannasse * mtasc/genSwf.ml: fixed clips id generation. 2005-07-14 21:36 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: removed -separe, added -group 2005-07-14 20:57 ncannasse * mtasc/std8/flash/: display/BitmapData.as, filters/BitmapFilter.as, filters/DisplacementMapFilter.as, text/TextRenderer.as: fixed sub classes. 2005-07-14 20:06 ncannasse * mtasc/doc/CHANGES.txt: updated. 2005-07-14 20:05 ncannasse * mtasc/main.ml: 1.09 2005-07-14 19:57 ncannasse * mtasc/typer.ml: fixed interfaces checking (allow variance). 2005-07-14 19:29 ncannasse * mtasc/: std/MovieClip.as, std/TextField.as, std8/flash/display/BitmapData.as, std8/flash/external/ExternalInterface.as, std8/flash/filters/BevelFilter.as, std8/flash/filters/BitmapFilter.as, std8/flash/filters/BlurFilter.as, std8/flash/filters/ColorMatrixFilter.as, std8/flash/filters/ConvolutionFilter.as, std8/flash/filters/DisplacementMapFilter.as, std8/flash/filters/DropShadowFilter.as, std8/flash/filters/GlowFilter.as, std8/flash/filters/GradientBevelFilter.as, std8/flash/filters/GradientGlowFilter.as, std8/flash/geom/ColorTransform.as, std8/flash/geom/Matrix.as, std8/flash/geom/Point.as, std8/flash/geom/Rectangle.as, std8/flash/geom/Transform.as, std8/flash/net/FileReference.as, std8/flash/net/FileReferenceList.as, std8/flash/text/TextRenderer.as: flash8. 2005-07-14 19:28 ncannasse * mtasc/genSwf.ml: removed -flash6 added -version X 2005-07-13 16:43 ncannasse * mtasc/doc/CHANGES.txt: added 2005-07-13 16:21 ncannasse * mtasc/genSwf.ml: fixed problem when autoregisterclass with classname = linkagename. fixed ordering problems. 2005-07-06 23:47 ncannasse * mtasc/genSwf.ml: fixed "delete" on register. 2005-07-04 18:50 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: changed -main and algorithm for updating SWF 2005-07-04 17:56 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: added check for file name case on Win32 2005-07-04 16:43 ncannasse * mtasc/genSwf.ml: -keep with -separate replace compiled packages. 2005-07-04 16:24 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: more strict checks of interface fields 2005-06-27 16:16 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed "delete". 2005-06-24 16:00 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed problems in escape sequences 2005-06-20 21:33 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.08 2005-06-20 21:22 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: fixed bug in check for implemented interfaces 2005-06-13 17:31 ncannasse * mtasc/doc/CHANGES.txt: update 2005-06-13 17:30 ncannasse * mtasc/std/: Accessibility.as, Array.as, Boolean.as, Button.as, Color.as, ContextMenu.as, ContextMenuItem.as, Function.as, Key.as, LoadVars.as, LocalConnection.as, Mouse.as, MovieClip.as, MovieClipLoader.as, NetConnection.as, NetStream.as, Object.as, Selection.as, Sound.as, Stage.as, System.as, TextField.as, TextSnapshot.as, TopLevel.as, XMLSocket.as: fixed headers (patch from Sascha Wolter) 2005-06-13 15:19 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: removed mtasc trace message added -out 2005-06-06 22:42 ncannasse * mtasc/std/System/security.as: added loadPolicyFile 2005-06-06 16:36 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-06-06 16:36 ncannasse * mtasc/genSwf.ml: fixed parsing with instanceof 2005-06-06 16:36 ncannasse * mtasc/parser.ml: fixed try with no catchs. 2005-06-02 23:48 ncannasse * mtasc/doc/CHANGES.txt: update 2005-06-02 23:48 ncannasse * mtasc/genSwf.ml: renamed and hide variable defined by main. 2005-06-02 23:41 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-06-02 23:40 ncannasse * mtasc/genSwf.ml: fixed getUrl2 stack. 2005-05-31 20:07 ncannasse * mtasc/std/ContextMenu.as: added missing. 2005-05-30 18:28 ncannasse * swflib/swf.ml: mutable header 2005-05-28 17:00 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.07 2005-05-28 16:55 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-05-28 16:55 ncannasse * mtasc/parser.ml: fixed for(;cond;incr) parsing error fixed (unop) expr ? parsing error 2005-05-28 16:55 ncannasse * mtasc/main.ml: added "/" in classpath. 2005-05-28 16:09 ncannasse * mtasc/genSwf.ml: fixed -main repetition on swf update. 2005-05-26 13:40 ncannasse * mtasc/std/TopLevel.as: fixed type of "print". 2005-05-26 13:39 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: added deprecated keywords usage error. 2005-05-26 10:28 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt, std/TopLevel.as: added "print". 2005-05-24 10:48 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-05-24 10:43 ncannasse * mtasc/std/SharedObject.as: getRemote argument to Object. 2005-05-24 10:42 ncannasse * mtasc/typer.ml: added 'con' error message. 2005-05-23 08:56 ncannasse * mtasc/doc/CHANGES.txt: update 2005-05-23 08:56 ncannasse * mtasc/genSwf.ml: fixed -keep + -main 2005-05-20 19:02 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.06 2005-05-19 18:53 ncannasse * swflib/swfParser.ml: use IO bits. 2005-05-19 10:40 ncannasse * swflib/: png.ml, png.mli: added make and write, changed API. 2005-05-19 10:39 ncannasse * swflib/swfPic.ml: fixed png changes 2005-05-19 08:00 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed Malformed_expression when using >32 bits integers 2005-05-19 07:45 ncannasse * mtasc/std/Object.as: added valueOf 2005-05-17 12:30 ncannasse * swflib/: png.ml, png.mli, swfPic.ml: fixed premult alpha problems. 2005-05-16 15:21 ncannasse * swflib/: png.ml, png.mli, swfPic.ml: added filter options. 2005-05-16 14:57 ncannasse * swflib/: swflib.dsp, swflib.dsw: removed. 2005-05-16 14:57 ncannasse * swflib/: install.bat, swflib.vcproj: added swfPic and Png 2005-05-16 14:57 ncannasse * swflib/: png.ml, png.mli, swfPic.ml: added 2005-05-13 09:44 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: main now takes "this" as parameter and is delayed (onEnterFrame) 2005-05-12 20:14 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed bug with auto register class 2005-05-07 17:01 ncannasse * mtasc/genSwf.ml: fixed 32K limit calculation (2) 2005-05-07 15:49 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed 32K limit calculation 2005-05-07 15:40 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed IO.No_more_input message 2005-05-01 10:30 ncannasse * mtasc/doc/CHANGES.txt: update 2005-05-01 10:26 ncannasse * mtasc/typer.ml: remove "return" in contructors restriction (allowed by MMC) import warnings disabled for mx classes when -mx 2005-05-01 10:26 ncannasse * mtasc/parser.ml: fixed missing "," between function call parameters 2005-04-30 12:23 ncannasse * mtasc/main.ml: 1.05 2005-04-30 12:23 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-04-30 12:21 ncannasse * mtasc/typer.ml: forbid contructor returns and return type (modified headers) 2005-04-30 12:20 ncannasse * mtasc/parser.ml: fixed operators priority for | ^ & against >> and % against * / 2005-04-30 12:20 ncannasse * mtasc/class.ml: fixed calls to super getter/setter problem 2005-04-30 12:20 ncannasse * mtasc/genSwf.ml: fixed class ordering problem with -keep fixed calls to super getter/setter problem 2005-04-30 11:13 ncannasse * mtasc/std/: Date.as, Number.as, SharedObject.as, String.as, TextFormat.as, XML.as, XMLNode.as: removed "Void" from constructors. 2005-04-21 23:03 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: register only one time the package. errors on 32K bytecode size limit reached. 2005-04-21 22:21 ncannasse * mtasc/: main.ml, parser.ml, typer.ml, doc/CHANGES.txt: warning when import not used (no longer add class) fixed error message when class not found 2005-04-21 13:33 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: error when multiple extends, interface cannot extends class 2005-04-21 13:31 ncannasse * mtasc/parser.ml: fixed left-assoc of binop numerics 2005-04-18 09:51 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed operator priority 2005-04-18 09:44 ncannasse * mtasc/typer.ml: fixed type required to String for for...in variable 2005-04-15 10:24 ncannasse * mtasc/: expr.ml, genSwf.ml, parser.ml, typer.ml, doc/CHANGES.txt: fixed compiler crash in "try" fixed boolean operators typing : returns most common type 2005-04-14 11:33 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.04 2005-04-14 11:23 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt, std/TopLevel.as: added -flash6 , -trace and bgcolor in header. 2005-04-09 11:44 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: fixed bug when catching "imported" exception class changed boolean operators typing. 2005-04-07 09:32 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed typing error with single "var" in a block fixed parser error with a?b:c and big left-expression 2005-04-01 18:30 ncannasse * mtasc/parser.ml: fixed for parsing bug. 2005-03-30 08:44 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: import fixes 2005-03-29 17:11 ncannasse * mtasc/: expr.ml, parser.ml, doc/CHANGES.txt: "for" optional first parameter and expression fixed while( o )++ i; 2005-03-29 16:16 ncannasse * mtasc/.cvsignore: ignore "test"directory 2005-03-27 02:25 ncannasse * mtasc/genSwf.ml: swf warnings off 2005-03-27 02:25 ncannasse * swflib/: swf.ml, swfParser.ml: warnings. 2005-03-25 23:09 ncannasse * extc/extc_stubs.c: fixed bsd error. 2005-03-24 18:44 ncannasse * mtasc/: main.ml, doc/CHANGES.txt, doc/Readme.txt: 1.03 2005-03-24 18:30 ncannasse * mtasc/: genSwf.ml, std/TopLevel.as, doc/CHANGES.txt: fixed trace 2005-03-18 18:04 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed bitshift operator priority 2005-03-17 23:19 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed 820 size limit for -header 2005-03-17 16:53 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: relaxed array access typing 2005-03-17 16:15 ncannasse * mtasc/std/TextField.as: autoSize is now object 2005-03-17 16:11 ncannasse * mtasc/std/SharedObject.as: added clear 2005-03-17 00:56 ncannasse * mtasc/: doc/CHANGES.txt, expr.ml, main.ml, typer.ml: added check function for values without side effects 2005-03-17 00:39 ncannasse * mtasc/std/Object.as: added __proto__ and constructor. 2005-03-17 00:38 ncannasse * mtasc/std/System/: capabilities.as, security.as: added 2005-03-17 00:32 ncannasse * mtasc/genSwf.ml: mtasc classes after mx components. 2005-03-15 00:32 ncannasse * mtasc/std/LocalConnection.as: dynamic 2005-03-14 20:58 ncannasse * extc/extc_stubs.c: added executable_path for mac 2005-03-10 17:50 ncannasse * mtasc/: class.ml, doc/CHANGES.txt: fixed interface extends interface. 2005-03-10 16:29 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.02 2005-03-10 16:25 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed instanceof & typeof parsing. 2005-03-09 15:01 ncannasse * mtasc/: lexer.mll, doc/CHANGES.txt: added scientific floats. 2005-03-09 03:08 ncannasse * mtasc/typer.ml: removed "with" warning. 2005-03-09 02:36 ncannasse * mtasc/: expr.ml, genSwf.ml, lexer.mll, parser.ml, typer.ml, doc/CHANGES.txt: added with and _level's 2005-03-06 18:02 ncannasse * mtasc/doc/CHANGES.txt: update 2005-03-06 18:01 ncannasse * mtasc/typer.ml: fixed "prototype" static resolved. 2005-03-06 18:00 ncannasse * mtasc/parser.ml: fixed typeof syntax & removed warning for components. 2005-03-06 04:23 ncannasse * mtasc/: main.ml, mtasc.dsp, mtasc.vcproj, doc/install.ml: removed checker. 2005-03-02 23:32 ncannasse * mtasc/main.ml: relaxed uppercase letter on argv files 2005-03-02 16:58 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: added getURL with one argument only. 2005-03-02 03:22 ncannasse * mtasc/typer.ml: minor : relaxed error message on setters. 2005-02-28 16:32 ncannasse * mtasc/: main.ml, typer.ml, doc/CHANGES.txt: fixed "class Number not found" when no std relaxed restriction on input file names 2005-02-25 16:44 ncannasse * mtasc/genSwf.ml: test if class already exists + -frame with -header. 2005-02-25 16:13 ncannasse * mtasc/doc/CHANGES.txt: test if class already exists. 2005-02-22 00:39 ncannasse * mtasc/genSwf.ml: remove traces 2005-02-21 23:20 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.01 2005-02-21 23:18 ncannasse * mtasc/typer.ml: fixed inherited statics and super constructor typecheck. 2005-02-21 23:18 ncannasse * mtasc/genSwf.ml: fixed return in for..in bug. 2005-02-11 01:29 ncannasse * mtasc/std/TopLevel.as: arguments fix 2005-02-10 23:44 ncannasse * mtasc/std/FunctionArguments.as: added 2005-02-07 17:33 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: added -exclude 2005-02-07 17:29 ncannasse * swflib/actionScript.ml: added 0x9E / CallFrame 2005-02-07 16:14 ncannasse * mtasc/: lexer.mll, doc/CHANGES.txt: dollars in identifiers 2005-02-03 19:48 ncannasse * mtasc/: genSwf.ml, std/TopLevel.as: added fscommand. 2005-02-02 21:17 ncannasse * mtasc/doc/CHANGES.txt: update 2005-02-02 21:15 ncannasse * mtasc/: typer.ml, genSwf.ml: fixed break in for..in 2005-02-01 17:28 ncannasse * mtasc/std/: ContextMenu.as, ContextMenuItem.as: added 2005-02-01 17:25 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-02-01 17:24 ncannasse * mtasc/typer.ml: fixed error in inherited statics 2005-01-31 23:33 ncannasse * mtasc/genSwf.ml: fixed toNumber 2005-01-31 17:28 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed type conversions instead of cast. 2005-01-28 00:17 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed doaction+showframe invertion. 2005-01-27 01:00 ncannasse * mtasc/main.ml: small fix for macosx executable path failure. 2005-01-27 00:23 ncannasse * extc/extc_stubs.c: fixed executable_path. 2005-01-26 20:10 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: 1.0 2005-01-26 19:53 ncannasse * mtasc/: genSwf.ml, main.ml, parser.ml, typer.ml: added -mx 2005-01-25 17:38 ncannasse * mtasc/std/Array.as: relaxed sort. 2005-01-24 19:49 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: Void unify with Any. 2005-01-21 19:32 ncannasse * mtasc/doc/CHANGES.txt: minor. 2005-01-21 19:30 ncannasse * mtasc/typer.ml: relaxed new so constructor can return any value. 2005-01-19 16:36 ncannasse * mtasc/doc/CHANGES.txt: updated 2005-01-19 16:34 ncannasse * mtasc/genSwf.ml: fixed -separate with -main issues 2005-01-19 16:25 ncannasse * mtasc/genSwf.ml: fixed super fields access 2005-01-14 00:11 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: rc2 2005-01-14 00:00 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: fixed bug in enum added superconstructor autocall added -separate 2005-01-13 16:43 ncannasse * mtasc/typer.ml: fixed multi-interface subtyping. 2005-01-13 01:44 ncannasse * mtasc/typer.ml: fixed constructor handling. 2005-01-12 00:15 ncannasse * mtasc/parser.ml: fixed typeof parsing. 2005-01-12 00:14 ncannasse * mtasc/main.ml: fixed package compilation 2005-01-11 20:26 ncannasse * mtasc/std/Error.as: added 2005-01-07 01:36 ncannasse * mtasc/parser.ml: re-fix for throw (optional parenthesis). 2005-01-07 01:34 ncannasse * mtasc/doc/CHANGES.txt: update 2005-01-07 01:34 ncannasse * mtasc/parser.ml: fixed small parsing problem with typeof 2005-01-05 00:53 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: fixed fun / Function unification. 2005-01-05 00:23 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed throw parsing. 2005-01-04 19:42 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: rc1 2005-01-04 19:36 ncannasse * mtasc/: parser.ml, typer.ml: fixed new with variable class name. 2004-12-29 21:21 ncannasse * mtasc/genSwf.ml: enable utf8 string. 2004-12-22 00:11 ncannasse * mtasc/doc/CHANGES.txt: updated 2004-12-21 23:30 ncannasse * mtasc/: expr.ml, genSwf.ml, lexer.mll, parser.ml, typer.ml: added exceptions : try/catch/finally/throw. 2004-12-21 23:20 ncannasse * mtasc/std/TopLevel.as: added throw 2004-12-21 21:59 ncannasse * swflib/: actionScript.ml, swf.ml: added try opcode. 2004-12-21 20:53 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: main no more default. 2004-12-17 20:14 ncannasse * mtasc/doc/CHANGES.txt: update 2004-12-17 20:13 ncannasse * mtasc/main.ml: added warning when package is missing. 2004-12-17 20:13 ncannasse * mtasc/std/TopLevel.as: trace takes any object. 2004-12-13 21:23 ncannasse * mtasc/std/NetConnection.as: dynamic 2004-12-10 21:48 ncannasse * mtasc/doc/CHANGES.txt: update. 2004-12-10 21:43 ncannasse * mtasc/typer.ml: private methods can be accessed by childs. 2004-12-10 21:43 ncannasse * mtasc/genSwf.ml: added main, fixed super calls (no super bindings). 2004-12-08 22:04 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: beta7 2004-12-08 21:54 ncannasse * mtasc/typer.ml: allowed private access to local class variables in lambdas 2004-12-07 17:13 ncannasse * mtasc/parser.ml: fixed multiple implements syntax 2004-12-07 16:31 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: no strict mode for native classes. 2004-12-01 19:55 ncannasse * mtasc/doc/CHANGES.txt: minor. 2004-12-01 19:54 ncannasse * mtasc/typer.ml: fixed bug when accessing superclass in static. 2004-12-01 17:29 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: released restriction on super. 2004-11-30 16:42 ncannasse * swflib/install.bat: added 2004-11-30 16:42 ncannasse * swflib/: swf.ml, swfParser.ml: added video tags. 2004-11-30 04:11 ncannasse * mtasc/: class.ml, genSwf.ml, typer.ml, doc/CHANGES.txt: fixed missing implementation of import wildcards for genSwf 2004-11-30 02:08 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt: pop instead of trace for string mark. 2004-11-30 01:12 ncannasse * mtasc/doc/CHANGES.txt: minors. 2004-11-30 01:12 ncannasse * mtasc/typer.ml: fixed imports in lambdas. 2004-11-23 00:17 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: beta6 2004-11-23 00:12 ncannasse * mtasc/doc/CHANGES.txt: typeof as operator. 2004-11-22 23:39 ncannasse * mtasc/parser.ml: typeof as operator. 2004-11-19 18:28 ncannasse * mtasc/doc/CHANGES.txt: update 2004-11-19 18:25 ncannasse * mtasc/typer.ml: fixed super when no super. 2004-11-19 18:25 ncannasse * mtasc/class.ml: fixed auto import. 2004-11-18 20:18 ncannasse * mtasc/: expr.ml, lexer.mll, parser.ml, typer.ml, doc/CHANGES.txt, std/Object.as, std/TextField.as: some fixes so mx package is compiling. 2004-11-18 20:11 ncannasse * mtasc/std/TextField/StyleSheet.as: package 2004-11-17 21:05 ncannasse * mtasc/parser.ml: fixed stack overflow when parsing metadata. 2004-11-17 20:51 ncannasse * mtasc/std/: Camera.as, Microphone.as, PrintJob.as: added 2004-11-17 20:50 ncannasse * mtasc/parser.ml: fixed function name "get" or "set". 2004-11-17 19:45 ncannasse * mtasc/std/: Accessibility.as, AsBroadcaster.as, Button.as, NetStream.as, Selection.as: added 2004-11-17 19:40 ncannasse * mtasc/std/: NetConnection.as, Video.as: added. 2004-11-17 18:59 ncannasse * mtasc/doc/CHANGES.txt: minors. 2004-11-17 18:33 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: beta 5 2004-11-16 23:47 ncannasse * extc/: extc.ml, extc_stubs.c: added support for *nix executable path 2004-11-13 06:22 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed parser for a (op) b ? x : x' 2004-11-12 17:35 ncannasse * mtasc/: main.ml, typer.ml: added -strict 2004-11-11 22:13 ncannasse * mtasc/lexer.mll: fixed problem with float '.' 2004-11-11 17:56 ncannasse * mtasc/: lexer.mll, doc/CHANGES.txt: fixed lexer for mac newlines. 2004-11-11 17:03 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: fixed Function object unify with any function. 2004-11-11 17:02 ncannasse * mtasc/doc/CHANGES.txt: update 2004-11-11 17:02 ncannasse * mtasc/doc/INSTALL.txt: improved changes. 2004-11-11 16:59 ncannasse * mtasc/mtasc.vcproj: added swfLib 2004-11-11 16:59 ncannasse * mtasc/lexer.mll: fixed numbers starting with '.' 2004-11-10 13:49 ncannasse * mtasc/: parser.ml, doc/CHANGES.txt: fixed multivariable ops, added delete call without parenthesis 2004-11-10 04:14 ncannasse * mtasc/: class.ml, genSwf.ml, doc/CHANGES.txt: fixed init member variable value generation. 2004-11-10 03:33 ncannasse * mtasc/doc/CHANGES.txt: hotfix 2004-11-10 03:33 ncannasse * mtasc/mtasc.vcproj: use swflib. 2004-11-10 03:30 ncannasse * mtasc/parser.ml: fixed assign for multiple assign. 2004-11-10 03:30 ncannasse * mtasc/genSwf.ml: fixed retval for double assignations, added Swfparser init. 2004-11-10 03:03 ncannasse * swflib/: swflib.sln, swflib.vcproj: added 2004-11-10 03:02 ncannasse * swflib/swfParser.ml: added init 2004-11-10 01:59 ncannasse * swflib/actionScript.ml: added some protection for overflows 2004-11-10 01:48 ncannasse * mtasc/doc/CHANGES.txt: update 2004-11-10 01:47 ncannasse * mtasc/genSwf.ml: minor fix (package name). 2004-11-10 01:33 ncannasse * mtasc/main.ml: beta4 2004-11-10 01:26 ncannasse * mtasc/doc/CHANGES.txt: beta4 2004-11-10 01:26 ncannasse * mtasc/genSwf.ml: support for AS2 class from flash IDE + fixed inheritance bug. 2004-11-10 00:58 ncannasse * mtasc/main.ml: added -pack option. 2004-11-10 00:55 ncannasse * mtasc/typer.ml: fixed error when null pos. 2004-11-10 00:30 ncannasse * mtasc/genSwf.ml: added arguments. 2004-11-10 00:16 ncannasse * mtasc/std/TopLevel.as: added arguments. 2004-11-10 00:12 ncannasse * mtasc/typer.ml: fixed error messages for unknown variable added import wildcards 2004-11-10 00:06 ncannasse * mtasc/: mtasc.sln, mtasc.vcproj: added 2004-11-09 20:24 ncannasse * mtasc/: genSwf.ml, doc/CHANGES.txt, std/TopLevel.as: added targetPath. 2004-11-06 10:00 ncannasse * mtasc/typer.ml: fixed bug when accessing local class 2004-11-05 08:53 ncannasse * mtasc/main.ml: priority of std. 2004-11-04 10:53 ncannasse * mtasc/: typer.ml, doc/CHANGES.txt: class import itself. 2004-11-03 16:05 ncannasse * mtasc/doc/CHANGES.txt: updated. 2004-11-03 15:59 ncannasse * mtasc/typer.ml: fixed interface A extends B. 2004-11-03 12:28 ncannasse * mtasc/: genSwf.ml, typer.ml: improved getter/setters and allowed static ones. 2004-11-03 10:52 ncannasse * mtasc/: main.ml, doc/CHANGES.txt: beta3 2004-11-03 10:42 ncannasse * mtasc/genSwf.ml: added -frame and -header, fixed classes removal. 2004-11-03 10:38 ncannasse * swflib/swf.ml: added to_float16 2004-11-03 10:38 ncannasse * swflib/swfZip.ml: removed SIZE print. 2004-11-03 09:54 ncannasse * mtasc/std/StdPresent.as: added to detect std. 2004-11-03 09:52 ncannasse * mtasc/: expr.ml, genSwf.ml, parser.ml, typer.ml: added getter/setter. 2004-11-03 09:51 ncannasse * mtasc/main.ml: added check for std. 2004-10-31 21:51 ncannasse * mtasc/: class.ml, expr.ml, genSwf.ml, main.ml, mtasc.dsp, typer.ml: added casts , eval, genswf as plugin. 2004-10-31 20:42 ncannasse * mtasc/doc/install.ml: fixed anonymous login (empty passwd). 2004-10-31 20:42 ncannasse * mtasc/std/TopLevel.as: added eval. 2004-10-29 00:54 ncannasse * mtasc/doc/Readme.linux: linux bin. 2004-10-28 21:56 ncannasse * extc/Makefile: windows specific... 2004-10-28 21:55 ncannasse * extc/LICENSE, mtasc/LICENSE, swflib/LICENSE: added some license 2004-10-28 21:44 ncannasse * mtasc/doc/INSTALL.txt: minor. 2004-10-28 21:37 ncannasse * mtasc/doc/: INSTALL.txt, install.ml: fixes to build with 3.07 and linux. 2004-10-28 21:30 ncannasse * extc/extc_stubs.c: String_val et pas Val_string 2004-10-28 20:47 ncannasse * mtasc/doc/install.ml: fixed swflib case 2004-10-28 16:23 ncannasse * mtasc/: expr.ml, genSwf.ml, lexer.mll, parser.ml, typer.ml, doc/CHANGES.txt: added physical (in)equality operation. 2004-10-28 12:43 ncannasse * mtasc/doc/: INSTALL.txt, install.ml: added 2004-10-28 12:00 ncannasse * extc/extc.ml, extc/extc.mli, extc/extc_stubs.c, extc/test.ml, mtasc/class.ml, mtasc/expr.ml, mtasc/genSwf.ml, mtasc/lexer.mll, mtasc/main.ml, mtasc/parser.ml, mtasc/plugin.ml, mtasc/typer.ml, swflib/actionScript.ml, swflib/swf.ml, swflib/swfParser.ml, swflib/swfZip.ml: added copyright headers. 2004-10-28 11:52 ncannasse * mtasc/: main.ml, mtasc.dsp: changed from osdep to extc. 2004-10-28 11:52 ncannasse * swflib/swfZip.ml: changed from camlzip to extc. 2004-10-28 11:48 ncannasse * extc/extc.ml: fixed buffer size, flush, and compression level. 2004-10-28 11:16 ncannasse * extc/: Makefile, extc.ml, extc.mli, extc_stubs.c, test.ml: added 2004-10-28 11:07 ncannasse * mtasc/doc/CHANGES.txt: updated 2004-10-28 11:07 ncannasse * mtasc/typer.ml: added class/interf check when extends/implements and modified s_type_decl 2004-10-27 15:38 ncannasse * mtasc/: class.ml, expr.ml, genSwf.ml, lexer.mll, main.ml, mtasc.dsp, parser.ml, typer.ml, doc/CHANGES.txt: removed naming convention, new build mode update swf. 2004-10-27 11:53 ncannasse * mtasc/: class.ml, expr.ml, genSwf.ml, lexer.mll, main.ml, mtasc.dsp, parser.ml, typer.ml: metadata , superconstructor, unify Static -> Function, remove AS2 classes (and -keep) and import * parsing. 2004-10-25 15:46 ncannasse * mtasc/: main.ml, std/Object.as: beta1 last fixes 2004-10-25 15:24 ncannasse * mtasc/: class.ml, genSwf.ml, parser.ml, typer.ml, std/TopLevel.as: working. 2004-10-22 21:04 ncannasse * mtasc/: class.ml, expr.ml, genSwf.ml, lexer.mll, main.ml, mtasc.dsp, parser.ml, typer.ml, std/Date.as, std/Number.as, std/Object.as, std/SharedObject.as, std/String.as, std/TextFormat.as, std/TopLevel.as, std/XML.as, std/XMLNode.as, std/TextField/StyleSheet.as: almost working. 2004-10-22 15:22 ncannasse * mtasc/std/: Array.as, Boolean.as, Color.as, Date.as, Function.as, Key.as, LoadVars.as, LocalConnection.as, Math.as, Mouse.as, MovieClip.as, MovieClipLoader.as, Number.as, Object.as, SharedObject.as, Sound.as, Stage.as, String.as, System.as, TextField.as, TextFormat.as, TopLevel.as, XML.as, XMLNode.as, XMLSocket.as, TextField/StyleSheet.as: added 2004-10-20 21:24 ncannasse * mtasc/: .cvsignore, expr.ml, lexer.mll, main.ml, mtasc.dsp, mtasc.dsw, parser.ml, plugin.ml, typer.ml: forked from mtypes. 2004-08-15 20:36 ncannasse * swflib/actionScript.ml: macromedia doubles. 2004-07-27 16:18 ncannasse * swflib/: swf.ml, swfZip.ml: fixed for new IO. 2004-07-16 17:51 ncannasse * swflib/swfZip.ml: added. 2004-07-16 17:51 ncannasse * swflib/swf.ml: minor update. 2004-07-16 17:51 ncannasse * swflib/actionScript.ml: fixed printer. 2004-07-14 00:58 ncannasse * swflib/: actionScript.ml, swf.ml: added needs for genSwf. 2004-06-16 18:20 ncannasse * swflib/: swf.ml, swfParser.ml: added place object events. 2004-06-11 21:08 ncannasse * swflib/actionScript.ml: fixed with (2). 2004-06-11 21:06 ncannasse * swflib/: actionScript.ml, swf.ml: fixed with. 2004-06-08 15:37 ncannasse * swflib/actionScript.ml: fixed With opcode (len = 2). 2004-05-18 18:59 ncannasse * swflib/swfParser.ml: fixed shape length bug. 2004-05-18 17:53 ncannasse * swflib/: swf.ml, swfParser.ml: added shapes and text2. 2004-05-11 15:47 ncannasse * swflib/swfParser.ml: fixed write bits overflow. 2004-04-26 22:49 ncannasse * swflib/swfParser.ml: fixed button2 actions. 2004-04-08 17:36 ncannasse * swflib/: swf.ml, swfParser.ml: added text and edit_text. 2004-04-07 23:34 ncannasse * swflib/: swf.ml, swfParser.ml: added shapes styles. 2004-04-07 17:14 ncannasse * swflib/: swf.ml, swfParser.ml: fixed extended, added remove_object and mutable cids. 2004-04-07 00:58 ncannasse * swflib/: swf.ml, swfParser.ml: completed tag infos. 2004-04-04 20:31 ncannasse * swflib/swfParser.ml: replace ui32 by i32. 2004-04-01 21:08 ncannasse * swflib/: swf.ml, swfParser.ml: added compression. 2004-04-01 17:11 ncannasse * swflib/: actionScript.ml, swf.ml, swfParser.ml, tools.ml: switched to extlib IO. 2004-03-07 03:38 ncannasse * swflib/: actionScript.ml, swf.ml, swfParser.ml, swflib.dsp, tools.ml: finished parser. 2004-03-01 02:19 ncannasse * swflib/: swf.ml, swflib.dsp, swflib.dsw: initial import. mtasc-1.14/ocaml/0000750000175000017500000000000011155145527012276 5ustar pabspabsmtasc-1.14/ocaml/mtasc/0000750000175000017500000000000011155145531013400 5ustar pabspabsmtasc-1.14/ocaml/mtasc/expr.ml0000640000175000017500000001755410310067001014710 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type pos = { pfile : string; pmin : int; pmax : int; } type keyword = | Function | Class | Var | If | Else | While | Do | For | Break | Continue | Return | Interface | Extends | Implements | Import | Switch | Case | Default | Static | Intrinsic | Dynamic | Public | Private | Try | Catch | Finally | With | In | InstanceOf | New | This | Throw | Typeof | Delete | Void (* deprecated *) | Add | And | Or | Eq | Ne | KwdNot | Le | Lt | Ge | Gt | IfFrameLoaded | On | OnClipEvent | TellTarget type binop = | OpAdd | OpMult | OpDiv | OpSub | OpAssign | OpEq | OpPhysEq | OpNotEq | OpPhysNotEq | OpGt | OpGte | OpLt | OpLte | OpAnd | OpOr | OpXor | OpBoolAnd | OpBoolOr | OpShl | OpShr | OpUShr | OpMod | OpAssignOp of binop type unop = | Increment | Decrement | Not | Neg | NegBits type constant = | Int of string | Float of string | String of string | Ident of string type token = | Eof | Const of constant | Kwd of keyword | Comment of string | CommentLine of string | Binop of binop | Unop of unop | Next | Sep | BrOpen | BrClose | BkOpen | BkClose | POpen | PClose | Dot | DblDot | Question | Sharp type unop_flag = | Prefix | Postfix type while_flag = | NormalWhile | DoWhile type static_flag = | IsMember | IsStatic type public_flag = | IsPublic | IsPrivate type getter_flag = | Normal | Getter | Setter type type_path = string list * string type func = { fname : string; fargs : (string * type_path option) list; ftype : type_path option; fstatic : static_flag; fpublic : public_flag; fgetter : getter_flag; fexpr : expr option; } and herit = | HExtends of type_path | HImplements of type_path | HIntrinsic | HDynamic and eval_def = | EConst of constant | EArray of eval * eval | EBinop of binop * eval * eval | EField of eval * string | EParenthesis of eval | EObjDecl of (string * eval) list | EArrayDecl of eval list | ECall of eval * eval list | ENew of eval * eval list | EUnop of unop * unop_flag * eval | EQuestion of eval * eval * eval | ELambda of func | EStatic of type_path | ECast of eval * eval and eval = eval_def * pos and expr_def = | EVars of static_flag * public_flag * (string * type_path option * eval option) list | EFunction of func | EBlock of expr list | EFor of expr list * eval list * eval list * expr | EForIn of expr * eval * expr | EIf of eval * expr * expr option | EWhile of eval * expr * while_flag | ESwitch of eval * (eval option * expr) list | ETry of expr * (string * type_path option * expr) list ref * expr option | EWith of eval * expr | EReturn of eval option | EBreak | EContinue | EVal of eval and expr = expr_def * pos and sign_def = | EClass of type_path * herit list * expr | EInterface of type_path * herit list * expr | EImport of string list * string option and signature = sign_def * pos let pos = snd let is_postfix (e,_) = function | Increment | Decrement -> (match e with EConst _ | EField _ | EStatic _ | EArray _ -> true | _ -> false) | Not | Neg | NegBits -> false let is_prefix = function | Increment | Decrement -> true | Not | Neg | NegBits -> true let base_class_name = snd let null_pos = { pfile = ""; pmin = -1; pmax = -1 } let set_eval (e : eval) (v : eval_def) = Obj.set_field (Obj.repr e) 0 (Obj.repr v) let punion p p2 = { pfile = p.pfile; pmin = min p.pmin p2.pmin; pmax = max p.pmax p2.pmax; } let s_type_path (p,s) = match p with [] -> s | _ -> String.concat "." p ^ "." ^ s let s_escape s = let b = Buffer.create (String.length s) in for i = 0 to (String.length s) - 1 do match s.[i] with | '\n' -> Buffer.add_string b "\\n" | '\t' -> Buffer.add_string b "\\t" | '\r' -> Buffer.add_string b "\\r" | c -> Buffer.add_char b c done; Buffer.contents b let s_constant = function | Int s -> s | Float s -> s | String s -> "\"" ^ s_escape s ^ "\"" | Ident s -> s let s_keyword = function | Function -> "function" | Class -> "class" | Static -> "static" | Var -> "var" | If -> "if" | Else -> "else" | While -> "while" | Do -> "do" | For -> "for" | Break -> "break" | Return -> "return" | Continue -> "continue" | Interface -> "interface" | Extends -> "extends" | Implements -> "implements" | Import -> "import" | Switch -> "switch" | Case -> "case" | Default -> "default" | Intrinsic -> "intrinsic" | Dynamic -> "dynamic" | Private -> "private" | Public -> "public" | Try -> "try" | Catch -> "catch" | Finally -> "finally" | With -> "with" | In -> "in" | InstanceOf -> "instanceof" | New -> "new" | This -> "this" | Throw -> "throw" | Typeof -> "typeof" | Delete -> "delete" | Void -> "void" (* deprecated *) | Add -> "add" | And -> "and" | Or -> "or" | Eq -> "eq" | Ne -> "ne" | KwdNot -> "not" | Le -> "le" | Lt -> "lt" | Ge -> "ge" | Gt -> "gt" | IfFrameLoaded -> "ifFrameLoaded" | On -> "on" | OnClipEvent -> "onClipEvent" | TellTarget -> "tellTarget" let rec s_binop = function | OpAdd -> "+" | OpMult -> "*" | OpDiv -> "/" | OpSub -> "-" | OpAssign -> "=" | OpEq -> "==" | OpPhysEq -> "===" | OpNotEq -> "!=" | OpPhysNotEq -> "!==" | OpGte -> ">=" | OpLte -> "<=" | OpGt -> ">" | OpLt -> "<" | OpAnd -> "&" | OpOr -> "|" | OpXor -> "^" | OpBoolAnd -> "&&" | OpBoolOr -> "||" | OpShr -> ">>" | OpUShr -> ">>>" | OpShl -> "<<" | OpMod -> "%" | OpAssignOp op -> s_binop op ^ "=" let s_unop = function | Increment -> "++" | Decrement -> "--" | Not -> "!" | Neg -> "-" | NegBits -> "~" let s_token = function | Eof -> "" | Const c -> s_constant c | Kwd k -> s_keyword k | Comment s -> "/*"^s^"*/" | CommentLine s -> "//"^s | Binop o -> s_binop o | Unop o -> s_unop o | Next -> ";" | Sep -> "," | BkOpen -> "[" | BkClose -> "]" | BrOpen -> "{" | BrClose -> "}" | POpen -> "(" | PClose -> ")" | Dot -> "." | DblDot -> ":" | Question -> "?" | Sharp -> "#" exception Invalid_expression of pos let rec check_val (v,p) = match v with | EBinop (OpAssign,_,_) | EBinop (OpAssignOp _,_,_) | ECall _ | EUnop (Increment,_,_) | EUnop (Decrement,_,_) | EQuestion _ -> () | ENew _ | EConst _ | EArray _ | EBinop _ | EField _ | EObjDecl _ | EArrayDecl _ | EUnop _ | ELambda _ | EStatic _ | ECast _ -> raise (Invalid_expression p) | EParenthesis v -> check_val v let rec check_expr (e,p) = match e with | EVars (_,_,vl) -> () | EFunction f -> (match f.fexpr with None -> () | Some e -> check_expr e) | EBlock el -> List.iter check_expr el | EFor (el, _ , _ , e ) -> List.iter check_expr el; check_expr e | EForIn (_,_,e) -> check_expr e | EIf (_,e,eo) -> check_expr e; (match eo with None -> () | Some e -> check_expr e) | EWhile (_,e,_) -> check_expr e | ESwitch (_,cl) -> List.iter (fun (_,e) -> check_expr e) cl; | ETry (e,cl,eo) -> check_expr e; List.iter (fun (_,_,e) -> check_expr e) !cl; (match eo with None -> () | Some e -> check_expr e) | EWith (_,e) -> check_expr e; | EReturn _ | EBreak | EContinue -> () | EVal v -> check_val v let check_sign (s,p) = match s with | EClass (_,_,e) -> check_expr e | EInterface (_,_,e) -> check_expr e | EImport _ -> () mtasc-1.14/ocaml/mtasc/lexer.mll0000640000175000017500000001711010310067001015211 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) { open Lexing open Expr type error_msg = | Invalid_character of char | Unterminated_string | Unclosed_comment exception Error of error_msg * pos let error_msg = function | Invalid_character c when int_of_char c > 32 && int_of_char c < 128 -> Printf.sprintf "Invalid character '%c'" c | Invalid_character c -> Printf.sprintf "Invalid character 0x%.2X" (int_of_char c) | Unterminated_string -> "Unterminated string" | Unclosed_comment -> "Unclosed comment" let cur_file = ref "" let all_lines = Hashtbl.create 0 let lines = ref [] let buf = Buffer.create 100 let error e pos = raise (Error (e,{ pmin = pos; pmax = pos; pfile = !cur_file })) let keywords = let h = Hashtbl.create 3 in List.iter (fun k -> Hashtbl.add h (s_keyword k) k) [Function;Class;Static;Var;If;Else;While;Do;For; Break;Return;Continue;Interface;Extends;Implements;Import; Switch;Case;Default;Intrinsic;Dynamic;Public;Private;Try; Catch;Finally;With; In;InstanceOf;New;This;Throw;Typeof;Delete;Void; Add;And;Or;Eq;Ne;KwdNot;Le;Lt;Ge;Gt;IfFrameLoaded;On;OnClipEvent;TellTarget]; h let init file = cur_file := file; lines := [] let save_lines() = Hashtbl.replace all_lines !cur_file !lines let save() = save_lines(); !cur_file let restore file = save_lines(); cur_file := file; lines := Hashtbl.find all_lines file let newline lexbuf = lines := (lexeme_end lexbuf) :: !lines let find_line p lines = let rec loop n delta = function | [] -> n , p - delta | lp :: l when lp > p -> n , p - delta | lp :: l -> loop (n+1) lp l in loop 1 0 lines let get_error_line p = let lines = List.rev (try Hashtbl.find all_lines p.pfile with Not_found -> []) in let l, _ = find_line p.pmin lines in l let get_error_pos printer p = if p.pmin = -1 then "(unknown)" else let lines = List.rev (try Hashtbl.find all_lines p.pfile with Not_found -> []) in let l1, p1 = find_line p.pmin lines in let l2, p2 = find_line p.pmax lines in if l1 = l2 then begin let s = (if p1 = p2 then Printf.sprintf " %d" p1 else Printf.sprintf "s %d-%d" p1 p2) in Printf.sprintf "%s character%s" (printer p.pfile l1) s end else Printf.sprintf "%s lines %d-%d" (printer p.pfile l1) l1 l2 let reset() = Buffer.reset buf let contents() = Buffer.contents buf let store lexbuf = Buffer.add_string buf (lexeme lexbuf) let add c = Buffer.add_string buf c let mk_tok t pmin pmax = t , { pfile = !cur_file; pmin = pmin; pmax = pmax } let mk lexbuf t = mk_tok t (lexeme_start lexbuf) (lexeme_end lexbuf) let mk_ident lexbuf = match lexeme lexbuf with | s -> mk lexbuf (try Kwd (Hashtbl.find keywords s) with Not_found -> Const (Ident s)) } let ident = ['_' '$' 'a'-'z' 'A'-'Z'] ['_' 'a'-'z' 'A'-'Z' '0'-'9' '$']* rule token = parse | eof { mk lexbuf Eof } | "\239\187\191" { token lexbuf } | [' ' '\t']+ { token lexbuf } | "\r\n" { newline lexbuf; token lexbuf } | '\n' | '\r' { newline lexbuf; token lexbuf } | "0x" ['0'-'9' 'a'-'f' 'A'-'F']+ { mk lexbuf (Const (Int (lexeme lexbuf))) } | ['0'-'9']+ { mk lexbuf (Const (Int (lexeme lexbuf))) } | ['0'-'9']+ '.' ['0'-'9']* { mk lexbuf (Const (Float (lexeme lexbuf))) } | '.' ['0'-'9']+ { mk lexbuf (Const (Float (lexeme lexbuf))) } | ['0'-'9']+ ['e' 'E'] ['+' '-']? ['0'-'9']+ { mk lexbuf (Const (Float (lexeme lexbuf))) } | ['0'-'9']+ '.' ['0'-'9']* ['e' 'E'] ['+' '-']? ['0'-'9']+ { mk lexbuf (Const (Float (lexeme lexbuf))) } | "//" [^'\n' '\r']* { let s = lexeme lexbuf in mk lexbuf (CommentLine (String.sub s 2 ((String.length s)-2))) } | "++" { mk lexbuf (Unop Increment) } | "--" { mk lexbuf (Unop Decrement) } | "~" { mk lexbuf (Unop NegBits) } | "%=" { mk lexbuf (Binop (OpAssignOp OpMod)) } | "&=" { mk lexbuf (Binop (OpAssignOp OpAnd)) } | "|=" { mk lexbuf (Binop (OpAssignOp OpOr)) } | "^=" { mk lexbuf (Binop (OpAssignOp OpXor)) } | "+=" { mk lexbuf (Binop (OpAssignOp OpAdd)) } | "-=" { mk lexbuf (Binop (OpAssignOp OpSub)) } | "*=" { mk lexbuf (Binop (OpAssignOp OpMult)) } | "/=" { mk lexbuf (Binop (OpAssignOp OpDiv)) } | "<<=" { mk lexbuf (Binop (OpAssignOp OpShl)) } | ">>=" { mk lexbuf (Binop (OpAssignOp OpShr)) } | ">>>=" { mk lexbuf (Binop (OpAssignOp OpUShr)) } | "===" { mk lexbuf (Binop OpPhysEq) } | "!==" { mk lexbuf (Binop OpPhysNotEq) } | "==" { mk lexbuf (Binop OpEq) } | "!=" { mk lexbuf (Binop OpNotEq) } | "<=" { mk lexbuf (Binop OpLte) } | ">=" { mk lexbuf (Binop OpGte) } | "&&" { mk lexbuf (Binop OpBoolAnd) } | "||" { mk lexbuf (Binop OpBoolOr) } | "<<" { mk lexbuf (Binop OpShl) } | ">>" { mk lexbuf (Binop OpShr) } | ">>>" { mk lexbuf (Binop OpUShr) } | "!" { mk lexbuf (Unop Not) } | "<" { mk lexbuf (Binop OpLt) } | ">" { mk lexbuf (Binop OpGt) } | ";" { mk lexbuf Next } | ":" { mk lexbuf DblDot } | "," { mk lexbuf Sep } | "." { mk lexbuf Dot } | "%" { mk lexbuf (Binop OpMod) } | "&" { mk lexbuf (Binop OpAnd) } | "|" { mk lexbuf (Binop OpOr) } | "^" { mk lexbuf (Binop OpXor) } | "+" { mk lexbuf (Binop OpAdd) } | "*" { mk lexbuf (Binop OpMult) } | "/" { mk lexbuf (Binop OpDiv) } | "-" { mk lexbuf (Binop OpSub) } | "=" { mk lexbuf (Binop OpAssign) } | "[" { mk lexbuf BkOpen } | "]" { mk lexbuf BkClose } | "{" { mk lexbuf BrOpen } | "}" { mk lexbuf BrClose } | "(" { mk lexbuf POpen } | ")" { mk lexbuf PClose } | "?" { mk lexbuf Question } | "#" { mk lexbuf Sharp } | "/*" { reset(); let pmin = lexeme_start lexbuf in let pmax = (try comment lexbuf with Exit -> error Unclosed_comment pmin) in mk_tok (Comment (contents())) pmin pmax; } | '"' { reset(); let pmin = lexeme_start lexbuf in let pmax = (try string lexbuf with Exit -> error Unterminated_string pmin) in mk_tok (Const (String (contents()))) pmin pmax; } | "'" { reset(); let pmin = lexeme_start lexbuf in let pmax = (try string2 lexbuf with Exit -> error Unterminated_string pmin) in mk_tok (Const (String (contents()))) pmin pmax; } | ident { mk_ident lexbuf } | _ { error (Invalid_character (lexeme_char lexbuf 0)) (lexeme_start lexbuf) } and comment = parse | eof { raise Exit } | '\n' | '\r' | "\r\n" { newline lexbuf; store lexbuf; comment lexbuf } | "*/" { lexeme_end lexbuf } | '*' { store lexbuf; comment lexbuf } | [^'*' '\n' '\r']+ { store lexbuf; comment lexbuf } and string = parse | eof { raise Exit } | '\n' | '\r' | "\r\n" { newline lexbuf; store lexbuf; string lexbuf } | "\\\"" { store lexbuf; string lexbuf } | "\\\\" { store lexbuf; string lexbuf } | '\\' { store lexbuf; string lexbuf } | '"' { lexeme_end lexbuf } | [^'"' '\\' '\r' '\n']+ { store lexbuf; string lexbuf } and string2 = parse | eof { raise Exit } | '\n' | '\r' | "\r\n" { newline lexbuf; store lexbuf; string2 lexbuf } | '\\' { store lexbuf; string2 lexbuf } | "\\\\" { store lexbuf; string2 lexbuf } | "\\'" { store lexbuf; string2 lexbuf } | "'" { lexeme_end lexbuf } | [^'\'' '\\' '\r' '\n']+ { store lexbuf; string2 lexbuf } mtasc-1.14/ocaml/mtasc/mtasc.vcproj0000640000175000017500000000273210464750522015745 0ustar pabspabs mtasc-1.14/ocaml/mtasc/LICENSE0000640000175000017500000004313110140175134014403 0ustar pabspabs GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. mtasc-1.14/ocaml/mtasc/typer.ml0000640000175000017500000010224510561363035015103 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Expr type import_path = { mutable imp_used : bool; imp_path : type_path; imp_pos : pos; } type import_wild = { mutable wimp_used : bool; wimp_path : string list; wimp_pos : pos; } type imports = { paths : (string,import_path) Hashtbl.t; mutable wildcards : import_wild list; } type type_decl = | Void | Dyn | Class of class_context | Static of class_context | Function of type_decl list * type_decl | Package of string list and class_field = { f_name : string; f_type : type_decl; f_static : static_flag; f_public : public_flag; f_pos : pos; } and class_context = { path : type_path; param : class_context option; name : string; file : string; native : bool; interface : bool; dynamic : bool; imports : imports; fields : (string,class_field) Hashtbl.t; statics : (string,class_field) Hashtbl.t; mutable super : class_context; mutable implements : class_context list; mutable constructor : class_field option; } type local = { lt : type_decl; lf : int; } type context = { class_path : string list; files : (string,signature list) Hashtbl.t; classes : (type_path,class_context) Hashtbl.t; in_static : bool; in_lambda : class_context option; in_constructor : bool; locals : (string,local) Hashtbl.t; mutable frame : int; mutable inumber : type_decl; mutable ibool : type_decl; mutable istring : type_decl; mutable returns : type_decl; mutable current : class_context; mutable curwith : type_decl option; finalizers : (unit -> unit) list ref; } type error_msg = | Class_not_found of type_path | Class_name_mistake of type_path | Cannot_unify of type_decl * type_decl | Custom of string exception Error of error_msg * pos exception File_not_found of string let verbose = ref false let strict_mode = ref false let use_components = ref false let local_inference = ref false let warn_imports = ref false let argv_pos = { pfile = ""; pmin = -1; pmax = -1 } let error msg p = raise (Error (msg,p)) let rec s_type_decl = function | Void -> "Void" | Dyn -> "Any" | Class c -> s_type_path c.path | Static c -> "#" ^ s_type_path c.path | Function (args,r) -> "function (" ^ String.concat ", " (List.map s_type_decl args) ^ ") : " ^ s_type_decl r | Package l -> String.concat "." l let error_msg = function | Class_not_found p -> "class not found : " ^ s_type_path p | Class_name_mistake p -> "class name mistake : should be " ^ s_type_path p | Cannot_unify (ta,tb) -> s_type_decl ta ^ " should be " ^ s_type_decl tb | Custom msg -> msg let verbose_msg m = if !verbose then begin print_endline m; flush stdout; end let load_class_ref = ref ((fun _ -> assert false) : context -> type_path -> pos -> class_context) let type_function_ref = ref (fun ?lambda _ -> assert false) let t_object ctx = !load_class_ref ctx ([],"Object") null_pos let t_array ctx = !load_class_ref ctx ([],"Array") null_pos let rec is_super sup c = if c == sup then true else if c.super == c then false else is_super sup c.super let is_number ctx = function | Class c when c == (match ctx.inumber with Class c2 -> c2 | _ -> assert false) -> true | _ -> false let is_boolean ctx = function | Class c when c == (match ctx.ibool with Class c2 -> c2 | _ -> assert false) -> true | _ -> false let is_string ctx = function | Class c when c == (match ctx.istring with Class c2 -> c2 | _ -> assert false) -> true | _ -> false let resolve_path ctx p pos = match p with | (_ :: _) , _ -> !load_class_ref ctx p pos | [] , n -> let rec loop = function | [] -> (try let imp = Hashtbl.find ctx.current.imports.paths n in let cl = !load_class_ref ctx imp.imp_path pos in imp.imp_used <- true; cl with Not_found -> !load_class_ref ctx p pos) | imp :: l -> try let cl = !load_class_ref ctx (imp.wimp_path,n) pos in imp.wimp_used <- true; cl with Error (Class_not_found p,_) when p = (imp.wimp_path,n) -> loop l in loop ctx.current.imports.wildcards let rec is_function cl = match cl.path with | ([],"Function") -> true | _ -> if cl.super == cl then false else is_function cl.super (* check that ta >= tb *) let rec unify ta tb p = match ta , tb with | Dyn , x | x , Dyn -> () | Void , Void -> () | Function (args1,r1) , Function (args2,r2) -> let rec loop a1 a2 = match a1 , a2 with | x :: l1, y :: l2 -> unify x y p; loop l1 l2 | _ , _ -> () in loop args1 args2; unify r2 r1 p | Class cl1, Class cl2 -> let rec loop cl1 = if cl1 == cl2 || List.exists loop cl1.implements then true else if cl1.super == cl1 then false else loop cl1.super in if not (loop cl1) then (match cl1.param , cl2.param with | Some c1 , Some c2 when c1 == c2 -> () | _ -> error (Cannot_unify (ta,tb)) p) | Function _, Class c | Static _, Class c when c.super == c -> () (* unify with Object *) | Static _ , Class cl | Class cl, Static _ | Class cl, Function _ | Function _ , Class cl when is_function cl -> () | _ , _ -> error (Cannot_unify (ta,tb)) p let unify_array t1 t2 v p = match t2 with | Class { path = ([t],"Array") } when t.[0] = '#' -> (match fst v with | ENew ((EStatic ([],"Array"),_),[]) -> () | EArrayDecl _ -> () | _ -> unify t1 t2 p); | _ -> unify t1 t2 p let rec tcommon ctx ta tb p = match ta , tb with | Void , Void -> Void | Void , _ | _ , Void -> error (Cannot_unify (ta,tb)) p | Dyn , _ | _ , Dyn -> Dyn | Function _ , _ | Static _ , _ -> tcommon ctx (Class (!load_class_ref ctx ([],"Function") null_pos)) tb p | _ , Function _ | _ , Static _ -> tcommon ctx ta (Class (!load_class_ref ctx ([],"Function") null_pos)) p | Package _ , _ | _ , Package _ -> assert false | Class a , Class b -> let rec is_sub cl1 cl2 = if cl1 == cl2 || List.exists (is_sub cl1) cl2.implements then true else if cl2.super == cl2 then false else is_sub cl1 cl2.super in let rec parent cl1 cl2 = if is_sub cl2 cl1 then Some cl2 else let rec loop = function | [] -> if cl2.super == cl2 then None else parent cl1 cl2.super | i :: l -> match parent cl1 i with | Some i -> Some i | None -> loop l in loop cl2.implements in let p1 = parent a b in let p2 = parent b a in match p1 , p2 with | None, None -> Class (t_object ctx) | Some a, None -> Class a | None, Some b -> Class b | Some a, Some b -> if is_sub a b then Class b else Class a let t_opt ctx p = function | None -> if !strict_mode && not ctx.current.native then error (Custom "Type required in strict mode") p; Dyn | Some ([],"Void") -> Void | Some t -> Class (resolve_path ctx t p) let rec has_return any (e,p) = let has_return = has_return any in match e with | EVars _ | EFunction _ | EBreak | EContinue | EVal _ -> false | EReturn None -> any | EBlock el -> List.exists has_return el | EFor (el,_,_,e) -> List.exists has_return (e::el) | EForIn (e1,_,e2) -> has_return e1 || has_return e2 | EIf (_,e,eo) -> has_return e || (match eo with None -> false | Some e -> has_return e) | EWhile (_,e,_) -> has_return e | ESwitch (_,cases) -> List.exists (fun (_,e) -> has_return e) cases | ETry (e,cl,fo) -> (has_return e) || List.exists (fun (_,_,e) -> has_return e) !cl || (match fo with None -> false | Some e -> has_return e) | EWith (_,e) -> has_return e | EReturn (Some _ ) -> true let ret_opt ctx p f = match f.fexpr with | Some e when not (has_return false e) -> (match f.ftype with | None | Some ([],"Void") -> Void | Some cp -> error (Custom ("Missing return of type " ^ s_type_path cp)) p) | _ -> t_opt ctx p f.ftype let rec add_class_field ctx clctx fname stat pub get ft p = if pub = IsPrivate && clctx.interface then error (Custom "Private fields are not possible in interfaces") p; if stat = IsStatic && clctx.interface then error (Custom "Static fields are not possible in interfaces") p; let h = (match stat with IsStatic -> clctx.statics | IsMember -> clctx.fields) in let f = (try Some (Hashtbl.find h fname) with Not_found -> None) in match get with | Getter | Setter -> add_class_field ctx clctx ((if get = Getter then "__get__" else "__set__") ^ fname) stat pub Normal ft p; let t = (if get = Getter then (match ft with Function (_,x) -> x | _ -> assert false) else (match ft with | Function ([arg],r) -> if r <> Void && r <> Dyn then error (Custom "Setter should not return any value") p; arg | Function _ -> error (Custom "Setter can only have one parameter") p | _ -> assert false) ) in let f = (match f with | None -> { f_name = fname; f_type = t; f_static = stat; f_public = pub; f_pos = p; } | Some f -> { f_name = fname; f_type = begin (try unify f.f_type t f.f_pos; unify t f.f_type p; t with Error (Cannot_unify _,_) when !use_components -> f.f_type) end; f_static = stat; f_public = (if pub <> f.f_public then error (Custom "Getter and setter have different public/private visibility") p else pub); f_pos = p; } ) in Hashtbl.replace h fname f | Normal -> if f <> None || Hashtbl.mem (match stat with IsStatic -> clctx.fields | IsMember -> clctx.statics) fname then error (Custom ("Field redefiniton : " ^ fname)) p; Hashtbl.add h fname { f_name = fname; f_type = ft; f_static = stat; f_public = pub; f_pos = p; } let is_dynamic = function | Dyn | Function _ | Package _ -> true | Void -> false | Static c | Class c -> c.dynamic let add_finalizer ctx f = ctx.finalizers := f :: !(ctx.finalizers) let no_void t p = if t = Void then error (Custom "Void where Object expected") p let define_local ctx name t p = if Hashtbl.mem ctx.locals name then error (Custom ("Local variable redefinition : " ^ name)) p; Hashtbl.add ctx.locals name { lt = t; lf = ctx.frame } let new_frame ctx = let f = ctx.frame in ctx.frame <- ctx.frame + 1; f let clean_frame ctx f = ctx.frame <- f; Hashtbl.iter (fun n l -> if l.lf > f then Hashtbl.remove ctx.locals n; ) ctx.locals let rec resolve t fname = match t with | Void | Dyn | Function _ -> None | Package p -> Some { f_name = fname; f_type = Package (p @ [fname]); f_static = IsMember; f_public = IsPublic; f_pos = null_pos; } | Static c -> (try Some (Hashtbl.find c.statics fname) with Not_found -> if c.super == c then None else resolve (Static c.super) fname) | Class c -> try Some (Hashtbl.find c.fields fname) with Not_found -> if c.super == c then None else resolve (Class c.super) fname and type_ident ctx name e p = (* with lookup *) try match ctx.curwith with | None -> raise Not_found | Some t -> match t with | Void | Static _ | Package _ -> assert false | Dyn -> set_eval e (EStatic (["__With"],name)); Dyn | Function _ -> set_eval e (EStatic (["__With"],name)); Dyn | Class c -> match resolve (Class c) name with | None -> raise Not_found | Some { f_public = IsPrivate } when not (is_super c ctx.current) -> error (Custom "Cannot access private field") p | Some f -> set_eval e (EStatic (["__With"],name)); f.f_type with Not_found -> (* local variable lookup *) try let l = Hashtbl.find ctx.locals name in l.lt with Not_found -> (* member variable lookup *) try if name = snd ctx.current.path then begin set_eval e (EStatic ctx.current.path); Static ctx.current end else let f = (match resolve (Class ctx.current) name with None -> raise Not_found | Some f -> f) in if ctx.in_static then error (Custom ("Cannot access member variable " ^ name ^" in static function")) p; set_eval e (EField ((EConst (Ident "this"),p),name)); f.f_type with Not_found -> (* static variable lookup *) let rec loop c = try Some (c , Hashtbl.find c.statics name) with Not_found -> if c.super == c then None else loop c.super in match loop ctx.current with | Some (c,f) -> set_eval e (EField ((EStatic c.path,p),name)); f.f_type | None -> match resolve (Static (!load_class_ref ctx ([],"TopLevel") null_pos)) name with | Some f -> if f.f_public = IsPublic then set_eval e (EField ((EConst (Ident "_global"),p),name)); f.f_type | None -> if String.length name > 6 && String.sub name 0 6 = "_level" && (try int_of_string (String.sub name 6 (String.length name - 6)) >= 0 with _ -> false) then Class (!load_class_ref ctx ([],"MovieClip") null_pos) else Package [name] let type_constant ctx c e p = match c with | Int _ | Float _ -> ctx.inumber | String _ -> ctx.istring | Ident "_root" -> Class (!load_class_ref ctx ([],"MovieClip") p) | Ident "true" | Ident "false" -> ctx.ibool | Ident "null" | Ident "undefined" | Ident "_global" -> Dyn | Ident "this" -> if ctx.in_lambda <> None then Dyn else begin if ctx.in_static then error (Custom "Cannot access this in static function") p; Class ctx.current end | Ident "super" -> if ctx.in_lambda <> None then Dyn else begin if ctx.in_static then error (Custom "Cannot access super in static function") p; Class ctx.current.super end | Ident name -> type_ident ctx name e p let rec resolve_package ctx v (p : string list) pos = match p with | [] -> assert false | cname :: fields -> let rec access p = function | [] -> EStatic p | x :: l -> EField ((access p l , pos), x) in let rec search_package p = let rec loop acc = function | [] -> raise Exit | x :: l -> let cpath = List.rev l , x in try let cl = !load_class_ref ctx cpath pos in let vv = access cl.path (List.rev acc) in set_eval v vv; Static cl , acc with Error (Class_not_found p,_) when p = cpath -> loop (x :: acc) l in let t , fields = loop [] (List.rev p) in let rec loop t = function | [] -> t | f :: l -> loop (type_field ctx t f pos) l in loop t fields in let rec loop = function | [] -> let rec last = function | x :: [] -> x | x :: l -> last l | [] -> assert false in (match last p with | x when String.length x > 0 && x.[0] >= 'A' && x.[0] <= 'Z' -> error (Custom ("Unknown class " ^ String.concat "." p)) pos | _ -> error (Custom ("Unknown variable " ^ List.hd p)) pos) | (p,use) :: l -> try let r = search_package p in use(); r with Exit -> loop l in let p2 , n , use = (try let imp = Hashtbl.find ctx.current.imports.paths cname in fst imp.imp_path, snd imp.imp_path, (fun() -> imp.imp_used <- true) with Not_found -> [] , cname, (fun() -> ()) ) in loop ((p2 @ n :: fields , use) :: (List.map (fun imp -> imp.wimp_path @ cname :: fields, (fun() -> imp.wimp_used <- true)) ctx.current.imports.wildcards)) and type_field ctx t f p = match resolve t f with | None -> if not (is_dynamic t) then error (Custom (s_type_decl (match t with Static c -> Class c | _ -> t) ^ " has no " ^ (match t with Static _ -> "static " | _ -> "") ^ "field " ^ f)) p; Dyn | Some f -> if f.f_public = IsPrivate then (match t with | Class c | Static c -> if not (is_super c ctx.current) then begin if (match ctx.in_lambda with | None -> true | Some cur -> not (is_super c cur) ) then error (Custom ("Cannot access private field " ^ f.f_name)) p end; | _ -> ()); f.f_type let rec type_binop ctx op v1 v2 p = let t1 = type_val ctx v1 in let t2 = type_val ctx v2 in no_void t1 (pos v1); no_void t2 (pos v2); let rec loop = function | OpAdd -> if t1 == Dyn || t2 == Dyn then Dyn else if is_number ctx t1 && is_number ctx t2 then ctx.inumber else ctx.istring | OpAnd | OpOr | OpXor | OpShl | OpShr | OpUShr | OpMod | OpMult | OpDiv | OpSub -> unify t1 ctx.inumber p; unify t2 ctx.inumber p; ctx.inumber | OpAssign -> unify_array t2 t1 v2 p; t1 | OpEq | OpPhysEq | OpPhysNotEq | OpNotEq | OpGt | OpGte | OpLt | OpLte -> ctx.ibool | OpBoolAnd | OpBoolOr -> tcommon ctx t1 t2 p | OpAssignOp op -> let t = loop op in unify t t1 p; t1 in loop op and type_val ?(in_field=false) ctx ((v,p) as e) = match v with | EConst c -> (match type_constant ctx c e p with | Package pk when not in_field -> resolve_package ctx e pk p | t -> t) | ECast (v1,v2) -> let t = type_val ctx v1 in ignore(type_val ctx v2); (match t with | Static c -> Class c | _ -> error (Custom "Casting to not a class") (pos v1)) | EArray (v1,v2) -> let t = type_val ctx v1 in ignore(type_val ctx v2); (match t with | Class { param = Some c } -> Class c | _ -> Dyn) | EBinop (op,v1,v2) -> type_binop ctx op v1 v2 p | EField (v,f) -> let t = type_val ~in_field:true ctx v in let t = (match type_field ctx t f p with | Package pk when not in_field -> resolve_package ctx e pk p | t -> t) in (match e with | EField ((EStatic p , pos) as v,_) , _ when f <> "prototype" && fst p <> ["__With"] -> let rec loop cl = if Hashtbl.mem cl.statics f then cl.path else if cl.super == cl then p else loop cl.super in let p = loop (!load_class_ref ctx p pos) in set_eval v (EStatic p); | _ -> ()); t | EStatic cpath -> let c = resolve_path ctx cpath p in set_eval e (EStatic c.path); Static c | EParenthesis v -> type_val ctx v | EObjDecl vl -> List.iter (fun (_,v) -> no_void (type_val ctx v) (pos v)) vl; Class (t_object ctx) | EArrayDecl vl -> List.iter (fun v -> no_void (type_val ctx v) (pos v)) vl; Class (t_array ctx) | ECall ((EConst (Ident "super"),_),args) -> if not ctx.in_constructor then error (Custom "Super constructor can only be called in class constructor") p; let args = List.map (type_val ctx) args in (match ctx.current.super.constructor with | None -> () | Some t -> unify (Function (args,Void)) t.f_type p); Void | ECall (v,args) -> let t = type_val ctx v in (match t with | Function (fargs,ret) -> let rec loop l1 l2 = match l1 , l2 with | [] , _ -> () | l , [] -> List.iter (fun v -> ignore(type_val ctx v)) l | v :: l1 , a :: l2 -> unify (type_val ctx v) a (pos v); loop l1 l2 in loop args fargs; ret | Dyn -> List.iter (fun v -> no_void (type_val ctx v) (pos v)) args; Dyn | Class cl when is_function cl -> List.iter (fun v -> no_void (type_val ctx v) (pos v)) args; Dyn | Static c when List.length args = 1 -> ignore(type_val ctx (List.hd args)); set_eval e (ECast (v,List.hd args)); Class c | _ -> error (Custom ("Cannot call non-function object " ^ s_type_decl t)) (pos v)); | EQuestion (v,v1,v2) -> no_void (type_val ctx v) (pos v); let t1 = type_val ctx v1 in let t2 = type_val ctx v2 in tcommon ctx t1 t2 p | EUnop (Not,_,v) -> no_void (type_val ctx v) (pos v); ctx.ibool | EUnop (_,_,v) -> unify (type_val ctx v) ctx.inumber (pos v); ctx.inumber | ENew (v,vl) -> let args = List.map (type_val ctx) vl in (match type_val ctx v with | Static cl -> (match cl.constructor with | None -> () | Some t -> if t.f_public = IsPrivate && not (is_super cl ctx.current) then error (Custom "Cannot call private constructor") p; unify (Function (args,Dyn)) t.f_type p); Class cl | Dyn -> Dyn | Class cl when is_function cl -> Dyn | t -> error (Custom ("Invalid type : " ^ s_type_decl t ^ " for new call")) p) | ELambda f -> !type_function_ref ~lambda:true ctx (t_object ctx) f p let rec type_expr ctx (e,p) = match e with | EVars (_,_,vl) -> List.iter (fun (name,tt,v) -> let t = (if !local_inference && v <> None && tt = None then Dyn else t_opt ctx p tt) in let t = (match v with | None -> t | Some v -> let tv = type_val ctx v in unify_array tv t v (pos v); if !local_inference && tt = None then tv else t ) in define_local ctx name t p ) vl | EFunction f -> assert false | EBlock el -> let f = new_frame ctx in List.iter (type_expr ctx) el; clean_frame ctx f | EFor (inits,conds,incrs,e) -> let f = new_frame ctx in List.iter (type_expr ctx) inits; List.iter (fun v -> no_void (type_val ctx v) (pos v) ) conds; List.iter (fun v -> ignore(type_val ctx v) ) incrs; type_expr ctx e; clean_frame ctx f | EForIn (decl,v,e) -> let f = new_frame ctx in (match decl with | EVal ((EConst (Ident x),_) as v) , p -> let t = type_val ctx v in unify ctx.istring t p; unify t ctx.istring p; | EVars (_,_,[x,t,None]) , p -> unify ctx.istring (t_opt ctx p t) p; define_local ctx x ctx.istring p | _ -> error (Custom "Invalid forin parameter") p); no_void (type_val ctx v) (pos v); type_expr ctx e; clean_frame ctx f | EIf (v,e,eo) -> no_void (type_val ctx v) (pos v); type_expr ctx e; (match eo with None -> () | Some e -> type_expr ctx e); | EWhile (v,e,_) -> no_void (type_val ctx v) (pos v); type_expr ctx e | ESwitch (v,cases) -> let t = type_val ctx v in List.iter (fun (v,e) -> (match v with | None -> () | Some v -> unify (type_val ctx v) t (pos v)); type_expr ctx e ) cases; | ETry (etry,cl,fo) -> type_expr ctx etry; let no_type = ref false in cl := List.map (fun (name,t,e) -> if !no_type then error (Custom "Misplaced catch will fail to catch any exception") (pos e); let t2 = (match t with None -> no_type := true; None | Some c -> Some (resolve_path ctx c p).path ) in let f = new_frame ctx in define_local ctx name (t_opt ctx p t) p; type_expr ctx e; clean_frame ctx f; name , t2 , e ) !cl; (match fo with None -> () | Some e -> type_expr ctx e) | EWith (v,e) -> let old_with = ctx.curwith in let t = type_val ctx v in (match t with | Void | Static _ -> error (Custom "Invalid type for 'with' argument") p | Package _ -> assert false | Dyn | Function _ | Class _ -> ()); ctx.curwith <- Some t; ignore(type_expr ctx e); ctx.curwith <- old_with; | EReturn None -> if ctx.returns <> Void && ctx.returns <> Dyn then error (Custom "Return type cannot be Void") p; | EReturn (Some v) -> unify (type_val ctx v) ctx.returns (pos v) | EBreak | EContinue -> () | EVal v -> ignore(type_val ctx v) let type_function ?(lambda=false) ctx clctx f p = match f.fexpr with | None -> assert false | Some e -> if not lambda then verbose_msg ("Typing " ^ s_type_path clctx.path ^ "." ^ f.fname); let ctx = { ctx with current = if lambda then { clctx with imports = ctx.current.imports; native = false; } else clctx; locals = if lambda then ctx.locals else Hashtbl.create 0; in_static = (f.fstatic = IsStatic); in_constructor = (f.fstatic = IsMember && f.fname = clctx.name); in_lambda = (if lambda then (match ctx.in_lambda with None -> Some ctx.current | Some _ -> ctx.in_lambda) else None); curwith = None; } in let fr = new_frame ctx in ctx.returns <- ret_opt ctx p f; let argst = List.map (fun (a,t) -> let t = t_opt ctx p t in define_local ctx a t p; t ) f.fargs in type_expr ctx e; clean_frame ctx fr; Function (argst,ctx.returns) let rec type_class_fields ctx clctx comp (e,p) = match e with | EBlock el -> List.iter (type_class_fields ctx clctx comp) el | EVars (stat,pub,vl) -> if clctx.interface then error (Custom "Interface cannot contain variable declaration") p; List.iter (fun (vname,vtype,vinit) -> let t = t_opt ctx p vtype in add_class_field ctx clctx vname stat pub Normal t p; match vinit with | None -> () | Some v -> if not comp then add_finalizer ctx (fun () -> ctx.current <- clctx; unify (type_val ctx v) t p ) ) vl | EFunction f -> let t = Function (List.map (fun (_,t) -> t_opt ctx p t) f.fargs , ret_opt ctx p f) in if f.fname = snd clctx.path then begin if f.ftype <> None then error (Custom "Constructor return type should not be specified") p; if clctx.interface then error (Custom "Interface can't have a constructor") p; match clctx.constructor with | None -> clctx.constructor <- Some { f_name = f.fname; f_type = t; f_static = IsMember; f_public = f.fpublic; f_pos = null_pos } | Some _ -> error (Custom "Duplicate constructor") p; end else add_class_field ctx clctx f.fname f.fstatic f.fpublic f.fgetter t p; if f.fexpr <> None && not comp then add_finalizer ctx (fun () -> ignore(type_function ctx clctx f p)); | _ -> assert false let type_class ctx cpath herits e imports file interf native s = let old = ctx.current in let rec clctx = { path = cpath; param = None; name = snd cpath; file = file; native = native; interface = interf; dynamic = List.exists ((=) HDynamic) herits; fields = Hashtbl.create 0; statics = Hashtbl.create 0; constructor = None; super = clctx; implements = []; imports = imports; } in Hashtbl.add imports.paths clctx.name { imp_path = clctx.path; imp_used = true; imp_pos = pos s }; if Hashtbl.mem ctx.classes cpath then error (Custom ("Redefinition of class " ^ s_type_path cpath ^ ", please check using -v that the file is not referenced several times")) (pos s); Hashtbl.add ctx.classes cpath clctx; ctx.current <- clctx; let herits = List.map (function | HExtends cpath -> HExtends (resolve_path ctx cpath (pos e)).path | HImplements cpath -> HImplements (resolve_path ctx cpath (pos e)).path | HDynamic | HIntrinsic as x -> x ) herits in let is_component = !use_components && (match clctx.path with ("mx" :: _ , _) -> true | _ -> false) in let herits = (if is_component then HIntrinsic :: herits else herits) in Obj.set_field (Obj.repr s) 0 (Obj.repr (if interf then EInterface (cpath,herits,e) else EClass (cpath,herits,e))); let rec loop flag = function | [] -> t_object ctx | HExtends cpath :: l -> if flag then error (Custom "Multiple inheritance is not allowed") (pos e); let cl = resolve_path ctx cpath (pos e) in if clctx.interface && not cl.interface then error (Custom "Interface cannot extends a class") (pos e); ignore(loop true l); cl | _ :: l -> loop flag l in clctx.super <- loop false herits; if clctx.super.interface && not clctx.interface then error (Custom "Cannot extends an interface") (pos e); let rec loop = function | [] -> [] | HImplements cpath :: l -> cpath :: loop l | _ :: l -> loop l in clctx.implements <- List.map (fun cpath -> let c = resolve_path ctx cpath (pos e) in if clctx.interface then error (Custom "Interface cannot implements another interface, use extends") (pos e); if not c.interface then error (Custom "Cannot implements a class") (pos e); c ) (loop herits); type_class_fields ctx clctx is_component e; ctx.current <- old; clctx let type_file ctx req_path file el pos = let clctx = ref None in let imports = { paths = Hashtbl.create 0; wildcards = []; } in let clerror t p = if pos = argv_pos then () else if String.lowercase (s_type_path req_path) = String.lowercase (s_type_path t) then begin Hashtbl.remove ctx.files file; error (Class_not_found req_path) pos end else begin let a = Array.to_list (Sys.readdir (Filename.dirname file)) in let f = Filename.basename file in if List.exists ((=) f) a then error (Class_name_mistake req_path) p else error (Class_name_mistake t) pos end in List.iter (fun ((s,p) as sign) -> match s with | EClass (t,hl,e) -> if t <> req_path then clerror t (snd e); if !clctx <> None then error (Custom "Cannot declare several classes in same file") p; clctx := Some (type_class ctx t hl e imports file false (List.exists ((=) HIntrinsic) hl) sign) | EInterface (t,hl,e) -> if t <> req_path then clerror t (snd e); if !clctx <> None then error (Custom "Cannot declare several classes in same file") p; clctx := Some (type_class ctx t hl e imports file true false sign) | EImport (path,Some name) -> if Hashtbl.mem imports.paths name then error (Custom "Duplicate Import") p; Hashtbl.add imports.paths name { imp_path = (path,name); imp_pos = p; imp_used = false } | EImport (pk,None) -> imports.wildcards <- { wimp_path = pk; wimp_pos = p; wimp_used = false } :: imports.wildcards ) el; if !warn_imports && (not !use_components || (match !clctx with Some { path = "mx" :: _ , _ } -> false | _ -> true)) then add_finalizer ctx (fun () -> Hashtbl.iter (fun _ imp -> if not imp.imp_used then (!Parser.warning) "import not used" imp.imp_pos) imports.paths; List.iter (fun imp -> if not imp.wimp_used then (!Parser.warning) "import not used" imp.wimp_pos) imports.wildcards; ); !clctx let load_file ctx file = let rec loop = function | [] -> raise (File_not_found file) | path :: paths -> try let file = path ^ file in file , open_in file with _ -> loop paths in let file, ch = loop ctx.class_path in let expr, comments = (try Parser.parse (Lexing.from_channel ch) file with | exc -> close_in ch; raise exc ) in close_in ch; List.iter check_sign expr; Hashtbl.add ctx.files file expr; verbose_msg ("Parsed " ^ file); file , expr let rec load_class ctx path p = match path with | [param] , "Array" when param.[0] == '#' -> let cl = load_class ctx ([],"ArrayPoly") p in let path2 = ExtString.String.nsplit (String.sub param 1 (String.length param - 1)) "." in let rec loop acc = function | [] -> assert false | [x] -> List.rev acc , x | x :: l -> loop (x :: acc) l in let path2 = loop [] path2 in let cl2 = resolve_path ctx path2 p in let arr = { cl with path = path; param = Some cl2; fields = Hashtbl.create 0; statics = Hashtbl.create 0; implements = []; constructor = None; } in let rec map_type = function | Class { path = ([],"ArrayParam") } -> Class cl2 | Class { path = (["#ArrayParam"],"Array") } -> Class arr | Function (params,ret) -> Function (List.map map_type params,map_type ret) | t -> t in Hashtbl.iter (fun s f -> Hashtbl.add arr.fields s { f with f_type = map_type f.f_type } ) cl.fields; arr | _ -> try Hashtbl.find ctx.classes path with Not_found -> if String.lowercase (snd path) = "con" then error (Custom "CON is a special file under Windows and shouldn't be used as class name") p; let file_name = (match fst path with | [] -> snd path ^ ".as" | _ -> String.concat "/" (fst path) ^ "/" ^ snd path ^ ".as") in try let f , e = load_file ctx file_name in match type_file ctx path f e p with | None -> error (Custom "Missing class definition") { pfile = file_name; pmin = 0; pmax = 0 } | Some c -> c with File_not_found _ -> error (Class_not_found path) p let check_interfaces ctx = Hashtbl.iter (fun _ clctx -> let cli = Class clctx in let rec loopeq variance t1 t2 = match t1, t2 with | Void , Void -> true | Dyn , _ -> true | Class cl1 , Class cl2 -> if cl1.path = cl2.path then true else let t = (try tcommon ctx (Class cl1) (Class cl2) null_pos with _ -> Dyn) in (match t with | Class c when c.path = cl1.path -> variance | Class c when c.path = cl2.path -> not variance | _ -> false) | Function (a1,r1) , Function (a2,r2) when List.length a1 = List.length a2 -> List.for_all2 (loopeq true) a1 a2 && loopeq false r1 r2 | _ , _ -> false in let rec loop_interf = function | i :: l -> loop_fields i; loop_interf l | [] -> () and loop_fields i = if i.super.interface then loop_fields i.super; Hashtbl.iter (fun _ f -> if f.f_static = IsMember then match resolve cli f.f_name with | None -> error (Custom ("Missing field " ^ f.f_name ^ " required by " ^ s_type_path i.path)) { pfile = clctx.file; pmin = 0; pmax = 0 } | Some f2 -> if f2.f_public = IsPrivate then error (Custom ("Field " ^ f.f_name ^ " is declared in an interface and should be public")) f2.f_pos; unify f2.f_type f.f_type f2.f_pos; if not (loopeq true f.f_type f2.f_type) then error (Custom ("Field " ^ f.f_name ^ " type is different from the one defined in " ^ s_type_path i.path)) f2.f_pos ) i.fields in loop_interf clctx.implements; ) ctx.classes let create cpath = let ctx = { current = Obj.magic(); inumber = Obj.magic(); ibool = Obj.magic(); istring = Obj.magic(); finalizers = ref []; class_path = cpath; files = Hashtbl.create 0; classes = Hashtbl.create 0; in_static = true; in_lambda = None; in_constructor = false; returns = Void; curwith = None; locals = Hashtbl.create 0; frame = 0; } in ignore(load_class ctx ([],"StdPresent") null_pos); ctx.inumber <- Class (load_class ctx ([],"Number") null_pos); ctx.ibool <- Class (load_class ctx ([],"Boolean") null_pos); ctx.istring <- Class (load_class ctx ([],"String") null_pos); ctx let rec finalize ctx = let fl = List.rev !(ctx.finalizers) in ctx.finalizers := []; match fl with | [] -> check_interfaces ctx | _ -> List.iter (fun f -> f()) fl; finalize ctx let exprs ctx = ctx.files ;; load_class_ref := load_class; type_function_ref := type_functionmtasc-1.14/ocaml/mtasc/main.ml0000640000175000017500000001355511056476411014674 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Printf open ExtString type p_style = | StyleJava | StyleMSVC let print_style = ref StyleJava let rec split l str = let rec loop = function | [] -> -1 | x :: l -> try let p = String.index str x in let p2 = loop l in if p2 = -1 || p2 > p then p else p2 with Not_found -> loop l in let p = loop l in if p = -1 then [str] else if p = 0 then split l (String.sub str 1 (String.length str - 1)) else let sub = String.sub str 0 p in sub :: (split l (String.sub str (p+1) (String.length str - (p+1)))) let class_name file = let path = Filename.dirname file in let path = (match split ['/';'\\'] path with "." :: l -> l | l -> l) in let file = Filename.basename file in path , try Filename.chop_extension file with _ -> file let normalize_path p = let l = String.length p in if l = 0 then "./" else match p.[l-1] with | '\\' | '/' -> p | _ -> p ^ "/" let rec parse_class_path base_path path = if path = "" then [] else let relative fp l = if String.length fp >= 2 && (fp.[0] = '/' || fp.[0] = '.' || fp.[1] = ':') then fp :: l else fp :: (base_path ^ fp) :: l in try let p = String.index path ';' in let fp = normalize_path (String.sub path 0 (p-1)) in let remains = String.sub path (p+1) (String.length path - p - 1) in relative fp (parse_class_path base_path remains) with Not_found -> relative (normalize_path path) [] let read_package path = let npath = normalize_path path in let rec loop = function | [] -> Printf.eprintf "Warning : package %s not found\n" path; [] | cpath :: l -> let filepath = normalize_path (cpath ^ path) in match Array.to_list (try Sys.readdir filepath with Sys_error _ -> [||]) with | [] -> loop l | files -> match List.filter (fun f -> String.ends_with (String.lowercase f) ".as") files with | [] -> loop l | files -> List.map (fun f -> npath ^ f) files in loop !Plugin.class_path let report ?(do_exit=true) (msg,p) etype printer = let error_printer file line = match !print_style with | StyleJava -> sprintf "%s:%d:" file line | StyleMSVC -> sprintf "%s(%d):" file line in let epos = Lexer.get_error_pos error_printer p in prerr_endline (sprintf "%s : %s %s" epos etype (printer msg)); if do_exit then exit 1 ;; try let usage = "Motion-Twin ActionScript2 Compiler 1.14 - (c)2004-2008 Motion-Twin\n Usage : mtasc.exe [options] \n Options :" in let base_path = normalize_path (try Extc.executable_path() with _ -> ".") in let files = ref [] in let time = Sys.time() in Plugin.class_path := [base_path;"";"/"]; let args_spec = [ ("-pack",Arg.String (fun path -> files := read_package path @ !files)," : compile all files in target package"); ("-cp",Arg.String (fun path -> Plugin.class_path := parse_class_path base_path path @ !Plugin.class_path)," : add classpath"); ("-v",Arg.Unit (fun () -> Typer.verbose := true; Plugin.verbose := true),": turn on verbose mode"); ("-strict",Arg.Unit (fun () -> Typer.strict_mode := true),": turn on strict mode"); ("-infer",Arg.Unit (fun () -> Typer.local_inference := true),": turn on local variables inference"); ("-wimp",Arg.Unit (fun () -> Typer.warn_imports := true),": turn on warnings for unused imports"); ("-msvc",Arg.Unit (fun () -> print_style := StyleMSVC),": use MSVC style errors"); ("-mx",Arg.Unit (fun () -> Typer.use_components := true; Parser.use_components := true; GenSwf.use_components := true; ),": use precompiled mx package"); ] @ !Plugin.options in Arg.parse args_spec (fun file -> files := file :: !files) usage; Plugin.class_path := (base_path ^ "std/") :: !Plugin.class_path; if (match !GenSwf.version with Some x -> x >= 8 | None -> false) then Plugin.class_path := (base_path ^ "std8/") :: !Plugin.class_path; Hashtbl.remove Lexer.keywords "add"; Parser.warning := (fun msg pos -> report ~do_exit:false (msg,pos) "Warning" (fun msg -> msg)); if !files = [] then begin Arg.usage args_spec usage end else begin if !Plugin.verbose then print_endline ("Classpath : " ^ (String.concat ";" !Plugin.class_path)); let typer = (try Typer.create !Plugin.class_path with Typer.Error (Typer.Class_not_found ([],"StdPresent"),_) -> failwith "Directory 'std' containing MTASC class headers cannot be found :\nPlease install it or set classpath using '-cp' so it can be found.") in List.iter (fun file -> let path = class_name file in ignore(Typer.load_class typer path Typer.argv_pos); ) (List.rev !files); Typer.finalize typer; List.iter (fun f -> f typer) !Plugin.calls; if !Plugin.verbose then print_endline ("Time spent : " ^ string_of_float (Sys.time() -. time)); end; with | Expr.Invalid_expression p -> report ((),p) "parse error" (fun() -> "Invalid Expression") | Lexer.Error (m,p) -> report (m,p) "syntax error" Lexer.error_msg | Parser.Error (m,p) -> report (m,p) "parse error" Parser.error_msg | Typer.Error (m,p) -> report (m,p) "type error" Typer.error_msg | Typer.File_not_found file -> prerr_endline (sprintf "File not found %s" file); exit 1 | Failure msg -> prerr_endline msg; exit 1; mtasc-1.14/ocaml/mtasc/mtasc.dsp0000640000175000017500000000615410212412475015223 0ustar pabspabs# Microsoft Developer Studio Project File - Name="mtasc" - Package Owner=<4> # Microsoft Developer Studio Generated Build File, Format Version 6.00 # ** DO NOT EDIT ** # TARGTYPE "Win32 (x86) External Target" 0x0106 CFG=mtasc - Win32 Debug !MESSAGE This is not a valid makefile. To build this project using NMAKE, !MESSAGE use the Export Makefile command and run !MESSAGE !MESSAGE NMAKE /f "mtasc.mak". !MESSAGE !MESSAGE You can specify a configuration when running NMAKE !MESSAGE by defining the macro CFG on the command line. For example: !MESSAGE !MESSAGE NMAKE /f "mtasc.mak" CFG="mtasc - Win32 Debug" !MESSAGE !MESSAGE Possible choices for configuration are: !MESSAGE !MESSAGE "mtasc - Win32 Release" (based on "Win32 (x86) External Target") !MESSAGE "mtasc - Win32 Debug" (based on "Win32 (x86) External Target") !MESSAGE # Begin Project # PROP AllowPerConfigDependencies 0 # PROP Scc_ProjName "" # PROP Scc_LocalPath "" !IF "$(CFG)" == "mtasc - Win32 Release" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 0 # PROP BASE Output_Dir "" # PROP BASE Intermediate_Dir "" # PROP BASE Cmd_Line "NMAKE /f mtasc.mak" # PROP BASE Rebuild_Opt "/a" # PROP BASE Target_File "mtasc.exe" # PROP BASE Bsc_Name "mtasc.bsc" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 0 # PROP Output_Dir "" # PROP Intermediate_Dir "" # PROP Cmd_Line "ocamake -opt -pp camlp4o mtasc.dsp extLib.cmxa extc.cmxa " # PROP Rebuild_Opt "/a" # PROP Target_File "mtasc.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ELSEIF "$(CFG)" == "mtasc - Win32 Debug" # PROP BASE Use_MFC 0 # PROP BASE Use_Debug_Libraries 1 # PROP BASE Output_Dir "Debug" # PROP BASE Intermediate_Dir "" # PROP BASE Cmd_Line "NMAKE /f mtasc.mak" # PROP BASE Rebuild_Opt "/a" # PROP BASE Target_File "mtasc.exe" # PROP BASE Bsc_Name "mtasc.bsc" # PROP BASE Target_Dir "" # PROP Use_MFC 0 # PROP Use_Debug_Libraries 1 # PROP Output_Dir "" # PROP Intermediate_Dir "" # PROP Cmd_Line "ocamake -lp -custom -pp camlp4o mtasc.dsp extLib.cma extc.cma" # PROP Rebuild_Opt "/a" # PROP Target_File "mtasc.exe" # PROP Bsc_Name "" # PROP Target_Dir "" !ENDIF # Begin Target # Name "mtasc - Win32 Release" # Name "mtasc - Win32 Debug" !IF "$(CFG)" == "mtasc - Win32 Release" !ELSEIF "$(CFG)" == "mtasc - Win32 Debug" !ENDIF # Begin Group "swflib" # PROP Default_Filter "" # Begin Source File SOURCE=..\swflib\actionScript.ml # End Source File # Begin Source File SOURCE=..\swflib\swf.ml # End Source File # Begin Source File SOURCE=..\swflib\swfParser.ml # End Source File # Begin Source File SOURCE=..\swflib\swfZip.ml # End Source File # End Group # Begin Group "main" # PROP Default_Filter "" # Begin Source File SOURCE=.\main.ml # End Source File # End Group # Begin Source File SOURCE=.\class.ml # End Source File # Begin Source File SOURCE=.\expr.ml # End Source File # Begin Source File SOURCE=.\genSwf.ml # End Source File # Begin Source File SOURCE=.\lexer.mll # End Source File # Begin Source File SOURCE=.\parser.ml # End Source File # Begin Source File SOURCE=.\plugin.ml # End Source File # Begin Source File SOURCE=.\typer.ml # End Source File # End Target # End Project mtasc-1.14/ocaml/mtasc/parser.ml0000640000175000017500000003556610561362764015257 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Expr type error_msg = | Unexpected of token | Unclosed_parenthesis | Duplicate_default exception Error of error_msg * pos let warning = ref (fun (msg : string) (p : pos) -> ()) let use_components = ref false let last_comment = ref None let error_msg = function | Unexpected t -> "Unexpected "^(s_token t) | Unclosed_parenthesis -> "Unclosed parenthesis" | Duplicate_default -> "Duplicate default" let error m p = raise (Error (m,p)) let priority = function | OpAssign | OpAssignOp _ -> -4 | OpBoolOr -> -3 | OpBoolAnd -> -2 | OpEq | OpNotEq | OpGt | OpLt | OpGte | OpLte | OpPhysEq | OpPhysNotEq -> -1 | OpOr | OpAnd | OpXor -> 0 | OpShl | OpShr | OpUShr -> 1 | OpAdd | OpSub -> 2 | OpMult | OpDiv -> 3 | OpMod -> 4 let is_not_assign = function | OpAssign | OpAssignOp _ -> false | _ -> true let can_swap _op op = let p1 = priority _op in let p2 = priority op in if p1 < p2 then true else if p1 = p2 && p1 >= 0 then (* numerical ops are left-assoc *) true else false let rec make_binop op e ((v,p2) as e2) = match v with | EBinop (_op,_e,_e2) when can_swap _op op && (is_not_assign _op || is_not_assign op) -> let _e = make_binop op e _e in EBinop (_op,_e,_e2) , punion (pos _e) (pos _e2) | EQuestion (_e,_e1,_e2) when is_not_assign op -> let _e = make_binop op e _e in EQuestion ( _e, _e1, _e2) , punion (pos e) (pos _e2) | _ -> EBinop (op,e,e2) , punion (pos e) (pos e2) let rec make_unop op ((v,p2) as e) p1 = match v with | EBinop (bop,e,e2) -> EBinop (bop, make_unop op e p1 , e2) , (punion p1 p2) | EQuestion (_e,_e1,_e2) -> let _e = make_unop op _e p1 in EQuestion ( _e, _e1, _e2) , punion p1 (pos _e2) | _ -> EUnop (op,Prefix,e), punion p1 p2 let rec make_path e = let rec loop acc (e,_) = match e with | EConst (Ident s) -> s :: acc | EField (e,f) -> loop (f :: acc) e | _ -> raise Stream.Failure in loop [] e let wrap_var e = match e with | EVars _ , p -> EBlock [e] , p | _ -> e let rec parse_code = parser | [< '(Eof,_) >] -> [] | [< '(Next,_); el = parse_code >] -> el | [< e = parse_signature; el = parse_code >] -> e :: el and parse_signature = parser | [< '(BkOpen,_); _ = parse_metadata; s = parse_signature >] -> s | [< '(Kwd Import,p1); p , w = parse_import >] -> EImport (p,w) , p1 | [< '(Kwd Interface,p1); path = parse_class_path; herits = parse_herits; '(BrOpen,p); el , p2 = parse_class true >] -> EInterface (path,herits,(EBlock el,punion p p2)) , punion p1 p2 | [< flags = parse_class_flags; '(Kwd Class,p); path = parse_class_path; herits = parse_herits; '(BrOpen,op); s >] -> let el, p2 = parse_class (List.exists ((=) HIntrinsic) flags) s in EClass (path, flags @ herits, (EBlock el, punion op p2)) , punion p p2 | [< _ = parse_include; s = parse_signature >] -> s and parse_herits = parser | [< '(Kwd Extends,_); p = parse_class_path; l = parse_herits >] -> HExtends p :: l | [< '(Kwd Implements,_); p = parse_class_path; l = parse_other_implements >] -> HImplements p :: l | [< >] -> [] and parse_other_implements = parser | [< '(Sep,_); p = parse_class_path; l = parse_other_implements >] -> HImplements p :: l | [< l = parse_herits >] -> l and parse_class_flags = parser | [< '(Kwd Intrinsic,_); l = parse_class_flags >] -> HIntrinsic :: l | [< '(Kwd Dynamic,_); l = parse_class_flags >] -> HDynamic :: l | [< >] -> [] and parse_class interf = parser | [< '(BrClose,p) >] -> [] , p | [< '(Next,_); n = parse_class interf >] -> n | [< '(BkOpen,_); _ = parse_metadata; i = parse_class interf >] -> i | [< _ = parse_include; s = parse_class interf >] -> s | [< flags = parse_field_flags IsMember None; f = parse_class_field flags interf; fl , p = parse_class interf >] -> f :: fl , p and parse_field_flags stat pub = parser | [< '(Kwd Static,_) when stat = IsMember; f = parse_field_flags IsStatic pub >] -> f | [< '(Kwd Public,_) when pub = None; f = parse_field_flags stat (Some IsPublic) >] -> f | [< '(Kwd Private,_) when pub = None; f = parse_field_flags stat (Some IsPrivate) >] -> f | [< >] -> stat , (match pub with None -> IsPublic | Some p -> p) and parse_class_field (stat,pub) interf = parser | [< '(Kwd Var,p1); vl, p2 = parse_vars p1 >] -> EVars (stat,pub,vl) , punion p1 p2 | [< '(Kwd Function,p1); name, g = parse_fun_name; '(POpen,_); args , p2 = parse_args; t = parse_type_option; s >] -> EFunction { fname = name; fargs = args; ftype = t; fstatic = stat; fpublic = pub; fgetter = g; fexpr = if interf then None else Some (parse_expr s); } , punion p1 p2 and parse_fun_name = parser | [< '(Kwd k,p) when Filename.basename p.pfile = "TopLevel.as" >] -> s_keyword k , Normal | [< '(Const (Ident name),_); s >] -> match name with | "get" | "set" -> (match s with parser | [< '(Const (Ident name2),_) >] -> name2 , if name = "get" then Getter else Setter | [< >] -> name , Normal) | _ -> name , Normal and parse_expr = parser | [< '(BrOpen,p1); el , p2 = parse_block parse_expr p1 >] -> EBlock el , punion p1 p2 | [< '(Kwd For,p); '(POpen,_); c = parse_expr_opt; e = parse_for p c >] -> e | [< '(Kwd If,p); cond = parse_eval; e = parse_expr_opt; e2 , p2 = parse_else (pos e) >] -> EIf (cond,wrap_var e,e2), punion p p2 | [< '(Kwd Return,p); v , p2 = parse_eval_option p; >] -> EReturn v , punion p p2 | [< '(Kwd Break,p); >] -> EBreak , p | [< '(Kwd Continue,p); >] -> EContinue , p | [< '(Kwd While,p1); v = parse_eval; e = parse_expr_opt >] -> EWhile (v,wrap_var e,NormalWhile) , punion p1 (pos e) | [< '(Kwd Do,p1); e = parse_expr; '(Kwd While,_); v = parse_eval; >] -> EWhile (v,wrap_var e,DoWhile) , punion p1 (pos v) | [< '(Kwd Switch,p1); v = parse_eval; '(BrOpen,_); el, p2 = parse_switch false >] -> ESwitch (v,el) , punion p1 p2 | [< '(Kwd Var,p1); vl, p2 = parse_vars p1 >] -> EVars (IsMember,IsPublic,vl), punion p1 p2 | [< '(Kwd Try,p1); e = parse_expr; c = parse_catches; f = parse_finally >] -> ETry (wrap_var e,ref c,f) , punion p1 (pos e) | [< '(Kwd With,p1); v = parse_eval; e = parse_expr >] -> EWith (v,wrap_var e) , punion p1 (pos e) | [< e = parse_eval >] -> EVal e , pos e | [< _ = parse_include; e = parse_expr >] -> e and parse_eval = parser | [< '(Kwd Function,p1); '(POpen,_); args, _ = parse_args; t = parse_type_option; e = parse_expr; v = parse_eval_next (ELambda { fname = ""; fargs = args; ftype = t; fgetter = Normal; fstatic = IsStatic; fpublic = IsPublic; fexpr = Some e; } , punion p1 (pos e)) >] -> v | [< '(Kwd Throw,p1); e = parse_delete (EConst (Ident "throw"),p1) >] -> e | [< '(Kwd Delete,p1); e = parse_delete (EConst (Ident "delete"),p1) >] -> e | [< '(Kwd Typeof,p1); e = parse_delete (EConst (Ident "typeof"),p1) >] -> e | [< '(Kwd New,p1); v, p2 = parse_eval; s >] -> (match v with | ECall (v,args) -> parse_eval_next (ENew (v,args), punion p1 p2) s | _ -> parse_eval_next (ENew ((v,p2),[]), punion p1 p2) s) | [< '(Const c,p); e = parse_eval_next (EConst c,p) >] -> e | [< '(Kwd This,p); e = parse_eval_next (EConst (Ident "this"),p) >] -> e | [< '(POpen,p1); e = parse_eval; '(PClose,p2); e = parse_eval_next (EParenthesis e , punion p1 p2) >] -> e | [< '(BrOpen,p1); el, p2 = parse_field_list; e = parse_eval_next (EObjDecl el, punion p1 p2) >] -> e | [< '(BkOpen,p1); el, p2 = parse_array; e = parse_eval_next (EArrayDecl el,punion p1 p2) >] -> e | [< '(Unop op,p1) when is_prefix op; e = parse_eval >] -> make_unop op e p1 | [< '(Binop OpSub,p1); e = parse_eval >] -> make_unop Neg e p1 | [< _ = parse_include; e = parse_eval_next (EObjDecl [],null_pos) >] -> e and parse_eval_next e = parser | [< '(BkOpen,_); e2 = parse_eval; '(BkClose,p2); e = parse_eval_next (EArray (e,e2) , punion (pos e) p2) >] -> e | [< '(Binop op,_); e2 = parse_eval; >] -> make_binop op e e2 | [< '(Kwd And,_); e2 = parse_eval; >] -> make_binop OpBoolAnd e e2 | [< '(Dot,_); '(Const (Ident field),p2); e = parse_eval_next (EField (e,field), punion (pos e) p2) >] -> e | [< '(POpen,_); args = parse_eval_list; '(PClose,p2); e = parse_eval_next (ECall (e,args), punion (pos e) p2) >] -> e | [< '(Unop op,p2) when is_postfix e op; e = parse_eval_next (EUnop (op,Postfix,e), punion (pos e) p2) >] -> e | [< '(Question,_); v1 = parse_eval; '(DblDot,_); v2 = parse_eval; e = parse_eval_next (EQuestion (e,v1,v2), punion (pos e) (pos v2)) >] -> e | [< '(Kwd InstanceOf,p); v = parse_eval; s >] -> let iof v = ECall ((EConst (Ident "instanceof"), p),[e;v]) , punion (pos e) (pos v) in let rec loop = function | EBinop (op,e1,e2) , pv -> EBinop (op,loop e1,e2) , punion p pv | EQuestion (e,e1,e2) , pv -> EQuestion(loop e,e1,e2) , punion p pv | v -> iof v in parse_eval_next (loop v) s | [< >] -> e and parse_delete v = parser | [< e = parse_eval; s >] -> let rec loop = function | EBinop (op,e1,e2) , _ -> EBinop (op,loop e1,e2) , punion (pos e) (pos v) | e -> ECall (v , [e]) , punion (pos e) (pos v) in parse_eval_next (loop e) s | [< e = parse_eval_next v >] -> e and parse_catches = parser | [< '(Kwd Catch,_); '(POpen,_); '(Const (Ident name),_); t = parse_type_option; '(PClose,_); e = parse_expr; l = parse_catches >] -> (name, t, e) :: l | [< >] -> [] and parse_finally = parser | [< '(Kwd Finally,_); e = parse_expr >] -> Some e | [< >] -> None and parse_eval_option p = parser | [< v = parse_eval >] -> Some v , pos v | [< >] -> None, p and parse_eval_list = parser | [< v = parse_eval; vl = parse_eval_list2 >] -> v :: vl | [< '(Next,_) >] -> [] | [< >] -> [] and parse_eval_list2 = parser | [< '(Sep,_); v = parse_eval; vl = parse_eval_list2 >] -> v :: vl | [< '(Next,_) >] -> [] | [< >] -> [] and parse_field_list = parser | [< '(Const (Ident fname),_); '(DblDot,_); e = parse_eval; el , p = parse_field_list2 >] -> (fname,e) :: el , p | [< '(BrClose,p) >] -> [] , p and parse_field_list2 = parser | [< '(Sep,_); '(Const (Ident fname),_); '(DblDot,_); e = parse_eval; el , p = parse_field_list2 >] -> (fname,e) :: el , p | [< '(BrClose,p) >] -> [] , p and parse_array = parser | [< e = parse_eval; el , p = parse_array2 >] -> e :: el , p | [< '(BkClose,p) >] -> [] , p and parse_array2 = parser | [< '(Sep,_); e = parse_eval; el , p = parse_array2 >] -> e :: el , p | [< '(BkClose,p) >] -> [] , p and parse_else p = parser | [< '(Next,_); e = parse_else p >] -> e | [< '(Kwd Else,_); e = parse_expr >] -> Some (wrap_var e), pos e | [< >] -> None , p and parse_expr_opt = parser | [< e = parse_expr >] -> e | [< '(Next,p); >] -> EBlock [] , p and parse_for p c = parser | [< '(Kwd In,_); v = parse_eval; '(PClose,p2); e = parse_expr_opt >] -> EForIn(c,v,wrap_var e) , punion p p2 | [< cl = parse_for_conds; l1 = parse_eval_list; l2 = parse_eval_list; '(PClose,p2); e = parse_expr_opt >] -> EFor(c :: cl,l1,l2,wrap_var e) , punion p p2 and parse_for_conds = parser | [< '(Sep,_); e = parse_expr; l = parse_for_conds >] -> e :: l | [< '(Next,_) >] -> [] | [< >] -> [] and parse_args = parser | [< '(Const (Ident name),_); t = parse_type_option; al , p = parse_args2 >] -> (name , t) :: al , p | [< '(PClose,p) >] -> [] , p and parse_args2 = parser | [< '(Sep,_); '(Const (Ident name),_); t = parse_type_option; al , p = parse_args2 >] -> (name , t) :: al , p | [< '(PClose,p) >] -> [] , p and parse_vars p = parser | [< '(Const (Ident name),p); t = parse_type_option; v = parse_var_init; vl , p = parse_vars_next p >] -> (name , t, v) :: vl , p | [< >] -> [] , p and parse_vars_next p = parser | [< '(Sep,_); vl , p = parse_vars p >] -> vl , p | [< >] -> [] , p and parse_var_init = parser | [< '(Binop OpAssign,_); v = parse_eval >] -> Some v | [< >] -> None and parse_switch def = parser | [< '(BrClose,p) >] -> [] , p | [< '(Kwd Case,p); v = parse_eval; '(DblDot,_); c = parse_switch_clause; el, p2 = parse_switch def >] -> (Some v,(EBlock c,p)) :: el , p2 | [< '(Kwd Default,p); '(DblDot,_); c = parse_switch_clause; el, p2 = parse_switch true >] -> if def then error Duplicate_default p; (None, (EBlock c,p)) :: el , p2 and parse_switch_clause = parser | [< e = parse_expr; el = parse_switch_clause >] -> e :: el | [< '(Next,_); el = parse_switch_clause >] -> el | [< >] -> [] and parse_block callb sp = parser | [< e = callb; el,p = parse_block callb sp >] -> e :: el , p | [< '(Next,_); el = parse_block callb sp >] -> el | [< '(BrClose,p); >] -> [] , p | [< '(Eof,_) >] -> error Unclosed_parenthesis sp and parse_expr_list p = parser | [< e = parse_expr; el, p = parse_expr_list (pos e) >] -> e :: el , p | [< '(Next,_); el = parse_expr_list p >] -> el | [< >] -> [] , p and parse_type_option = parser | [< '(DblDot,_); t = parse_class_path >] -> Some t | [< >] -> None and parse_class_path s = last_comment := None; match s with parser | [< '(Const (Ident "Array"),_); s >] -> (match !last_comment with | None -> parse_class_path2 "Array" s | Some s -> ["#" ^ s] , "Array") | [< '(Const (Ident name),_); p = parse_class_path2 name >] -> p and parse_class_path2 name = parser | [< '(Dot,_); p , n = parse_class_path >] -> name :: p , n | [< >] -> [] , name and parse_import = parser | [< '(Const (Ident name),_); p = parse_import2 name >] -> p | [< '(Binop OpMult,_); >] -> [] , None and parse_import2 name = parser | [< '(Dot,_); p , n = parse_import >] -> name :: p , n | [< >] -> [] , Some name and parse_metadata = parser | [< '(BkClose,_) >] -> () | [< '(_) ; () = parse_metadata >] -> () and parse_include = parser | [< '(Sharp,p1); '(Const (Ident "include"),_); '(Const (String inc),p2) >] -> let t = "ComponentVersion.as" in let tl = String.length t in if String.length inc < tl || String.sub inc (String.length inc - tl) tl <> t then (!warning) "unsupported #include" (punion p1 p2) let parse code file = let old = Lexer.save() in Lexer.init file; let last = ref (Eof,null_pos) in let comments = ref [] in let rec next_token x = let t, p = Lexer.token code in match t with | Comment s | CommentLine s -> last_comment := Some s; comments := (s,p) :: !comments; next_token x | _ -> last := (t , p); Some (t , p) in try let l = parse_code (Stream.from next_token) in Lexer.restore old; l , List.rev !comments with | Stream.Error _ | Stream.Failure -> Lexer.restore old; error (Unexpected (fst !last)) (pos !last) | e -> Lexer.restore old; raise e mtasc-1.14/ocaml/mtasc/std/0000750000175000017500000000000011155145531014172 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std/Button.as0000640000175000017500000000201310311570510015757 0ustar pabspabsintrinsic class Button { var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var useHandCursor:Boolean; var enabled:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var trackAsMenu:Boolean; var menu:ContextMenu; function getDepth():Number; function onDragOut():Void; function onDragOver():Void; function onKillFocus(newFocus:Object):Void; function onPress():Void; function onRelease():Void; function onReleaseOutside():Void; function onRollOut():Void; function onRollOver():Void; function onSetFocus(oldFocus:Object):Void; function onKeyDown():Void; function onKeyUp():Void; } mtasc-1.14/ocaml/mtasc/std/Accessibility.as0000640000175000017500000000032210253251114017275 0ustar pabspabsintrinsic class Accessibility { static function isActive():Boolean; static function sendEvent(mc:MovieClip, childID:Object, event:Object, isNonHtml:Boolean):Void; static function updateProperties():Void; } mtasc-1.14/ocaml/mtasc/std/TopLevel.as0000640000175000017500000000410010645115466016254 0ustar pabspabs intrinsic class TopLevel { static var _quality:String; static var _focusrect:Boolean; static var _soundbuftime:Number; static var newline:String; static var Infinity:Number; static var NaN:Number; static function escape(value:String):String; static function unescape(value:String):String; static function parseInt(value:String,radix:Number):Number; static function parseFloat(value:String):Number; static function updateAfterEvent():Void; static function isNaN(value:Object):Boolean; static function isFinite(value:Object):Boolean; static function setInterval():Number; static function clearInterval(id:Number):Void; static function setTimeout():Number; static function clearTimeout(id:Number):Void; static function MMExecute(expr:String); // private members are not stored into _global, they need special compilation opcodes private static function FSCommand2(p1:Object,p2:Object); private static function getVersion():String; private static function trace(value):Void; private static function eval( e : String ); private static function getURL(url:String,target:String,vars:String):Void; private static function getTimer():Number; private static function random( n : Number ) : Number; private static function int( o : Object ) : Number; private static function string( o : Object ) : String; private static function chr( o : Number ) : String; private static function ord( s : String ) : Number; private static function delete( o ) : Boolean; private static function loadMovie( url : String, target : MovieClip, method : String ) : Void; private static function loadVariables( url : String, target : MovieClip, method : String ) : Void; private static function typeof( o ) : String; private static function instanceof( o : Object, cl : Object ) : Boolean; private static function targetPath( o : MovieClip ) : String; private static var arguments : FunctionArguments; private static function throw(x) : Void; private static function fscommand(x,y) : Void; private static function print(x,y : String) : Void; private static function stopAllSounds() : Void; } mtasc-1.14/ocaml/mtasc/std/ContextMenuItem.as0000640000175000017500000000053110253251115017601 0ustar pabspabsintrinsic dynamic class ContextMenuItem { var caption:String; var separatorBefore:Boolean; var enabled:Boolean; var visible:Boolean; function ContextMenuItem(caption:String, callbackFunction:Function, separatorBefore:Boolean, enabled:Boolean, visible:Boolean); function copy():ContextMenuItem; function onSelect():Void; } mtasc-1.14/ocaml/mtasc/std/Sound.as0000640000175000017500000000155410253251115015607 0ustar pabspabsintrinsic class Sound { var duration:Number; var id3:Object; var ID3:Object; var position:Number; function Sound(target:Object); function onLoad(success:Boolean):Void; function onSoundComplete():Void; function onID3():Void; function getPan():Number; function getTransform():Object; function getVolume():Number; function setPan(value:Number):Void; function setTransform(transformObject:Object):Void; function setVolume(value:Number):Void; function stop(linkageID:String):Void; function attachSound(id:String):Void; function start(secondOffset:Number, loops:Number):Void; function getDuration():Number; function setDuration(value:Number):Void; function getPosition():Number; function setPosition(value:Number):Void; function loadSound(url:String, isStreaming:Boolean):Void; function getBytesLoaded():Number; function getBytesTotal():Number; } mtasc-1.14/ocaml/mtasc/std/Video.as0000640000175000017500000000117610561363054015575 0ustar pabspabsintrinsic class Video { var _alpha : Number; var _height : Number; var _name : String; var _parent : MovieClip; var _rotation : Number; var _visible : Boolean; var _width : Number; var _x : Number; var _xmouse : Number; var _xscale : Number; var _y : Number; var _ymouse : Number; var _yscale : Number; var deblocking : Number; var height : Number; var smoothing : Boolean; var width : Number; function attachVideo(source : Object) : Void; function clear() : Void; // Flash Lite 2.x function close() : Void; function pause() : Void; function play() : Boolean; function resume() : Void; function stop() : Void; } mtasc-1.14/ocaml/mtasc/std/Camera.as0000640000175000017500000000150610146644551015717 0ustar pabspabsintrinsic class Camera { static var names:Array; static function get(index:Number):Camera; var nativeModes:Array; var keyFrameInterval:Number; var bandwidth:Number; var motionLevel:Number; var motionTimeOut:Number; var quality:Number; var loopback:Boolean; var width:Number; var height:Number; var fps:Number; var activityLevel:Number; var muted:Boolean; var currentFps:Number; var name:String; var index:Number; function setKeyFrameInterval(keyFrameInterval:Number):Void; function setLoopback(compress:Boolean):Void; function setMode(width:Number,height:Number,fps:Number,favorArea:Boolean):Void; function setMotionLevel(motionLevel:Number,timeOut:Number):Void; function setQuality(bandwidth:Number,quality:Number):Void; function onActivity(active:Boolean):Void; function onStatus(infoObject:Object):Void; } mtasc-1.14/ocaml/mtasc/std/XMLSocket.as0000640000175000017500000000046110253251115016324 0ustar pabspabsintrinsic class XMLSocket { function XMLSocket(); function connect(url:String,port:Number):Boolean; function send(data:Object):Boolean; function close():Boolean; function onData(src:String):Void; function onXML(src:XML):Void; function onConnect(success:Boolean):Void; function onClose():Void; } mtasc-1.14/ocaml/mtasc/std/Selection.as0000640000175000017500000000065210253251115016442 0ustar pabspabsintrinsic class Selection { static function getBeginIndex():Number; static function getEndIndex():Number; static function getCaretIndex():Number; static function getFocus():String; static function setFocus(newFocus:Object):Boolean; static function setSelection(beginIndex:Number, endIndex:Number):Void; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Boolean; } mtasc-1.14/ocaml/mtasc/std/ExtendedKey.as0000640000175000017500000000076110561363054016737 0ustar pabspabs// Flash Lite 2.x intrinsic class ExtendedKey { static var SOFT1:String = "soft1"; static var SOFT2:String = "soft2"; static var SOFT3:String = "soft3"; static var SOFT4:String = "soft4"; static var SOFT5:String = "soft5"; static var SOFT6:String = "soft6"; static var SOFT7:String = "soft7"; static var SOFT8:String = "soft8"; static var SOFT9:String = "soft9"; static var SOFT10:String = "soft10"; static var SOFT11:String = "soft11"; static var SOFT12:String = "soft12"; } mtasc-1.14/ocaml/mtasc/std/SharedObject.as0000640000175000017500000000131110561363054017053 0ustar pabspabsintrinsic class SharedObject { static function getLocal(name:String,localPath:String):SharedObject; static function getRemote(name:String,remotePath:String,persistence:Object):SharedObject; static function deleteAll(url:String); static function getDiskUsage(url:String); function connect(myConnection:NetConnection):Boolean; function send(handlerName:String):Void; function flush(minDiskSpace:Number):Object; function close():Void; function getSize():Number; function setFps(updatesPerSecond:Number):Boolean; function onStatus(infoObject:Object):Void; function onSync(objArray:Array):Void; function clear() : Void; var data:Object; // Flash Lite 2.x static function GetMaxSize():Number; } mtasc-1.14/ocaml/mtasc/std/FunctionArguments.as0000640000175000017500000000013410202700524020160 0ustar pabspabsintrinsic class FunctionArguments extends Array { function caller(); function callee(); } mtasc-1.14/ocaml/mtasc/std/TextFormat.as0000640000175000017500000000126210234573743016625 0ustar pabspabsintrinsic class TextFormat { var font:String; var size:Number; var color:Number; var url:String; var target:String; var bold:Boolean; var italic:Boolean; var underline:Boolean; var align:String; var leftMargin:Number; var rightMargin:Number; var indent:Number; var leading:Number; var blockIndent:Number; var tabStops:Array; var bullet:Boolean; function TextFormat(font:String,size:Number,textColor:Number, bold:Boolean,italic:Boolean,underline:Boolean, url:String,window:String,align:String, leftMargin:Number,rightMargin:Number,indent:Number,leading:Number); function getTextExtent(text:String):Object; } mtasc-1.14/ocaml/mtasc/std/LoadVars.as0000640000175000017500000000111110253251115016217 0ustar pabspabsdynamic intrinsic class LoadVars { var contentType:String; var loaded:Boolean; var _customHeaders:Array; function LoadVars(); function addRequestHeader(header:Object, headerValue:String):Void; function load(url:String):Boolean; function send(url:String,target:String,method:String):Boolean; function sendAndLoad(url:String,target,method:String):Boolean; function getBytesLoaded():Number; function getBytesTotal():Number; function decode(queryString:String):Void; function toString():String; function onLoad(success:Boolean):Void; function onData(src:String):Void; } mtasc-1.14/ocaml/mtasc/std/ArrayParam.as0000640000175000017500000000003010313032304016534 0ustar pabspabsinterface ArrayParam { }mtasc-1.14/ocaml/mtasc/std/TextField.as0000640000175000017500000000365510311570510016411 0ustar pabspabsdynamic intrinsic class TextField { var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var autoSize:Object; var background:Boolean; var backgroundColor:Number; var border:Boolean; var borderColor:Number; var bottomScroll:Number; var condenseWhite:Boolean; var embedFonts:Boolean; var hscroll:Number; var html:Boolean; var htmlText:String; var length:Number; var maxChars:Number; var maxhscroll:Number; var maxscroll:Number; var multiline:Boolean; var password:Boolean; var restrict:String; var scroll:Number; var selectable:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var text:String; var textColor:Number; var textHeight:Number; var textWidth:Number; var type:String; var variable:String; var wordWrap:Boolean; var mouseWheelEnabled:Boolean; var styleSheet:TextField.StyleSheet; function replaceText(beginIndex:Number,endIndex:Number,newText:String):Void; function replaceSel(newText:String):Void; function getTextFormat(beginIndex:Number,endIndex:Number):TextFormat; function setTextFormat():Void; function removeTextField():Void; function getNewTextFormat():TextFormat; function setNewTextFormat(tf:TextFormat):Void; function getDepth():Number; function addListener(listener:Object):Boolean; function removeListener(listener:Object):Boolean; static function getFontList():Array; function onChanged(changedField:TextField):Void; function onKillFocus(newFocus:Object):Void; function onScroller(scrolledField:TextField):Void; function onSetFocus(oldFocus:Object):Void; } mtasc-1.14/ocaml/mtasc/std/Error.as0000640000175000017500000000014610170742774015622 0ustar pabspabsintrinsic class Error { var name : String; var message : String; function Error(message:String); } mtasc-1.14/ocaml/mtasc/std/AsBroadcaster.as0000640000175000017500000000027310146634747017252 0ustar pabspabsintrinsic class AsBroadcaster { static function initialize(o:Object); static function broadcastMessage(msg:String); static function addListener(); static function removeListener(); } mtasc-1.14/ocaml/mtasc/std/Object.as0000640000175000017500000000112410366376453015740 0ustar pabspabsdynamic intrinsic class Object { function watch(name:String, callback:Function, userData:Object):Boolean; function unwatch(name:String):Boolean; function addProperty(name:String, getter:Function, setter:Function):Boolean; function hasOwnProperty(name:String):Boolean; function isPropertyEnumerable(name:String):Boolean; function isPrototypeOf(theClass:Object):Boolean; function toString():String; function valueOf():Object; var __proto__:Object; var constructor : Function; static function registerClass(name:String, theClass:Function):Boolean; static var prototype:Object; } mtasc-1.14/ocaml/mtasc/std/Key.as0000640000175000017500000000210310311570510015234 0ustar pabspabsintrinsic class Key { static var ALT :Number = 18; static var ENTER :Number = 13; static var SPACE :Number = 32; static var UP :Number = 38; static var DOWN :Number = 40; static var LEFT :Number = 37; static var RIGHT :Number = 39; static var PGUP :Number = 33; static var PGDN :Number = 34; static var HOME :Number = 36; static var END :Number = 35; static var TAB :Number = 9; static var CONTROL :Number = 17; static var SHIFT :Number = 16; static var ESCAPE :Number = 27; static var INSERT :Number = 45; static var DELETEKEY :Number = 46; static var BACKSPACE :Number = 8; static var CAPSLOCK :Number = 20; static var _listeners:Array; static function getAscii():Number; static function getCode():Number; static function isDown(code:Number):Boolean; static function isToggled(code:Number):Boolean; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Boolean; } mtasc-1.14/ocaml/mtasc/std/Date.as0000640000175000017500000000334010561363054015377 0ustar pabspabsintrinsic class Date { function Date(year:Number,month:Number,date:Number,hour:Number,min:Number,sec:Number,ms:Number); function getFullYear():Number; function getYear():Number; function getMonth():Number; function getDate():Number; function getDay():Number; function getHours():Number; function getMinutes():Number; function getSeconds():Number; function getMilliseconds():Number; function getUTCFullYear():Number; function getUTCYear():Number; function getUTCMonth():Number; function getUTCDate():Number; function getUTCDay():Number; function getUTCHours():Number; function getUTCMinutes():Number; function getUTCSeconds():Number; function getUTCMilliseconds():Number; function setFullYear(value:Number):Void; function setMonth(value:Number):Void; function setDate(value:Number):Void; function setHours(value:Number):Void; function setMinutes(value:Number):Void; function setSeconds(value:Number):Void; function setMilliseconds(value:Number):Void; function setUTCFullYear(value:Number):Void; function setUTCMonth(value:Number):Void; function setUTCDate(value:Number):Void; function setUTCHours(value:Number):Void; function setUTCMinutes(value:Number):Void; function setUTCSeconds(value:Number):Void; function setUTCMilliseconds(value:Number):Void; function getTime():Number; function setTime(value:Number):Void; function getTimezoneOffset():Number; function toString():String; function valueOf():Number; function setYear(value:Number):Void; // Flash Lite 2.x function getLocaleLongDate():String; function getLocaleShortDate():String; function getLocaleTime():String; static function UTC(year:Number,month:Number,date:Number, hour:Number,min:Number,sec:Number,ms:Number):Number; } mtasc-1.14/ocaml/mtasc/std/System/0000750000175000017500000000000011155145531015456 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std/System/security.as0000640000175000017500000000025010251060326017642 0ustar pabspabsintrinsic class System.security { static function allowDomain():Void; static function allowInsecureDomain():Void; static function loadPolicyFile(url:String):Void; } mtasc-1.14/ocaml/mtasc/std/System/capabilities.as0000640000175000017500000000331610561405440020436 0ustar pabspabsintrinsic class System.capabilities { static var hasAudio:Boolean; static var hasMP3:Boolean; static var hasAudioEncoder:Boolean; static var hasVideoEncoder:Boolean; static var screenResolutionX:Number; static var screenResolutionY:Number; static var screenDPI:Number; static var screenColor:String; static var pixelAspectRatio:Number; static var hasAccessibility:Boolean; static var input:String; static var isDebugger:Boolean; static var language:String; static var manufacturer:String; static var os:String; static var serverString:String; static var version:String; static var hasPrinting:Boolean; static var playerType:String; static var hasStreamingAudio:Boolean; static var hasScreenBroadcast:Boolean; static var hasScreenPlayback:Boolean; static var hasStreamingVideo:Boolean; static var hasEmbeddedVideo:Boolean; static var avHardwareDisable:Boolean; static var localFileReadDisable:Boolean; static var windowlessDisable:Boolean; // Flash Lite 2.x static var audioMIMETypes:Array; static var has4WayKeyAS:Boolean; static var hasCMIDI:Boolean; static var hasCompoundSound:Boolean; static var hasDataLoading:Boolean; static var hasEmail:Boolean; static var hasMappableSoftKeys:Boolean; static var hasMFI:Boolean; static var hasMIDI:Boolean; static var hasMMS:Boolean; static var hasMouse:Boolean; static var hasQWERTYKeyboard:Boolean; static var hasSharedObjects:Boolean; static var hasSMAF:Boolean; static var hasSMS:Number; static var hasStylus:Boolean; static var hasXMLSocket:Boolean; // added in Flash Lite 2.1 static var imageMIMETypes:Array; static var MIMETypes:Array; static var screenOrientation:String; static var softKeyCount:Number; static var videoMIMETypes:Array; } mtasc-1.14/ocaml/mtasc/std/TextField/0000750000175000017500000000000011155145531016062 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std/TextField/StyleSheet.as0000640000175000017500000000061410147110577020504 0ustar pabspabsintrinsic class TextField.StyleSheet { function getStyle(name:String):Object; function setStyle(name:String,style:Object):Void; function clear():Void; function getStyleNames():Array; function transform(style:Object):TextFormat; function parseCSS(cssText:String):Boolean; function parse(cssText:String):Boolean; function load(url:String):Boolean; function onLoad(success:Boolean):Void; } mtasc-1.14/ocaml/mtasc/std/MovieClipLoader.as0000640000175000017500000000046510253251115017535 0ustar pabspabsintrinsic class MovieClipLoader { function MovieClipLoader(); function addListener(listener:Object):Boolean; function getProgress(target:Object):Object; function loadClip(url:String, target:Object):Boolean; function removeListener(listener:Object):Boolean; function unloadClip(target:Object):Boolean; } mtasc-1.14/ocaml/mtasc/std/ArrayPoly.as0000640000175000017500000000117510313525200016434 0ustar pabspabsintrinsic class ArrayPoly extends Array { function push(value : ArrayParam):Number; function pop():Object; function concat(value:Object):/*ArrayParam*/Array; function shift():Object; function unshift(value:ArrayParam):Number; function slice(startIndex:Number, endIndex:Number):/*ArrayParam*/Array; function join(delimiter:String):String; function splice(startIndex:Number, deleteCount:Number, value:ArrayParam):/*ArrayParam*/Array; function toString():String; function sort(compare : Object, options: Number):/*ArrayParam*/Array; function reverse():Void; function sortOn(key:Object, options: Number):/*ArrayParam*/Array; } mtasc-1.14/ocaml/mtasc/std/Number.as0000640000175000017500000000036610351766264015766 0ustar pabspabsintrinsic class Number { function Number(num:Object); function valueOf():Number; static var NaN:Number; static var MAX_VALUE:Number; static var MIN_VALUE:Number; static var NEGATIVE_INFINITY:Number; static var POSITIVE_INFINITY:Number; } mtasc-1.14/ocaml/mtasc/std/PrintJob.as0000640000175000017500000000044610146644551016260 0ustar pabspabsintrinsic class PrintJob { function start():Boolean; function addPage(target:Object, printArea:Object, options:Object, frameNum:Number):Boolean; function send():Void; var paperWidth:Number; var paperHeight:Number; var pageWidth:Number; var pageHeight:Number; var orientation:String; } mtasc-1.14/ocaml/mtasc/std/Function.as0000640000175000017500000000023010253251115016272 0ustar pabspabsintrinsic dynamic class Function { var prototype:Object; function call(thisArg:Object):Object; function apply(thisArg:Object,args:Array):Object; } mtasc-1.14/ocaml/mtasc/std/Mouse.as0000640000175000017500000000031210253251115015576 0ustar pabspabsintrinsic class Mouse { static function show():Number; static function hide():Number; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Boolean; } mtasc-1.14/ocaml/mtasc/std/NetConnection.as0000640000175000017500000000055210253251115017262 0ustar pabspabsdynamic intrinsic class NetConnection { var isConnected : Boolean; var uri : String; function connect( targetURI : String) : Boolean; function call( remoteMethod : String, resultObject : Object) : Void; function onStatus(infoObject : Object) : Void; function onResult(infoObject : Object) : Void; function addHeader():Void; function close() : Void; } mtasc-1.14/ocaml/mtasc/std/XML.as0000640000175000017500000000130110234573743015162 0ustar pabspabsintrinsic class XML extends XMLNode { var contentType:String; var docTypeDecl:String; var ignoreWhite:Boolean; var loaded:Boolean; var status:Number; var xmlDecl:String; function XML(text:String); function createElement(name:String):XMLNode; function createTextNode(value:String):XMLNode; function parseXML(value:String):Void; function getBytesLoaded():Number; function getBytesTotal():Number; function load(url:String):Boolean; function send(url:String,target:String,method:String):Boolean; function sendAndLoad(url:String, resultXML):Void; function onLoad(success:Boolean):Void; function onData(src:String):Void; function addRequestHeader(header:Object, headerValue:String):Void; } mtasc-1.14/ocaml/mtasc/std/MovieClip.as0000640000175000017500000000623110313536447016416 0ustar pabspabsdynamic intrinsic class MovieClip { var useHandCursor:Boolean; var enabled:Boolean; var focusEnabled:Boolean; var tabChildren:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var hitArea:Object; var trackAsMenu:Boolean; var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _lockroot:Boolean; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var menu:ContextMenu; function getURL(url:String,window:String,method:String):Void; function unloadMovie():Void; function loadVariables(url:String,method:String):Void; function loadMovie(url:String,method:String):Void; function attachMovie(id:String,name:String,depth:Number,initObject:Object):MovieClip; function swapDepths(mc:Object):Void; function localToGlobal(pt:Object):Void; function globalToLocal(pt:Object):Void; function hitTest():Boolean; function getBounds(bounds:Object):Object; function getSWFVersion():Number; function getBytesLoaded():Number; function getBytesTotal():Number; function attachAudio(id:Object):Void; function attachVideo(id:Object):Void; function getDepth():Number; function getInstanceAtDepth(depth:Number):MovieClip; function getNextHighestDepth():Number; function setMask(mc:Object):Void; function play():Void; function stop():Void; function nextFrame():Void; function prevFrame():Void; function gotoAndPlay(frame:Object):Void; function gotoAndStop(frame:Object):Void; function duplicateMovieClip(name:String,depth:Number,initObject:Object):MovieClip; function removeMovieClip():Void; function startDrag(lockCenter:Boolean,left:Number,top:Number,right:Number,bottom:Number):Void; function stopDrag():Void; function createEmptyMovieClip(name:String,depth:Number):MovieClip; function beginFill(rgb:Number,alpha:Number):Void; function beginGradientFill(fillType:String,colors:Array,alphas:Array,ratios:Array,matrix:Object):Void; function moveTo(x:Number,y:Number):Void; function lineTo(x:Number,y:Number):Void; function curveTo(controlX:Number,controlY:Number,anchorX:Number,anchorY:Number):Void; function lineStyle(thickness:Number,rgb:Number,alpha:Number):Void; function endFill():Void; function clear():Void; function createTextField(instanceName:String,depth:Number,x:Number,y:Number,width:Number,height:Number):Void; function getTextSnapshot():TextSnapshot; function onData():Void; function onDragOut():Void; function onDragOver():Void; function onEnterFrame():Void; function onKeyDown():Void; function onKeyUp():Void; function onKillFocus(newFocus:Object):Void; function onLoad():Void; function onMouseDown():Void; function onMouseMove():Void; function onMouseUp():Void; function onPress():Void; function onRelease():Void; function onReleaseOutside():Void; function onRollOut():Void; function onRollOver():Void; function onSetFocus(oldFocus:Object):Void; function onUnload():Void; } mtasc-1.14/ocaml/mtasc/std/Array.as0000640000175000017500000000133410405542146015577 0ustar pabspabsintrinsic dynamic class Array { static var CASEINSENSITIVE:Number; static var DESCENDING:Number; static var UNIQUESORT:Number; static var RETURNINDEXEDARRAY:Number; static var NUMERIC:Number; var length:Number; function push(value : Object):Number; function pop():Object; function concat(value:Object):Array; function shift():Object; function unshift(value:Object):Number; function slice(startIndex:Number, endIndex:Number):Array; function join(delimiter:String):String; function splice(startIndex:Number, deleteCount:Number, value:Object):Array; function toString():String; function sort(compare : Object, options: Number):Array; function reverse():Void; function sortOn(key:Object, options: Object):Array; } mtasc-1.14/ocaml/mtasc/std/NetStream.as0000640000175000017500000000164610467114565016441 0ustar pabspabsdynamic intrinsic class NetStream { var time:Number; var currentFps:Number; var bufferTime:Number; var bufferLength:Number; var liveDelay:Number; var bytesLoaded:Number; var bytesTotal:Number; function NetStream(connection:NetConnection); function onMetaData(info:Object):Void; function onStatus(info:Object):Void; function publish(name:Object, type:String):Void; function play(name:Object, start:Number, len:Number, reset:Object); function receiveAudio(flag:Boolean):Void; function receiveVideo(flag:Object):Void; function pause(flag:Boolean):Void; function seek(offset:Number):Void; function close():Void; function attachAudio(theMicrophone:Microphone):Void; function attachVideo(theCamera:Camera,snapshotMilliseconds:Number):Void; function send(handlerName:String):Void; function setBufferTime(bufferTime:Number):Void; function onPlayStatus(info:Object):Void; function onCuePoint(info:Object):Void; } mtasc-1.14/ocaml/mtasc/std/XMLNode.as0000640000175000017500000000150310311570510015755 0ustar pabspabsintrinsic class XMLNode { var attributes:Object; var childNodes:Array; var firstChild:XMLNode; var lastChild:XMLNode; var nextSibling:XMLNode; var nodeName:String; var nodeType:Number; var nodeValue:String; var parentNode:XMLNode; var previousSibling:XMLNode; function XMLNode(type:Number, value:String); function cloneNode(deep:Boolean):XMLNode; function removeNode():Void; function insertBefore(newChild:XMLNode,insertPoint:XMLNode):Void; function appendChild(newChild:XMLNode):Void; function hasChildNodes():Boolean; function toString():String; function addTreeNodeAt(index:Number, arg1:Object, arg2:Object):XMLNode; function addTreeNode(arg1:Object, arg2:Object):XMLNode; function getTreeNodeAt(index:Number):XMLNode; function removeTreeNodeAt(index:Number):XMLNode; function removeTreeNode():XMLNode; } mtasc-1.14/ocaml/mtasc/std/Stage.as0000640000175000017500000000042510253251115015556 0ustar pabspabsintrinsic class Stage { static var width:Number; static var height:Number; static var scaleMode:String; static var align:String; static var showMenu:Boolean; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Void; } mtasc-1.14/ocaml/mtasc/std/String.as0000640000175000017500000000121210351766264015773 0ustar pabspabsintrinsic class String { function String(string:String); function toUpperCase():String; function toLowerCase():String; function charAt(index:Number):String; function charCodeAt(index:Number):Number; function concat():String; function indexOf(value:String, startIndex:Number):Number; function lastIndexOf(value:String, startIndex:Number):Number; function slice(index1:Number,index2:Number):String; function substring(index1:Number,index2:Number):String; function split(delimiter:String):Array; function substr(index1:Number,index2:Number):String; function valueOf():String; static function fromCharCode():String; var length:Number; } mtasc-1.14/ocaml/mtasc/std/Color.as0000640000175000017500000000032310253251115015566 0ustar pabspabsintrinsic class Color { function Color(target:Object); function setRGB(offset:Number):Void; function setTransform(transformObject:Object):Void; function getRGB():Number; function getTransform():Object; } mtasc-1.14/ocaml/mtasc/std/LocalConnection.as0000640000175000017500000000062110253251115017563 0ustar pabspabsdynamic intrinsic class LocalConnection { function LocalConnection(); function connect(connectionName:String):Boolean; function send(connectionName:String, methodName:String, args:Object):Boolean; function close():Void; function domain():String; function allowDomain(domain:String):Boolean; function allowInsecureDomain(domain:String):Boolean; function onStatus(infoObject:Object):Void; } mtasc-1.14/ocaml/mtasc/std/Microphone.as0000640000175000017500000000114510146644551016631 0ustar pabspabsintrinsic class Microphone { static var names:Array; static function get(index:Number):Microphone; var gain:Number; var index:Number; var activityLevel:Number; var name:String; var silenceLevel:Number; var silenceTimeOut:Number; var rate:Number; var useEchoSuppression:Boolean; var muted:Boolean; function setSilenceLevel(silenceLevel:Number,timeOut:Number):Void; function setRate(rate:Number):Void; function setGain(gain:Number):Void; function setUseEchoSuppression(useEchoSuppression:Boolean):Void; function onActivity(active:Boolean):Void; function onStatus(infoObject:Object):Void; } mtasc-1.14/ocaml/mtasc/std/StdPresent.as0000640000175000017500000000012710142035075016607 0ustar pabspabs// only needed in order to check that we can find 'std' intrinsic class StdPresent { } mtasc-1.14/ocaml/mtasc/std/Math.as0000640000175000017500000000205110136132463015405 0ustar pabspabsintrinsic class Math { static var E:Number; static var LN10:Number; static var LN2:Number; static var LOG10E:Number; static var LOG2E:Number; static var PI:Number; static var SQRT1_2:Number; static var SQRT2:Number; static function abs(value:Number):Number; static function min(value1:Number,value2:Number):Number; static function max(value1:Number,value2:Number):Number; static function sin(value:Number):Number; static function cos(value:Number):Number; static function atan2(value1:Number,value2:Number):Number; static function tan(value:Number):Number; static function exp(value:Number):Number; static function log(value:Number):Number; static function sqrt(value:Number):Number; static function round(value:Number):Number; static function random():Number; static function floor(value:Number):Number; static function ceil(value:Number):Number; static function atan(value:Number):Number; static function asin(value:Number):Number; static function acos(value:Number):Number; static function pow(value1:Number,value2:Number):Number; } mtasc-1.14/ocaml/mtasc/std/TextSnapshot.as0000640000175000017500000000114210607634043017164 0ustar pabspabsintrinsic class TextSnapshot { function findText(startIndex:Number, textToFind:String, caseSensitive:Boolean):Number; function getCount():Number; function getSelected(start:Number, end:Number):Boolean; function getSelectedText(includeLineEndings:Boolean):String; function getText(start:Number, end:Number, includeLineEndings:Boolean):String; function hitTestTextNearPos(x:Number, y:Number, closeDist:Number):Number; function setSelectColor(color:Number):Void; function setSelected(start:Number, end:Number, select:Boolean):Void; function getTextRunInfo(beginIndex:Number, endIndex:Number):Array; } mtasc-1.14/ocaml/mtasc/std/System.as0000640000175000017500000000037210253251115016000 0ustar pabspabsintrinsic class System { static var useCodepage:Boolean; static var exactSettings:Boolean; static function showSettings(tabID:Number):Void; static function setClipboard(text:String):Void; static function onStatus(infoObject:Object):Void; } mtasc-1.14/ocaml/mtasc/std/Boolean.as0000640000175000017500000000007210253251115016070 0ustar pabspabsintrinsic class Boolean { function valueOf():Boolean; } mtasc-1.14/ocaml/mtasc/std/ContextMenu.as0000640000175000017500000000035410253251115016765 0ustar pabspabsintrinsic dynamic class ContextMenu { var customItems:Array; var builtInItems:Object; function ContextMenu(callbackFunction:Function); function copy():ContextMenu; function hideBuiltInItems():Void; function onSelect():Void; } mtasc-1.14/ocaml/mtasc/std8/0000750000175000017500000000000011155145531014262 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/Button.as0000640000175000017500000000221610311570510016054 0ustar pabspabsintrinsic class Button { var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var useHandCursor:Boolean; var enabled:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var trackAsMenu:Boolean; var menu:ContextMenu; function getDepth():Number; function onDragOut():Void; function onDragOver():Void; function onKillFocus(newFocus:Object):Void; function onPress():Void; function onRelease():Void; function onReleaseOutside():Void; function onRollOut():Void; function onRollOver():Void; function onSetFocus(oldFocus:Object):Void; function onKeyDown():Void; function onKeyUp():Void; // Flash 8 var scale9Grid : flash.geom.Rectangle; var filters : Array; var cacheAsBitmap : Boolean; var blendMode : String; } mtasc-1.14/ocaml/mtasc/std8/TextFormat.as0000640000175000017500000000135710355535572016724 0ustar pabspabsintrinsic class TextFormat { var font:String; var size:Number; var color:Number; var url:String; var target:String; var bold:Boolean; var italic:Boolean; var underline:Boolean; var align:String; var leftMargin:Number; var rightMargin:Number; var indent:Number; var leading:Number; var blockIndent:Number; var tabStops:Array; var bullet:Boolean; function TextFormat(font:String,size:Number,textColor:Number, bold:Boolean,italic:Boolean,underline:Boolean, url:String,window:String,align:String, leftMargin:Number,rightMargin:Number,indent:Number,leading:Number); function getTextExtent(text:String):Object; // Flash8 var kerning:Boolean; var letterSpacing:Number; } mtasc-1.14/ocaml/mtasc/std8/TextField.as0000640000175000017500000000407310311570510016474 0ustar pabspabsdynamic intrinsic class TextField { var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var autoSize:Object; var background:Boolean; var backgroundColor:Number; var border:Boolean; var borderColor:Number; var bottomScroll:Number; var condenseWhite:Boolean; var embedFonts:Boolean; var hscroll:Number; var html:Boolean; var htmlText:String; var length:Number; var maxChars:Number; var maxhscroll:Number; var maxscroll:Number; var multiline:Boolean; var password:Boolean; var restrict:String; var scroll:Number; var selectable:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var text:String; var textColor:Number; var textHeight:Number; var textWidth:Number; var type:String; var variable:String; var wordWrap:Boolean; var mouseWheelEnabled:Boolean; var styleSheet:TextField.StyleSheet; function replaceText(beginIndex:Number,endIndex:Number,newText:String):Void; function replaceSel(newText:String):Void; function getTextFormat(beginIndex:Number,endIndex:Number):TextFormat; function setTextFormat():Void; function removeTextField():Void; function getNewTextFormat():TextFormat; function setNewTextFormat(tf:TextFormat):Void; function getDepth():Number; function addListener(listener:Object):Boolean; function removeListener(listener:Object):Boolean; static function getFontList():Array; function onChanged(changedField:TextField):Void; function onKillFocus(newFocus:Object):Void; function onScroller(scrolledField:TextField):Void; function onSetFocus(oldFocus:Object):Void; // Flash 8 var antiAliasType : String; var filters : Array; var gridFitType : String; var sharpness : Number; var thickness : Number; } mtasc-1.14/ocaml/mtasc/std8/Key.as0000640000175000017500000000217410311570510015334 0ustar pabspabsintrinsic class Key { static var ALT :Number = 18; static var ENTER :Number = 13; static var SPACE :Number = 32; static var UP :Number = 38; static var DOWN :Number = 40; static var LEFT :Number = 37; static var RIGHT :Number = 39; static var PGUP :Number = 33; static var PGDN :Number = 34; static var HOME :Number = 36; static var END :Number = 35; static var TAB :Number = 9; static var CONTROL :Number = 17; static var SHIFT :Number = 16; static var ESCAPE :Number = 27; static var INSERT :Number = 45; static var DELETEKEY :Number = 46; static var BACKSPACE :Number = 8; static var CAPSLOCK :Number = 20; static var _listeners:Array; static function getAscii():Number; static function getCode():Number; static function isDown(code:Number):Boolean; static function isToggled(code:Number):Boolean; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Boolean; // Flash 8 static function isAccessible() : Boolean; } mtasc-1.14/ocaml/mtasc/std8/System/0000750000175000017500000000000011155145531015546 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/System/security.as0000640000175000017500000000033310427061200017731 0ustar pabspabsintrinsic class System.security { static function allowDomain():Void; static function allowInsecureDomain():Void; static function loadPolicyFile(url:String):Void; static function sandboxType():String; } mtasc-1.14/ocaml/mtasc/std8/System/IME.as0000640000175000017500000000137110313536447016515 0ustar pabspabsintrinsic class System.IME { static var ALPHANUMERIC_FULL : String; static var ALPHANUMERIC_HALF : String; static var CHINESE : String; static var JAPANESE_HIRAGANA : String; static var JAPANESE_KATAKANA_FULL : String; static var JAPANESE_KATAKANA_HALF : String; static var KOREAN : String; static var UNKNOWN : String; static function getEnabled() : Boolean; static function setEnabled(enabled:Boolean) : Boolean; static function getConversionMode() : String; static function setConversionMode(mode:String) : Boolean; static function setCompositionString (composition:String) : Boolean; static function doConversion() : Boolean; static function addListener(listener:Object) : Void; static function removeListener(listener:Object) : Boolean; } mtasc-1.14/ocaml/mtasc/std8/MovieClip.as0000640000175000017500000000732410636001476016507 0ustar pabspabsdynamic intrinsic class MovieClip { var useHandCursor:Boolean; var enabled:Boolean; var focusEnabled:Boolean; var tabChildren:Boolean; var tabEnabled:Boolean; var tabIndex:Number; var hitArea:Object; var trackAsMenu:Boolean; var _x:Number; var _y:Number; var _xmouse:Number; var _ymouse:Number; var _xscale:Number; var _yscale:Number; var _width:Number; var _height:Number; var _alpha:Number; var _lockroot:Boolean; var _visible:Boolean; var _target:String; var _rotation:Number; var _name:String; var _framesloaded:Number; var _droptarget:String; var _currentframe:Number; var _totalframes:Number; var _quality:String; var _focusrect:Boolean; var _soundbuftime:Number; var _url:String; var _parent:MovieClip; var menu:ContextMenu; function getURL(url:String,window:String,method:String):Void; function unloadMovie():Void; function loadVariables(url:String,method:String):Void; function loadMovie(url:String,method:String):Void; function attachMovie(id:String,name:String,depth:Number,initObject:Object):MovieClip; function swapDepths(mc:Object):Void; function localToGlobal(pt:Object):Void; function globalToLocal(pt:Object):Void; function hitTest():Boolean; function getBounds(bounds : Object):Object; function getBytesLoaded():Number; function getBytesTotal():Number; function attachAudio(id:Object):Void; function attachVideo(id:Object):Void; function getDepth():Number; function getInstanceAtDepth(depth:Number):MovieClip; function getNextHighestDepth():Number; function setMask(mc:Object):Void; function play():Void; function stop():Void; function nextFrame():Void; function prevFrame():Void; function gotoAndPlay(frame:Object):Void; function gotoAndStop(frame:Object):Void; function duplicateMovieClip(name:String,depth:Number,initObject:Object):MovieClip; function removeMovieClip():Void; function startDrag(lockCenter:Boolean,left:Number,top:Number,right:Number,bottom:Number):Void; function stopDrag():Void; function createEmptyMovieClip(name:String,depth:Number):MovieClip; function beginFill(rgb:Number,alpha:Number):Void; function beginGradientFill(fillType:String,colors:Array,alphas:Array,ratios:Array,matrix:Object):Void; function moveTo(x:Number,y:Number):Void; function lineTo(x:Number,y:Number):Void; function curveTo(controlX:Number,controlY:Number,anchorX:Number,anchorY:Number):Void; function lineStyle(thickness:Number,rgb:Number,alpha:Number,pixelHinting:Boolean,noScale:String,capsStyle:String,jointStyle:String,miterLimit:Number):Void; function endFill():Void; function clear():Void; function createTextField(instanceName:String,depth:Number,x:Number,y:Number,width:Number,height:Number):TextField; /* Void before Flash 8 */ function getTextSnapshot():TextSnapshot; function getSWFVersion():Number; function onData():Void; function onDragOut():Void; function onDragOver():Void; function onEnterFrame():Void; function onKeyDown():Void; function onKeyUp():Void; function onKillFocus(newFocus:Object):Void; function onLoad():Void; function onMouseDown():Void; function onMouseMove():Void; function onMouseUp():Void; function onPress():Void; function onRelease():Void; function onReleaseOutside():Void; function onRollOut():Void; function onRollOver():Void; function onSetFocus(oldFocus:Object):Void; function onUnload():Void; // FLASH 8 var filters : Array; var blendMode : Object; var cacheAsBitmap : Boolean; var opaqueBackground : Number; var scrollRect : Object; var transform : flash.geom.Transform; var scale9Grid : flash.geom.Rectangle; function getRect( bounds : Object ) : Object; function attachBitmap( bmp : flash.display.BitmapData, depth : Number, pixelSnapping : String, smoothing : Boolean ) : Void; // FLASH 9 var forceSmoothing : Boolean; } mtasc-1.14/ocaml/mtasc/std8/flash/0000750000175000017500000000000011155145531015357 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/external/0000750000175000017500000000000011155145531017201 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/external/ExternalInterface.as0000640000175000017500000000036210311565566023142 0ustar pabspabsintrinsic class flash.external.ExternalInterface { static var available : Boolean; static function addCallback( methodName : String, instance : Object, method : Function) : Boolean; static function call( methodName : String ) : Object; }mtasc-1.14/ocaml/mtasc/std8/flash/display/0000750000175000017500000000000011155145531017024 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/display/BitmapData.as0000640000175000017500000000534710620302073021361 0ustar pabspabsimport flash.geom.Rectangle; import flash.geom.Point; intrinsic class flash.display.BitmapData { static function loadBitmap( id : String ) : BitmapData; var width : Number; var height : Number; var rectangle : Rectangle; var transparent : Boolean; function BitmapData( width : Number, height : Number, transparent : Boolean, fillcolor : Number ); function getPixel( x : Number, y : Number ) : Number; function setPixel( x : Number, y : Number, color : Number ) : Void; function getPixel32( x : Number, y : Number ) : Number; function setPixel32( x : Number, y : Number, color : Number ) : Void; function fillRect( r : Rectangle, color : Number ) : Void; function copyPixels( src : BitmapData, srcRect : Rectangle, dst : Point, alpha : BitmapData, alphaPos : Point, mergeAlpha : Boolean ) : Void; function applyFilter( source : BitmapData, sourceRect : Rectangle, dest : Point, filter : flash.filters.BitmapFilter ) : Number; function scroll( dx : Number, dy : Number ) : Void; function threshold( src : BitmapData , srcRect : Rectangle, dstPoint : Point, op : String, threshold : Number, color : Number, mask : Number, copy : Boolean ) : Number; function draw( source : Object, matrix : flash.geom.Matrix, colortrans : flash.geom.ColorTransform, blendMode : Object, clipRect : Rectangle, smooth : Boolean) : Void; function pixelDissolve( src : BitmapData, srcRect : Rectangle, dst : Point, seed : Number, npixels : Number, fillColor : Number ) : Number; function floodFill( x : Number, y : Number, color : Number ) : Void; function getColorBoundsRect( mask : Number, color : Number, fillColor : Boolean ) : Rectangle; function perlinNoise( x : Number, y : Number, num : Number, seed : Number, stitch : Boolean, noise : Boolean, channels : Number, gray : Boolean, offsets : Object ) : Void; function colorTransform( r : Rectangle, trans : flash.geom.ColorTransform ) : Void; function hitTest( firstPoint : Point, firstAlpha : Number, object : Object, secondPoint : Point, secondAlpha : Number ) : Boolean; function paletteMap( source : BitmapData, srcRect : Rectangle, dst : Point, reds : Array, greens, Array, blues : Array, alphas : Array ) : Void; function merge( src : BitmapData, srcRect : Rectangle, dst : Point, redMult : Number, greenMult : Number, blueMult : Number, alphaMult : Number ) : Void; function noise( seed : Number, low : Number, high : Number, channels : Number, gray : Boolean ) : Void; function copyChannel( source : BitmapData, sourceRect : Rectangle, dest : Point, sourceChannel : Number, destChannel : Number ) : Void; function clone() : BitmapData; function dispose() : Void; function generateFilterRect(sourceRect : Rectangle, filter : flash.filters.BitmapFilter ) : Rectangle; function compare( b : BitmapData ) : Object; }mtasc-1.14/ocaml/mtasc/std8/flash/filters/0000750000175000017500000000000011155145531017027 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/filters/ConvolutionFilter.as0000640000175000017500000000101010313536447023037 0ustar pabspabsintrinsic class flash.filters.ConvolutionFilter extends flash.filters.BitmapFilter { var alpha : Number; var color : Number; var clamp : Boolean; var preserveAlpha : Boolean; var bias : Number; var divisor : Number; var matrix : Array; var matrixX : Number; var matrixY : Number; function ConvolutionFilter(matrixX : Number, matrixY : Number, matrix : Array, divisor : Number, bias : Number, preserveAlpha : Boolean, clamp : Boolean, color : Number, alpha : Number); function clone() : ConvolutionFilter; }mtasc-1.14/ocaml/mtasc/std8/flash/filters/DropShadowFilter.as0000640000175000017500000000113010313536447022575 0ustar pabspabsintrinsic class flash.filters.DropShadowFilter extends flash.filters.BitmapFilter { var hideObject : Boolean; var blurX : Number; var blurY : Number; var knockout : Boolean; var strength : Number; var inner : Boolean; var quality : Number; var alpha : Number; var color : Number; var angle : Number; var distance : Number; function DropShadowFilter(distance : Number, angle : Number, color : Number, alpha : Number, blurX : Number, blurY : Number, strength : Number, quality : Number, inner : Boolean, knockout : Boolean, hideObject : Boolean); function clone() : DropShadowFilter; } mtasc-1.14/ocaml/mtasc/std8/flash/filters/GradientGlowFilter.as0000640000175000017500000000111510313536447023114 0ustar pabspabsintrinsic class flash.filters.GradientGlowFilter extends flash.filters.BitmapFilter { var type : String; var knockout : Boolean; var strength : Number; var quality : Number; var blurX : Number; var blurY : Number; var ratios : Array; var alphas : Array; var colors : Array; var angle : Number; var distance : Number; function GradientGlowFilter(distance : Number, angle : Number, colors : Array, alphas : Array, ratios : Array, blurX : Number, blurY : Number, strength : Number, quality : Number, type : String, knockout : Boolean); function clone() : GradientGlowFilter; }mtasc-1.14/ocaml/mtasc/std8/flash/filters/BitmapFilter.as0000640000175000017500000000015510265460443021743 0ustar pabspabsintrinsic class flash.filters.BitmapFilter { function BitmapFilter(); function clone() : BitmapFilter; } mtasc-1.14/ocaml/mtasc/std8/flash/filters/BlurFilter.as0000640000175000017500000000036510313536447021440 0ustar pabspabsintrinsic class flash.filters.BlurFilter extends flash.filters.BitmapFilter { var quality : Number; var blurX : Number; var blurY : Number; function BlurFilter( bx : Number, by : Number, qual : Number ); function clone() : BlurFilter; } mtasc-1.14/ocaml/mtasc/std8/flash/filters/BevelFilter.as0000640000175000017500000000123210313536447021563 0ustar pabspabsintrinsic class flash.filters.BevelFilter extends flash.filters.BitmapFilter { var type : String; var blurX : Number; var blurY : Number; var knockout : Boolean; var strength : Number; var quality : Number; var shadowAlpha : Number; var shadowColor : Number; var highlightAlpha : Number; var highlightColor : Number; var angle : Number; var distance : Number; function BevelFilter(distance : Number, angle : Number, highlightColor : Number, highlightAlpha : Number, shadowColor : Number, shadowAlpha : Number, blurX : Number, blurY : Number, strength : Number, quality : Number, type : String, knockout : Boolean); function clone() : BevelFilter; } mtasc-1.14/ocaml/mtasc/std8/flash/filters/GlowFilter.as0000640000175000017500000000070410313536447021441 0ustar pabspabsintrinsic class flash.filters.GlowFilter extends flash.filters.BitmapFilter { var blurX : Number; var blurY : Number; var knockout : Boolean; var strength : Number; var quality : Number; var inner : Boolean; var alpha : Number; var color : Number; function GlowFilter(color : Number, alpha : Number, blurX : Number, blurY : Number, strength : Number, quality : Number, inner : Boolean, knockout : Boolean) function clone() : GlowFilter; } mtasc-1.14/ocaml/mtasc/std8/flash/filters/ColorMatrixFilter.as0000640000175000017500000000032210313536447022770 0ustar pabspabsintrinsic class flash.filters.ColorMatrixFilter extends flash.filters.BitmapFilter { var matrix : Array; // 20 Numbers function ColorMatrixFilter( matrix : Array ); function clone() : ColorMatrixFilter; }mtasc-1.14/ocaml/mtasc/std8/flash/filters/GradientBevelFilter.as0000640000175000017500000000112010313536447023235 0ustar pabspabsintrinsic class flash.filters.GradientBevelFilter extends flash.filters.BitmapFilter { var type : String; var knockout : Boolean; var strength : Number; var quality : Number; var blurX : Number; var blurY : Number; var ratios : Array; var alphas : Array; var colors : Array; var angle : Number; var distance : Number; function GradientBevelFilter(distance : Number, angle : Number, colors : Array, alphas : Array, ratios : Array, blurX : Number, blurY : Number, strength : Number, quality : Number, type : String, knockout : Boolean); function clone() : GradientBevelFilter; }mtasc-1.14/ocaml/mtasc/std8/flash/filters/DisplacementMapFilter.as0000640000175000017500000000112210313536447023572 0ustar pabspabsintrinsic class flash.filters.DisplacementMapFilter extends flash.filters.BitmapFilter { var alpha : Number; var color : Number; var mode : String; var scaleX : Number; var scaleY : Number; var componentX : Number; var componentY : Number; var mapPoint : flash.geom.Point; var mapBitmap : flash.display.BitmapData; function DisplacementMapFilter(mapBitmap : flash.display.BitmapData, mapPoint : flash.geom.Point, componentX : Number, componentY : Number, scaleX : Number, scaleY : Number, mode : String, color : Number, alpha : Number); function clone() : DisplacementMapFilter; }mtasc-1.14/ocaml/mtasc/std8/flash/geom/0000750000175000017500000000000011155145531016306 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/geom/Transform.as0000640000175000017500000000046710311565566020625 0ustar pabspabsintrinsic class flash.geom.Transform { var matrix : flash.geom.Matrix; var concatenatedMatrix : flash.geom.Matrix; var colorTransform : flash.geom.ColorTransform; var concatenatedColorTransform : flash.geom.ColorTransform; var pixelBounds : flash.geom.Rectangle; function Transform( mc : MovieClip ); }mtasc-1.14/ocaml/mtasc/std8/flash/geom/Point.as0000640000175000017500000000115510311565566017736 0ustar pabspabsintrinsic class flash.geom.Point { var x : Number; var y : Number; var length : Number; function Point( x : Number, y : Number ); function normalize( length : Number ) : Void; function add( p : Point ) : Point; function subtract( p : Point ) : Point; function equals( p : Object ) : Boolean; function offset( dx : Number, dy : Number ) : Void; function clone() : Point; function toString() : String; static function distance( p1 : Point, p2 : Point ) : Number; static function interpolate( p1 : Point, p2 : Point, f : Number ) : Point; static function polar( dist : Number, angle : Number ) : Point; }mtasc-1.14/ocaml/mtasc/std8/flash/geom/Rectangle.as0000640000175000017500000000203010311565566020542 0ustar pabspabsimport flash.geom.Point; intrinsic class flash.geom.Rectangle { var left : Number; var top : Number; var right : Number; var bottom : Number; // OR var x : Number; var y : Number; var width : Number; var height : Number; // OR var size : Point; var bottomRight : Point; var topLeft : Point; function Rectangle( x : Number, y : Number, w : Number, h : Number ); function equals( r : Object ) : Boolean; function union( r : Rectangle ) : Rectangle; function intersects( r : Rectangle ) : Boolean; function intersection( r : Rectangle ) : Rectangle; function containsRectangle( r : Rectangle ) : Boolean; function containsPoint( p : Point ) : Boolean; function contains( x : Number, y : Number ) : Boolean; function offsetPoint( p : Point ) : Void; function offset( x : Number, y : Number ) : Void; function inflatePoint( p : Point ) : Void; function inflate( x : Number, y : Number ) : Void; function isEmpty() : Boolean; function setEmpty() : Void; function clone() : Rectangle; function toString() : String; }mtasc-1.14/ocaml/mtasc/std8/flash/geom/ColorTransform.as0000640000175000017500000000076710320412505021607 0ustar pabspabsintrinsic class flash.geom.ColorTransform { var rgb : Number; var blueOffset : Number; var greenOffset : Number; var redOffset : Number; var alphaOffset : Number; var blueMultiplier : Number; var greenMultiplier : Number; var redMultiplier : Number; var alphaMultiplier : Number; function ColorTransform( rm : Number, gm : Number, bm : Number, am : Number, ro : Number, go : Number, bo : Number, ao : Number ); function toString() : String; function concat( c : ColorTransform ) : Void; }mtasc-1.14/ocaml/mtasc/std8/flash/geom/Matrix.as0000640000175000017500000000161110616603501020074 0ustar pabspabsimport flash.geom.Point; intrinsic class flash.geom.Matrix { // 3x2 affine 2D matrix var a : Number; var b : Number; var c : Number; var d : Number; var tx : Number; var ty : Number; function Matrix(a : Number, b : Number, c : Number, d : Number, tx : Number, ty : Number); function transformPoint( p : Point ) : Point; function deltaTransformPoint( p : Point ) : Point; function toString() : String; function scale( sx : Number, sy : Number ) : Void; function translate( tx : Number, ty : Number ) : Void; function rotate( r : Number ) : Void; function identity() : Void; function invert() : Void; function concat( m : Matrix ) : Void; function clone() : Matrix; function createGradientBox( width : Number, height : Number, rot : Number, tx : Number, ty : Number ) : Void; function createBox( scalex : Number, scaley : Number, rot : Number, tx : Number, ty : Number ) : Void; }mtasc-1.14/ocaml/mtasc/std8/flash/text/0000750000175000017500000000000011155145531016343 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/text/TextRenderer.as0000640000175000017500000000034110311565566021311 0ustar pabspabsintrinsic class flash.text.TextRenderer { static var maxLevel : Number; static function setAdvancedAntialiasingTable( fontName : String, fontStyle: String, colorType : String, advancedAntialiasingTable : Array ) : Void; }mtasc-1.14/ocaml/mtasc/std8/flash/net/0000750000175000017500000000000011155145531016145 5ustar pabspabsmtasc-1.14/ocaml/mtasc/std8/flash/net/FileReference.as0000640000175000017500000000077510311565566021211 0ustar pabspabsintrinsic class flash.net.FileReference { var creator : String; var creationDate : Date; var modificationDate : Date; var size : Number; var type : String; var name : String; function FileReference(); function browse( typeList : Array ) : Boolean; function upload( url : String ) : Boolean; function download( url : String, defaultName : String ) : Boolean; function cancel() : Void; function addListener( listener : Object ) : Void; function removeListener( listener : Object ) : Boolean; }mtasc-1.14/ocaml/mtasc/std8/flash/net/FileReferenceList.as0000640000175000017500000000040510311565566022033 0ustar pabspabsintrinsic class flash.net.FileReferenceList { var fileList : Array; function FileReferenceList(); function browse( typeList : Array ) : Boolean; function addListener( listener : Object ) : Void; function removeListener( listener : Object ) : Boolean; }mtasc-1.14/ocaml/mtasc/std8/XMLNode.as0000640000175000017500000000201110311570510016040 0ustar pabspabsintrinsic class XMLNode { var attributes:Object; var childNodes:Array; var firstChild:XMLNode; var lastChild:XMLNode; var nextSibling:XMLNode; var nodeName:String; var nodeType:Number; var nodeValue:String; var parentNode:XMLNode; var previousSibling:XMLNode; function XMLNode(type:Number, value:String); function cloneNode(deep:Boolean):XMLNode; function removeNode():Void; function insertBefore(newChild:XMLNode,insertPoint:XMLNode):Void; function appendChild(newChild:XMLNode):Void; function hasChildNodes():Boolean; function toString():String; function addTreeNodeAt(index:Number, arg1:Object, arg2:Object):XMLNode; function addTreeNode(arg1:Object, arg2:Object):XMLNode; function getTreeNodeAt(index:Number):XMLNode; function removeTreeNodeAt(index:Number):XMLNode; function removeTreeNode():XMLNode; // Flash 8 var prefix:String; var localName:String; var namespaceURI:String; function getPrefixForNamespace(namespaceURI:String):String; function getNamespaceForPrefix(prefix:String):String; } mtasc-1.14/ocaml/mtasc/std8/Stage.as0000640000175000017500000000065211056476411015662 0ustar pabspabsintrinsic class Stage { static var width:Number; static var height:Number; static var scaleMode:String; static var align:String; static var showMenu:Boolean; static function addListener(listener:Object):Void; static function removeListener(listener:Object):Void; static var displayState : String; static var fullScreenSourceRect : flash.geom.Rectangle; static function onFullScreen( full : Boolean ) : Void; } mtasc-1.14/ocaml/mtasc/plugin.ml0000640000175000017500000000234410140067355015234 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let verbose = ref false let options = ref ([] : (string * Arg.spec * string) list) let calls = ref ([] : (Typer.context -> unit) list) let class_path = ref ([] : string list) let find_file f = let rec loop = function | [] -> raise Not_found | p :: l -> let file = p ^ f in if Sys.file_exists file then file else loop l in loop !class_path let add l f = options := l @ !options; calls := f :: !calls mtasc-1.14/ocaml/mtasc/doc/0000750000175000017500000000000011155145531014145 5ustar pabspabsmtasc-1.14/ocaml/mtasc/doc/HelloWorld.as0000640000175000017500000000053410407242724016551 0ustar pabspabs// Run: mtasc -swf helloworld.swf -main -header 640:480:20 HelloWorld.as // Your basic Hello World app that every language needs class HelloWorld { static var app : HelloWorld; function HelloWorld() { _root.createTextField("tf",0,0,0,640,480); _root.tf.text = "Hello world !"; } static function main(mc) { app = new HelloWorld(); } } mtasc-1.14/ocaml/mtasc/doc/INSTALL.txt0000640000175000017500000000266510144625232016024 0ustar pabspabsThis document is dedicated to people who want to compile MTASC from sources. Quick Guide : ------------- - install OCaml (at http://caml.inria.fr ). 3.08 is recommanded - install CVS (http://www.cvshome.org) - download and compile ZLIB (http://www.zlib.org) - put the "install.ml" MTASC install script into a directory of your choice - configure ocaml and cvs so it can run from commandline - edit and *configure* install.ml (see below) - run the following command "ocaml install.ml" to run compilation script - the binary can be found in the "bin" subdirectory of install.ml - you also need to copy somewhere on your system the "ocaml/mtasc/std" subdirectory (and use -cp for mtasc commandline). Configuration ------------- install.ml is an install script that will download and compile sources. It needs some minimal configuration in order to work correctly. First you need to choose which of the two build you want to compile : - native : native is compiled for your processor, it will run a lot faster - bytecode : ocaml bytecode program, however it is not platform independant since it links some C code for ZLib bindings Then you need to configure the path where zlib.lib or zlib.a can be found. For example on Linux you will have to replace it by something like : let zlib = "/usr/lib/libz.a" Problems : ---------- In case of problem please join the MTASC mailing list here : http://lists.motion-twin.com/mailman/listinfo/mtasc mtasc-1.14/ocaml/mtasc/doc/Future.txt0000640000175000017500000000072610377521557016201 0ustar pabspabsMTASC is very stable right now, so the releases since version 1.11 are focused on minor fixes and enhancements. Some people asked about the Future of MTASC, related to the next version of Flash 8.5 player and ActionScript 3. MTASC will not support AS3, as we are currently working on a new and powerful language name haXe that will support Flash Players 6-7-8 and 8.5 as well as Javascript and Server-Side scripting. You can check about it on http://haxe.org Nicolas mtasc-1.14/ocaml/mtasc/doc/Readme.txt0000640000175000017500000004412310343027426016110 0ustar pabspabsMTASC help is available on official website : http://www.mtasc.org MTASC is Licensed under the GNU General Public License (GPL) The compiler sources are available on mtasc.org website. The GPL license does NOT imply that you source code will have to be GPL or Open Source. You can use MTASC in order to compiler any source code without restrictions. Only if you want use the compiler as part of your application you'll have to apply the GPL rules. --------------------------------------------------- GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. mtasc-1.14/ocaml/mtasc/doc/mtasc.10000640000175000017500000000320410407251225015333 0ustar pabspabs.TH MTASC "1" "February 2006" "mtasc " "User Commands" .SH NAME mtasc \- ActionScript 2 to Flash (SWF) compiler .SH DESCRIPTION .PP This manual page documents briefly the \fBmtasc\fR command. .PP It was written for Debian as \fBmtasc\fR does not have a manual page. .PP \fBmtasc\fR compiles ActionScript 2 files to Flash (SWF) files. .PP .SH SYNOPSIS \fBmtasc\fP [options] .SH OPTIONS .PP The options are processed from left to right. All of the options use a single dash. .TP \fB\-pack\fR Compile all files in target package. .TP \fB\-cp\fR Add classpath. .TP \fB\-v\fR Turn on verbose mode. .TP \fB\-strict\fR Turn on strict mode. .TP \fB\-infer\fR Turn on local variables inference. .TP \fB\-wimp\fR Turn on warnings for unused imports. .TP \fB\-msvc\fR Use MSVC style errors. .TP \fB\-mx\fR Use precompiled mx package. .TP \fB\-swf\fR Input SWF file to update. .TP \fB\-out\fR SWF output file. .TP \fB\-keep\fR Do not remove AS2 classes from input SWF. .TP \fB\-frame\fR Export into target frame (it must exist in the SWF). .TP \fB\-main\fR Enable the main entry point. .TP \fB\-header\fR
Specify header format. The format of this option is 'width:height:fps', where fps means frames per second. .TP \fB\-group\fR Group classes into a single clip .TP \fB\-exclude\fR Exclude classes listed in a file. .TP \fB\-version\fR Change SWF version (6,7,8,...) .TP \fB\-trace\fR Specify a TRACE function. .TP \fB\-help\fR or \fB\-\-help\fR Display a list of options and what they do. .SH "SEE ALSO" .PP The mtasc website (http://www.mtasc.org) and the mtasc osflash page (http://osflash.org/mtasc). mtasc-1.14/ocaml/mtasc/doc/Readme.linux0000640000175000017500000000054210140222110016403 0ustar pabspabsMTASC : Motion-Twin ActionScript 2 OpenSource Compiler. http://team.motion-twin.com/ncannasse/mtasc.html You can put the "std" directory as a subdirectory of the dir you installed the mtasc binary, or you can specify each time you want to compile the classpath to flash class headers stored into the "std" directory using the -cp commandline parameter. mtasc-1.14/ocaml/mtasc/doc/install.ml0000640000175000017500000000710410464146041016147 0ustar pabspabs(* * MTASC installer * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) #load "unix.cma" (* ----- BEGIN CONFIGURATION ---- *) let zlib = match Sys.os_type with "Win32" -> "zlib.lib" | _ -> "-lz" let bytecode = true let native = true (* ------ END CONFIGURATION ----- *) let obj_ext = match Sys.os_type with "Win32" -> ".obj" | _ -> ".o" let exe_ext = match Sys.os_type with "Win32" | "Cygwin" -> ".exe" | _ -> "" let msg m = prerr_endline m; flush stdout let command c = msg ("> " ^ c); if Sys.command c <> 0 then failwith ("Error while running " ^ c) let cvs root cmd = command ("cvs -z3 -d" ^ root ^ " " ^ cmd) let ocamlc file = if bytecode then command ("ocamlc -c " ^ file); if native then command ("ocamlopt -c " ^ file) let modules l ext = String.concat " " (List.map (fun f -> f ^ ext) l) ;; let motiontwin = ":pserver:anonymous@cvs.motion-twin.com:/cvsroot" in let download () = msg "*** Please hit enter on login (empty password) ***"; cvs motiontwin "login"; cvs motiontwin "co ocaml/extlib-dev"; cvs motiontwin "co ocaml/mtasc"; cvs motiontwin "co ocaml/swflib"; cvs motiontwin "co ocaml/extc"; in let compile() = (try Unix.mkdir "bin" 0o740 with Unix.Unix_error(Unix.EEXIST,_,_) -> ()); (* EXTLIB *) Sys.chdir "ocaml/extlib-dev"; command ("ocaml install.ml -nodoc -d .. " ^ (if bytecode then "-b " else "") ^ (if native then "-n" else "")); msg ""; Sys.chdir "../.."; (* EXTC *) Sys.chdir "ocaml/extc"; let c_opts = (if Sys.ocaml_version < "3.08" then " -ccopt -Dcaml_copy_string=copy_string " else " ") in command ("ocamlc" ^ c_opts ^ "extc_stubs.c"); let options = "-cclib ../extc/extc_stubs" ^ obj_ext ^ " -cclib " ^ zlib ^ " extc.mli extc.ml" in if bytecode then command ("ocamlc -a -o extc.cma " ^ options); if native then command ("ocamlopt -a -o extc.cmxa " ^ options); Sys.chdir "../.."; (* SWFLIB *) Sys.chdir "ocaml/swflib"; let files = "-I .. -I ../extc as3.mli as3code.ml as3parse.ml swf.ml swfZip.ml actionScript.ml swfParser.ml" in if bytecode then command ("ocamlc -a -o swflib.cma " ^ files); if native then command ("ocamlopt -a -o swflib.cmxa " ^ files); Sys.chdir "../.."; (* MTASC *) Sys.chdir "ocaml/mtasc"; command "ocamllex lexer.mll"; ocamlc "expr.ml lexer.ml"; ocamlc "-pp camlp4o parser.ml"; ocamlc "-I .. -I ../extc -I ../swflib typer.ml class.ml plugin.ml genSwf.ml main.ml"; let mlist = ["expr";"lexer";"parser";"typer";"class";"plugin";"genSwf";"main"] in if bytecode then command ("ocamlc -custom -o ../../bin/mtasc-byte" ^ exe_ext ^ " ../extLib.cma ../extc/extc.cma ../swflib/swflib.cma " ^ modules mlist ".cmo"); if native then command ("ocamlopt -o ../../bin/mtasc" ^ exe_ext ^ " ../extLib.cmxa ../extc/extc.cmxa ../swflib/swflib.cmxa " ^ modules mlist ".cmx"); in let startdir = Sys.getcwd() in try download(); compile(); Sys.chdir startdir; with Failure msg -> Sys.chdir startdir; prerr_endline msg; exit 1mtasc-1.14/ocaml/mtasc/doc/Makefile0000640000175000017500000000224710407251225015610 0ustar pabspabsDESTDIR= PREFIX=/usr/local ZLIB=/usr/lib/libz.so build: ( cd ocaml/extc ; ocamlc extc_stubs.c ;\ ocamlfind ocamlopt -package extlib -a -o extc.cmxa -cclib ../extc/extc_stubs.o -cclib $(ZLIB) extc.mli extc.ml ) cd ocaml/swflib ; ocamlfind ocamlopt -package extlib -a -o swflib.cmxa -I .. -I ../extc swf.ml swfZip.ml actionScript.ml swfParser.ml ( cd ocaml/mtasc ; ocamllex lexer.mll ; ocamlopt -c expr.ml lexer.ml ; ocamlopt -c -pp camlp4o parser.ml ;\ ocamlfind ocamlopt -package extlib -c -I .. -I ../extc -I ../swflib typer.ml class.ml plugin.ml genSwf.ml main.ml ;\ ocamlfind ocamlopt -package extlib -linkpkg -o mtasc -cclib $(ZLIB) extLib.cmxa ../extc/extc.cmxa ../swflib/swflib.cmxa expr.cmx lexer.cmx parser.cmx typer.cmx class.cmx plugin.cmx genSwf.cmx main.cmx ) clean: rm -f ocaml/*/*.cma ocaml/*/*.cmi ocaml/*/*.cmo ocaml/*/*.cmx rm -f ocaml/*/*.cmxa ocaml/*/*.o ocaml/*/*.a rm -f ocaml/mtasc/lexer.ml ocaml/mtasc/mtasc install: mkdir -p $(DESTDIR)$(PREFIX)/bin/ $(DESTDIR)$(PREFIX)/share/ cp ocaml/mtasc/mtasc $(DESTDIR)$(PREFIX)/bin/ cp -r ocaml/mtasc/std $(DESTDIR)$(PREFIX)/share/ cp -r ocaml/mtasc/std8 $(DESTDIR)$(PREFIX)/share/ .PHONY: build install clean mtasc-1.14/ocaml/mtasc/doc/CHANGES.txt0000640000175000017500000002342211056476514015772 0ustar pabspabs2008-08-31 : 1.14 added stopAllSounds() support added lineStyle F8 additional parameters fixed FSCommand2 stack added Stage.fullScreenSourceRect compiling with version 9+ now uses std8 folder 2007-02-04 : 1.13 updated Video and NetStream headers. fixed small bug if environment variable in new E() fixed multivars declarations fixed bug with filters inside buttons fscommand2 ret value fix fixed various bugs in SWF for Flash8 interfaces can't have a constructor inverted % and *,/ priorities fixed missing types for local functions when -strict fix in getTimer() always allow 'add' deprecated keyword bugfix in exclude files (when line endings differs from OS default) allow more than 255 locals more flash lite 2 support for standard headers 2006-01-31 : 1.12 prevented -keep with -header allowed dynamic static classes improved Flash8 shapes support allowed access to private variables inside local defined functions faster SWF parsing (hotfixes) added FSCommand2 support for FlashLite 2005-11-29 : 1.11 added typed arrays no casts when compiling for flash6 warning "imports not used" off by default (added -wimp) catched errors in swf parsing some fixes in flash8 headers and file format handling fixed duplicate main calls when registerClass calls found fixed bug when using "with" added error cannot have same field in class (static + member) (hotfixes) fixed resolve path for typed Arrays. allowed new and literal Array init for typed Arrays. 2005-09-13 : 1.10 fixed small problem with class case and import wildcards added -infer parameter fixed bug with += with properties added exclude wildcards and exclude without file changed TRACE in "trace" added AS keywords as real keywords (including deprecated ones) fixed parsing of objects and array declarations and parameters lists fixed escape sequences in strings and added unicode escape sequences. fixed && and || precedence. fixed duplicate public/static/private qualifiers. fixed for...in variable forced as String no more private and static fields in interfaces implemented field cannot be private better error when same file referenced several times. delete now returns Boolean fixed getVersion() in TopLevel fixed problem in class replace when not -keep and -mx changed -main : now in DoAction and not InitAction fixed stack corruption in new var(expr). fixed break with several stacked for..in disabled variables in interfaces added error message when several classes in same file changed switch implementation fixed typing of ?: fixed stack problem with "for" separate directory and "add" keyword hack for Flash8 (hotfixes 1.10b) fixed bug in switchs (default cause stack corruption) 2005-07-14 : 1.09 fixed problems in escape sequences such as \\t fixed problem with "delete" more strict checks of interface fields : same type and structure and not only unifiable. allowed variance on interface fields implementation. -keep with -separate replace compiled packages. added check for file name case on Win32 changed -main and algorithm for updating SWF fixed problem when autoregisterclass with classname = linkagename added -version X (removed -flash6) added Flash8 headers (hotfixes) removed -separate (now on by default), added -group (turn off separate) fixed clips id generation (bug when compiling several times). 2005-06-20 : 1.08 fixed getUrl2 stack. renamed and hide variable defined by main. fixed x instanceof y ? a : b parsing fixed try with no catch clauses removed mtasc trace message added -out a lot of small fixes in "std" header fixed bug in check for implemented interfaces 2005-05-28 : 1.07 fixed -keep + -main added 'con' error message SharedObject.getRemote argument to Object. added "print". added deprecated keywords usage error. fixed "main" duplication added / to classpath (for absolute file paths) fixed for(;cond;incr) parsing error fixed (unop) expr ? parsing error 2005-05-20 : 1.06 fixed IO.No_more_input message fixed 32K limit calculation fixed bug with auto register class main now takes "this" as parameter and is delayed (onEnterFrame) added Object.valueOf intrinsic fixed Malformed_expression when using >32 bits integers 2005-04-30 : 1.05 fixed type required to String for for...in variable fixed operator priority : a || b && c -> a || (b && c) error when multiple extends, interface cannot extends class warning when import not used (no longer add class) fixed error message when class not found register only one time the package errors on 32K bytecode size limit reached fixed operators priority for | ^ & against >> and % against * / forbid contructor returns and return type (modified headers) fixed class ordering problem with -keep fixed calls to super getter/setter problem (hotfixes) remove "return" in contructors restriction (allowed by MMC) import warnings disabled for mx classes when -mx fixed missing "," between function call parameters 2005-04-14 : 1.04 "for" optional first parameter and expression fixed while( o )++ i; added error when duplicate import statement (with same or different package) added class-exist import check => import will now link classes fixed typing error with single "var" in a block fixed parser error with a?b:c and big left-expression fixed bug when catching "imported" exception class changed boolean operators typing added -flash6 for F6 compilation added -trace for custom trace function added optional color component for -header (hotfixes) fixed compiler crash in "try" fixed boolean operators typing : returns most common type 2005-03-24 : 1.03 fixed "interface extends interface" bytecode generation some missing headers fixed problem with -mx (classes initialized before mx components) added check function for values without side effects relaxed array access typing fixed 820 size limit for -header changed bitshifts operator priority trace now use flash opcode 2005-03-10 : 1.02 test if class already exists (multiple swf statics init) -frame now works with -header fixed "class Number not found" when no std relaxed restriction on input file names added getURL with one argument only fixed "prototype" static resolved. fixed typeof syntax added "with" added _levelXX added scientific floats : 1.23e-23 fixed instanceof & typeof parsing. 2005-02-21 : 1.01 fixed doaction/showframe inversion Number, String and Boolean now perform conversion fixed error in inherited statics fixed break in for...in added fscommand. added -exclude fixed $ in identifiers fixed return in for..in bug. fixed inherited statics and super constructor typecheck. 2005-01-26 : 1.0 fixed super field accesses fixed -separate with -main issues relaxed new so constructor can return any value. Void now unify with Any added -mx , good support for mx.controls parsing 2005-01-13 : rc2 fixed throw parsing fixed , Function unification fixed small parsing problem with typeof fixed multi-interface subtyping. fixed constructor handling fixed bug in enum added superconstructor autocall added -separate 2005-01-05 : rc1 private methods can be called from childs fixed super calls without superclass failure added warning when package is missing. fixed error when package not found NetConnection is now dynamic trace() takes any object, not just Strings added "-main" argument added try/catch/finally+throw support added documentation tutorial fixed utf8 encoding problems fixed "new x" problem (when x is a variable) 2004-12-08 : beta7 released restriction on super fixed imports in lambdas pop instead of trace for string mark. fixed missing implementation of import wildcards for genSwf fixed bug when accessing superclass in static. no strict mode for native classes. fixed multiple implements syntax allowed private access to local class variables in lambdas 2004-11-22 : beta6 fixed stack overflow in parsing metadata added missing intrinsic headers allowed to have a method named "get" or "set" warning instead of error on #include allowing call object "Function" relaxed array access to Array only improved typing of classnames as Function allowed Array[Boolean] fixed parsing of x = y ? z : w; fixed auto self import in swf generation forbidden calls to super when no super available typeof as operator (parenthesis are optional) 2004-11-17 : beta5 fixed back the Export name to "MTASC" (causing problem with -keep) fixed member variable declaration with init value fixed multivariable ops added delete call without parenthesis fixed numbers starting with '.' fixed Function object unify with any function. fixed lexer for mac newlines. fixed parser for a (op) b ? x : x' added -strict mode 2004-11-09 : beta4 support for "arguments" fixed bug when a class reference itself : lookup was member constructor support for targetPath improved precision of some error messages import wildcards added -pack enabled specifying AS2 classes for MC directly into Flash IDE. fixed little inheritance problem in generated SWF (hotfixes) fixed multiple assignations fixed swfLib linking for Linux 2004-11-03 : beta3 checks that implements an interface and extends a class added physical (in)equality operation added eval added casts fixed issue when std is not installed added getter/setter optimized prototype registration fixed problem with AS2 classes not removed from SWF added -frame for choosing export frame added -header for creating SWF (hotfixes) added static getter/setters fixed interface A extends B class import itself 2004-10-27 : beta2 fixed typing of super constructor removed naming conventions added error on import x.* usage fixed var x : Function = Class typing new build model : update SWF by removing AS2 classes (and -keep) fixed registerClass in statics : classes just before first ShowFrame partly rewrote usage documentation 2004-10-25 : beta1 compiler working, starting beta mtasc-1.14/ocaml/mtasc/genSwf.ml0000640000175000017500000012451211056475504015177 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Expr open Swf open ExtHashtbl open ExtString open ExtList type kind = | VarReg of int | VarStr | VarObj | VarGetSet of string type local_ctx = { reg : int; sp : int; } type context = { idents : (string,int) Hashtbl.t; ops : action DynArray.t; super_bindings : (type_path * string,bool) Hashtbl.t; locals : (string,local_ctx) Hashtbl.t; main : type_path option ref; mutable current : Class.context; mutable stack : int; mutable code_pos : int; mutable ident_count : int; mutable reg_count : int; mutable stack_size : int; mutable cur_block : expr; mutable breaks : (unit -> unit) list; mutable continue_pos : int; mutable opt_push : bool; mutable curmethod : string; mutable forins : int; } type push_style = | VStr of string | VInt of int | VInt32 of int32 | VFloat of float | VReg of int | VThis | VNull | VSuper let stack_delta = function | APush l -> List.length l | ASetReg _ -> 0 | AAdd | ADivide | ASubtract | AMultiply | AMod | AStringAdd -> -1 | AAnd | AOr | AXor | AShl | AShr | AAsr -> -1 | ACompare | AGreater -> -1 | AEval | ANot | AJump _ | AToInt | AToNumber | AToString | ATry _ | ASwap -> 0 | ACondJump _ -> -1 | AEqual | APhysEqual -> -1 | ANew -> -1 (** only if 0 params **) | AObject | AInitArray -> 0 (** calculated outside **) | ASet -> -2 | APop -> -1 | AFunction _ | AFunction2 _ -> 1 | ADup -> 1 | AWith _ -> -1 | AObjGet -> -1 | AObjSet -> -3 | ALocalVar -> -1 | ALocalAssign -> -2 | AReturn -> -1 | AFSCommand2 -> 0 | AGetURL2 _ -> -2 | ADeleteObj | AInstanceOf | ACast -> -1 | AExtends | AImplements -> -2 | AEnum2 | ATrace | AThrow -> -1 | AGetTimer -> 1 | AIncrement | ADecrement | AChr | AOrd | ARandom | ADelete | ATypeOf | ATargetPath -> 0 | AObjCall | ACall | ANewMethod -> assert false | op -> failwith ("Unknown stack delta for " ^ (ActionScript.action_string (fun _ -> "") 0 op)) let enable_main = ref false let version = ref None let ftrace = ref None let write ctx op = let write b op = DynArray.add ctx.ops op; ctx.code_pos <- ctx.code_pos + 1; ctx.stack_size <- ctx.stack_size + stack_delta op; ctx.opt_push <- b in match op with | APush l when ctx.opt_push -> (match DynArray.last ctx.ops with | (APush l2) as a -> ctx.code_pos <- ctx.code_pos - 1; ctx.stack_size <- ctx.stack_size - stack_delta a; DynArray.delete_last ctx.ops; write true (APush (l2 @ l)) | _ -> assert false) | APush _ -> write true op | _ -> write false op let call ctx kind n = let op , n = (match kind with | VarReg r -> write ctx (APush [PReg r;PUndefined]); AObjCall , n + 2 | VarStr -> ACall , n + 1 | VarObj -> AObjCall , n + 2 | VarGetSet s -> assert false ) in DynArray.add ctx.ops op; ctx.opt_push <- false; ctx.code_pos <- ctx.code_pos + 1; ctx.stack_size <- ctx.stack_size - n let new_call ctx kind n = let op , n = (match kind with | VarReg r -> write ctx (APush [PReg r;PUndefined]); ANewMethod , n + 2 | VarStr -> ANew , n + 1 | VarObj -> ANewMethod , n + 2 | VarGetSet _ -> assert false ) in DynArray.add ctx.ops op; ctx.opt_push <- false; ctx.code_pos <- ctx.code_pos + 1; ctx.stack_size <- ctx.stack_size - n let push ctx items = write ctx (APush (List.map (fun i -> match i with | VStr str -> let n = (try Hashtbl.find ctx.idents str with Not_found -> let n = ctx.ident_count in ctx.ident_count <- n + 1; Hashtbl.add ctx.idents str n; n ) in if n <= 0xFF then PStack n else PStack2 n | VInt n -> PInt (Int32.of_int n) | VInt32 n -> PInt n | VFloat f -> PDouble f | VThis -> PReg 1 | VNull -> PNull | VSuper -> PReg 2 | VReg n -> PReg n ) items)) let rec pop ctx n = if n > 0 then begin write ctx APop; pop ctx (n-1); end let cjmp ctx = write ctx (ACondJump 0); let start_pos = ctx.code_pos in let op_pos = DynArray.length ctx.ops - 1 in (fun() -> let delta = ctx.code_pos - start_pos in DynArray.set ctx.ops op_pos (ACondJump delta); ctx.opt_push <- false ) let jmp ctx = write ctx (AJump 0); let start_pos = ctx.code_pos in let op_pos = DynArray.length ctx.ops - 1 in (fun() -> let delta = ctx.code_pos - start_pos in DynArray.set ctx.ops op_pos (AJump delta); ctx.opt_push <- false ) let error p = raise (Typer.Error (Typer.Custom "Malformed expression",p)) let do_jmp ctx pos = write ctx (AJump (pos - (ctx.code_pos + 1))) let func ctx args constructor arguments = let default_flags = ThisRegister :: (if arguments then [] else [ArgumentsNoVar]) in let f = { f2_name = ""; f2_args = args; f2_codelen = 0; f2_nregs = 0; f2_flags = (if constructor then SuperRegister :: default_flags else SuperNoVar :: default_flags); } in write ctx (AFunction2 f); let start_pos = ctx.code_pos in (fun nregs -> let delta = ctx.code_pos - start_pos in f.f2_codelen <- delta; f.f2_nregs <- nregs ) let setvar ?(retval=false) ctx = function | VarReg (-1) -> assert false (** true, false, null **) | VarReg n -> write ctx (ASetReg n); if not retval then write ctx APop | VarStr | VarObj as s -> if retval then write ctx (ASetReg 0); write ctx (if s = VarStr then ASet else AObjSet); if retval then push ctx [VReg 0] | VarGetSet f -> push ctx [VInt 1; VSuper; VStr ("__set__" ^ f)]; call ctx VarObj 1 let getvar ctx = function | VarReg (-1) -> () (** true, false, null **) | VarReg n -> push ctx [VReg n] | VarStr -> write ctx AEval | VarObj -> write ctx AObjGet | VarGetSet f -> push ctx [VInt 0; VSuper; VStr ("__get__" ^ f)]; call ctx VarObj 0 let clean_stack ctx stack = Hashtbl.iter (fun name r -> if r.sp > stack then Hashtbl.remove ctx.locals name ) ctx.locals; ctx.stack <- stack let open_block ctx e = let old_block = ctx.cur_block in let old_stack = ctx.stack in let start_size = ctx.stack_size in ctx.stack <- ctx.stack + 1; ctx.cur_block <- e; (fun() -> clean_stack ctx old_stack; pop ctx (ctx.stack_size - start_size); ctx.cur_block <- old_block ) let rec used_in_block curblock vname e = let in_lambda = ref curblock in let rec vloop (v,p) = match v with | EConst c -> (match c with | Ident v -> !in_lambda && v = vname | _ -> false) | ECast (v1,v2) | EArray (v1,v2) -> vloop v1 || vloop v2 | EBinop (_,v1,v2) -> vloop v1 || vloop v2 | EField (v,_) -> vloop v | EStatic (["__With"],v) -> v = vname | EStatic _ -> false | EParenthesis v -> vloop v | EObjDecl decls -> List.exists (fun (_,v) -> vloop v) decls | EArrayDecl vl -> List.exists vloop vl | ECall (v,vl) -> List.exists vloop (v :: vl) | ENew (v,vl) -> vloop v || List.exists vloop vl | EUnop (_,_,v) -> vloop v | EQuestion (v,v1,v2) -> vloop v || vloop v1 || vloop v2 | ELambda f -> match f.fexpr with | None -> false | Some e -> let old = !in_lambda in in_lambda := true; let r = loop e in in_lambda := old; r and loop (e,p) = match e with | EFunction _ -> assert false | EVars (_,_,vl) -> List.exists (fun (_,_,v) -> match v with | None -> false | Some v -> vloop v ) vl | EBlock el -> List.exists loop el | EFor (el,conds,incrs,e) -> List.exists loop el || List.exists vloop conds || List.exists vloop incrs || loop e | EForIn (decl,v,e) -> loop decl || vloop v || loop e | EIf (v,e,eopt) -> vloop v || loop e || (match eopt with None -> false | Some e -> loop e) | EWhile (v,e,_) -> vloop v || loop e | ESwitch (v,cases) -> vloop v || List.exists (fun (v,e) -> (match v with None -> false | Some v -> vloop v) || loop e) cases | ETry (e,cl,fopt) -> loop e || List.exists (fun (n,_,e) -> vname = n || loop e) !cl || (match fopt with None -> false | Some e -> loop e) | EWith (v,e) -> vloop v || loop e | EReturn (Some v) -> vloop v | EVal v -> vloop v | EReturn None | EBreak | EContinue -> false in loop e let super_binding_ident path fname = (match fst path with | [] -> "" | l -> String.concat "_" l ^ "_") ^ snd path ^ "_" ^ fname let generate_package ?(fast=false) ctx l = let fast = fast && (match l with | [] -> true | p :: _ -> not (Hashtbl.mem ctx.locals p) ) in if fast then begin match l with | [] -> VarStr | p :: l -> push ctx [VStr p]; write ctx AEval; List.iter (fun p -> push ctx [VStr p]; write ctx AObjGet) l; VarObj end else begin push ctx [VStr "_global"]; write ctx AEval; List.iter (fun p -> push ctx [VStr p]; write ctx AObjGet; ) l; VarObj end let rec generate_package_register ctx = function | [] -> () | p :: [] -> ignore(generate_package ~fast:true ctx (p :: [])); write ctx ANot; write ctx ANot; let j = cjmp ctx in push ctx [VStr "_global"]; write ctx AEval; push ctx [VStr p; VInt 0; VStr "Object"]; write ctx ANew; write ctx AObjSet; j() | p :: l -> let lrev = List.rev l in let all_but_last , last = List.rev (List.tl lrev), List.hd lrev in generate_package_register ctx (p :: all_but_last); ignore(generate_package ~fast:true ctx (p :: l)); write ctx ANot; write ctx ANot; let j = cjmp ctx in push ctx [VStr "_global"]; write ctx AEval; List.iter (fun p -> push ctx [VStr p]; write ctx AObjGet) (p :: all_but_last); push ctx [VStr last; VInt 0; VStr "Object"]; write ctx ANew; write ctx AObjSet; j() let generate_ident ctx s p = match s with | "this" -> VarReg 1 | "undefined" -> write ctx (APush [PUndefined]); VarReg (-1) | "null" -> push ctx [VNull]; VarReg (-1) | "true" -> write ctx (APush [PBool true]); VarReg (-1) | "false" -> write ctx (APush [PBool false]); VarReg (-1) | "_global" | "_root" | "arguments" -> push ctx [VStr s]; VarStr | "super" -> assert false | _ -> try let l = Hashtbl.find ctx.locals s in if l.reg = 0 then begin push ctx [VStr s]; VarStr end else VarReg l.reg with Not_found -> push ctx [VStr s]; VarStr let unescape_chars s p = let b = Buffer.create 0 in let rec loop esc i = if i = String.length s then () else let c = s.[i] in if esc then begin let inext = ref (i + 1) in (match c with | 'b' -> Buffer.add_char b '\b' | 'f' -> Buffer.add_char b (char_of_int 12) | 'n' -> Buffer.add_char b '\n' | 'r' -> Buffer.add_char b '\r' | 't' -> Buffer.add_char b '\t' | '"' | '\'' | '\\' -> Buffer.add_char b c | '0'..'3' -> let c = (try char_of_int (int_of_string ("0o" ^ String.sub s i 3)) with _ -> raise (Lexer.Error (Lexer.Invalid_character c,p)) ) in Buffer.add_char b c; inext := !inext + 2; | 'x' -> let c = (try char_of_int (int_of_string ("0x" ^ String.sub s (i+1) 2)) with _ -> raise (Lexer.Error (Lexer.Invalid_character c,p)) ) in Buffer.add_char b c; inext := !inext + 2; | 'u' -> let i = (try int_of_string ("0x" ^ String.sub s (i+1) 4) with _ -> raise (Lexer.Error (Lexer.Invalid_character c,p)) ) in let ub = UTF8.Buf.create 0 in UTF8.Buf.add_char ub (UChar.chr i); Buffer.add_string b (UTF8.Buf.contents ub); inext := !inext + 4 | _ -> raise (Lexer.Error (Lexer.Invalid_character c,p))); loop false !inext; end else match c with | '\\' -> loop true (i + 1) | c -> Buffer.add_char b c; loop false (i + 1) in loop false 0; Buffer.contents b let rec generate_constant ctx p = function | Int str -> (try push ctx [VInt32 (Int32.of_string str)] with _ -> generate_constant ctx p (Float str)) | Float str -> push ctx [VFloat (try float_of_string str with _ -> error p)] | String s -> push ctx [VStr (unescape_chars s p)] | Ident s -> assert false let generate_breaks ctx olds = List.iter (fun f -> f()) ctx.breaks; ctx.breaks <- olds let generate_function_ref = ref (fun _ _ -> assert false) let rec generate_access ?(forcall=false) ctx (v,p) = match v with | EConst (Ident "super") -> (* for superconstructor *) if forcall then begin push ctx [VSuper]; write ctx (APush [PUndefined]); VarObj end else VarReg 2 | EConst (Ident s) -> generate_ident ctx s p | EField ((EConst (Ident "super"),_),s) when Class.is_getset ctx.current s -> VarGetSet s | EField (v,s) -> generate_val ctx v; push ctx [VStr s]; VarObj | EStatic (["__With"],s) -> push ctx [VStr s]; VarStr | EStatic (p,s) -> let k = generate_package ~fast:true ctx p in push ctx [VStr s]; k | EArray (va,vb) -> generate_val ctx va; generate_val ctx vb; VarObj | _ -> if not forcall then error p; generate_val ctx (v,p); write ctx (APush [PUndefined]); VarObj and generate_binop retval ctx op v1 v2 = let gen a = generate_val ctx v1; generate_val ctx v2; write ctx a in match op with | OpAssign -> let k = generate_access ctx v1 in generate_val ctx v2; setvar ~retval ctx k | OpAssignOp op -> let k = generate_access ctx v1 in generate_binop true ctx op v1 v2; setvar ~retval ctx k | OpAdd -> gen AAdd | OpMult -> gen AMultiply | OpDiv -> gen ADivide | OpSub -> gen ASubtract | OpEq -> gen AEqual | OpPhysEq -> gen APhysEqual | OpPhysNotEq -> gen APhysEqual; write ctx ANot | OpNotEq -> gen AEqual; write ctx ANot | OpGt -> gen AGreater | OpGte -> gen ACompare; write ctx ANot | OpLt -> gen ACompare | OpLte -> gen AGreater; write ctx ANot | OpAnd -> gen AAnd | OpOr -> gen AOr | OpXor -> gen AXor | OpBoolAnd -> generate_val ctx v1; write ctx ADup; write ctx ANot; let jump_end = cjmp ctx in write ctx APop; generate_val ctx v2; jump_end() | OpBoolOr -> generate_val ctx v1; write ctx ADup; let jump_end = cjmp ctx in write ctx APop; generate_val ctx v2; jump_end() | OpShl -> gen AShl | OpShr -> gen AShr | OpUShr -> gen AAsr | OpMod -> gen AMod and generate_geturl ctx c vars p = let k = match vars with | [v] when c = "getURL" -> generate_val ctx v; push ctx [VStr "_self"]; 0 | v1 :: v2 :: l -> generate_val ctx v1; generate_val ctx v2; (match l with | [] -> 0 | [EConst (String "GET"),_] -> 1 | [EConst (String "POST"),_] -> 2 | (_,p) :: [] -> error p | _ -> error p) | _ -> error p in write ctx (AGetURL2 (k + (match c with "getURL" -> 0 | "loadMovie" -> 64 | "loadVariables" -> 192 | _ -> assert false))) and generate_call ?(newcall=false) ctx v vl = match fst v , vl with | EConst (Ident "trace") , args -> (match !ftrace with | None -> (match args with | [v] -> generate_val ctx v; write ctx ATrace | _ -> error (pos v)) | Some "" | Some "no" -> () | Some f -> let rec loop f = try let p , f = String.split f "." in let p2 , f = loop f in p :: p2 , f with Invalid_string -> [] , f in let p , f = loop f in let pos = snd v in let e = EStatic (p,f) , pos in let line = Lexer.get_error_line pos in generate_call ctx e (args @ [ (EConst (String (s_type_path (Class.path ctx.current) ^ "::" ^ ctx.curmethod))) , pos; (EConst (String (String.concat "\\\\" (String.nsplit pos.pfile "\\")))) , pos; (EConst (Int (string_of_int line))) , pos ])) | EConst (Ident "instanceof") , [v1;v2] -> generate_val ctx v1; generate_val ctx v2; write ctx AInstanceOf | EConst (Ident "typeof") , [v] -> generate_val ctx v; write ctx ATypeOf; | EConst (Ident "chr") , [v] -> generate_val ctx v; write ctx AChr; | EConst (Ident "ord") , [v] -> generate_val ctx v; write ctx AOrd; | EConst (Ident "int") , [v] -> generate_val ctx v; write ctx AToInt | EConst (Ident "string") , [v] -> generate_val ctx v; write ctx AToString | EConst (Ident "random") , [v] -> generate_val ctx v; write ctx ARandom | EConst (Ident "delete") , [v] -> let v = (match v with EParenthesis v , _ -> v | _ -> v) in (match generate_access ctx v with | VarObj -> write ctx ADeleteObj | VarReg n when n <> -1 -> () | _ -> write ctx ADelete) | EConst (Ident "throw") , [v] -> generate_val ctx v; write ctx AThrow | EConst (Ident "eval") , [v] -> generate_val ctx v; write ctx AEval | EConst (Ident "getTimer"), [] -> write ctx AGetTimer | EConst (Ident "targetPath") , [v] -> generate_val ctx v; write ctx ATargetPath | EConst (Ident "FSCommand2") , l -> List.iter (generate_val ctx) (List.rev l); let nargs = List.length l in push ctx [VInt nargs]; write ctx AFSCommand2; ctx.stack <- ctx.stack - nargs | EConst (Ident "fscommand") , [v] -> push ctx [VStr "FSCommand:"]; generate_val ctx v; write ctx AStringAdd; push ctx [VStr ""]; write ctx (AGetURL2 0) | EConst (Ident "fscommand") , [v1;v2] -> push ctx [VStr "FSCommand:"]; generate_val ctx v1; write ctx AStringAdd; generate_val ctx v2; write ctx (AGetURL2 0) | EConst (Ident "print") , [v1;v2] -> let str = (match fst v2 with | EConst (String "bmovie") -> "print:" | EConst (String "bframe") -> "print:#bframe" | EConst (String "bmax") -> "print:#bmax" | _ -> raise (Typer.Error (Typer.Custom "print parameter should be either bmovie, bframe or bmax",pos v2)) ) in push ctx [VStr str]; generate_val ctx v1; write ctx (AGetURL2 0) | EConst (Ident ("getURL" as x)) , params | EConst (Ident ("loadMovie" as x)) , params | EConst (Ident ("loadVariables" as x)) , params -> generate_geturl ctx x params (pos v) | EField ((EConst (Ident "super"),_),fname) , args -> let nargs = List.length args in List.iter (generate_val ctx) (List.rev args); push ctx [VInt nargs; VSuper; VStr fname]; call ctx VarObj nargs; | EConst (Ident "getVersion") , _ -> push ctx [VStr "/:$version"]; write ctx AEval; | EConst (Ident "stopAllSounds"), [] -> write ctx AStopSounds | _ , _ -> let nargs = List.length vl in List.iter (generate_val ctx) (List.rev vl); push ctx [VInt nargs]; let k = generate_access ~forcall:true ctx v in if newcall then new_call ctx k nargs else call ctx k nargs and generate_val ?(retval=true) ctx (v,p) = match v with | EConst (Ident _) | EArray _ | EField _ | EStatic _ -> let k = generate_access ctx (v,p) in getvar ctx k | EConst c -> generate_constant ctx p c | EParenthesis v -> generate_val ~retval ctx v | ECast ((EStatic ([],"String"),_),v) -> generate_val ctx v; write ctx AToString | ECast ((EStatic ([],"Number"),_),v) -> generate_val ctx v; write ctx AToNumber; | ECast ((EStatic ([],"Boolean"),_),v) -> generate_val ctx v; write ctx ANot; write ctx ANot; | ECast (_,v) when !version = Some 6 -> generate_val ctx v | ECast (v1,v2) -> generate_val ctx v1; generate_val ctx v2; write ctx ACast | EQuestion (v,v1,v2) -> generate_val ctx v; let jump_else = cjmp ctx in generate_val ctx v2; let jump_end = jmp ctx in jump_else(); generate_val ctx v1; jump_end(); ctx.stack_size <- ctx.stack_size - 1; | EBinop (op,v1,v2) -> generate_binop retval ctx op v1 v2 | ELambda f -> !generate_function_ref ctx f | ECall (v,vl) -> generate_call ctx v vl | EObjDecl fields -> let nfields = List.length fields in List.iter (fun (s,v) -> push ctx [VStr s]; generate_val ctx v ) fields; push ctx [VInt nfields]; write ctx AObject; ctx.stack_size <- ctx.stack_size - (nfields * 2); | EArrayDecl vl -> let nfields = List.length vl in List.iter (generate_val ctx) (List.rev vl); push ctx [VInt nfields]; write ctx AInitArray; ctx.stack_size <- ctx.stack_size - nfields; | ENew (v,args) -> generate_call ~newcall:true ctx v args | EUnop (Not,_,v) -> generate_val ctx v; write ctx ANot | EUnop (Neg,x,(EConst (Int s),p2)) -> (try push ctx [VInt32 (Int32.neg (Int32.of_string s))] with _ -> generate_val ctx (EUnop (Neg,x,(EConst (Float s),p2)),p)) | EUnop (Neg,_,(EConst (Float f),p)) -> push ctx [VFloat (0. -. (try float_of_string f with _ -> error p))] | EUnop (Neg,_,v) -> push ctx [VInt 0]; generate_val ctx v; write ctx ASubtract | EUnop (NegBits,_,v) -> generate_val ctx v; push ctx [VInt (-1)]; write ctx AXor | EUnop (op,flag,v) -> if retval && flag = Postfix then begin let k = generate_access ctx v in getvar ctx k end; ignore(generate_access ctx v); let k = generate_access ctx v in getvar ctx k; write ctx (match op with Increment -> AIncrement | Decrement -> ADecrement | _ -> assert false); setvar ~retval:(retval && flag = Prefix) ctx k let generate_local_var ctx (vname,_,vinit) = if used_in_block false vname ctx.cur_block || ctx.reg_count >= 250 then begin push ctx [VStr vname]; Hashtbl.add ctx.locals vname { reg = 0; sp = ctx.stack }; match vinit with | None -> write ctx ALocalVar | Some v -> generate_val ctx v; write ctx ALocalAssign end else begin ctx.reg_count <- ctx.reg_count + 1; let r = ctx.reg_count in Hashtbl.add ctx.locals vname { reg = r; sp = ctx.stack }; match vinit with | None -> () | Some v -> generate_val ctx v; setvar ctx (VarReg r) end let gen_forins ctx all = for i = 1 to (if all then ctx.forins else 1) do push ctx [VNull]; write ctx AEqual; write ctx ANot; write ctx (ACondJump (-4)); done let rec generate_expr ctx (e,p) = match e with | EFunction _ -> assert false | EVars (_,_,vl) -> List.iter (generate_local_var ctx) vl | EBlock el -> let block_end = open_block ctx (e,p) in List.iter (generate_expr ctx) el; block_end() | EFor (inits,conds,incrs,e) -> let block_end = open_block ctx e in List.iter (generate_expr ctx) inits; let test = jmp ctx in let start_pos = ctx.code_pos in let old_continue = ctx.continue_pos in let old_breaks = ctx.breaks in ctx.breaks <- []; ctx.continue_pos <- start_pos; ctx.opt_push <- false; List.iter (fun v -> generate_expr ctx (EVal v,null_pos)) incrs; test(); let jumps = ref [] in List.iter (fun cond -> generate_val ctx cond; write ctx ANot; jumps := cjmp ctx :: !jumps; ) conds; generate_expr ctx e; do_jmp ctx start_pos; List.iter (fun j -> j()) !jumps; generate_breaks ctx old_breaks; ctx.continue_pos <- old_continue; block_end() | EForIn (decl,v,e) -> let block_end = open_block ctx e in generate_val ctx v; write ctx AEnum2; let start_pos = ctx.code_pos in let old_continue = ctx.continue_pos in let old_breaks = ctx.breaks in ctx.breaks <- []; ctx.continue_pos <- start_pos; ctx.opt_push <- false; ctx.forins <- ctx.forins + 1; write ctx (ASetReg 0); push ctx [VNull]; write ctx AEqual; let jump_end = cjmp ctx in (match fst decl with | EVal ((EConst (Ident _),_) as x) -> let k = generate_access ctx x in push ctx [VReg 0]; setvar ctx k | EVars (_,_,[(x,_,None)]) -> push ctx [VStr x]; Hashtbl.add ctx.locals x { reg = 0; sp = ctx.stack }; push ctx [VReg 0]; write ctx ALocalAssign | _ -> error (pos decl)); generate_expr ctx e; do_jmp ctx start_pos; let has_breaks = (ctx.breaks <> []) in generate_breaks ctx old_breaks; if has_breaks then gen_forins ctx false; jump_end(); ctx.forins <- ctx.forins - 1; ctx.continue_pos <- old_continue; block_end() | EIf (v,e,eelse) -> generate_val ctx v; write ctx ANot; let jump_else = cjmp ctx in generate_expr ctx e; (match eelse with | None -> jump_else() | Some e -> let jump_end = jmp ctx in jump_else(); generate_expr ctx e; jump_end()) | EVal v -> let s = ctx.stack_size in generate_val ~retval:false ctx v; pop ctx (ctx.stack_size - s) | EWhile (v,e,flag) -> let jump_begin = (match flag with NormalWhile -> (fun()->()) | DoWhile -> jmp ctx) in let start_pos = ctx.code_pos in let old_continue = ctx.continue_pos in let old_breaks = ctx.breaks in ctx.breaks <- []; ctx.opt_push <- false; ctx.continue_pos <- start_pos; generate_val ctx v; write ctx ANot; let jump_end = cjmp ctx in jump_begin(); generate_expr ctx e; do_jmp ctx start_pos; generate_breaks ctx old_breaks; ctx.continue_pos <- old_continue; jump_end() | EWith (v,e) -> generate_val ctx v; write ctx (AWith 0); let start = ctx.code_pos in generate_expr ctx e; let delta = ctx.code_pos - start in DynArray.set ctx.ops (start - 1) (AWith delta); | EBreak -> ctx.breaks <- jmp ctx :: ctx.breaks | EContinue -> do_jmp ctx ctx.continue_pos | EReturn None -> gen_forins ctx true; write ctx (APush [PUndefined]); write ctx AReturn | EReturn (Some v) -> gen_forins ctx true; generate_val ctx v; write ctx AReturn | ESwitch (v,cases) -> generate_val ctx v; write ctx (ASetReg 0); let old_breaks = ctx.breaks in let first_case = ref true in let def_pos = ref (fun () -> ()) in ctx.breaks <- []; let cases = List.map (fun (v,e) -> match v with | None -> (fun () -> (!def_pos)(); def_pos := (fun() -> ())) , e | Some v -> if !first_case then first_case := false else push ctx [VReg 0]; generate_val ctx v; write ctx APhysEqual; cjmp ctx , e ) cases in def_pos := jmp ctx; List.iter (fun (j,e) -> j(); generate_expr ctx e ) cases; (!def_pos)(); generate_breaks ctx old_breaks | ETry (e,cl,fo) -> let tdata = { tr_style = TryRegister 0; tr_trylen = 0; tr_catchlen = None; tr_finallylen = None; } in write ctx (ATry tdata); let p = ctx.code_pos in generate_expr ctx e; let jump_end = jmp ctx in tdata.tr_trylen <- ctx.code_pos - p; let p = ctx.code_pos in let end_throw = ref true in let first_catch = ref true in let jumps = List.map (fun (name,t,e) -> Hashtbl.add ctx.locals name { reg = 0; sp = ctx.stack }; let next_catch = (match t with | None -> end_throw := false; write ctx APop; push ctx [VStr name;VReg 0]; write ctx ALocalAssign; generate_expr ctx e; (fun() -> ()) | Some t -> if not !first_catch then write ctx APop; getvar ctx (generate_access ctx (EStatic t,pos e)); push ctx [VReg 0]; write ctx ACast; write ctx ADup; push ctx [VNull]; write ctx AEqual; let c = cjmp ctx in push ctx [VStr name]; write ctx ASwap; write ctx ALocalAssign; generate_expr ctx e; c ) in first_catch := false; let j = jmp ctx in next_catch(); Hashtbl.remove ctx.locals name; j ) !cl in if !end_throw && !cl <> [] then begin write ctx APop; push ctx [VReg 0]; write ctx AThrow; end; if !cl <> [] then tdata.tr_catchlen <- Some (ctx.code_pos - p); List.iter (fun j -> j()) jumps; jump_end(); (match fo with | None -> () | Some e -> let p = ctx.code_pos in generate_expr ctx e; tdata.tr_finallylen <- Some (ctx.code_pos - p)) let super_call = EVal (ECall ((EConst (Ident "super"),null_pos),[]),null_pos) , null_pos let generate_function ?(constructor=false) ctx f = match f.fexpr with | None -> () | Some fexpr -> let old_name = ctx.curmethod in let stack_base , old_nregs = ctx.stack , ctx.reg_count in let have_super = used_in_block true "super" fexpr in let reg_super = have_super || (constructor && Class.superclass ctx.current <> None) in let old_forin = ctx.forins in ctx.reg_count <- (if reg_super then 2 else 1); if f.fname <> "" then ctx.curmethod <- f.fname; ctx.forins <- 0; ctx.stack <- ctx.stack + 1; let args = List.map (fun (aname,_) -> let r = (if used_in_block false aname fexpr then 0 else begin ctx.reg_count <- ctx.reg_count + 1; ctx.reg_count end) in Hashtbl.add ctx.locals aname { reg = r; sp = ctx.stack }; r , aname ) f.fargs in let fdone = func ctx args reg_super (used_in_block true "arguments" fexpr) in if constructor && Class.superclass ctx.current <> None && not have_super then generate_expr ctx super_call; generate_expr ctx fexpr; if f.fgetter = Setter then begin push ctx [VInt 0;VThis;VStr ("__get__"^f.fname)]; call ctx VarObj 0; write ctx AReturn; end; fdone (ctx.reg_count + 1); clean_stack ctx stack_base; ctx.forins <- old_forin; ctx.reg_count <- old_nregs; ctx.curmethod <- old_name let generate_super_bindings ctx = Hashtbl.iter (fun (path,fname) flag -> if not flag then begin Hashtbl.replace ctx.super_bindings (path,fname) true; let ident = super_binding_ident path fname in push ctx [VStr ident]; let k = generate_access ctx (EStatic path,null_pos) in getvar ctx k; push ctx [VStr "prototype"]; getvar ctx VarObj; push ctx [VStr fname]; getvar ctx VarObj; setvar ctx VarStr; end; ) ctx.super_bindings let generate_class_code ctx clctx h = let cpath , cname = Class.path clctx in getvar ctx (generate_access ctx (EStatic (cpath,cname),null_pos)); write ctx ANot; write ctx ANot; let jump_end_def = cjmp ctx in if not (Hashtbl.mem h cpath) then begin generate_package_register ctx cpath; Hashtbl.add h cpath (); end; let k = generate_package ctx cpath in push ctx [VStr cname]; (match Class.constructor clctx with | None -> let fdone = func ctx [] true false in (match Class.superclass clctx with | None -> () | Some _ -> generate_expr ctx super_call); fdone 3 | Some f -> generate_function ~constructor:true ctx f); write ctx (ASetReg 0); setvar ctx k; (match Class.superclass clctx with | None -> () | Some csuper when !version = Some 6 -> (* myclass.prototype.__proto__ = superclass.prototype *) push ctx [VReg 0; VStr "prototype"]; getvar ctx VarObj; push ctx [VStr "__proto__"]; getvar ctx (generate_access ctx (EStatic (Class.path csuper),null_pos)); push ctx [VStr "prototype"]; getvar ctx VarObj; setvar ctx VarObj; (* myclass.prototype.__constructor__ = superclass *) push ctx [VReg 0; VStr "prototype"]; getvar ctx VarObj; push ctx [VStr "__constructor__"]; getvar ctx (generate_access ctx (EStatic (Class.path csuper),null_pos)); setvar ctx VarObj | Some csuper -> push ctx [VReg 0]; getvar ctx (generate_access ctx (EStatic (Class.path csuper),null_pos)); write ctx AExtends); push ctx [VReg 0; VStr "prototype"]; getvar ctx VarObj; write ctx (ASetReg 1); write ctx APop; let getters = Hashtbl.create 0 in List.iter (fun f -> match f.fexpr with | None -> () | Some _ -> push ctx [VReg (if f.fstatic = IsMember then 1 else 0)]; let name = (match f.fgetter with | Normal -> if f.fname = "main" && f.fstatic = IsStatic && !enable_main then begin match !(ctx.main) with | None -> ctx.main := Some (Class.path clctx); | Some path -> failwith ("Duplicate main entry point : " ^ s_type_path path ^ " and " ^ s_type_path (Class.path clctx)) end; f.fname | Getter -> Hashtbl.add getters (f.fname,Getter,f.fstatic) (); "__get__" ^ f.fname | Setter -> Hashtbl.add getters (f.fname,Setter,f.fstatic) (); "__set__" ^ f.fname) in push ctx [VStr name]; generate_function ctx f; setvar ctx VarObj; ) (Class.methods clctx); let dones = Hashtbl.create 0 in Hashtbl.iter (fun (name,get,stat) _ -> if Hashtbl.mem dones (name,get,stat) then () else let reg = (if stat = IsMember then 1 else 0) in let getter = (get = Getter || Hashtbl.mem getters (name,Getter,stat)) in let setter = (get = Setter || Hashtbl.mem getters (name,Setter,stat)) in let no_getset = AFunction { f_name = ""; f_args = []; f_codelen = 0 } in Hashtbl.add dones (name,Getter,stat) (); Hashtbl.add dones (name,Setter,stat) (); if setter then begin push ctx [VReg reg; VStr ("__set__" ^ name)]; getvar ctx VarObj; end else write ctx no_getset; if getter then begin push ctx [VReg reg; VStr ("__get__" ^ name)]; getvar ctx VarObj; end else write ctx no_getset; push ctx [VStr name; VInt 3]; push ctx [VReg reg; VStr "addProperty"]; call ctx VarObj 3; write ctx APop; ) getters; List.iter (fun cintf -> getvar ctx (generate_access ctx (EStatic (Class.path cintf),null_pos)); ) (Class.interfaces clctx); let nintf = List.length (Class.interfaces clctx) in if nintf > 0 then begin push ctx [VInt nintf; VReg 0]; write ctx AImplements; ctx.stack_size <- ctx.stack_size - nintf; end; push ctx [VInt 1; VNull; VReg 1; VInt 3; VStr "ASSetPropFlags"]; call ctx VarStr 3; write ctx APop; List.iter (fun (name,stat,v) -> push ctx [VReg (if stat = IsMember then 1 else 0); VStr name]; generate_val ctx v; setvar ctx VarObj; ) (Class.initvars clctx); generate_super_bindings ctx; jump_end_def() let to_utf8 str = try UTF8.validate str; str; with UTF8.Malformed_code -> let b = UTF8.Buf.create 0 in String.iter (fun c -> UTF8.Buf.add_char b (UChar.of_char c)) str; UTF8.Buf.contents b let use_components = ref false let separate = ref true let keep = ref false let bgcolor = ref 0xFFFFFF let frame = ref 1 let header = ref None let excludes = Hashtbl.create 0 let new_context ctx = { ctx with idents = Hashtbl.create 0; locals = Hashtbl.create 0; stack_size = 0; ops = DynArray.create(); code_pos = 1; ident_count = 0; stack = 0; reg_count = 0; opt_push = false; } let is_excluded (path,name) = if Hashtbl.mem excludes (s_type_path (path,name)) then true else let rec loop = function | [] -> false | p :: l -> Hashtbl.mem excludes (String.concat "." (List.rev ("*" :: p :: l))) || loop l in loop (List.rev path) let generate file out ~compress exprs = let file , linkage = (try let f,l = String.split file "@" in f , Some l with Invalid_string -> file , None) in let ctx = { main = ref None; idents = Hashtbl.create 0; ops = DynArray.create(); super_bindings = Hashtbl.create 0; current = Class.empty; code_pos = 1; ident_count = 0; stack = 0; reg_count = 0; locals = Hashtbl.create 0; stack_size = 0; cur_block = (EBreak,null_pos); breaks = []; forins = 0; continue_pos = 0; opt_push = false; curmethod = ""; } in DynArray.add ctx.ops (AStringPool []); let tags = ref [] in let hpackages = Hashtbl.create 0 in Class.generate (fun clctx -> ctx.current <- clctx; let ctx = (if !separate then new_context ctx else ctx) in if not (Class.intrinsic clctx) && not (is_excluded (Class.path clctx)) then begin if !separate then DynArray.add ctx.ops (AStringPool []); let ssize = ActionScript.actions_length ctx.ops in generate_class_code ctx clctx (if !separate then Hashtbl.create 0 else hpackages); if !separate then tags := ("__Packages." ^ s_type_path (Class.path clctx),ctx.idents,ctx.ops) :: !tags; let size = ActionScript.actions_length ctx.ops in if size - ssize >= 1 lsl 15 then failwith ("Class " ^ s_type_path (Class.path clctx) ^ " excess 32K bytecode limit, please split it"); end; ) exprs; if not !separate then tags := ("__Packages.MTASC",ctx.idents,ctx.ops) :: !tags; (match !(ctx.main) with | None -> if !enable_main then failwith "Main entry point not found"; | Some (p,clname) -> let ctx = new_context ctx in DynArray.add ctx.ops (AStringPool []); (*// (main class).main(this); *) push ctx [VStr "MTASC_MAIN"]; write ctx (ASetReg 0); write ctx APop; push ctx [VStr "this"]; write ctx AEval; push ctx [VInt 1]; let k = generate_package ~fast:true ctx p in push ctx [VStr clname]; getvar ctx k; push ctx [VStr "main"]; call ctx VarObj 1; write ctx APop; tags := ("",ctx.idents,ctx.ops) :: !tags; ); tags := List.rev !tags; List.iter (fun (n,idents,ops) -> let idents = Hashtbl.fold (fun ident pos acc -> (ident,pos) :: acc) idents [] in let idents = List.sort ~cmp:(fun (_,p1) (_,p2) -> compare p1 p2) idents in DynArray.set ops 0 (AStringPool (List.map (fun (id,_) -> to_utf8 id) idents)); ) !tags; let tag ?(ext=false) d = { tid = 0; textended = ext; tdata = d; } in let header , data = (match !header with | None -> let ch = IO.input_channel (open_in_bin file) in let header, data = (try Swf.parse ch with IO.No_more_input | IO.Overflow _ | IO.Bits_error -> failwith "Input swf is corrupted") in IO.close_in ch; header , data | Some h -> let data = [tag (TSetBgColor { cr = !bgcolor lsr 16; cg = (!bgcolor lsr 8) land 0xFF; cb = !bgcolor land 0xFF }) ] in let data = data @ (Array.to_list (Array.init !frame (fun _ -> tag TShowFrame))) in h , data) in let header = (match !version with None -> header | Some v -> { header with h_version = v }) in let found = ref false in let curf = ref !frame in let regs = ref [] in let found_ids = ref [] in let insert loop showf acc l = if !found || !curf > 1 then begin curf := !curf - 1; loop (showf @ acc) l end else begin found := true; let main = ref None in let rec loop_tag cid l = if List.exists ((=) cid) !found_ids then loop_tag (cid + 1) l else loop_tag_rec cid l and loop_tag_rec cid = function | [] -> [] | ("",_,ops) :: l -> main := Some (tag ~ext:true (TDoAction ops)); loop_tag (cid + 1) l | (name,_,ops) :: l -> tag ~ext:true (TClip { c_id = cid; c_frame_count = 1; c_tags = [] }) :: tag ~ext:true (TExport [{ exp_id = cid; exp_name = name }]) :: tag ~ext:true (TDoInitAction { dia_id = cid; dia_actions = ops }) :: loop_tag (cid + 1) l in let t = List.rev (loop_tag 0x5000 !tags) in loop (showf @ (match !main with None -> [] | Some m -> [m]) @ !regs @ t @ acc) l end in let replace_package p cid x y z = if p = "__Packages.MTASC" || (not !use_components && not !keep) then [] else try let t = List.find (fun (n,_,_) -> p = n) !tags in tags := List.filter ((!=) t) !tags; [x;y;tag ~ext:true (TDoInitAction { dia_id = cid; dia_actions = (match t with (_,_,o) -> o) })] with Not_found -> if !use_components && String.length p > 14 && String.sub p 0 14 = "__Packages.mx." then [x;y;z] else if !keep then [x;y;z] else [] in let rec loop acc = function | [] -> if not !found then failwith ("Frame " ^ string_of_int !frame ^ " not found in SWF"); List.rev acc | ({ tdata = TDoAction a } as x1) :: ({ tdata = TShowFrame } as x2) :: l -> if DynArray.length a > 0 && (match DynArray.get a 0 with AStringPool ("MTASC_MAIN" :: _) -> true | _ -> false) then loop acc (x2 :: l) else insert loop [x2;x1] acc l | ({ tdata = TShowFrame } as x) :: l -> insert loop [x] acc l | ({ tdata = TClip _ } as x) :: ({ tdata = TExport [{ exp_name = e; exp_id = cid }] } as y) :: ({ tdata = TDoInitAction _ } as z) :: l -> let l2 = replace_package e cid x y z in if l2 <> [] then found_ids := cid :: !found_ids; loop ((List.rev l2) @ acc) l | { tdata = TDoInitAction { dia_actions = d } } as x :: l -> let process mcname clname = let cpath = (match List.rev (String.nsplit clname ".") with [] -> assert false | x :: l -> List.rev l , x) in (try ignore(Class.getclass ctx.current cpath) with _ -> if not !use_components || (match cpath with ("mx" :: _, _) -> false | _ -> true) then prerr_endline ("Warning : The MovieClip " ^ mcname ^ " needs the class " ^ clname ^ " which was not compiled :\nPlease force compilation of this class by adding it to the commandline.")); if !found then loop (x :: acc) l else begin regs := x :: !regs; loop acc l end in (match DynArray.to_list d with | [ APush [PString clname]; AEval; APush [PString mcname;PInt _;PString "Object"]; AEval; APush [PString "registerClass"]; AObjCall; APop ] -> process mcname clname | [ AStringPool [clname;"Object";"registerClass"]; APush [PStack 0]; AEval; APush [PStack 0;PInt _;PStack 1]; AEval; APush [PStack 2]; AObjCall; APop; ] -> process clname clname | _ -> loop (x :: acc) l); | x :: l -> loop (x :: acc) l in let ch = IO.output_channel (open_out_bin out) in Swf.write ch (header,loop [] data); IO.close_out ch let make_header s = let sl = String.nsplit s ":" in try let make w h fps = let w = int_of_string w in let h = int_of_string h in { h_version = 7; h_size = { rect_nbits = if (max w h) >= 820 then 16 else 15; left = 0; top = 0; right = w * 20; bottom = h * 20; }; h_frame_count = 1; h_fps = to_float16 (float_of_string fps); h_compressed = true; } in match sl with | [w;h;fps] -> make w h fps | [w;h;fps;color] -> bgcolor := int_of_string ("0x" ^ color); make w h fps; | _ -> raise Exit with _ -> raise (Arg.Bad "Invalid header format") let rec trim f = let l = String.length f in if l = 0 then "" else match f.[l - 1] with | '\r' | '\n' -> trim (String.sub f 0 (l - 1)) | _ -> f let exclude_file f = let lines = (try let ch = open_in (Plugin.find_file f) in let lines = Std.input_list ch in close_in ch; lines with Not_found | Sys_error _ -> String.nsplit f ";" ) in List.iter (fun f -> let f = trim f in if f <> "" then Hashtbl.replace excludes f () ) lines ;; generate_function_ref := generate_function; SwfParser.init SwfZip.inflate SwfZip.deflate; SwfParser.full_parsing := false; (* faster, safer *) Swf.warnings := false; let swf = ref None in let out = ref None in Plugin.add [ ("-swf",Arg.String (fun f -> swf := Some f)," : swf file to update"); ("-out",Arg.String (fun f -> out := Some f)," : swf output file"); ("-keep",Arg.Unit (fun () -> keep := true),": does not remove AS2 classes from input SWF"); ("-frame",Arg.Int (fun i -> if i <= 0 then raise (Arg.Bad "Invalid frame"); frame := i)," : export into target frame (must exist in the swf)"); ("-main",Arg.Unit (fun () -> enable_main := true),": enable main entry point"); ("-header",Arg.String (fun s -> header := Some (make_header s)),"
: specify header format 'width:height:fps'"); ("-group",Arg.Unit (fun () -> separate := false),": group classes into a single clip"); ("-exclude",Arg.String (fun f -> exclude_file f)," : exclude classes listed in file"); ("-version",Arg.Int (fun n -> version := Some n),": change SWF version (6,7,8,...)"); ("-trace",Arg.String (fun t -> ftrace := Some t)," : specify a TRACE function"); ] (fun t -> if !keep && !header <> None then failwith "-keep cannot be used together with -header"; if !Plugin.verbose && Hashtbl.length excludes > 0 then Printf.printf "Excludes : %s\n" (String.concat ";" (List.of_enum (Hashtbl.keys excludes))); match !swf with | None -> () | Some f -> generate f (match !out with None -> f | Some f -> f) ~compress:true (Typer.exprs t) ); mtasc-1.14/ocaml/mtasc/class.ml0000640000175000017500000001300110341713101015021 0ustar pabspabs(* * MTASC - MotionTwin ActionScript2 Compiler * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Expr type vars = (string,static_flag) Hashtbl.t type generated = | NotYet | Generating | Done type context = { path : type_path; vars : vars; herits : herit list; exprs : signature list; expr : expr; classes : (type_path , context) Hashtbl.t; filename : string; is_interface : bool; mutable interfaces : context list; mutable superclass : context option; mutable constructor : func option; mutable generated : generated; mutable initvars : (string * static_flag * eval) list; mutable methods : func list; } let empty = { path = ([],""); vars = Hashtbl.create 0; herits = []; expr = (EBlock [],null_pos); classes = Hashtbl.create 0; filename = ""; is_interface = false; interfaces = []; superclass = None; constructor = None; generated = NotYet; initvars = []; exprs = []; methods = []; } let path clctx = clctx.path let getclass clctx p = Hashtbl.find clctx.classes p let filename clctx = clctx.filename let expr clctx = clctx.expr let full_exprs clctx = clctx.exprs let constructor clctx = clctx.constructor let superclass clctx = clctx.superclass let methods clctx = clctx.methods let initvars clctx = clctx.initvars let intrinsic clctx = List.exists (( = ) HIntrinsic) clctx.herits let interface clctx = clctx.is_interface let interfaces clctx = clctx.interfaces let is_getset clctx v = match clctx.superclass with | None -> false | Some c -> List.exists (fun f -> f.fname = v && f.fgetter <> Normal) c.methods let rec resolve_supervar c name = match c.superclass with | None -> assert false | Some c -> try if Hashtbl.find c.vars name = IsStatic then resolve_supervar c name else c.path with Not_found -> resolve_supervar c name let generate_exprs h fname el = let add_class interf path herits e = Hashtbl.add h path { filename = fname; path = path; vars = Hashtbl.create 0; herits = herits; is_interface = interf; classes = h; constructor = None; superclass = None; interfaces = []; initvars = []; methods = []; generated = NotYet; expr = e; exprs = el; } in let rec loop (e,p) = match e with | EClass (path,herits,e) -> add_class false path herits e | EInterface (path,herits,e) -> add_class true path herits e | EImport _ -> () in List.iter loop el let rec generate_class_vars h gen clctx (e,p) = match e with | EVars (static_flag,public_flag,vl) -> List.iter (fun (name,_,vinit) -> Hashtbl.add clctx.vars name static_flag; match vinit with | Some v -> clctx.initvars <- (name,static_flag,v) :: clctx.initvars; if static_flag = IsStatic then generate_class_static_refs h gen clctx v | _ -> () ) vl | EFunction f -> if f.fname = snd clctx.path then clctx.constructor <- Some f else begin Hashtbl.add clctx.vars f.fname f.fstatic; clctx.methods <- f :: clctx.methods end | EBlock el -> List.iter (generate_class_vars h gen clctx) el | _ -> assert false and generate_class_static_refs h gen clctx v = let check p = let clctx2 = (try Hashtbl.find h p with Not_found -> assert false) in if clctx2 != clctx then generate_class h gen clctx2 in let rec loop (v,p) = match v with | EField (v,_) | EParenthesis v | EUnop (_,_,v) -> loop v | EArray (v1,v2) | ECast (v1,v2) | EBinop (_,v1,v2) -> loop v1; loop v2 | EObjDecl vl -> List.iter (fun (_,v) -> loop v) vl | EArrayDecl vl -> List.iter loop vl | ECall (v,vl) -> List.iter loop (v :: vl) | EQuestion (v,v1,v2) -> loop v; loop v1; loop v2 | EStatic p -> check p; | ENew (v,vl) -> List.iter loop (v :: vl) | EConst _ | ELambda _ -> () in loop v and generate_class h gen clctx = match clctx.generated with | Done -> () | Generating -> prerr_endline ("Warning : loop in generation for class " ^ s_type_path clctx.path) | NotYet -> let generate_herit = function | HIntrinsic | HDynamic -> () | HExtends path when not clctx.is_interface -> (try let hctx = Hashtbl.find h path in clctx.superclass <- Some hctx; generate_class h gen hctx with Not_found -> assert false) | HExtends path | HImplements path -> try let hctx = Hashtbl.find h path in clctx.interfaces <- hctx :: clctx.interfaces; generate_class h gen hctx with Not_found -> assert false in clctx.generated <- Generating; List.iter generate_herit clctx.herits; generate_class_vars h gen clctx clctx.expr; clctx.methods <- List.rev clctx.methods; clctx.initvars <- List.rev clctx.initvars; gen clctx; clctx.generated <- Done let generate gen exprs = let h = Hashtbl.create 0 in Hashtbl.iter (fun fname el -> generate_exprs h fname el) exprs; Hashtbl.iter (fun _ cl -> generate_class h gen cl) hmtasc-1.14/ocaml/mtasc/mtasc.dsw0000640000175000017500000000077010135463416015235 0ustar pabspabsMicrosoft Developer Studio Workspace File, Format Version 6.00 # WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE! ############################################################################### Project: "mtasc"=.\mtasc.dsp - Package Owner=<4> Package=<5> {{{ }}} Package=<4> {{{ }}} ############################################################################### Global: Package=<5> {{{ }}} Package=<3> {{{ }}} ############################################################################### mtasc-1.14/ocaml/mtasc/.cvsignore0000640000175000017500000000001510222207365015373 0ustar pabspabslexer.ml testmtasc-1.14/ocaml/mtasc/mtasc.sln0000640000175000017500000000155610144165365015241 0ustar pabspabsMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "mtasc", "mtasc.vcproj", "{27658BE2-E5AA-4336-B2BB-15E53872EAFA}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Debug = Debug Release = Release EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {27658BE2-E5AA-4336-B2BB-15E53872EAFA}.Debug.ActiveCfg = Debug|Win32 {27658BE2-E5AA-4336-B2BB-15E53872EAFA}.Debug.Build.0 = Debug|Win32 {27658BE2-E5AA-4336-B2BB-15E53872EAFA}.Release.ActiveCfg = Release|Win32 {27658BE2-E5AA-4336-B2BB-15E53872EAFA}.Release.Build.0 = Release|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal mtasc-1.14/ocaml/swflib/0000750000175000017500000000000011155145522013557 5ustar pabspabsmtasc-1.14/ocaml/swflib/swfParser.ml0000640000175000017500000013536111041363545016100 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Swf open ActionScript open IO (* ************************************************************************ *) (* TOOLS *) let full_parsing = ref true let force_as3_parsing = ref false let swf_version = ref 0 let id_count = ref 0 let tag_end = { tid = 0; textended = false; tdata = TEnd } let sum f l = List.fold_left (fun acc x -> acc + f x) 0 l let gen_id() = incr id_count; !id_count let const n = fun _ -> n let opt_len f = function | None -> 0 | Some x -> f x let opt_flag flags fid f fparam = if (flags land fid) = 0 then None else Some (f fparam) let opt f = function | None -> () | Some x -> f x let flag = function | None -> false | Some _ -> true let rec make_flags = function | [] -> 0 | true :: l -> 1 lor ((make_flags l) lsl 1) | false :: l -> (make_flags l) lsl 1 let f16_value (a,b) = let k = int_of_char a lor (int_of_char b lsl 8) in float_of_int k /. float_of_int (1 lsl 8) let rec read_count n f arg = if n = 0 then [] else let v = f arg in v :: read_count (n - 1) f arg (* ************************************************************************ *) (* LENGTH *) let _nbits x = if x < 0 then error "Negative nbits"; if x = 0 then 0 else let x = ref x in let nbits = ref 0 in while !x > 0 do x := !x lsr 1; incr nbits; done; !nbits let rect_nbits r = r.rect_nbits let bigrect_nbits r = r.brect_nbits let rgba_nbits c = max (max (_nbits c.r) (_nbits c.g)) (max (_nbits c.b) (_nbits c.a)) let cxa_nbits c = c.cxa_nbits let matrix_part_nbits m = m.m_nbits let rgb_length = 3 let rgba_length = 4 let color_length = function | ColorRGB _ -> rgb_length | ColorRGBA _ -> rgba_length let rect_length r = let nbits = rect_nbits r in let nbits = nbits * 4 + 5 in (nbits + 7) / 8 let big_rect_length r = let nbits = bigrect_nbits r in let nbits = nbits * 4 + 5 in (nbits + 7) / 8 let gradient_length = function | GradientRGB (l,_) -> 1 + (1 + rgb_length) * List.length l | GradientRGBA (l,_) -> 1 + (1 + rgba_length) * List.length l let matrix_length m = let matrix_part_len m = 5 + matrix_part_nbits m * 2 in let nbits = 2 + opt_len matrix_part_len m.scale + opt_len matrix_part_len m.rotate + matrix_part_len m.trans in (nbits + 7) / 8 let cxa_length c = let nbits = cxa_nbits c in let nbits = 6 + opt_len (const (nbits * 4)) c.cxa_add + opt_len (const (nbits * 4)) c.cxa_mult in (nbits + 7) / 8 let clip_event_length c = (if !swf_version >= 6 then 4 else 2) + 4 + (opt_len (const 1) c.cle_key) + actions_length c.cle_actions let clip_events_length l = (if !swf_version >= 6 then 10 else 6) + sum clip_event_length l let export_length e = 2 + String.length e.exp_name + 1 let sound_length s = 2 + 1 + 4 + String.length s.so_data let shape_fill_style_length s = 1 + match s with | SFSSolid _ -> rgb_length | SFSSolid3 _ -> rgba_length | SFSLinearGradient (m,g) | SFSRadialGradient (m,g,None) -> matrix_length m + gradient_length g | SFSRadialGradient (m,g,Some _) -> matrix_length m + gradient_length g + 2 | SFSBitmap b -> 2 + matrix_length b.sfb_mpos let shape_line_style_length s = 2 + match s.sls_flags with | None -> color_length s.sls_color | Some _ -> 2 + (match s.sls_fill with None -> color_length s.sls_color | Some f -> shape_fill_style_length f) + opt_len (const 2) s.sls_miter let shape_array_length f s = let n = List.length s in (if n < 0xFF then 1 else 3) + sum f s let shape_new_styles_length s = shape_array_length shape_fill_style_length s.sns_fill_styles + shape_array_length shape_line_style_length s.sns_line_styles + 1 let shape_records_length records = let nbits = ref 8 in let nfbits = ref records.srs_nfbits in let nlbits = ref records.srs_nlbits in List.iter (fun r -> nbits := !nbits + 6; match r with | SRStyleChange s -> nbits := !nbits + opt_len (fun (n,_,_) -> 5 + n * 2) s.scsr_move + opt_len (const !nfbits) s.scsr_fs0 + opt_len (const !nfbits) s.scsr_fs1 + opt_len (const !nlbits) s.scsr_ls; (match s.scsr_new_styles with | None -> () | Some s -> nbits := (((!nbits + 7) / 8) + shape_new_styles_length s) * 8; nfbits := s.sns_nfbits; nlbits := s.sns_nlbits) | SRCurvedEdge s -> nbits := !nbits + s.scer_nbits * 4 | SRStraightEdge s -> nbits := !nbits + 1 + (match s.sser_line with | None , None -> assert false | Some _ , None | None, Some _ -> 1 + s.sser_nbits | Some _ , Some _ -> 2 * s.sser_nbits) ) records.srs_records; nbits := !nbits + 6; (!nbits + 7) / 8 let shape_with_style_length s = shape_array_length shape_fill_style_length s.sws_fill_styles + shape_array_length shape_line_style_length s.sws_line_styles + shape_records_length s.sws_records let shape_length s = 2 + rect_length s.sh_bounds + opt_len (fun (r,_) -> rect_length r + 1) s.sh_bounds2 + shape_with_style_length s.sh_style let bitmap_lossless_length b = 2 + 1 + 2 + 2 + String.length b.bll_data let morph_shape_length s = 2 + rect_length s.msh_start_bounds + rect_length s.msh_end_bounds + String.length s.msh_data let text_record_length t r = 1 + opt_len (const 4) r.txr_font + opt_len color_length r.txr_color + opt_len (const 2) r.txr_dx + opt_len (const 2) r.txr_dy + 1 + ((((t.txt_ngbits + t.txt_nabits) * List.length r.txr_glyphs) + 7) / 8) let text_length t = 2 + big_rect_length t.txt_bounds + matrix_length t.txt_matrix + 2 + sum (text_record_length t) t.txt_records + 1 let filters_length l = 1 + sum (fun f -> 1 + match f with | FDropShadow s | FBlur s | FGlow s | FBevel s | FAdjustColor s -> String.length s | FGradientGlow fg | FGradientBevel fg -> 1 + ((rgba_length + 1) * List.length fg.fgr_colors) + String.length fg.fgr_data ) l let button_record_length r = 1 + 2 + 2 + matrix_length r.btr_mpos + (match r.btr_color with None -> 0 | Some c -> cxa_length c) + opt_len filters_length r.btr_filters let button_action_length r = 2 + 2 + actions_length r.bta_actions let button2_length b = 2 + 1 + 2 + 1 + sum button_record_length b.bt2_records + sum button_action_length b.bt2_actions let font2_length f = 2 + String.length f.ft2_data let font3_length f = 2 + String.length f.ft3_data let font_glyphs_length f = 2 + String.length f.fgl_data let edit_text_layout_length = 9 let header_length h = 3 + 1 + rect_length h.h_size + 2 + 4 let edit_text_length t = 2 + rect_length t.edt_bounds + 2 + opt_len (const 4) t.edt_font + opt_len (const rgba_length) t.edt_color + opt_len (const 2) t.edt_maxlen + opt_len (const edit_text_layout_length) t.edt_layout + String.length t.edt_variable + 1 + opt_len (fun s -> String.length s + 1) t.edt_text let place_object_length p v3 = 3 + (if v3 then 1 else 0) + 0 (* po_move *) + opt_len (const 2) p.po_cid + opt_len matrix_length p.po_matrix + opt_len cxa_length p.po_color + opt_len (const 2) p.po_ratio + opt_len (fun s -> String.length s + 1) p.po_inst_name + opt_len (const 2) p.po_clip_depth + opt_len clip_events_length p.po_events + (if v3 then opt_len filters_length p.po_filters + opt_len (const 1) p.po_blend + opt_len (const 1) p.po_bcache else 0) let rec tag_data_length = function | TEnd -> 0 | TShowFrame -> 0 | TShape s -> shape_length s | TRemoveObject _ -> 4 | TBitsJPEG b -> 2 + String.length b.jpg_data | TJPEGTables tab -> String.length tab | TSetBgColor _ -> rgb_length | TText t -> text_length t | TDoAction acts -> actions_length acts | TSound s -> sound_length s | TStartSound s -> 2 + String.length s.sts_data | TBitsLossless b -> bitmap_lossless_length b | TBitsJPEG2 b -> 2 + String.length b.jp2_table + String.length b.jp2_data | TShape2 s -> shape_length s | TProtect -> 0 | TPlaceObject2 p -> place_object_length p false | TRemoveObject2 _ -> 2 | TShape3 s -> shape_length s | TText2 t -> text_length t | TButton2 b -> button2_length b | TBitsJPEG3 b -> 2 + 4 + String.length b.jp3_alpha_data + String.length b.jp3_data + String.length b.jp3_table | TBitsLossless2 b -> bitmap_lossless_length b | TEditText t -> edit_text_length t | TClip c -> 4 + sum tag_length (tag_end :: c.c_tags) | TProductInfo s -> String.length s | TFrameLabel (label,id) -> String.length label + 1 + (match id with None -> 0 | Some _ -> 1) | TSoundStreamHead2 data -> String.length data | TMorphShape s -> morph_shape_length s | TFont2 f -> font2_length f | TExport el -> 2 + sum export_length el | TDoInitAction i -> 2 + actions_length i.dia_actions | TVideoStream s -> String.length s | TVideoFrame s -> String.length s | TDebugID s -> String.length s | TEnableDebugger2 (_,data) -> 2 + String.length data + 1 | TScriptLimits _ -> 4 | TSandbox _ -> 4 | TPlaceObject3 p -> place_object_length p true | TFontGlyphs f -> font_glyphs_length f | TTextInfo s -> String.length s | TFont3 f -> font3_length f | TF9Classes l -> 2 + sum (fun c -> String.length c.f9_classname + 1 + 2) l | TMetaData meta -> String.length meta | TActionScript3 (id,a) -> (match id with None -> 0 | Some (id,f) -> 4 + String.length f + 1) + As3parse.as3_length a | TShape4 s -> shape_length s | TShape5 (_,s) -> 2 + String.length s | TF9Scene name -> 2 + String.length name + 1 + 1 | TUnknown (_,data) -> String.length data and tag_length t = let dlen = tag_data_length t.tdata in dlen + 2 + (if t.textended || dlen >= 63 then 4 else 0) (* ************************************************************************ *) (* READ PRIMS *) let skip ch n = seek_in ch ((Pervasives.pos_in ch) + n) let read_rgba ch = let r = read_byte ch in let g = read_byte ch in let b = read_byte ch in let a = read_byte ch in { r = r; g = g; b = b; a = a; } let read_rgb ch = let r = read_byte ch in let g = read_byte ch in let b = read_byte ch in { cr = r; cg = g; cb = b; } let read_gradient ch is_rgba = let grad_rgb() = let r = read_byte ch in let c = read_rgb ch in (r, c) in let grad_rgba() = let r = read_byte ch in let c = read_rgba ch in (r, c) in let n = read_byte ch in let n , flags = n land 0xF , n lsr 4 in if is_rgba then GradientRGBA (read_count n grad_rgba (),flags) else GradientRGB (read_count n grad_rgb (),flags) let read_rect ch = let b = input_bits ch in let nbits = read_bits b 5 in let left = read_bits b nbits in let right = read_bits b nbits in let top = read_bits b nbits in let bottom = read_bits b nbits in { rect_nbits = nbits; left = left; right = right; top = top; bottom = bottom; } let rec read_multi_bits b n = if n <= 30 then [read_bits b n] else let d = read_bits b 30 in d :: read_multi_bits b (n - 30) let read_big_rect ch = let b = input_bits ch in let nbits = read_bits b 5 in let left = read_multi_bits b nbits in let right = read_multi_bits b nbits in let top = read_multi_bits b nbits in let bottom = read_multi_bits b nbits in { brect_nbits = nbits; bleft = left; bright = right; btop = top; bbottom = bottom; } let read_matrix ch = let b = input_bits ch in let read_matrix_part() = let nbits = read_bits b 5 in let x = read_bits b nbits in let y = read_bits b nbits in { m_nbits = nbits; mx = x; my = y; } in let has_scale = (read_bits b 1 = 1) in let scale = (if has_scale then Some (read_matrix_part()) else None) in let has_rotate = (read_bits b 1 = 1) in let rotate = (if has_rotate then Some (read_matrix_part()) else None) in let trans = read_matrix_part() in { scale = scale; rotate = rotate; trans = trans; } let read_cxa ch = let b = input_bits ch in let has_add = (read_bits b 1 = 1) in let has_mult = (read_bits b 1 = 1) in let nbits = read_bits b 4 in let read_cxa_color() = let r = read_bits b nbits in let g = read_bits b nbits in let bl = read_bits b nbits in let a = read_bits b nbits in { r = r; g = g; b = bl; a = a; } in let mult = (if has_mult then Some (read_cxa_color()) else None) in let add = (if has_add then Some (read_cxa_color()) else None) in { cxa_nbits = nbits; cxa_add = add; cxa_mult = mult; } let read_event ch = (if !swf_version >= 6 then read_i32 else read_ui16) ch (* ************************************************************************ *) (* WRITE PRIMS *) let write_rgb ch c = write_byte ch c.cr; write_byte ch c.cg; write_byte ch c.cb let write_rgba ch c = write_byte ch c.r; write_byte ch c.g; write_byte ch c.b; write_byte ch c.a let write_color ch = function | ColorRGB c -> write_rgb ch c | ColorRGBA c -> write_rgba ch c let write_gradient ch = function | GradientRGB (l,flags) -> let n = List.length l in write_byte ch (n lor (flags lsl 4)); List.iter (fun (ratio,c) -> write_byte ch ratio; write_rgb ch c) l | GradientRGBA (l,flags) -> let n = List.length l in write_byte ch (n lor (flags lsl 4)); List.iter (fun (ratio,c) -> write_byte ch ratio; write_rgba ch c) l let write_rect ch r = let b = output_bits ch in let nbits = rect_nbits r in write_bits b 5 nbits; write_bits b nbits r.left; write_bits b nbits r.right; write_bits b nbits r.top; write_bits b nbits r.bottom; flush_bits b let rec write_multi_bits b n l = if n <= 30 then match l with | [] -> write_bits b n 0 | [x] -> write_bits b n x | _ -> assert false else match l with | [] -> write_bits b 30 0; write_multi_bits b (n - 30) [] | x :: l -> write_bits b 30 x; write_multi_bits b (n - 30) l let write_big_rect ch r = let b = output_bits ch in let nbits = bigrect_nbits r in write_bits b 5 nbits; write_multi_bits b nbits r.bleft; write_multi_bits b nbits r.bright; write_multi_bits b nbits r.btop; write_multi_bits b nbits r.bbottom; flush_bits b let write_matrix ch m = let b = output_bits ch in let write_matrix_part m = let nbits = matrix_part_nbits m in write_bits b 5 nbits; write_bits b nbits m.mx; write_bits b nbits m.my; in (match m.scale with | None -> write_bits b 1 0 | Some s -> write_bits b 1 1; write_matrix_part s ); (match m.rotate with | None -> write_bits b 1 0 | Some r -> write_bits b 1 1; write_matrix_part r); write_matrix_part m.trans; flush_bits b let write_cxa ch c = let b = output_bits ch in let nbits = cxa_nbits c in (match c.cxa_add , c.cxa_mult with | None , None -> write_bits b 2 0; write_bits b 4 1; (* some strange MM thing... *) | Some c , None -> write_bits b 2 2; write_bits b 4 nbits; List.iter (write_bits b ~nbits) [c.r;c.g;c.b;c.a]; | None , Some c -> write_bits b 2 1; write_bits b 4 nbits; List.iter (write_bits b ~nbits) [c.r;c.g;c.b;c.a]; | Some c1 , Some c2 -> write_bits b 2 3; write_bits b 4 nbits; List.iter (write_bits b ~nbits) [c2.r;c2.g;c2.b;c2.a;c1.r;c1.g;c1.b;c1.a] ); flush_bits b let write_event ch evt = (if !swf_version >= 6 then write_i32 else write_ui16) ch evt (* ************************************************************************ *) (* PARSING *) let parse_clip_events ch = ignore(read_ui16 ch); (* reserved *) ignore(read_event ch); (* all_events *) let rec loop() = let events = read_event ch in if events = 0 then [] else begin ignore(read_i32 ch); (* len *) let key = (if events land (1 lsl 17) <> 0 then Some (read ch) else None) in let e = { cle_events = events; cle_key = key; cle_actions = parse_actions ch } in e :: (loop()) end; in loop() let parse_shape_fill_style ch vshape = let t = read_byte ch in match t with | 0x00 when vshape >= 3 -> SFSSolid3 (read_rgba ch) | 0x00 -> SFSSolid (read_rgb ch) | 0x10 -> let m = read_matrix ch in let g = read_gradient ch (vshape >= 3) in SFSLinearGradient (m,g) | 0x12 -> let m = read_matrix ch in let g = read_gradient ch (vshape >= 3) in SFSRadialGradient (m,g,None) | 0x13 -> let m = read_matrix ch in let g = read_gradient ch (vshape >= 3) in let i = read_i16 ch in SFSRadialGradient (m,g,Some i) | 0x40 | 0x41 | 0x42 | 0x43 -> let id = read_ui16 ch in let m = read_matrix ch in SFSBitmap { sfb_repeat = (t = 0x40 || t = 0x42); sfb_smooth = (t = 0x42 || t = 0x43); sfb_cid = id; sfb_mpos = m; } | _ -> assert false let parse_shape_line_style ch vshape = let width = read_ui16 ch in if vshape >= 4 then begin let flags = read_ui16 ch in let fill = (flags land 8 <> 0) in let miterjoin = (flags land 0x20 <> 0) in let miter = (if miterjoin then Some (IO.read_ui16 ch) else None) in let color = (if fill then { r = 0; g = 0; b = 0; a = 0 } else read_rgba ch) in (* let noVscale = (flags land 0x02 <> 0) in let noHscale = (flags land 0x04 <> 0) in let beveljoin = (flags land 0x10 <> 0) in let nocap = (flags land 0x40 <> 0) in let squarecap = (flags land 0x80 <> 0) in *) { sls_width = width; sls_color = ColorRGBA color; sls_fill = if fill then Some (parse_shape_fill_style ch vshape) else None; sls_flags = Some flags; sls_miter = miter; } end else { sls_width = width; sls_color = if vshape = 3 then ColorRGBA (read_rgba ch) else ColorRGB (read_rgb ch); sls_fill = None; sls_flags = None; sls_miter = None; } let parse_shape_array f ch vshape = let n = (match read_byte ch with 0xFF -> read_ui16 ch | n -> n) in read_count n (f ch) vshape let parse_shape_style_change_record ch b flags nlbits nfbits vshape = let move = (if flags land 1 <> 0 then begin let mbits = read_bits b 5 in let dx = read_bits b mbits in let dy = read_bits b mbits in Some (mbits,dx,dy) end else None) in let fs0 = (if flags land 2 <> 0 then Some (read_bits b !nfbits) else None) in let fs1 = (if flags land 4 <> 0 then Some (read_bits b !nfbits) else None) in let ls = (if flags land 8 <> 0 then Some (read_bits b !nlbits) else None) in let styles = (if flags land 16 <> 0 then begin IO.drop_bits b; let fstyles = parse_shape_array parse_shape_fill_style ch vshape in let lstyles = parse_shape_array parse_shape_line_style ch vshape in let bits = read_byte ch in nlbits := bits land 15; nfbits := bits lsr 4; Some { sns_fill_styles = fstyles; sns_line_styles = lstyles; sns_nlbits = !nlbits; sns_nfbits = !nfbits; } end else None ) in { scsr_move = move; scsr_fs0 = fs0; scsr_fs1 = fs1; scsr_ls = ls; scsr_new_styles = styles; } let parse_shape_curved_edge_record b flags = let nbits = (flags land 15) + 2 in let cx = read_bits b nbits in let cy = read_bits b nbits in let ax = read_bits b nbits in let ay = read_bits b nbits in { scer_nbits = nbits; scer_cx = cx; scer_cy = cy; scer_ax = ax; scer_ay = ay; } let parse_shape_straight_edge_record b flags = let nbits = (flags land 15) + 2 in let is_general = (read_bits b 1 = 1) in let l = (if is_general then let dx = read_bits b nbits in let dy = read_bits b nbits in Some dx, Some dy else let is_vertical = (read_bits b 1 = 1) in let p = read_bits b nbits in if is_vertical then None, Some p else Some p, None) in { sser_nbits = nbits; sser_line = l; } let parse_shape_records ch nlbits nfbits vshape = let b = input_bits ch in let nlbits = ref nlbits in let nfbits = ref nfbits in let rec loop() = let flags = read_bits b 6 in if flags = 0 then [] else let r = (if (flags land 32) = 0 then SRStyleChange (parse_shape_style_change_record ch b flags nlbits nfbits vshape) else if (flags land 48) = 32 then SRCurvedEdge (parse_shape_curved_edge_record b flags) else SRStraightEdge (parse_shape_straight_edge_record b flags)) in r :: loop() in loop() let parse_shape_with_style ch vshape = let fstyles = parse_shape_array parse_shape_fill_style ch vshape in let lstyles = parse_shape_array parse_shape_line_style ch vshape in let bits = read_byte ch in let nlbits = bits land 15 in let nfbits = bits lsr 4 in let records = parse_shape_records ch nlbits nfbits vshape in { sws_fill_styles = fstyles; sws_line_styles = lstyles; sws_records = { srs_nlbits = nlbits; srs_nfbits = nfbits; srs_records = records; } } let parse_shape ch len vshape = let id = read_ui16 ch in let bounds = read_rect ch in let bounds2 = (if vshape = 4 then let r = read_rect ch in let b = read_byte ch in Some (r, b) else None ) in let style = parse_shape_with_style ch vshape in { sh_id = id; sh_bounds = bounds; sh_bounds2 = bounds2; sh_style = style; } let parse_jpg_table ch = let b = Buffer.create 0 in let rec loop flag = let c = IO.read ch in Buffer.add_char b c; match int_of_char c with | 0xFF -> loop true | 0xD9 when flag -> () | _ -> loop false in loop false; Buffer.contents b let parse_bitmap_lossless ch len = let id = read_ui16 ch in let format = read_byte ch in let width = read_ui16 ch in let height = read_ui16 ch in let data = nread ch (len - 7) in { bll_id = id; bll_format = format; bll_width = width; bll_height = height; bll_data = data; } let parse_text ch is_txt2 = let id = read_ui16 ch in let bounds = read_big_rect ch in let matrix = read_matrix ch in let ngbits = read_byte ch in let nabits = read_byte ch in let read_glyph bits = let indx = read_bits bits ngbits in let adv = read_bits bits nabits in { txg_index = indx; txg_advanced = adv; } in let rec loop() = let flags = read_byte ch in if flags = 0 then [] else let font_id = (if flags land 8 <> 0 then read_ui16 ch else 0) in let color = (if flags land 4 <> 0 then Some (if is_txt2 then ColorRGBA (read_rgba ch) else ColorRGB (read_rgb ch)) else None) in let dx = (if flags land 1 <> 0 then Some (read_i16 ch) else None) in let dy = (if flags land 2 <> 0 then Some (read_i16 ch) else None) in let font = (if flags land 8 <> 0 then Some (font_id,read_ui16 ch) else None) in let nglyphs = read_byte ch in let r = { txr_font = font; txr_color = color; txr_dx = dx; txr_dy = dy; txr_glyphs = read_count nglyphs read_glyph (input_bits ch); } in r :: loop() in { txt_id = id; txt_bounds = bounds; txt_matrix = matrix; txt_ngbits = ngbits; txt_nabits = nabits; txt_records = loop(); } let parse_edit_text_layout ch = let align = read_byte ch in let ml = read_ui16 ch in let rl = read_ui16 ch in let ident = read_ui16 ch in let lead = read_ui16 ch in { edtl_align = align; edtl_left_margin = ml; edtl_right_margin = rl; edtl_indent = ident; edtl_leading = lead; } let parse_edit_text ch = let id = read_ui16 ch in let bounds = read_rect ch in let flags = read_ui16 ch in let font = (if flags land 1 <> 0 then let fid = read_ui16 ch in let height = read_ui16 ch in Some (fid, height) else None) in let color = (if flags land 4 <> 0 then Some (read_rgba ch) else None) in let maxlen = (if flags land 2 <> 0 then Some (read_ui16 ch) else None) in let layout = (if flags land (1 lsl 13) <> 0 then Some (parse_edit_text_layout ch) else None) in let variable = read_string ch in let text = (if flags land 128 <> 0 then Some (read_string ch) else None) in { edt_id = id; edt_bounds = bounds; edt_font = font; edt_color = color; edt_maxlen = maxlen; edt_layout = layout; edt_variable = variable; edt_text = text; edt_wordwrap = (flags land 64) <> 0; edt_multiline = (flags land 32) <> 0; edt_password = (flags land 16) <> 0; edt_readonly = (flags land 8) <> 0; edt_autosize = (flags land (1 lsl 14)) <> 0; edt_noselect = (flags land 4096) <> 0; edt_border = (flags land 2048) <> 0; edt_html = (flags land 512) <> 0; edt_outlines = (flags land 256) <> 0; } let parse_font2 ch len = let id = read_ui16 ch in let data = nread ch (len - 2) in { ft2_id = id; ft2_data = data; } let parse_font3 ch len = let id = read_ui16 ch in let data = nread ch (len - 2) in { ft3_id = id; ft3_data = data; } let parse_font_glyphs ch len = let id = read_ui16 ch in let data = nread ch (len - 2) in { fgl_id = id; fgl_data = data; } let parse_morph_shape ch len = let id = read_ui16 ch in let sbounds = read_rect ch in let ebounds = read_rect ch in let data = nread ch (len - 2 - rect_length sbounds - rect_length ebounds) in { msh_id = id; msh_start_bounds = sbounds; msh_end_bounds = ebounds; msh_data = data; } let parse_filter_gradient ch = let ncolors = read_byte ch in let colors = read_count ncolors read_rgba ch in let cvals = read_count ncolors read_byte ch in let data = nread ch 19 in { fgr_colors = List.combine colors cvals; fgr_data = data; } let parse_filter ch = match read_byte ch with | 0 -> FDropShadow (nread ch 23) | 1 -> FBlur (nread ch 9) | 2 -> FGlow (nread ch 15) | 3 -> FBevel (nread ch 27) | 4 -> FGradientGlow (parse_filter_gradient ch) | 6 -> FAdjustColor (nread ch 80) | 7 -> FGradientBevel (parse_filter_gradient ch) | _ -> assert false let parse_filters ch = let nf = read_byte ch in read_count nf parse_filter ch let rec parse_button_records ch color = let flags = read_byte ch in if flags = 0 then [] else let cid = read_ui16 ch in let depth = read_ui16 ch in let mpos = read_matrix ch in let cxa = (if color then Some (read_cxa ch) else None) in let filters = (if flags land 16 = 0 then None else Some (parse_filters ch)) in let r = { btr_flags = flags; btr_cid = cid; btr_depth = depth; btr_mpos = mpos; btr_color = cxa; btr_filters = filters; } in r :: parse_button_records ch color let rec parse_button_actions ch = let size = read_ui16 ch in let flags = read_ui16 ch in let actions = parse_actions ch in let bta = { bta_flags = flags; bta_actions = actions; } in if size = 0 then [bta] else bta :: parse_button_actions ch let parse_button2 ch len = let id = read_ui16 ch in let flags = read_byte ch in let track = (match flags with 0 -> false | 1 -> true | _ -> assert false) in let offset = read_ui16 ch in let records = parse_button_records ch true in let actions = (if offset = 0 then [] else parse_button_actions ch) in { bt2_id = id; bt2_track_as_menu = track; bt2_records = records; bt2_actions = actions; } let parse_place_object ch v3 = let f = read_byte ch in let fext = (if v3 then read_byte ch else 0) in let depth = read_ui16 ch in let move = (f land 1) <> 0 in let cid = opt_flag f 2 read_ui16 ch in let matrix = opt_flag f 4 read_matrix ch in let color = opt_flag f 8 read_cxa ch in let ratio = opt_flag f 16 read_ui16 ch in let name = opt_flag f 32 read_string ch in let clip_depth = opt_flag f 64 read_ui16 ch in let clip_events = opt_flag f 128 parse_clip_events ch in let filters = opt_flag fext 1 parse_filters ch in let blend = opt_flag fext 2 read_byte ch in let bcache = opt_flag fext 4 read_byte ch in { po_depth = depth; po_move = move; po_cid = cid; po_matrix = matrix; po_color = color; po_ratio = ratio; po_inst_name = name; po_clip_depth = clip_depth; po_events = clip_events; po_filters = filters; po_blend = blend; po_bcache = bcache; } let rec parse_tag ch h = let id = h lsr 6 in let len = h land 63 in let len , extended = ( if len = 63 then let len = read_i32 ch in len , len < 63 else len , false ) in let t = ( match id with | 0x00 -> TEnd | 0x01 -> TShowFrame | 0x02 when !full_parsing -> TShape (parse_shape ch len 1) (*//0x04 TPlaceObject *) | 0x05 -> let cid = read_ui16 ch in let depth = read_ui16 ch in TRemoveObject { rmo_id = cid; rmo_depth = depth; } | 0x06 -> let id = read_ui16 ch in let data = nread ch (len - 2) in TBitsJPEG { jpg_id = id; jpg_data = data; } (*//0x07 TButton *) | 0x08 -> TJPEGTables (nread ch len) | 0x09 -> TSetBgColor (read_rgb ch) (*//0x0A TFont *) | 0x0B when !full_parsing -> TText (parse_text ch false) | 0x0C -> TDoAction (parse_actions ch) (*//0x0D TFontInfo *) | 0x0E -> let sid = read_ui16 ch in let flags = read_byte ch in let samples = read_i32 ch in let data = nread ch (len - 7) in TSound { so_id = sid; so_flags = flags; so_samples = samples; so_data = data; } | 0x0F -> let sid = read_ui16 ch in let data = nread ch (len - 2) in TStartSound { sts_id = sid; sts_data = data; } (*//0x11 TButtonSound *) (*//0x12 TSoundStreamHead *) (*//0x13 TSoundStreamBlock *) | 0x14 -> TBitsLossless (parse_bitmap_lossless ch len) | 0x15 -> let id = read_ui16 ch in let table = parse_jpg_table ch in let data = nread ch (len - 2 - String.length table) in TBitsJPEG2 { jp2_id = id; jp2_table = table; jp2_data = data; } | 0x16 when !full_parsing -> TShape2 (parse_shape ch len 2) (*//0x17 TButtonCXForm *) | 0x18 -> TProtect | 0x1A when !full_parsing -> TPlaceObject2 (parse_place_object ch false) | 0x1C -> let depth = read_ui16 ch in TRemoveObject2 depth | 0x20 when !full_parsing -> TShape3 (parse_shape ch len 3) | 0x21 when !full_parsing -> TText2 (parse_text ch true) | 0x22 when !full_parsing -> TButton2 (parse_button2 ch len) | 0x23 -> let id = read_ui16 ch in let size = read_i32 ch in let table = parse_jpg_table ch in let data = nread ch (size - String.length table) in let alpha_data = nread ch (len - 6 - size) in TBitsJPEG3 { jp3_id = id; jp3_table = table; jp3_data = data; jp3_alpha_data = alpha_data; } | 0x24 -> TBitsLossless2 (parse_bitmap_lossless ch len) | 0x25 when !full_parsing -> TEditText (parse_edit_text ch) | 0x27 -> let cid = read_ui16 ch in let fcount = read_ui16 ch in let tags = parse_tag_list ch in TClip { c_id = cid; c_frame_count = fcount; c_tags = tags; } | 0x29 -> TProductInfo (nread ch len) | 0x2B -> let label = read_string ch in let id = (if len = String.length label + 2 then Some (read ch) else None) in TFrameLabel (label,id) | 0x2D -> TSoundStreamHead2 (nread ch len) | 0x2E when !full_parsing -> TMorphShape (parse_morph_shape ch len) | 0x30 when !full_parsing -> TFont2 (parse_font2 ch len) | 0x38 -> let read_export() = let cid = read_ui16 ch in let name = read_string ch in { exp_id = cid; exp_name = name } in TExport (read_count (read_ui16 ch) read_export ()) (*// 0x39 TImport *) (*// 0x3A TEnableDebugger *) | 0x3B -> let cid = read_ui16 ch in let actions = parse_actions ch in TDoInitAction { dia_id = cid; dia_actions = actions; } | 0x3C -> TVideoStream (nread ch len) | 0x3D -> TVideoFrame (nread ch len) (*// 0x3E TFontInfo2 *) | 0x3F -> TDebugID (nread ch len) | 0x40 -> let tag = read_ui16 ch in (* 0 in general, 6517 for some swfs *) let pass_md5 = read_string ch in TEnableDebugger2 (tag,pass_md5) | 0x41 -> let recursion_depth = read_ui16 ch in let script_timeout = read_ui16 ch in TScriptLimits (recursion_depth, script_timeout) (*// 0x42 TSetTabIndex *) | 0x45 -> TSandbox (match IO.read_i32 ch with | 0 -> SBLocal | 1 -> SBNetwork | n -> SBUnknown n ) | 0x46 when !full_parsing -> TPlaceObject3 (parse_place_object ch true) | 0x48 when !full_parsing || !force_as3_parsing -> TActionScript3 (None , As3parse.parse ch len) | 0x49 when !full_parsing -> TFontGlyphs (parse_font_glyphs ch len) | 0x4A -> TTextInfo (nread ch len) | 0x4B when !full_parsing -> TFont3 (parse_font3 ch len) | 0x4C -> let i = read_ui16 ch in let rec loop i = if i = 0 then [] else let a = read_ui16 ch in let s = read_string ch in { f9_cid = if a = 0 then None else Some a; f9_classname = s; } :: loop (i - 1) in TF9Classes (loop i) | 0x4D -> TMetaData (nread ch len) | 0x52 when !full_parsing || !force_as3_parsing -> let id = read_i32 ch in let frame = read_string ch in let len = len - (4 + String.length frame + 1) in TActionScript3 (Some (id,frame), As3parse.parse ch len) | 0x53 when !full_parsing -> TShape4 (parse_shape ch len 4) | 0x54 when !full_parsing -> let id = read_ui16 ch in TShape5 (id,nread ch (len - 2)) | 0x56 -> let n = read_ui16 ch in if n <> 1 then assert false; let name = read_string ch in let k = read_byte ch in if k <> 0 then assert false; TF9Scene name | _ -> (*if !Swf.warnings then Printf.printf "Unknown tag 0x%.2X\n" id;*) TUnknown (id,nread ch len) ) in (* let len2 = tag_data_length t in if len <> len2 then error (Printf.sprintf "Datalen mismatch for tag 0x%.2X (%d != %d)" id len len2); *) { tid = gen_id(); tdata = t; textended = extended; } and parse_tag_list ch = let rec loop acc = let h = (try read_ui16 ch with IO.No_more_input -> 0) in match parse_tag ch h with | { tdata = TEnd } -> List.rev acc | t -> loop (t :: acc) in loop [] let parse ch = let sign = nread ch 3 in if sign <> "FWS" && sign <> "CWS" then error "Invalid SWF signature"; let ver = read_byte ch in swf_version := ver; ignore(read_i32 ch); (* file length *) let compressed, ch = (if sign = "CWS" then true , inflate ch else false, ch) in let size = read_rect ch in let fps = read_ui16 ch in let frame_count = read_ui16 ch in let h = { h_version = ver; h_size = size; h_fps = fps; h_frame_count = frame_count; h_compressed = compressed; } in h , parse_tag_list ch (* ************************************************************************ *) (* WRITING *) let rec tag_id = function | TEnd -> 0x00 | TShowFrame -> 0x01 | TShape _ -> 0x02 | TRemoveObject _ -> 0x05 | TBitsJPEG _ -> 0x06 | TJPEGTables _ -> 0x08 | TSetBgColor _ -> 0x09 | TText _ -> 0x0B | TDoAction _ -> 0x0C | TSound _ -> 0x0E | TStartSound _ -> 0x0F | TBitsLossless _ -> 0x14 | TBitsJPEG2 _ -> 0x15 | TShape2 _ -> 0x16 | TProtect -> 0x18 | TPlaceObject2 _ -> 0x1A | TRemoveObject2 _ -> 0x1C | TShape3 _ -> 0x20 | TText2 _ -> 0x21 | TButton2 _ -> 0x22 | TBitsJPEG3 _ -> 0x23 | TBitsLossless2 _ -> 0x24 | TEditText _ -> 0x25 | TClip _ -> 0x27 | TProductInfo _ -> 0x29 | TFrameLabel _ -> 0x2B | TSoundStreamHead2 _ -> 0x2D | TMorphShape _ -> 0x2E | TFont2 _ -> 0x30 | TExport _ -> 0x38 | TDoInitAction _ -> 0x3B | TVideoStream _ -> 0x3C | TVideoFrame _ -> 0x3D | TDebugID _ -> 0x3F | TEnableDebugger2 _ -> 0x40 | TScriptLimits _ -> 0x41 | TSandbox _ -> 0x45 | TPlaceObject3 _ -> 0x46 | TFontGlyphs _ -> 0x49 | TTextInfo _ -> 0x4A | TFont3 _ -> 0x4B | TF9Classes _ -> 0x4C | TMetaData _ -> 0x4D | TActionScript3 (None,_) -> 0x48 | TActionScript3 _ -> 0x52 | TShape4 _ -> 0x53 | TShape5 _ -> 0x54 | TF9Scene _ -> 0x56 | TUnknown (id,_) -> id let write_clip_event ch c = write_event ch c.cle_events; write_i32 ch (actions_length c.cle_actions + opt_len (const 1) c.cle_key); opt (write ch) c.cle_key; write_actions ch c.cle_actions let write_clip_events ch event_list = write_ui16 ch 0; let all_events = List.fold_left (fun acc c -> acc lor c.cle_events) 0 event_list in write_event ch all_events; List.iter (write_clip_event ch) event_list; write_event ch 0 let write_shape_fill_style ch s = match s with | SFSSolid c -> write_byte ch 0x00; write_rgb ch c | SFSSolid3 c -> write_byte ch 0x00; write_rgba ch c | SFSLinearGradient (m,g) -> write_byte ch 0x10; write_matrix ch m; write_gradient ch g | SFSRadialGradient (m,g,None) -> write_byte ch 0x12; write_matrix ch m; write_gradient ch g | SFSRadialGradient (m,g,Some i) -> write_byte ch 0x13; write_matrix ch m; write_gradient ch g; write_i16 ch i; | SFSBitmap b -> write_byte ch (match b.sfb_repeat , b.sfb_smooth with | true, false -> 0x40 | false , false -> 0x41 | true , true -> 0x42 | false, true -> 0x43); write_ui16 ch b.sfb_cid; write_matrix ch b.sfb_mpos let write_shape_line_style ch l = write_ui16 ch l.sls_width; opt (write_ui16 ch) l.sls_flags; opt (write_ui16 ch) l.sls_miter; match l.sls_fill with | None -> write_color ch l.sls_color; | Some fill -> write_shape_fill_style ch fill let write_shape_array ch f sl = let n = List.length sl in if n >= 0xFF then begin write_byte ch 0xFF; write_ui16 ch n; end else write_byte ch n; List.iter (f ch) sl let write_shape_style_change_record ch b nlbits nfbits s = let flags = make_flags [flag s.scsr_move; flag s.scsr_fs0; flag s.scsr_fs1; flag s.scsr_ls; flag s.scsr_new_styles] in write_bits b 6 flags; opt (fun (n,dx,dy) -> write_bits b 5 n; write_bits b n dx; write_bits b n dy; ) s.scsr_move; opt (write_bits b ~nbits:!nfbits) s.scsr_fs0; opt (write_bits b ~nbits:!nfbits) s.scsr_fs1; opt (write_bits b ~nbits:!nlbits) s.scsr_ls; match s.scsr_new_styles with | None -> () | Some s -> flush_bits b; write_shape_array ch write_shape_fill_style s.sns_fill_styles; write_shape_array ch write_shape_line_style s.sns_line_styles; nfbits := s.sns_nfbits; nlbits := s.sns_nlbits; write_bits b 4 !nfbits; write_bits b 4 !nlbits let write_shape_record ch b nlbits nfbits = function | SRStyleChange s -> write_shape_style_change_record ch b nlbits nfbits s | SRCurvedEdge s -> write_bits b 2 2; write_bits b 4 (s.scer_nbits - 2); write_bits b s.scer_nbits s.scer_cx; write_bits b s.scer_nbits s.scer_cy; write_bits b s.scer_nbits s.scer_ax; write_bits b s.scer_nbits s.scer_ay; | SRStraightEdge s -> write_bits b 2 3; write_bits b 4 (s.sser_nbits - 2); match s.sser_line with | None , None -> assert false | None , Some p | Some p , None -> write_bits b 1 0; write_bits b 1 (if (fst s.sser_line) = None then 1 else 0); write_bits b s.sser_nbits p; | Some dx, Some dy -> write_bits b 1 1; write_bits b s.sser_nbits dx; write_bits b s.sser_nbits dy let write_shape_with_style ch s = write_shape_array ch write_shape_fill_style s.sws_fill_styles; write_shape_array ch write_shape_line_style s.sws_line_styles; let r = s.sws_records in let b = output_bits ch in write_bits b 4 r.srs_nfbits; write_bits b 4 r.srs_nlbits; let nlbits = ref r.srs_nlbits in let nfbits = ref r.srs_nfbits in List.iter (write_shape_record ch b nlbits nfbits) r.srs_records; write_bits b 6 0; flush_bits b let write_shape ch s = write_ui16 ch s.sh_id; write_rect ch s.sh_bounds; (match s.sh_bounds2 with | None -> () | Some (r,b) -> write_rect ch r; write_byte ch b); write_shape_with_style ch s.sh_style let write_bitmap_lossless ch b = write_ui16 ch b.bll_id; write_byte ch b.bll_format; write_ui16 ch b.bll_width; write_ui16 ch b.bll_height; nwrite ch b.bll_data let write_morph_shape ch s = write_ui16 ch s.msh_id; write_rect ch s.msh_start_bounds; write_rect ch s.msh_end_bounds; nwrite ch s.msh_data let write_text_record ch t r = write_byte ch (make_flags [flag r.txr_dx; flag r.txr_dy; flag r.txr_color; flag r.txr_font; false; false; false; true]); opt (fun (id,_) -> write_ui16 ch id) r.txr_font; opt (write_color ch) r.txr_color; opt (write_i16 ch) r.txr_dx; opt (write_i16 ch) r.txr_dy; opt (fun (_,id) -> write_ui16 ch id) r.txr_font; write_byte ch (List.length r.txr_glyphs); let bits = output_bits ch in List.iter (fun g -> write_bits bits t.txt_ngbits g.txg_index; write_bits bits t.txt_nabits g.txg_advanced; ) r.txr_glyphs; flush_bits bits let write_text ch t = write_ui16 ch t.txt_id; write_big_rect ch t.txt_bounds; write_matrix ch t.txt_matrix; write_byte ch t.txt_ngbits; write_byte ch t.txt_nabits; List.iter (write_text_record ch t) t.txt_records; write_byte ch 0 let write_edit_text_layout ch l = write_byte ch l.edtl_align; write_ui16 ch l.edtl_left_margin; write_ui16 ch l.edtl_right_margin; write_ui16 ch l.edtl_indent; write_ui16 ch l.edtl_leading let write_edit_text ch t = write_ui16 ch t.edt_id; write_rect ch t.edt_bounds; write_ui16 ch (make_flags [ flag t.edt_font; flag t.edt_maxlen; flag t.edt_color; t.edt_readonly; t.edt_password; t.edt_multiline; t.edt_wordwrap; flag t.edt_text; t.edt_outlines; t.edt_html; false; t.edt_border; t.edt_noselect; flag t.edt_layout; t.edt_autosize; false ]); opt (fun (id,h) -> write_ui16 ch id; write_ui16 ch h) t.edt_font; opt (write_rgba ch) t.edt_color; opt (write_ui16 ch) t.edt_maxlen; opt (write_edit_text_layout ch) t.edt_layout; write_string ch t.edt_variable; opt (write_string ch) t.edt_text let write_font2 ch t = write_ui16 ch t.ft2_id; nwrite ch t.ft2_data let write_font3 ch t = write_ui16 ch t.ft3_id; nwrite ch t.ft3_data let write_font_glyphs ch t = write_ui16 ch t.fgl_id; nwrite ch t.fgl_data let write_filter_gradient ch fg = write_byte ch (List.length fg.fgr_colors); List.iter (fun (c,_) -> write_rgba ch c) fg.fgr_colors; List.iter (fun (_,n) -> write_byte ch n) fg.fgr_colors; nwrite ch fg.fgr_data let write_filter ch = function | FDropShadow s -> write_byte ch 0; nwrite ch s | FBlur s -> write_byte ch 1; nwrite ch s | FGlow s -> write_byte ch 2; nwrite ch s | FBevel s -> write_byte ch 3; nwrite ch s | FGradientGlow fg -> write_byte ch 4; write_filter_gradient ch fg | FAdjustColor s -> write_byte ch 6; nwrite ch s | FGradientBevel fg -> write_byte ch 7; write_filter_gradient ch fg let write_button_record ch r = write_byte ch r.btr_flags; write_ui16 ch r.btr_cid; write_ui16 ch r.btr_depth; write_matrix ch r.btr_mpos; (match r.btr_color with | None -> () | Some c -> write_cxa ch c); opt (fun l -> write_byte ch (List.length l); List.iter (write_filter ch) l ) r.btr_filters let rec write_button_actions ch = function | [] -> assert false | [a] -> write_ui16 ch 0; write_ui16 ch a.bta_flags; write_actions ch a.bta_actions | a :: l -> let size = button_action_length a in write_ui16 ch size; write_ui16 ch a.bta_flags; write_actions ch a.bta_actions; write_button_actions ch l let write_button2 ch b = write_ui16 ch b.bt2_id; write_byte ch (if b.bt2_track_as_menu then 1 else 0); if b.bt2_actions <> [] then write_ui16 ch (3 + sum button_record_length b.bt2_records) else write_ui16 ch 0; List.iter (write_button_record ch) b.bt2_records; write_byte ch 0; if b.bt2_actions <> [] then write_button_actions ch b.bt2_actions let write_place_object ch p v3 = write_byte ch (make_flags [ p.po_move; flag p.po_cid; flag p.po_matrix; flag p.po_color; flag p.po_ratio; flag p.po_inst_name; flag p.po_clip_depth; flag p.po_events ]); if v3 then write_byte ch (make_flags [flag p.po_filters; flag p.po_blend; flag p.po_bcache]); write_ui16 ch p.po_depth; opt (write_ui16 ch) p.po_cid; opt (write_matrix ch) p.po_matrix; opt (write_cxa ch) p.po_color; opt (write_ui16 ch) p.po_ratio; opt (write_string ch) p.po_inst_name; opt (write_ui16 ch) p.po_clip_depth; opt (write_clip_events ch) p.po_events; if v3 then begin opt (fun l -> write_byte ch (List.length l); List.iter (write_filter ch) l ) p.po_filters; opt (write_byte ch) p.po_blend; opt (write_byte ch) p.po_bcache; end let rec write_tag_data ch = function | TEnd -> () | TShowFrame -> () | TShape s -> write_shape ch s | TRemoveObject r -> write_ui16 ch r.rmo_id; write_ui16 ch r.rmo_depth; | TBitsJPEG b -> write_ui16 ch b.jpg_id; nwrite ch b.jpg_data | TJPEGTables tab -> nwrite ch tab | TSetBgColor c -> write_rgb ch c | TText t -> write_text ch t | TDoAction acts -> write_actions ch acts | TSound s -> write_ui16 ch s.so_id; write_byte ch s.so_flags; write_i32 ch s.so_samples; nwrite ch s.so_data | TStartSound s -> write_ui16 ch s.sts_id; nwrite ch s.sts_data | TBitsLossless b -> write_bitmap_lossless ch b | TBitsJPEG2 b -> write_ui16 ch b.jp2_id; nwrite ch b.jp2_table; nwrite ch b.jp2_data; | TShape2 s -> write_shape ch s | TProtect -> () | TPlaceObject2 p -> write_place_object ch p false; | TRemoveObject2 depth -> write_ui16 ch depth; | TShape3 s -> write_shape ch s | TText2 t -> write_text ch t | TButton2 b -> write_button2 ch b | TBitsJPEG3 b -> write_ui16 ch b.jp3_id; write_i32 ch (String.length b.jp3_data + String.length b.jp3_table); nwrite ch b.jp3_table; nwrite ch b.jp3_data; nwrite ch b.jp3_alpha_data; | TBitsLossless2 b -> write_bitmap_lossless ch b | TEditText t -> write_edit_text ch t | TClip c -> write_ui16 ch c.c_id; write_ui16 ch c.c_frame_count; List.iter (write_tag ch) c.c_tags; write_tag ch tag_end; | TProductInfo s -> nwrite ch s | TFrameLabel (label,id) -> write_string ch label; opt (write ch) id; | TSoundStreamHead2 data -> nwrite ch data | TMorphShape s -> write_morph_shape ch s | TFont2 f -> write_font2 ch f | TExport el -> write_ui16 ch (List.length el); List.iter (fun e -> write_ui16 ch e.exp_id; write_string ch e.exp_name ) el | TDoInitAction i -> write_ui16 ch i.dia_id; write_actions ch i.dia_actions; | TVideoStream s -> nwrite ch s | TVideoFrame s -> nwrite ch s | TDebugID s -> nwrite ch s | TEnableDebugger2 (tag,pass) -> write_ui16 ch tag; write_string ch pass | TScriptLimits (recursion_depth, script_timeout) -> write_ui16 ch recursion_depth; write_ui16 ch script_timeout; | TSandbox s -> write_i32 ch (match s with | SBLocal -> 0 | SBNetwork -> 1 | SBUnknown n -> n) | TPlaceObject3 p -> write_place_object ch p true; | TFontGlyphs f -> write_font_glyphs ch f | TTextInfo s -> nwrite ch s | TFont3 f -> write_font3 ch f | TF9Classes l -> write_ui16 ch (List.length l); List.iter (fun c -> write_ui16 ch (match c.f9_cid with None -> 0 | Some id -> id); write_string ch c.f9_classname ) l | TMetaData meta -> nwrite ch meta | TActionScript3 (id,a) -> (match id with | None -> () | Some (id,frame) -> write_i32 ch id; write_string ch frame; ); As3parse.write ch a | TShape4 s -> write_shape ch s | TShape5 (id,s) -> write_ui16 ch id; nwrite ch s | TF9Scene s -> write_ui16 ch 1; write_string ch s; write_byte ch 0; | TUnknown (_,data) -> nwrite ch data and write_tag ch t = let id = tag_id t.tdata in let dlen = tag_data_length t.tdata in if t.textended || dlen >= 63 then begin write_ui16 ch ((id lsl 6) lor 63); write_i32 ch dlen; end else begin write_ui16 ch ((id lsl 6) lor dlen); end; write_tag_data ch t.tdata let write ch (h,tags) = swf_version := h.h_version; nwrite ch (if h.h_compressed then "CWS" else "FWS"); write ch (char_of_int h.h_version); let rec calc_len = function | [] -> tag_length tag_end | t :: l -> tag_length t + calc_len l in let len = calc_len tags in let len = len + 4 + 4 + rect_length h.h_size + 2 + 2 in write_i32 ch len; let ch = (if h.h_compressed then deflate ch else ch) in write_rect ch h.h_size; write_ui16 ch h.h_fps; write_ui16 ch h.h_frame_count; List.iter (write_tag ch) tags; write_tag ch tag_end; flush ch let init inflate deflate = Swf.__parser := parse; Swf.__printer := write; Swf.__inflate := inflate; Swf.__deflate := deflate; ;; Swf.__parser := parse; Swf.__printer := writemtasc-1.14/ocaml/swflib/as3.mli0000640000175000017500000001576111111342564014760 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004-2006 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type 'a index type 'a index_nz type as3_ident = string type as3_int = int32 type as3_uint = int32 type as3_float = float type as3_slot = int type reg = int type nargs = int type as3_jump = | J3NotLt | J3NotLte | J3NotGt | J3NotGte | J3Always | J3True | J3False | J3Eq | J3Neq | J3Lt | J3Lte | J3Gt | J3Gte | J3PhysEq | J3PhysNeq type as3_op = | A3OAs | A3ONeg | A3OIncr | A3ODecr | A3ONot | A3OBitNot | A3OAdd | A3OSub | A3OMul | A3ODiv | A3OMod | A3OShl | A3OShr | A3OUShr | A3OAnd | A3OOr | A3OXor | A3OEq | A3OPhysEq | A3OLt | A3OLte | A3OGt | A3OGte | A3OIs | A3OIn | A3OIIncr | A3OIDecr | A3OINeg | A3OIAdd | A3OISub | A3OIMul | A3OMemSet8 | A3OMemSet16 | A3OMemSet32 | A3OMemSetFloat | A3OMemSetDouble | A3OMemGet8 | A3OMemGet16 | A3OMemGet32 | A3OMemGetFloat | A3OMemGetDouble | A3OSign1 | A3OSign8 | A3OSign16 type as3_name = as3_multi_name index and as3_opcode = | A3BreakPoint | A3Nop | A3Throw | A3GetSuper of as3_name | A3SetSuper of as3_name | A3DxNs of as3_ident index | A3DxNsLate | A3RegKill of reg | A3Label | A3Jump of as3_jump * int | A3Switch of int * int list | A3PushWith | A3PopScope | A3ForIn | A3HasNext | A3Null | A3Undefined | A3ForEach | A3SmallInt of int | A3Int of int | A3True | A3False | A3NaN | A3Pop | A3Dup | A3Swap | A3String of as3_ident index | A3IntRef of as3_int index | A3UIntRef of as3_uint index | A3Float of as3_float index | A3Scope | A3Namespace of as3_namespace index | A3Next of reg * reg | A3Function of as3_method_type index_nz | A3CallStack of nargs | A3Construct of nargs | A3CallMethod of as3_slot * nargs | A3CallStatic of as3_method_type index * nargs | A3CallSuper of as3_name * nargs | A3CallProperty of as3_name * nargs | A3RetVoid | A3Ret | A3ConstructSuper of nargs | A3ConstructProperty of as3_name * nargs | A3CallPropLex of as3_name * nargs | A3CallSuperVoid of as3_name * nargs | A3CallPropVoid of as3_name * nargs | A3ApplyType of nargs | A3Object of nargs | A3Array of nargs | A3NewBlock | A3ClassDef of unit index_nz | A3GetDescendants of as3_name | A3Catch of int | A3FindPropStrict of as3_name | A3FindProp of as3_name | A3FindDefinition of as3_name | A3GetLex of as3_name | A3SetProp of as3_name | A3Reg of reg | A3SetReg of reg | A3GetGlobalScope | A3GetScope of int | A3GetProp of as3_name | A3InitProp of as3_name | A3DeleteProp of as3_name | A3GetSlot of as3_slot | A3SetSlot of as3_slot | A3ToString | A3ToXml | A3ToXmlAttr | A3ToInt | A3ToUInt | A3ToNumber | A3ToBool | A3ToObject | A3CheckIsXml | A3Cast of as3_name | A3AsAny | A3AsString | A3AsType of as3_name | A3AsObject | A3IncrReg of reg | A3DecrReg of reg | A3Typeof | A3InstanceOf | A3IsType of as3_name | A3IncrIReg of reg | A3DecrIReg of reg | A3This | A3SetThis | A3DebugReg of as3_ident index * reg * int | A3DebugLine of int | A3DebugFile of as3_ident index | A3BreakPointLine of int | A3Timestamp | A3Op of as3_op | A3Unk of char and as3_namespace = | A3NPrivate of as3_ident index option | A3NPublic of as3_ident index option | A3NInternal of as3_ident index option | A3NProtected of as3_ident index | A3NNamespace of as3_ident index | A3NExplicit of as3_ident index | A3NStaticProtected of as3_ident index option and as3_ns_set = as3_namespace index list and as3_multi_name = | A3MName of as3_ident index * as3_namespace index | A3MMultiName of as3_ident index option * as3_ns_set index | A3MRuntimeName of as3_ident index | A3MRuntimeNameLate | A3MMultiNameLate of as3_ns_set index | A3MAttrib of as3_multi_name | A3MParams of as3_multi_name index * as3_multi_name index list and as3_value = | A3VNone | A3VNull | A3VBool of bool | A3VString of as3_ident index | A3VInt of as3_int index | A3VUInt of as3_uint index | A3VFloat of as3_float index | A3VNamespace of int * as3_namespace index (* int : kind of namespace *) and as3_method_type = { mt3_ret : as3_name option; mt3_args : as3_name option list; mt3_native : bool; mt3_var_args : bool; mt3_arguments_defined : bool; mt3_uses_dxns : bool; mt3_new_block : bool; mt3_unused_flag : bool; mt3_debug_name : as3_ident index option; mt3_dparams : as3_value list option; mt3_pnames : as3_ident index option list option; } type as3_method_kind = | MK3Normal | MK3Getter | MK3Setter type as3_method = { m3_type : as3_method_type index_nz; m3_final : bool; m3_override : bool; m3_kind : as3_method_kind; } type as3_var = { v3_type : as3_name option; v3_value : as3_value; v3_const : bool; } type as3_metadata = { meta3_name : as3_ident index; meta3_data : (as3_ident index option * as3_ident index) array; } type as3_field_kind = | A3FMethod of as3_method | A3FVar of as3_var | A3FClass of as3_class index_nz | A3FFunction of as3_method_type index_nz and as3_field = { f3_name : as3_name; f3_slot : as3_slot; f3_kind : as3_field_kind; f3_metas : as3_metadata index_nz array option; } and as3_class = { cl3_name : as3_name; cl3_super : as3_name option; cl3_sealed : bool; cl3_final : bool; cl3_interface : bool; cl3_namespace : as3_namespace index option; cl3_implements : as3_name array; cl3_construct : as3_method_type index_nz; cl3_fields : as3_field array; } type as3_static = { st3_method : as3_method_type index_nz; st3_fields : as3_field array; } type as3_try_catch = { tc3_start : int; tc3_end : int; tc3_handle : int; tc3_type : as3_name option; tc3_name : as3_name option; } type as3_function = { fun3_id : as3_method_type index_nz; fun3_stack_size : int; fun3_nregs : int; fun3_init_scope : int; fun3_max_scope : int; fun3_code : as3_opcode array; fun3_trys : as3_try_catch array; fun3_locals : as3_field array; } type as3_tag = { as3_ints : as3_int array; as3_uints : as3_uint array; as3_floats : as3_float array; as3_idents : as3_ident array; as3_namespaces : as3_namespace array; as3_nsets : as3_ns_set array; mutable as3_names : as3_multi_name array; mutable as3_method_types : as3_method_type array; mutable as3_metadatas : as3_metadata array; mutable as3_classes : as3_class array; mutable as3_statics : as3_static array; mutable as3_inits : as3_static array; mutable as3_functions : as3_function array; mutable as3_unknown : string; (* only for partial parsing *) } mtasc-1.14/ocaml/swflib/as3hlparse.ml0000640000175000017500000006710511116520154016163 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004-2008 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open As3 open As3hl type parse_ctx = { as3 : as3_tag; mutable namespaces : hl_namespace array; mutable nsets : hl_ns_set array; mutable names : hl_name array; mutable methods : hl_method array; mutable classes : hl_class array; mutable jumps : (int * int) list; mutable pos : int; } let get = As3parse.iget let no_nz = As3parse.no_nz let idx n = As3parse.index_int n - 1 let ident ctx i = get ctx.as3.as3_idents i let name ctx n = ctx.names.(idx n) let method_type ctx n = ctx.methods.(idx (no_nz n)) let getclass ctx n = ctx.classes.(idx (no_nz n)) let opt f ctx = function | None -> None | Some x -> Some (f ctx x) let stack_delta = function | HBreakPoint -> 0 | HNop -> 0 | HThrow -> -1 | HGetSuper _ -> 0 | HSetSuper _ -> -1 | HDxNs _ -> 0 | HDxNsLate -> -1 | HRegKill _ -> 0 | HLabel -> 0 | HJump (cond,_) -> (match cond with | J3Always -> 0 | J3True | J3False -> -1 | _ -> -2) | HSwitch _ -> -1 | HPushWith -> -1 | HPopScope -> 0 | HForIn -> -1 | HHasNext -> -1 | HNull | HUndefined -> 1 | HForEach -> -1 | HSmallInt _ | HInt _ | HTrue | HFalse | HString _ | HIntRef _ | HUIntRef _ | HFunction _ | HFloat _ | HNaN -> 1 | HPop -> -1 | HDup -> 1 | HSwap -> 0 | HScope -> -1 | HNamespace _ -> 1 | HNext _ -> 1 | HCallStack n -> -(n + 1) | HConstruct n -> -n | HCallMethod (_,n) -> -n | HCallStatic (_,n) -> -n | HCallSuper (_,n) -> -n | HCallProperty (_,n) -> -n | HRetVoid -> 0 | HRet -> -1 | HConstructSuper n -> -(n + 1) | HConstructProperty (_,n) -> -n | HCallPropLex (_,n) -> -n | HCallSuperVoid (_,n) -> -(n + 1) | HCallPropVoid (_,n) -> -(n + 1) | HApplyType n -> -n | HObject n -> -(n * 2) + 1 | HArray n -> -n + 1 | HNewBlock -> 1 | HClassDef _ -> 0 | HGetDescendants _ -> 0 | HCatch _ -> 1 | HFindPropStrict _ -> 1 | HFindProp _ -> 1 | HFindDefinition _ -> 1 | HGetLex _ -> 1 | HSetProp _ -> -2 | HReg _ -> 1 | HSetReg _ | HSetThis -> -1 | HGetGlobalScope | HGetScope _ -> 1 | HGetProp _ -> 0 | HInitProp _ -> -2 | HDeleteProp _ -> -1 (* true/false *) | HGetSlot _ -> 0 | HSetSlot _ -> -2 | HToString | HToXml | HToXmlAttr | HToInt | HToUInt | HToNumber | HToObject | HAsAny | HAsType _ | HIsType _ | HAsObject | HAsString | HToBool -> 0 | HCheckIsXml -> 0 | HCast _ -> 0 | HTypeof -> 0 | HInstanceOf -> -1 | HIncrReg _ | HDecrReg _ | HIncrIReg _ | HDecrIReg _ -> 0 | HThis -> 1 | HDebugReg _ | HDebugLine _ | HBreakPointLine _ | HTimestamp | HDebugFile _ -> 0 | HOp op -> (match op with | A3ONeg | A3OINeg | A3OIncr | A3ODecr | A3ONot | A3OBitNot | A3OIIncr | A3OIDecr -> 0 | A3OMemGet8 | A3OMemGet16 | A3OMemGet32 | A3OMemGetFloat | A3OMemGetDouble | A3OSign1 | A3OSign8 | A3OSign16 -> 0 | A3OMemSet8 | A3OMemSet16 | A3OMemSet32 | A3OMemSetFloat | A3OMemSetDouble -> -2 | _ -> -1) | HUnk _ -> assert false let parse_opcode ctx i = function | A3BreakPoint -> HBreakPoint | A3Nop -> HNop | A3Throw -> HThrow | A3GetSuper n -> HGetSuper (name ctx n) | A3SetSuper n -> HSetSuper (name ctx n) | A3DxNs s -> HDxNs (ident ctx s) | A3DxNsLate -> HDxNsLate | A3RegKill r -> HRegKill r | A3Label -> HLabel | A3Jump (j,n) -> ctx.jumps <- (i,ctx.pos) :: ctx.jumps; HJump (j,n) | A3Switch (n,infos) as op -> ctx.jumps <- (i,ctx.pos - As3code.length op) :: ctx.jumps; HSwitch(n,infos) | A3PushWith -> HPushWith | A3PopScope -> HPopScope | A3ForIn -> HForIn | A3HasNext -> HHasNext | A3Null -> HNull | A3Undefined -> HUndefined | A3ForEach -> HForEach | A3SmallInt n -> HSmallInt n | A3Int n -> HInt n | A3True -> HTrue | A3False -> HFalse | A3NaN -> HNaN | A3Pop -> HPop | A3Dup -> HDup | A3Swap -> HSwap | A3String i -> HString (ident ctx i) | A3IntRef i -> HIntRef (get ctx.as3.as3_ints i) | A3UIntRef i -> HUIntRef (get ctx.as3.as3_uints i) | A3Float f -> HFloat (get ctx.as3.as3_floats f) | A3Scope -> HScope | A3Namespace n -> HNamespace ctx.namespaces.(idx n) | A3Next (r1,r2) -> HNext (r1,r2) | A3Function f -> HFunction (method_type ctx f) | A3CallStack n -> HCallStack n | A3Construct n -> HConstruct n | A3CallMethod (s,n) -> HCallMethod (s,n) | A3CallStatic (m,n) -> HCallStatic (ctx.methods.(idx m),n) | A3CallSuper (p,n) -> HCallSuper (name ctx p,n) | A3CallProperty (p,n) -> HCallProperty (name ctx p,n) | A3RetVoid -> HRetVoid | A3Ret -> HRet | A3ConstructSuper n -> HConstructSuper n | A3ConstructProperty (p,n) -> HConstructProperty (name ctx p,n) | A3CallPropLex (p,n) -> HCallPropLex (name ctx p,n) | A3CallSuperVoid (p,n) -> HCallSuperVoid (name ctx p,n) | A3CallPropVoid (p,n) -> HCallPropVoid (name ctx p,n) | A3ApplyType n -> HApplyType n | A3Object n -> HObject n | A3Array n -> HArray n | A3NewBlock -> HNewBlock | A3ClassDef n -> HClassDef (getclass ctx n) | A3GetDescendants p -> HGetDescendants (name ctx p) | A3Catch n -> HCatch n | A3FindPropStrict p -> HFindPropStrict (name ctx p) | A3FindProp p -> HFindProp (name ctx p) | A3FindDefinition p -> HFindDefinition (name ctx p) | A3GetLex p -> HGetLex (name ctx p) | A3SetProp p -> HSetProp (name ctx p) | A3Reg r -> HReg r | A3SetReg r -> HSetReg r | A3GetGlobalScope -> HGetGlobalScope | A3GetScope n -> HGetScope n | A3GetProp p -> HGetProp (name ctx p) | A3InitProp p -> HInitProp (name ctx p) | A3DeleteProp p -> HDeleteProp (name ctx p) | A3GetSlot n -> HGetSlot n | A3SetSlot n -> HSetSlot n | A3ToString -> HToString | A3ToXml -> HToXml | A3ToXmlAttr -> HToXmlAttr | A3ToInt -> HToInt | A3ToUInt -> HToUInt | A3ToNumber -> HToNumber | A3ToBool -> HToBool | A3ToObject -> HToObject | A3CheckIsXml -> HCheckIsXml | A3Cast p -> HCast (name ctx p) | A3AsAny -> HAsAny | A3AsString -> HAsString | A3AsType p -> HAsType (name ctx p) | A3AsObject -> HAsObject | A3IncrReg r -> HIncrReg r | A3DecrReg r -> HDecrReg r | A3Typeof -> HTypeof | A3InstanceOf -> HInstanceOf | A3IsType p -> HIsType (name ctx p) | A3IncrIReg r -> HIncrIReg r | A3DecrIReg r -> HDecrIReg r | A3This -> HThis | A3SetThis -> HSetThis | A3DebugReg (id,r,n) -> HDebugReg (ident ctx id,r,n) | A3DebugLine n -> HDebugLine n | A3DebugFile p -> HDebugFile (ident ctx p) | A3BreakPointLine n -> HBreakPointLine n | A3Timestamp -> HTimestamp | A3Op op -> HOp op | A3Unk n -> HUnk n let parse_code ctx f trys = let code = f.fun3_code in let old = ctx.pos , ctx.jumps in let indexes = DynArray.create() in ctx.pos <- 0; ctx.jumps <- []; let codepos pos delta = let id = (try DynArray.get indexes (pos + delta) with _ -> -1) in if id = -1 then begin (*Printf.eprintf "MISALIGNED JUMP AT %d %c %d IN #%d\n" pos (if delta < 0 then '-' else '+') (if delta < 0 then -delta else delta) (idx (no_nz f.fun3_id));*) DynArray.get indexes pos; (* jump 0 *) end else id in let hcode = Array.mapi (fun i op -> let len = As3code.length op in DynArray.add indexes i; for k = 2 to len do DynArray.add indexes (-1); done; ctx.pos <- ctx.pos + len; parse_opcode ctx i op ) code in (* in case we have a dead-jump at the end of code *) DynArray.add indexes (Array.length code); (* patch jumps *) List.iter (fun (j,pos) -> Array.set hcode j (match Array.get hcode j with | HJump (jc,n) -> HJump (jc,codepos pos n - j) | HSwitch (n,infos) -> HSwitch (codepos pos n - j, List.map (fun n -> codepos pos n - j) infos) | _ -> assert false) ) ctx.jumps; (* patch try/catches *) Array.iteri (fun i t -> Array.set trys i { hltc_start = codepos 0 t.hltc_start; hltc_end = codepos 0 t.hltc_end; hltc_handle = codepos 0 t.hltc_handle; hltc_type = t.hltc_type; hltc_name = t.hltc_name; } ) trys; ctx.pos <- fst old; ctx.jumps <- snd old; hcode let parse_metadata ctx m = { hlmeta_name = ident ctx m.meta3_name; hlmeta_data = Array.map (fun (i1,i2) -> opt ident ctx i1, ident ctx i2) m.meta3_data; } let parse_method ctx m = { hlm_type = method_type ctx m.m3_type; hlm_final = m.m3_final; hlm_override = m.m3_override; hlm_kind = m.m3_kind; } let parse_value ctx = function | A3VNone -> HVNone | A3VNull -> HVNull | A3VBool b -> HVBool b | A3VString s -> HVString (ident ctx s) | A3VInt i -> HVInt (get ctx.as3.as3_ints i) | A3VUInt i -> HVUInt (get ctx.as3.as3_uints i) | A3VFloat f -> HVFloat (get ctx.as3.as3_floats f) | A3VNamespace (n,ns) -> HVNamespace (n,ctx.namespaces.(idx ns)) let parse_var ctx v = { hlv_type = opt name ctx v.v3_type; hlv_value = parse_value ctx v.v3_value; hlv_const = v.v3_const; } let parse_field_kind ctx = function | A3FMethod m -> HFMethod (parse_method ctx m) | A3FVar v -> HFVar (parse_var ctx v) | A3FFunction f -> HFFunction (method_type ctx f) | A3FClass c -> HFClass (getclass ctx c) let parse_field ctx f = { hlf_name = name ctx f.f3_name; hlf_slot = f.f3_slot; hlf_kind = parse_field_kind ctx f.f3_kind; hlf_metas = match f.f3_metas with | None -> None | Some a -> Some (Array.map (fun i -> parse_metadata ctx (get ctx.as3.as3_metadatas (no_nz i)) ) a); } let parse_static ctx s = { hls_method = method_type ctx s.st3_method; hls_fields = Array.map (parse_field ctx) s.st3_fields; } let parse_namespace ctx = function | A3NPrivate id -> HNPrivate (opt ident ctx id) | A3NPublic id -> HNPublic (opt ident ctx id) | A3NInternal id -> HNInternal (opt ident ctx id) | A3NProtected id -> HNProtected (ident ctx id) | A3NNamespace id -> HNNamespace (ident ctx id) | A3NExplicit id -> HNExplicit (ident ctx id) | A3NStaticProtected id -> HNStaticProtected (opt ident ctx id) let parse_nset ctx l = List.map (fun n -> ctx.namespaces.(idx n)) l let rec parse_name names ctx = function | A3MName (id,ns) -> (match ctx.namespaces.(idx ns) with | HNPublic p -> let pack = (match p with None -> [] | Some i -> ExtString.String.nsplit i ".") in HMPath (pack, ident ctx id) | ns -> HMName (ident ctx id, ns)) | A3MMultiName (id,ns) -> HMMultiName (opt ident ctx id,ctx.nsets.(idx ns)) | A3MRuntimeName id -> HMRuntimeName (ident ctx id) | A3MRuntimeNameLate -> HMRuntimeNameLate | A3MMultiNameLate ns -> HMMultiNameLate ctx.nsets.(idx ns) | A3MAttrib multi -> HMAttrib (parse_name names ctx multi) | A3MParams (id,pl) -> HMParams (parse_name names ctx names.(idx id),List.map (fun id -> parse_name names ctx names.(idx id)) pl) let parse_try_catch ctx t = { hltc_start = t.tc3_start; hltc_end = t.tc3_end; hltc_handle = t.tc3_handle; hltc_type = opt name ctx t.tc3_type; hltc_name = opt name ctx t.tc3_name; } let parse_function ctx f = { hlf_stack_size = f.fun3_stack_size; hlf_nregs = f.fun3_nregs; hlf_init_scope = f.fun3_init_scope; hlf_max_scope = f.fun3_max_scope; hlf_code = [||]; (* keep for later *) hlf_trys = Array.map (parse_try_catch ctx) f.fun3_trys; hlf_locals = Array.map (fun f -> if f.f3_metas <> None then assert false; match f.f3_kind with | A3FVar v -> (* v3_value can be <> None if it's a fun parameter with a default value - which looks like a bug of the AS3 compiler *) name ctx f.f3_name , opt name ctx v.v3_type , f.f3_slot, v.v3_const | _ -> assert false ) f.fun3_locals; } let parse_method_type ctx idx f = let m = ctx.as3.as3_method_types.(idx) in { hlmt_index = idx; hlmt_ret = opt name ctx m.mt3_ret; hlmt_args = List.map (opt name ctx) m.mt3_args; hlmt_native = m.mt3_native; hlmt_var_args = m.mt3_var_args; hlmt_arguments_defined = m.mt3_arguments_defined; hlmt_uses_dxns = m.mt3_uses_dxns; hlmt_new_block = m.mt3_new_block; hlmt_unused_flag = m.mt3_unused_flag; hlmt_debug_name = opt ident ctx m.mt3_debug_name; hlmt_dparams = opt (fun ctx -> List.map (parse_value ctx)) ctx m.mt3_dparams; hlmt_pnames = opt (fun ctx -> List.map (opt ident ctx)) ctx m.mt3_pnames; hlmt_function = opt parse_function ctx f; } let parse_class ctx c s index = { hlc_index = index; hlc_name = name ctx c.cl3_name; hlc_super = opt name ctx c.cl3_super; hlc_sealed = c.cl3_sealed; hlc_final = c.cl3_final; hlc_interface = c.cl3_interface; hlc_namespace = opt (fun ctx i -> ctx.namespaces.(idx i)) ctx c.cl3_namespace; hlc_implements = Array.map (name ctx) c.cl3_implements; hlc_construct = method_type ctx c.cl3_construct; hlc_fields = Array.map (parse_field ctx) c.cl3_fields; hlc_static_construct = method_type ctx s.st3_method; hlc_static_fields = Array.map (parse_field ctx) s.st3_fields; } let parse_static ctx s = { hls_method = method_type ctx s.st3_method; hls_fields = Array.map (parse_field ctx) s.st3_fields; } let parse t = let ctx = { as3 = t; namespaces = [||]; nsets = [||]; names = [||]; methods = [||]; classes = [||]; jumps = []; pos = 0; } in ctx.namespaces <- Array.map (parse_namespace ctx) t.as3_namespaces; ctx.nsets <- Array.map (parse_nset ctx) t.as3_nsets; ctx.names <- Array.map (parse_name t.as3_names ctx) t.as3_names; let hfunctions = Hashtbl.create 0 in Array.iter (fun f -> Hashtbl.add hfunctions (idx (no_nz f.fun3_id)) f) t.as3_functions; ctx.methods <- Array.mapi (fun i m -> parse_method_type ctx i (try Some (Hashtbl.find hfunctions i) with Not_found -> None); ) t.as3_method_types; ctx.classes <- Array.mapi (fun i c -> parse_class ctx c t.as3_statics.(i) i ) t.as3_classes; let inits = List.map (parse_static ctx) (Array.to_list t.as3_inits) in Array.iter (fun f -> match (method_type ctx f.fun3_id).hlmt_function with | None -> assert false | Some fl -> fl.hlf_code <- parse_code ctx f fl.hlf_trys ) t.as3_functions; inits (* ************************************************************************ *) (* FLATTEN *) (* ************************************************************************ *) type ('hl,'item) lookup = { h : ('hl,int) Hashtbl.t; a : 'item DynArray.t; f : flatten_ctx -> 'hl -> 'item; } and ('hl,'item) index_lookup = { ordered_list : 'hl list; ordered_array : 'item option DynArray.t; map_f : flatten_ctx -> 'hl -> 'item; } and flatten_ctx = { fints : (hl_int,as3_int) lookup; fuints : (hl_uint,as3_uint) lookup; ffloats : (hl_float,as3_float) lookup; fidents : (hl_ident,as3_ident) lookup; fnamespaces : (hl_namespace,as3_namespace) lookup; fnsets : (hl_ns_set,as3_ns_set) lookup; fnames : (hl_name,as3_multi_name) lookup; fmetas : (hl_metadata,as3_metadata) lookup; fmethods : (hl_method,as3_method_type) index_lookup; fclasses : (hl_class,as3_class * as3_static) index_lookup; mutable ffunctions : as3_function list; mutable fjumps : int list; } let new_lookup f = { h = Hashtbl.create 0; a = DynArray.create(); f = f; } let new_index_lookup l f = { ordered_list = l; ordered_array = DynArray.init (List.length l) (fun _ -> None); map_f = f; } let lookup_array l = DynArray.to_array l.a let lookup_index_array l = Array.map (function None -> assert false | Some x -> x) (DynArray.to_array l.ordered_array) let lookup ctx (l:('a,'b) lookup) item : 'b index = let idx = try Hashtbl.find l.h item with Not_found -> let idx = DynArray.length l.a in (* set dummy value for recursion *) DynArray.add l.a (Obj.magic 0); Hashtbl.add l.h item (idx + 1); DynArray.set l.a idx (l.f ctx item); idx + 1 in As3parse.magic_index idx let lookup_index_nz ctx (l:('a,'b) index_lookup) item : 'c index_nz = let rec loop n = function | [] -> assert false | x :: l -> if x == item then n else loop (n + 1) l in let idx = loop 0 l.ordered_list in if DynArray.get l.ordered_array idx = None then begin (* set dummy value for recursion *) DynArray.set l.ordered_array idx (Some (Obj.magic 0)); DynArray.set l.ordered_array idx (Some (l.map_f ctx item)); end; As3parse.magic_index_nz idx let lookup_nz ctx l item = As3parse.magic_index_nz (As3parse.index_int (lookup ctx l item) - 1) let lookup_ident ctx i = lookup ctx ctx.fidents i let lookup_name ctx n = lookup ctx ctx.fnames n let lookup_method ctx m : as3_method_type index_nz = lookup_index_nz ctx ctx.fmethods m let lookup_class ctx c : as3_class index_nz = lookup_index_nz ctx ctx.fclasses c let flatten_namespace ctx = function | HNPrivate i -> A3NPrivate (opt lookup_ident ctx i) | HNPublic i -> A3NPublic (opt lookup_ident ctx i) | HNInternal i -> A3NInternal (opt lookup_ident ctx i) | HNProtected i -> A3NProtected (lookup_ident ctx i) | HNNamespace i -> A3NNamespace (lookup_ident ctx i) | HNExplicit i -> A3NExplicit (lookup_ident ctx i) | HNStaticProtected i -> A3NStaticProtected (opt lookup_ident ctx i) let flatten_ns_set ctx n = List.map (lookup ctx ctx.fnamespaces) n let rec flatten_name ctx = function | HMPath (pack,i) -> let ns = HNPublic (match pack with [] -> None | l -> Some (String.concat "." l)) in A3MName (lookup_ident ctx i,lookup ctx ctx.fnamespaces ns) | HMName (i,n) -> A3MName (lookup_ident ctx i,lookup ctx ctx.fnamespaces n) | HMMultiName (i,ns) -> A3MMultiName (opt lookup_ident ctx i,lookup ctx ctx.fnsets ns) | HMRuntimeName i -> A3MRuntimeName (lookup_ident ctx i) | HMRuntimeNameLate -> A3MRuntimeNameLate | HMMultiNameLate ns -> A3MMultiNameLate (lookup ctx ctx.fnsets ns) | HMAttrib n -> A3MAttrib (flatten_name ctx n) | HMParams (i,nl) -> A3MParams (lookup_name ctx i,List.map (lookup_name ctx) nl) let flatten_meta ctx m = { meta3_name = lookup_ident ctx m.hlmeta_name; meta3_data = Array.map (fun (i,i2) -> opt lookup_ident ctx i, lookup_ident ctx i2) m.hlmeta_data; } let flatten_value ctx = function | HVNone -> A3VNone | HVNull -> A3VNull | HVBool b -> A3VBool b | HVString s -> A3VString (lookup_ident ctx s) | HVInt i -> A3VInt (lookup ctx ctx.fints i) | HVUInt i -> A3VUInt (lookup ctx ctx.fuints i) | HVFloat f -> A3VFloat (lookup ctx ctx.ffloats f) | HVNamespace (n,ns) -> A3VNamespace (n,lookup ctx ctx.fnamespaces ns) let flatten_field ctx f = { f3_name = lookup_name ctx f.hlf_name; f3_slot = f.hlf_slot; f3_kind = (match f.hlf_kind with | HFMethod m -> A3FMethod { m3_type = lookup_method ctx m.hlm_type; m3_final = m.hlm_final; m3_override = m.hlm_override; m3_kind = m.hlm_kind; } | HFVar v -> A3FVar { v3_type = opt lookup_name ctx v.hlv_type; v3_value = flatten_value ctx v.hlv_value; v3_const = v.hlv_const; } | HFFunction f -> A3FFunction (lookup_method ctx f) | HFClass c -> A3FClass (lookup_class ctx c) ); f3_metas = opt (fun ctx -> Array.map (fun m -> lookup_nz ctx ctx.fmetas m)) ctx f.hlf_metas; } let flatten_class ctx c = { cl3_name = lookup_name ctx c.hlc_name; cl3_super = opt lookup_name ctx c.hlc_super; cl3_sealed = c.hlc_sealed; cl3_final = c.hlc_final; cl3_interface = c.hlc_interface; cl3_namespace = opt (fun ctx -> lookup ctx ctx.fnamespaces) ctx c.hlc_namespace; cl3_implements = Array.map (lookup_name ctx) c.hlc_implements; cl3_construct = lookup_method ctx c.hlc_construct; cl3_fields = Array.map (flatten_field ctx) c.hlc_fields; }, { st3_method = lookup_method ctx c.hlc_static_construct; st3_fields = Array.map (flatten_field ctx) c.hlc_static_fields; } let flatten_opcode ctx i = function | HBreakPoint -> A3BreakPoint | HNop -> A3Nop | HThrow -> A3Throw | HGetSuper n -> A3GetSuper (lookup_name ctx n) | HSetSuper n -> A3SetSuper (lookup_name ctx n) | HDxNs s -> A3DxNs (lookup_ident ctx s) | HDxNsLate -> A3DxNsLate | HRegKill r -> A3RegKill r | HLabel -> A3Label | HJump (j,n) -> ctx.fjumps <- i :: ctx.fjumps; A3Jump (j,n) | HSwitch (n,l) -> ctx.fjumps <- i :: ctx.fjumps; A3Switch (n,l) | HPushWith -> A3PushWith | HPopScope -> A3PopScope | HForIn -> A3ForIn | HHasNext -> A3HasNext | HNull -> A3Null | HUndefined -> A3Undefined | HForEach -> A3ForEach | HSmallInt n -> A3SmallInt n | HInt n -> A3Int n | HTrue -> A3True | HFalse -> A3False | HNaN -> A3NaN | HPop -> A3Pop | HDup -> A3Dup | HSwap -> A3Swap | HString s -> A3String (lookup_ident ctx s) | HIntRef i -> A3IntRef (lookup ctx ctx.fints i) | HUIntRef i -> A3UIntRef (lookup ctx ctx.fuints i) | HFloat f -> A3Float (lookup ctx ctx.ffloats f) | HScope -> A3Scope | HNamespace n -> A3Namespace (lookup ctx ctx.fnamespaces n) | HNext (r1,r2) -> A3Next (r1,r2) | HFunction m -> A3Function (lookup_method ctx m) | HCallStack n -> A3CallStack n | HConstruct n -> A3Construct n | HCallMethod (s,n) -> A3CallMethod (s,n) | HCallStatic (m,n) -> A3CallStatic (no_nz (lookup_method ctx m),n) | HCallSuper (i,n) -> A3CallSuper (lookup_name ctx i,n) | HCallProperty (i,n) -> A3CallProperty (lookup_name ctx i,n) | HRetVoid -> A3RetVoid | HRet -> A3Ret | HConstructSuper n -> A3ConstructSuper n | HConstructProperty (i,n) -> A3ConstructProperty (lookup_name ctx i,n) | HCallPropLex (i,n) -> A3CallPropLex (lookup_name ctx i,n) | HCallSuperVoid (i,n) -> A3CallSuperVoid (lookup_name ctx i,n) | HCallPropVoid (i,n)-> A3CallPropVoid (lookup_name ctx i,n) | HApplyType n -> A3ApplyType n | HObject n -> A3Object n | HArray n -> A3Array n | HNewBlock -> A3NewBlock | HClassDef c -> A3ClassDef (As3parse.magic_index_nz (As3parse.index_nz_int (lookup_class ctx c))) | HGetDescendants i -> A3GetDescendants (lookup_name ctx i) | HCatch n -> A3Catch n | HFindPropStrict i -> A3FindPropStrict (lookup_name ctx i) | HFindProp i -> A3FindProp (lookup_name ctx i) | HFindDefinition i -> A3FindDefinition (lookup_name ctx i) | HGetLex i -> A3GetLex (lookup_name ctx i) | HSetProp i -> A3SetProp (lookup_name ctx i) | HReg r -> A3Reg r | HSetReg r -> A3SetReg r | HGetGlobalScope -> A3GetGlobalScope | HGetScope n -> A3GetScope n | HGetProp n -> A3GetProp (lookup_name ctx n) | HInitProp n -> A3InitProp (lookup_name ctx n) | HDeleteProp n -> A3DeleteProp (lookup_name ctx n) | HGetSlot s -> A3GetSlot s | HSetSlot s -> A3SetSlot s | HToString -> A3ToString | HToXml -> A3ToXml | HToXmlAttr -> A3ToXmlAttr | HToInt -> A3ToInt | HToUInt -> A3ToUInt | HToNumber -> A3ToNumber | HToBool -> A3ToBool | HToObject -> A3ToObject | HCheckIsXml -> A3CheckIsXml | HCast n -> A3Cast (lookup_name ctx n) | HAsAny -> A3AsAny | HAsString -> A3AsString | HAsType n -> A3AsType (lookup_name ctx n) | HAsObject -> A3AsObject | HIncrReg r -> A3IncrReg r | HDecrReg r -> A3DecrReg r | HTypeof -> A3Typeof | HInstanceOf -> A3InstanceOf | HIsType t -> A3IsType (lookup_name ctx t) | HIncrIReg r -> A3IncrIReg r | HDecrIReg r -> A3DecrIReg r | HThis -> A3This | HSetThis -> A3SetThis | HDebugReg (i,r,l) -> A3DebugReg (lookup_ident ctx i,r,l) | HDebugLine l -> A3DebugLine l | HDebugFile f -> A3DebugFile (lookup_ident ctx f) | HBreakPointLine n -> A3BreakPointLine n | HTimestamp -> A3Timestamp | HOp op -> A3Op op | HUnk c -> A3Unk c let flatten_code ctx hcode trys = let positions = Array.create (Array.length hcode + 1) 0 in let pos = ref 0 in let old = ctx.fjumps in ctx.fjumps <- []; let code = Array.mapi (fun i op -> let op = flatten_opcode ctx i op in pos := !pos + As3code.length op; Array.set positions (i + 1) !pos; op ) hcode in (* patch jumps *) List.iter (fun j -> Array.set code j (match Array.get code j with | A3Jump (jc,n) -> A3Jump (jc,positions.(j+n) - positions.(j+1)) | A3Switch (n,infos) -> A3Switch (positions.(j+n) - positions.(j),List.map (fun n -> positions.(j+n) - positions.(j)) infos) | _ -> assert false); ) ctx.fjumps; (* patch trys *) let trys = Array.mapi (fun i t -> { tc3_start = positions.(t.hltc_start); tc3_end = positions.(t.hltc_end); tc3_handle = positions.(t.hltc_handle); tc3_type = opt lookup_name ctx t.hltc_type; tc3_name = opt lookup_name ctx t.hltc_name; } ) trys in ctx.fjumps <- old; code, trys let flatten_function ctx f mid = let code, trys = flatten_code ctx f.hlf_code f.hlf_trys in { fun3_id = mid; fun3_stack_size = f.hlf_stack_size; fun3_nregs = f.hlf_nregs; fun3_init_scope = f.hlf_init_scope; fun3_max_scope = f.hlf_max_scope; fun3_code = code; fun3_trys = trys; fun3_locals = Array.map (fun (n,t,s,c) -> { f3_name = lookup_name ctx n; f3_slot = s; f3_kind = A3FVar { v3_type = opt lookup_name ctx t; v3_value = A3VNone; v3_const = c }; f3_metas = None; } ) f.hlf_locals; } let flatten_method ctx m = let mid = lookup_method ctx m in (match m.hlmt_function with | None -> () | Some f -> ctx.ffunctions <- flatten_function ctx f mid :: ctx.ffunctions); { mt3_ret = opt lookup_name ctx m.hlmt_ret; mt3_args = List.map (opt lookup_name ctx) m.hlmt_args; mt3_native = m.hlmt_native; mt3_var_args = m.hlmt_var_args; mt3_arguments_defined = m.hlmt_arguments_defined; mt3_uses_dxns = m.hlmt_uses_dxns; mt3_new_block = m.hlmt_new_block; mt3_unused_flag = m.hlmt_unused_flag; mt3_debug_name = opt lookup_ident ctx m.hlmt_debug_name; mt3_dparams = opt (fun ctx -> List.map (flatten_value ctx)) ctx m.hlmt_dparams; mt3_pnames = opt (fun ctx -> List.map (opt lookup_ident ctx)) ctx m.hlmt_pnames; } let flatten_static ctx s = { st3_method = lookup_method ctx s.hls_method; st3_fields = Array.map (flatten_field ctx) s.hls_fields; } let rec browse_method ctx m = let ml, _ = ctx in if not (List.memq m !ml) then begin ml := m :: !ml; match m.hlmt_function with | None -> () | Some f -> Array.iter (function | HFunction f | HCallStatic (f,_) -> browse_method ctx f | HClassDef _ -> () (* ignore, should be in fields list anyway *) | _ -> () ) f.hlf_code end and browse_class ctx c = let _, cl = ctx in if not (List.memq c !cl) then begin cl := c :: !cl; browse_method ctx c.hlc_construct; browse_method ctx c.hlc_static_construct; Array.iter (browse_field ctx) c.hlc_fields; Array.iter (browse_field ctx) c.hlc_static_fields; end and browse_field ctx f = match f.hlf_kind with | HFMethod m -> browse_method ctx m.hlm_type | HFVar _ -> () | HFFunction m -> browse_method ctx m | HFClass c -> browse_class ctx c let flatten t = let id _ x = x in (* collect methods and classes, sort by index and force evaluation in order to keep order *) let methods = ref [] in let classes = ref [] in let ctx = (methods,classes) in List.iter (fun s -> Array.iter (browse_field ctx) s.hls_fields; browse_method ctx s.hls_method; ) t; let methods = List.sort (fun m1 m2 -> m1.hlmt_index - m2.hlmt_index) (List.rev !methods) in (* done *) let rec ctx = { fints = new_lookup id; fuints = new_lookup id; ffloats = new_lookup id; fidents = new_lookup id; fnamespaces = new_lookup flatten_namespace; fnsets = new_lookup flatten_ns_set; fnames = new_lookup flatten_name; fmetas = new_lookup flatten_meta; fmethods = new_index_lookup methods flatten_method; fclasses = new_index_lookup (List.rev !classes) flatten_class; fjumps = []; ffunctions = []; } in ignore(lookup_ident ctx ""); let inits = List.map (flatten_static ctx) t in let classes = lookup_index_array ctx.fclasses in { as3_ints = lookup_array ctx.fints; as3_uints = lookup_array ctx.fuints; as3_floats = lookup_array ctx.ffloats; as3_idents = lookup_array ctx.fidents; as3_namespaces = lookup_array ctx.fnamespaces; as3_nsets = lookup_array ctx.fnsets; as3_names = lookup_array ctx.fnames; as3_metadatas = lookup_array ctx.fmetas; as3_method_types = lookup_index_array ctx.fmethods; as3_classes = Array.map fst classes; as3_statics = Array.map snd classes; as3_functions = Array.of_list (List.rev ctx.ffunctions); as3_inits = Array.of_list inits; as3_unknown = ""; } mtasc-1.14/ocaml/swflib/swfZip.ml0000640000175000017500000000234210142042231015361 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) let inflate i = IO.input_string (Extc.unzip (IO.read_all i)) let deflate o = let buf = Buffer.create 0 in let flush() = let data = Buffer.contents buf in IO.nwrite o (Extc.zip data); IO.flush o; Buffer.reset buf; in IO.create_out ~write:(Buffer.add_char buf) ~output:(fun s p l -> Buffer.add_substring buf s p l; l) ~flush ~close:(fun () -> flush(); IO.close_out o) ;; Swf.__inflate := inflate; Swf.__deflate := deflate;mtasc-1.14/ocaml/swflib/LICENSE0000640000175000017500000004313110140175134014562 0ustar pabspabs GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. mtasc-1.14/ocaml/swflib/swflib.vcproj0000640000175000017500000000323710730515402016274 0ustar pabspabs mtasc-1.14/ocaml/swflib/actionScript.ml0000640000175000017500000004534210367723034016570 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Swf open IO open Printf let push_item_length = function | PString s -> String.length s + 1 | PFloat _ -> 4 | PNull -> 0 | PUndefined -> 0 | PReg _ -> 1 | PBool _ -> 1 | PDouble _ -> 8 | PInt _ -> 4 | PStack _ -> 1 | PStack2 _ -> 2 let push_item_id = function | PString s -> 0 | PFloat _ -> 1 | PNull -> 2 | PUndefined -> 3 | PReg _ -> 4 | PBool _ -> 5 | PDouble _ -> 6 | PInt _ -> 7 | PStack _ -> 8 | PStack2 _ -> 9 let opcodes = Hashtbl.create 0 let opcodes_rev = Hashtbl.create 0 let opcodes_names = Hashtbl.create 0 let ( => ) code (op,name) = Hashtbl.add opcodes op code; Hashtbl.add opcodes_rev code op; Hashtbl.add opcodes_names op name let short_op_codes = begin 0x00 => (AEnd,"END"); 0x04 => (ANextFrame,"NEXTFRAME"); 0x05 => (APrevFrame,"PREVFRAME"); 0x06 => (APlay,"PLAY"); 0x07 => (AStop,"STOP"); 0x08 => (AToggleHighQuality,"TGLHIGHQULTY"); 0x09 => (AStopSounds,"STOPSOUNDS"); 0x0A => (AAddNum,"ADDNUM"); 0x0B => (ASubtract,"SUB"); 0x0C => (AMultiply,"MULT"); 0x0D => (ADivide,"DIV"); 0x0E => (ACompareNum,"CMP"); 0x0F => (AEqualNum,"EQNUM"); 0x10 => (ALogicalAnd,"LAND"); 0x11 => (ALogicalOr,"LOR"); 0x12 => (ANot,"NOT"); 0x13 => (AStringEqual,"STREQ"); 0x14 => (AStringLength,"STRLEN"); 0x15 => (ASubString,"SUBSTR"); 0x17 => (APop,"POP"); 0x18 => (AToInt,"TOINT"); 0x1C => (AEval,"EVAL"); 0x1D => (ASet,"SET"); 0x20 => (ATellTarget,"TELLTARGET"); 0x21 => (AStringAdd,"STRADD"); 0x22 => (AGetProperty,"GETPROP"); 0x23 => (ASetProperty,"SETPROP"); 0x24 => (ADuplicateMC,"DUPLICATEMC"); 0x25 => (ARemoveMC,"REMOVEMC"); 0x26 => (ATrace,"TRACE"); 0x27 => (AStartDrag,"STARTDRAG"); 0x28 => (AStopDrag,"STOPDRAG"); 0x2A => (AThrow,"THROW"); 0x2B => (ACast,"CAST"); 0x2C => (AImplements,"IMPLEMENTS"); 0x2D => (AFSCommand2,"FSCOMMAND2"); 0x30 => (ARandom,"RANDOM"); 0x31 => (AMBStringLength,"MBSTRLEN"); 0x32 => (AOrd,"ORD"); 0x33 => (AChr,"CHR"); 0x34 => (AGetTimer,"GETTIMER"); 0x35 => (AMBStringSub,"MBSTRSUB"); 0x36 => (AMBOrd,"MBORD"); 0x37 => (AMBChr,"MBCHR"); 0x3A => (ADeleteObj,"DELETEOBJ"); 0x3B => (ADelete,"DELETE"); 0x3C => (ALocalAssign,"VARSET"); 0x3D => (ACall,"CALL"); 0x3E => (AReturn,"RET"); 0x3F => (AMod,"MOD"); 0x40 => (ANew,"NEW"); 0x41 => (ALocalVar,"VAR"); 0x42 => (AInitArray,"ARRAY"); 0x43 => (AObject,"OBJECT"); 0x44 => (ATypeOf,"TYPEOF"); 0x45 => (ATargetPath,"TARGETPATH"); 0x46 => (AEnum,"ENUM"); 0x47 => (AAdd,"ADD"); 0x48 => (ACompare,"CMP"); 0x49 => (AEqual,"EQ"); 0x4A => (AToNumber,"TONUMBER"); 0x4B => (AToString,"TOSTRING"); 0x4C => (ADup,"DUP"); 0x4D => (ASwap,"SWAP"); 0x4E => (AObjGet,"OBJGET"); 0x4F => (AObjSet,"OBJSET"); 0x50 => (AIncrement,"INCR"); 0x51 => (ADecrement,"DECR"); 0x52 => (AObjCall,"OBJCALL"); 0x53 => (ANewMethod,"NEWMETHOD"); 0x54 => (AInstanceOf,"INSTANCEOF"); 0x55 => (AEnum2,"ENUM2"); 0x60 => (AAnd,"AND"); 0x61 => (AOr,"OR"); 0x62 => (AXor,"XOR"); 0x63 => (AShl,"SHL"); 0x64 => (AShr,"SHR"); 0x65 => (AAsr,"ASR"); 0x66 => (APhysEqual,"PHYSEQ"); 0x67 => (AGreater,"GT"); 0x68 => (AStringGreater,"STRGT"); 0x69 => (AExtends,"EXTENDS"); 0x9E => (ACallFrame,"CALLFRAME"); (* special case *) end let action_id = function | AGotoFrame _ -> 0x81 | AGetURL _ -> 0x83 | ASetReg _ -> 0x87 | AStringPool _ -> 0x88 | AWaitForFrame _ -> 0x8A | ASetTarget _ -> 0x8B | AGotoLabel _ -> 0x8C | AWaitForFrame2 _ -> 0x8D | AFunction2 _ -> 0x8E | ATry _ -> 0x8F | AWith _ -> 0x94 | APush _ -> 0x96 | AJump _ -> 0x99 | AGetURL2 _ -> 0x9A | AFunction _ -> 0x9B | ACondJump _ -> 0x9D | AGotoFrame2 _ -> 0x9F | AUnknown (id,_) -> id | op -> try Hashtbl.find opcodes op with Not_found -> error "Unknown opcode id" let action_data_length = function | AGotoFrame _ -> 2 | AGetURL (url,target) -> 2 + String.length url + String.length target | ASetReg _ -> 1 | AStringPool strs -> List.fold_left (fun acc item -> acc + 1 + String.length item) 2 strs | AWaitForFrame _ -> 3 | AFunction2 f -> let base = String.length f.f2_name + 1 + 2 + 1 + 2 + 2 in List.fold_left (fun acc (_,s) -> acc + 2 + String.length s) base f.f2_args | ASetTarget target -> String.length target + 1 | AGotoLabel label -> String.length label + 1 | AWaitForFrame2 _ -> 1 | ATry t -> 1 + 6 + (match t.tr_style with TryVariable n -> String.length n + 1 | TryRegister _ -> 1) | AWith _ -> 2 (* the string does not count in length *) | APush items -> List.fold_left (fun acc item -> acc + 1 + push_item_length item) 0 items | AJump _ -> 2 | AGetURL2 _ -> 1 | AFunction f -> List.fold_left (fun acc s -> acc + 1 + String.length s) 4 (f.f_name :: f.f_args) | ACondJump _ -> 2 | AGotoFrame2 (_,id) -> 1 + (if id = None then 0 else 2) | AUnknown (_,data) -> String.length data | _ -> 0 let action_length a = let len = (if action_id a >= 0x80 then 3 else 1) in len + action_data_length a let actions_length acts = DynArray.fold_left (fun acc a -> acc + action_length a) (action_length AEnd) acts let read_mm_double ch = let i1 = Int64.of_int32 (read_real_i32 ch) in let i2 = Int64.of_int32 (read_real_i32 ch) in let i2 = (if i2 < Int64.zero then Int64.add i2 (Int64.shift_left Int64.one 32) else i2) in Int64.float_of_bits (Int64.logor i2 (Int64.shift_left i1 32)) let write_mm_double ch f = let i64 = Int64.bits_of_float f in write_real_i32 ch (Int64.to_int32 (Int64.shift_right_logical i64 32)); write_real_i32 ch (Int64.to_int32 i64) let read_string_max ch len = let b = Buffer.create 0 in let rec loop l = if l = 0 then begin let s = Buffer.contents b in String.sub s 0 (String.length s - 1) end else let c = read ch in if c = '\000' then Buffer.contents b else begin Buffer.add_char b c; loop (l - 1) end; in loop len let parse_push_item ch len = let id = read_byte ch in match id with | 0 -> PString (read_string_max ch len) | 1 -> PFloat (read_real_i32 ch) | 2 -> PNull | 3 -> PUndefined | 4 -> PReg (read_byte ch) | 5 -> PBool (read_byte ch <> 0) | 6 -> PDouble (read_mm_double ch) | 7 -> PInt (read_real_i32 ch) | 8 -> PStack (read_byte ch) | 9 -> PStack2 (read_ui16 ch) | _ -> error (sprintf "Unknown PUSH item id : %d" id) let rec parse_push_items ch len = if len < 0 then error "PUSH parse overflow"; if len = 0 then [] else let item = parse_push_item ch len in item :: parse_push_items ch (len - 1 - push_item_length item) let rec read_strings ch n = if n = 0 then [] else let s = read_string ch in s :: read_strings ch (n-1) let parse_function_decl ch = let name = read_string ch in let nargs = read_ui16 ch in let args = read_strings ch nargs in let clen = read_ui16 ch in { f_name = name; f_args = args; f_codelen = clen; } let parse_f2_flags n = let flags = ref [] in let v = ref 1 in let add_flag f = if n land !v <> 0 then flags := f :: !flags; v := !v lsl 1 in List.iter add_flag [ThisRegister; ThisNoVar; ArgumentsRegister; ArgumentsNoVar; SuperRegister; SuperNoVar; RootRegister; ParentRegister; GlobalRegister]; !flags let parse_function_decl2 ch = let name = read_string ch in let nargs = read_ui16 ch in let nregs = read_byte ch in let flags = parse_f2_flags (read_ui16 ch) in let rec loop n = if n = 0 then [] else let r = read_byte ch in let s = read_string ch in (r,s) :: loop (n-1) in let args = loop nargs in let clen = read_ui16 ch in { f2_name = name; f2_args = args; f2_flags = flags; f2_codelen = clen; f2_nregs = nregs; } let parse_action ch = let id = read_byte ch in let len = (if id >= 0x80 then read_ui16 ch else 0) in let len = (if len = 0xFFFF then 0 else len) in let act = (match id with | 0x81 -> AGotoFrame (read_ui16 ch) | 0x83 -> let url = read_string ch in let target = read_string ch in AGetURL (url,target) | 0x87 -> ASetReg (read_byte ch) | 0x88 -> let nstrs = read_ui16 ch in AStringPool (read_strings ch nstrs) | 0x8A -> let frame = read_ui16 ch in let skip = read_byte ch in AWaitForFrame (frame,skip) | 0x8B -> ASetTarget (read_string ch) | 0x8C -> AGotoLabel (read_string ch) | 0x8D -> AWaitForFrame2 (read_byte ch) | 0x8E -> AFunction2 (parse_function_decl2 ch) | 0x8F -> let flags = read_byte ch in let tsize = read_ui16 ch in let csize = read_ui16 ch in let fsize = read_ui16 ch in let tstyle = (if flags land 4 == 0 then TryVariable (read_string ch) else TryRegister (read_byte ch)) in ATry { tr_style = tstyle; tr_trylen = tsize; tr_catchlen = (if flags land 1 == 0 then None else Some csize); tr_finallylen = (if flags land 2 == 0 then None else Some fsize); } | 0x94 -> let size = read_ui16 ch in AWith size | 0x96 -> APush (parse_push_items ch len) | 0x99 -> AJump (read_i16 ch) | 0x9A -> AGetURL2 (read_byte ch) | 0x9B -> AFunction (parse_function_decl ch) | 0x9D -> ACondJump (read_i16 ch) | 0x9E -> ACallFrame | 0x9F -> let flags = read_byte ch in let play = flags land 1 <> 0 in let delta = (if flags land 2 == 0 then None else Some (read_ui16 ch)) in AGotoFrame2 (play,delta) | _ -> try Hashtbl.find opcodes_rev id with Not_found -> printf "Unknown Action 0x%.2X (%d)\n" id len; AUnknown (id,nread ch len) ) in (* let len2 = action_data_length act in if len <> len2 then error (sprintf "Datalen mismatch for action 0x%.2X (%d != %d)" id len len2); *) act let size_to_jump_index acts curindex size = let delta = ref 0 in let size = ref size in if !size >= 0 then begin while !size > 0 do incr delta; size := !size - action_length (DynArray.get acts (curindex + !delta)); if !size < 0 then error "Unaligned code"; done; end else begin while !size < 0 do size := !size + action_length (DynArray.get acts (curindex + !delta)); if !size > 0 then error "Unaligned code"; decr delta; done; end; !delta let parse_actions ch = let acts = DynArray.create() in let rec loop() = match parse_action ch with | AEnd -> () | AUnknown (0xFF,"") -> DynArray.add acts APlay; DynArray.add acts APlay; DynArray.add acts APlay; loop() | a -> DynArray.add acts a; loop(); in loop(); (* process jump indexes *) let process_jump curindex = function | AJump size -> let index = size_to_jump_index acts curindex size in DynArray.set acts curindex (AJump index) | ACondJump size -> let index = size_to_jump_index acts curindex size in DynArray.set acts curindex (ACondJump index) | AFunction f -> let index = size_to_jump_index acts curindex f.f_codelen in DynArray.set acts curindex (AFunction { f with f_codelen = index }) | AFunction2 f -> let index = size_to_jump_index acts curindex f.f2_codelen in DynArray.set acts curindex (AFunction2 { f with f2_codelen = index }) | AWith size -> let index = size_to_jump_index acts curindex size in DynArray.set acts curindex (AWith index) | ATry t -> let tindex = size_to_jump_index acts curindex t.tr_trylen in let cindex = (match t.tr_catchlen with None -> None | Some size -> Some (size_to_jump_index acts (curindex + tindex) size)) in let findex = (match t.tr_finallylen with None -> None | Some size -> Some (size_to_jump_index acts (curindex + tindex + (match cindex with None -> 0 | Some i -> i)) size)) in DynArray.set acts curindex (ATry { t with tr_trylen = tindex; tr_catchlen = cindex; tr_finallylen = findex }) | _ -> () in DynArray.iteri process_jump acts; acts let jump_index_to_size acts curindex target = let size = ref 0 in if target >= 0 then begin for i = 1 to target do size := !size + action_length (DynArray.get acts (curindex + i)); done; end else begin for i = 0 downto target+1 do size := !size - action_length (DynArray.get acts (curindex + i)); done; end; !size let rec write_strings ch = function | [] -> () | s :: l -> write_string ch s; write_strings ch l let write_push_item_data ch = function | PString s -> write_string ch s | PFloat f -> write_real_i32 ch f | PNull -> () | PUndefined -> () | PReg r -> write_byte ch r | PBool b -> write_byte ch (if b then 1 else 0) | PDouble f -> write_mm_double ch f | PInt n -> write_real_i32 ch n | PStack index -> write_byte ch index | PStack2 index -> write_ui16 ch index let f2_flags_value flags = let fval = function | ThisRegister -> 1 | ThisNoVar -> 2 | ArgumentsRegister -> 4 | ArgumentsNoVar -> 8 | SuperRegister -> 16 | SuperNoVar -> 32 | RootRegister -> 64 | ParentRegister -> 128 | GlobalRegister -> 256 in List.fold_left (fun n f -> n lor (fval f)) 0 flags let write_action_data acts curindex ch = function | AGotoFrame frame -> write_ui16 ch frame | AGetURL (url,target) -> write_string ch url; write_string ch target | ASetReg reg -> write_byte ch reg | AStringPool strs -> write_ui16 ch (List.length strs); write_strings ch strs | AWaitForFrame (frame,skip) -> write_ui16 ch frame; write_byte ch skip | ASetTarget target -> write_string ch target | AGotoLabel label -> write_string ch label | AWaitForFrame2 n -> write_byte ch n | AFunction2 f -> write_string ch f.f2_name; write_ui16 ch (List.length f.f2_args); write_byte ch f.f2_nregs; write_ui16 ch (f2_flags_value f.f2_flags); List.iter (fun (r,s) -> write_byte ch r; write_string ch s; ) f.f2_args; let size = jump_index_to_size acts curindex f.f2_codelen in write_ui16 ch size; | ATry t -> let tsize = jump_index_to_size acts curindex t.tr_trylen in let csize = (match t.tr_catchlen with None -> 0 | Some idx -> jump_index_to_size acts (curindex + t.tr_trylen) idx) in let fsize = (match t.tr_finallylen with None -> 0 | Some idx -> jump_index_to_size acts (curindex + t.tr_trylen + (match t.tr_catchlen with None -> 0 | Some n -> n)) idx) in let flags = (if t.tr_catchlen <> None then 1 else 0) lor (if t.tr_finallylen <> None then 2 else 0) lor (match t.tr_style with TryRegister _ -> 4 | TryVariable _ -> 0) in write_byte ch flags; write_ui16 ch tsize; write_ui16 ch csize; write_ui16 ch fsize; (match t.tr_style with | TryVariable v -> write_string ch v | TryRegister r -> write_byte ch r) | AWith target -> let size = jump_index_to_size acts curindex target in write_ui16 ch size | APush items -> List.iter (fun item -> write_byte ch (push_item_id item); write_push_item_data ch item ) items | AJump target -> let size = jump_index_to_size acts curindex target in write_i16 ch size | AGetURL2 n -> write_byte ch n | AFunction f -> write_string ch f.f_name; write_ui16 ch (List.length f.f_args); write_strings ch f.f_args; let size = jump_index_to_size acts curindex f.f_codelen in write_ui16 ch size; | ACondJump target -> let size = jump_index_to_size acts curindex target in write_i16 ch size; | AGotoFrame2 (play,None) -> write_byte ch (if play then 1 else 0) | AGotoFrame2 (play,Some delta) -> write_byte ch (if play then 3 else 2); write_ui16 ch delta; | ACallFrame -> () | AUnknown (_,data) -> nwrite ch data | _ -> assert false let write_action acts curindex ch a = let id = action_id a in let len = action_data_length a in if id < 0x80 && len > 0 then error "Invalid Action Written"; write_byte ch id; if len > 0 || id >= 0x80 then begin write_ui16 ch len; write_action_data acts curindex ch a; end let write_actions ch acts = DynArray.iteri (fun index act -> write_action acts index ch act) acts; write_action acts (DynArray.length acts) ch AEnd let sprintf = Printf.sprintf let action_string get_ident pos = function | AGotoFrame n -> sprintf "GOTOFRAME %d" n | AGetURL (a,b) -> sprintf "GETURL '%s' '%s'" a b | ASetReg n -> sprintf "SETREG %d" n | AStringPool strlist -> let b = Buffer.create 0 in Buffer.add_string b "STRINGS "; let p = ref 0 in List.iter (fun s -> Buffer.add_string b (string_of_int !p); incr p; Buffer.add_char b ':'; Buffer.add_string b s; Buffer.add_char b ' '; ) strlist; Buffer.contents b | AWaitForFrame (i,j) -> sprintf "WAITFORFRAME %d %d" i j | ASetTarget s -> sprintf "SETTARGET %s" s | AGotoLabel s -> sprintf "GOTOLABEL %s" s | AWaitForFrame2 n -> sprintf "WAITFORFRAME2 %d" n | AFunction2 f -> let b = Buffer.create 0 in Buffer.add_string b "FUNCTION2 "; Buffer.add_string b f.f2_name; Buffer.add_char b '('; Buffer.add_string b (String.concat "," (List.map (fun (n,str) -> sprintf "%d:%s" n str) f.f2_args)); Buffer.add_char b ')'; Buffer.add_string b (sprintf " nregs:%d flags:%d " f.f2_nregs (f2_flags_value f.f2_flags)); Buffer.add_string b (sprintf "0x%.4X" (pos + 1 + f.f2_codelen)); Buffer.contents b | APush pl -> let b = Buffer.create 0 in Buffer.add_string b "PUSH"; List.iter (fun it -> Buffer.add_char b ' '; match it with | PString s -> Buffer.add_char b '"'; Buffer.add_string b s; Buffer.add_char b '"' | PFloat _ -> Buffer.add_string b "" | PNull -> Buffer.add_string b "null" | PUndefined -> Buffer.add_string b "undefined" | PReg n -> Buffer.add_string b (sprintf "reg:%d" n) | PBool fl -> Buffer.add_string b (if fl then "true" else "false") | PDouble _ -> Buffer.add_string b "" | PInt i -> Buffer.add_string b (Int32.to_string i) | PStack n | PStack2 n -> Buffer.add_char b '['; Buffer.add_string b (string_of_int n); Buffer.add_char b ':'; Buffer.add_string b (get_ident n); Buffer.add_char b ']'; ) pl; Buffer.contents b | ATry _ -> sprintf "TRY" | AWith n -> sprintf "WITH %d" n | AJump n -> sprintf "JUMP 0x%.4X" (n + pos + 1) | AGetURL2 n -> sprintf "GETURL2 %d" n | AFunction f -> let b = Buffer.create 0 in Buffer.add_string b "FUNCTION "; Buffer.add_string b f.f_name; Buffer.add_char b '('; Buffer.add_string b (String.concat "," f.f_args); Buffer.add_char b ')'; Buffer.add_string b (sprintf " 0x%.4X" (pos + 1 + f.f_codelen)); Buffer.contents b | ACondJump n -> sprintf "CJMP 0x%.4X" (n + pos + 1) | AGotoFrame2 (b,None) -> sprintf "GOTOFRAME2 %b" b | AGotoFrame2 (b,Some i) -> sprintf "GOTOFRAME2 %b %d" b i | AUnknown (tag,_) -> sprintf "??? 0x%.2X" tag | op -> try Hashtbl.find opcodes_names op with Not_found -> assert false mtasc-1.14/ocaml/swflib/png.ml0000640000175000017500000002403010242776216014703 0ustar pabspabs(* * PNG File Format Library * Copyright (c)2005 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type grey_bits = | GBits1 | GBits2 | GBits4 | GBits8 | GBits16 type grey_alpha_bits = | GABits8 | GABits16 type true_bits = | TBits8 | TBits16 type index_bits = | IBits1 | IBits2 | IBits4 | IBits8 type alpha = | NoAlpha | HaveAlpha type color = | ClGreyScale of grey_bits | ClGreyAlpha of grey_alpha_bits | ClTrueColor of true_bits * alpha | ClIndexed of index_bits type header = { png_width : int; png_height : int; png_color : color; png_interlace : bool; } type chunk_id = string type chunk = | CEnd | CHeader of header | CData of string | CPalette of string | CUnknown of chunk_id * string type png = chunk list type error_msg = | Invalid_header | Invalid_file | Truncated_file | Invalid_CRC | Invalid_colors | Unsupported_colors | Invalid_datasize | Invalid_filter of int | Invalid_array exception Error of error_msg let error_msg = function | Invalid_header -> "Invalid header" | Invalid_file -> "Invalid file" | Truncated_file -> "Truncated file" | Invalid_CRC -> "Invalid CRC" | Invalid_colors -> "Invalid color model" | Unsupported_colors -> "Unsupported color model" | Invalid_datasize -> "Invalid data size" | Invalid_filter f -> "Invalid filter " ^ string_of_int f | Invalid_array -> "Invalid array" let error msg = raise (Error msg) let is_upper c = ((int_of_char c) land 32) <> 0 let is_critical id = is_upper id.[0] let is_public id = is_upper id.[1] let is_reseverd id = is_upper id.[2] let is_safe_to_copy id = is_upper id.[3] let is_id_char c = (c >= '\065' && c <= '\090') || (c >= '\097' && c <= '\122') let rec header = function | [] -> error Invalid_file | CHeader h :: _ -> h | _ :: l -> header l let rec data = function | [] -> error Invalid_file | CData s :: _ -> s | _ :: l -> data l let color_bits = function | ClGreyScale g -> (match g with | GBits1 -> 1 | GBits2 -> 2 | GBits4 -> 4 | GBits8 -> 8 | GBits16 -> 16) | ClGreyAlpha g -> (match g with | GABits8 -> 8 | GABits16 -> 16) | ClTrueColor (t,_) -> (match t with | TBits8 -> 8 | TBits16 -> 16) | ClIndexed i -> (match i with | IBits1 -> 1 | IBits2 -> 2 | IBits4 -> 4 | IBits8 -> 8) let crc_table = Array.init 256 (fun n -> let c = ref (Int32.of_int n) in for k = 0 to 7 do if Int32.logand !c 1l <> 0l then c := Int32.logxor 0xEDB88320l (Int32.shift_right_logical !c 1) else c := (Int32.shift_right_logical !c 1); done; !c) let input_crc ch = let crc = ref 0xFFFFFFFFl in let update c = let c = Int32.of_int (int_of_char c) in let k = Array.unsafe_get crc_table (Int32.to_int (Int32.logand (Int32.logxor !crc c) 0xFFl)) in crc := Int32.logxor k (Int32.shift_right_logical !crc 8) in let ch2 = IO.create_in ~read:(fun () -> let c = IO.read ch in update c; c ) ~input:(fun s p l -> let l = IO.input ch s p l in for i = 0 to l - 1 do update s.[p+i] done; l ) ~close:(fun () -> IO.close_in ch ) in ch2 , (fun () -> Int32.logxor !crc 0xFFFFFFFFl) let output_crc ch = let crc = ref 0xFFFFFFFFl in let update c = let c = Int32.of_int (int_of_char c) in let k = Array.unsafe_get crc_table (Int32.to_int (Int32.logand (Int32.logxor !crc c) 0xFFl)) in crc := Int32.logxor k (Int32.shift_right_logical !crc 8) in let ch2 = IO.create_out ~write:(fun c -> IO.write ch c; update c; ) ~output:(fun s p l -> let l = IO.output ch s p l in for i = 0 to l - 1 do update s.[p+i] done; l ) ~flush:(fun () -> IO.flush ch ) ~close:(fun () -> IO.close_out ch ) in ch2 , (fun () -> Int32.logxor !crc 0xFFFFFFFFl) let parse_header ch = let width = IO.BigEndian.read_i32 ch in let height = IO.BigEndian.read_i32 ch in if width < 0 || height < 0 then error Invalid_header; let bits = IO.read_byte ch in let color = IO.read_byte ch in let color = (match color with | 0 -> ClGreyScale (match bits with 1 -> GBits1 | 2 -> GBits2 | 4 -> GBits4 | 8 -> GBits8 | 16 -> GBits16 | _ -> error Invalid_colors) | 2 -> ClTrueColor ((match bits with 8 -> TBits8 | 16 -> TBits16 | _ -> error Invalid_colors) , NoAlpha) | 3 -> ClIndexed (match bits with 1 -> IBits1 | 2 -> IBits2 | 4 -> IBits4 | 8 -> IBits8 | _ -> error Invalid_colors) | 4 -> ClGreyAlpha (match bits with 8 -> GABits8 | 16 -> GABits16 | _ -> error Invalid_colors) | 6 -> ClTrueColor ((match bits with 8 -> TBits8 | 16 -> TBits16 | _ -> error Invalid_colors) , HaveAlpha) | _ -> error Invalid_colors) in let compress = IO.read_byte ch in let filter = IO.read_byte ch in if compress <> 0 || filter <> 0 then error Invalid_header; let interlace = IO.read_byte ch in let interlace = (match interlace with 0 -> false | 1 -> true | _ -> error Invalid_header) in { png_width = width; png_height = height; png_color = color; png_interlace = interlace; } let parse_chunk ch = let len = IO.BigEndian.read_i32 ch in let ch2 , crc = input_crc ch in let id = IO.nread ch2 4 in if len < 0 || not (is_id_char id.[0]) || not (is_id_char id.[1]) || not (is_id_char id.[2]) || not (is_id_char id.[3]) then error Invalid_file; let data = IO.nread ch2 len in let crc_val = IO.BigEndian.read_real_i32 ch in if crc_val <> crc() then error Invalid_CRC; match id with | "IEND" -> CEnd | "IHDR" -> CHeader (parse_header (IO.input_string data)) | "IDAT" -> CData data | "PLTE" -> CPalette data | _ -> CUnknown (id,data) let png_sign = "\137\080\078\071\013\010\026\010" let parse ch = let sign = (try IO.nread ch (String.length png_sign) with IO.No_more_input -> error Invalid_header) in if sign <> png_sign then error Invalid_header; let rec loop acc = match parse_chunk ch with | CEnd -> List.rev acc | c -> loop (c :: acc) in try loop [] with | IO.No_more_input -> error Truncated_file | IO.Overflow _ -> error Invalid_file let write_chunk ch cid cdata = IO.BigEndian.write_i32 ch (String.length cdata); let ch2 , crc = output_crc ch in IO.nwrite ch2 cid; IO.nwrite ch2 cdata; IO.BigEndian.write_real_i32 ch (crc()) let write_header real_ch h = let ch = IO.output_string() in IO.BigEndian.write_i32 ch h.png_width; IO.BigEndian.write_i32 ch h.png_height; IO.write_byte ch (color_bits h.png_color); IO.write_byte ch (match h.png_color with | ClGreyScale _ -> 0 | ClTrueColor (_,NoAlpha) -> 2 | ClIndexed _ -> 3 | ClGreyAlpha _ -> 4 | ClTrueColor (_,HaveAlpha) -> 6); IO.write_byte ch 0; IO.write_byte ch 0; IO.write_byte ch (if h.png_interlace then 1 else 0); let data = IO.close_out ch in write_chunk real_ch "IHDR" data let write ch png = IO.nwrite ch png_sign; List.iter (function | CEnd -> write_chunk ch "IEND" "" | CHeader h -> write_header ch h | CData s -> write_chunk ch "IDAT" s | CPalette s -> write_chunk ch "PLTE" s | CUnknown (id,data) -> write_chunk ch id data ) png let filter png data = let head = header png in let w = head.png_width in let h = head.png_height in match head.png_color with | ClGreyScale _ | ClGreyAlpha _ | ClIndexed _ | ClTrueColor (TBits16,_) -> error Unsupported_colors | ClTrueColor (TBits8,alpha) -> let alpha = (match alpha with NoAlpha -> false | HaveAlpha -> true) in let buf = String.create (w * h * 4) in let nbytes = if alpha then 4 else 3 in let stride = nbytes * w + 1 in if String.length data < h * stride then error Invalid_datasize; let bp = ref 0 in let get p = int_of_char (String.unsafe_get data p) in let bget p = int_of_char (String.unsafe_get buf p) in let set v = String.unsafe_set buf !bp (Char.unsafe_chr v); incr bp in let filters = [| (fun x y v -> v ); (fun x y v -> let v2 = if x = 0 then 0 else bget (!bp - 4) in v + v2 ); (fun x y v -> let v2 = if y = 0 then 0 else bget (!bp - 4*w) in v + v2 ); (fun x y v -> let v2 = if x = 0 then 0 else bget (!bp - 4) in let v3 = if y = 0 then 0 else bget (!bp - 4*w) in v + (v2 + v3) / 2 ); (fun x y v -> let a = if x = 0 then 0 else bget (!bp - 4) in let b = if y = 0 then 0 else bget (!bp - 4*w) in let c = if x = 0 || y = 0 then 0 else bget (!bp - 4 - 4*w) in let p = a + b - c in let pa = abs (p - a) in let pb = abs (p - b) in let pc = abs (p - c) in let d = (if pa <= pb && pa <= pc then a else if pb <= pc then b else c) in v + d ); |] in for y = 0 to h - 1 do let f = get (y * stride) in let f = (if f < 5 then filters.(f) else error (Invalid_filter f)) in for x = 0 to w - 1 do let p = x * nbytes + y * stride in if not alpha then begin set 255; for c = 1 to 3 do let v = get (p + c) in set (f x y v) done; end else begin let v = get (p + 4) in let a = f x y v in set a; for c = 1 to 3 do let v = get (p + c) in set (f x y v) done; end; done; done; buf let make ~width ~height ~pixel ~compress = let data = String.create (width * height * 4 + height) in let p = ref 0 in let set v = String.unsafe_set data !p (Char.unsafe_chr v); incr p in for y = 0 to height - 1 do set 0; for x = 0 to width - 1 do let c = pixel x y in let ic = Int32.to_int c in (* RGBA *) set (ic lsr 16); set (ic lsr 8); set ic; set (Int32.to_int (Int32.shift_right_logical c 24)); done; done; let data = compress data in let header = { png_width = width; png_height = height; png_color = ClTrueColor (TBits8,HaveAlpha); png_interlace = false; } in [CHeader header; CData data; CEnd] mtasc-1.14/ocaml/swflib/swflib.sln0000640000175000017500000000163210144212173015560 0ustar pabspabsMicrosoft Visual Studio Solution File, Format Version 8.00 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "swflib", "swflib.vcproj", "{A9DD9D90-85E1-4FCF-8C09-42BF78942849}" ProjectSection(ProjectDependencies) = postProject EndProjectSection EndProject Global GlobalSection(SolutionConfiguration) = preSolution Bytecode = Bytecode Native code = Native code EndGlobalSection GlobalSection(ProjectConfiguration) = postSolution {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.ActiveCfg = Bytecode|Win32 {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Bytecode.Build.0 = Bytecode|Win32 {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.ActiveCfg = Native code|Win32 {A9DD9D90-85E1-4FCF-8C09-42BF78942849}.Native code.Build.0 = Native code|Win32 EndGlobalSection GlobalSection(ExtensibilityGlobals) = postSolution EndGlobalSection GlobalSection(ExtensibilityAddIns) = postSolution EndGlobalSection EndGlobal mtasc-1.14/ocaml/swflib/install.bat0000640000175000017500000000067410730515402015721 0ustar pabspabs@ocamake -a *.ml *.mli -o swfLib.cma -clean @ocamake -a *.ml *.mli -o swfLib.cmxa -clean @ocamake -a *.ml *.mli -o swfLib.cma @ocamake -g -a *.ml *.mli -o swfLib.cmxa @cp -f as3parse.cmi as3code.cmi as3.cmi as3hl.cmi as3hlparse.cmi swf.cmi png.cmi swfPic.cmi swfParser.cmi swfZip.cmi actionScript.cmi swfLib.lib swfLib.cma swfLib.cmxa c:\ocaml\lib @ocamake -a *.ml *.mli -o swfLib.cma -clean @ocamake -a *.ml *.mli -o swfLib.cmxa -clean @pause mtasc-1.14/ocaml/swflib/as3hl.mli0000640000175000017500000001301411055013762015273 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004-2008 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open As3 type hl_ident = string type hl_int = int32 type hl_uint = int32 type hl_float = float type hl_slot = int type hl_jump = as3_jump type hl_op = as3_op type hl_opcode = | HBreakPoint | HNop | HThrow | HGetSuper of hl_name | HSetSuper of hl_name | HDxNs of hl_ident | HDxNsLate | HRegKill of reg | HLabel | HJump of hl_jump * int | HSwitch of int * int list | HPushWith | HPopScope | HForIn | HHasNext | HNull | HUndefined | HForEach | HSmallInt of int | HInt of int | HTrue | HFalse | HNaN | HPop | HDup | HSwap | HString of hl_ident | HIntRef of hl_int | HUIntRef of hl_uint | HFloat of hl_float | HScope | HNamespace of hl_namespace | HNext of reg * reg | HFunction of hl_method | HCallStack of nargs | HConstruct of nargs | HCallMethod of hl_slot * nargs | HCallStatic of hl_method * nargs | HCallSuper of hl_name * nargs | HCallProperty of hl_name * nargs | HRetVoid | HRet | HConstructSuper of nargs | HConstructProperty of hl_name * nargs | HCallPropLex of hl_name * nargs | HCallSuperVoid of hl_name * nargs | HCallPropVoid of hl_name * nargs | HApplyType of nargs | HObject of nargs | HArray of nargs | HNewBlock | HClassDef of hl_class | HGetDescendants of hl_name | HCatch of int | HFindPropStrict of hl_name | HFindProp of hl_name | HFindDefinition of hl_name | HGetLex of hl_name | HSetProp of hl_name | HReg of reg | HSetReg of reg | HGetGlobalScope | HGetScope of int | HGetProp of hl_name | HInitProp of hl_name | HDeleteProp of hl_name | HGetSlot of hl_slot | HSetSlot of hl_slot | HToString | HToXml | HToXmlAttr | HToInt | HToUInt | HToNumber | HToBool | HToObject | HCheckIsXml | HCast of hl_name | HAsAny | HAsString | HAsType of hl_name | HAsObject | HIncrReg of reg | HDecrReg of reg | HTypeof | HInstanceOf | HIsType of hl_name | HIncrIReg of reg | HDecrIReg of reg | HThis | HSetThis | HDebugReg of hl_ident * reg * int | HDebugLine of int | HDebugFile of hl_ident | HBreakPointLine of int | HTimestamp | HOp of hl_op | HUnk of char and hl_namespace = | HNPrivate of hl_ident option | HNPublic of hl_ident option | HNInternal of hl_ident option | HNProtected of hl_ident | HNNamespace of hl_ident | HNExplicit of hl_ident | HNStaticProtected of hl_ident option and hl_ns_set = hl_namespace list and hl_name = | HMPath of hl_ident list * hl_ident | HMName of hl_ident * hl_namespace | HMMultiName of hl_ident option * hl_ns_set | HMRuntimeName of hl_ident | HMRuntimeNameLate | HMMultiNameLate of hl_ns_set | HMAttrib of hl_name | HMParams of hl_name * hl_name list and hl_value = | HVNone | HVNull | HVBool of bool | HVString of hl_ident | HVInt of hl_int | HVUInt of hl_uint | HVFloat of hl_float | HVNamespace of int * hl_namespace and hl_method = { hlmt_index : int; (* used to sort methods (preserve order) *) hlmt_ret : hl_name option; hlmt_args : hl_name option list; hlmt_native : bool; hlmt_var_args : bool; hlmt_arguments_defined : bool; hlmt_uses_dxns : bool; hlmt_new_block : bool; hlmt_unused_flag : bool; hlmt_debug_name : hl_ident option; hlmt_dparams : hl_value list option; hlmt_pnames : hl_ident option list option; mutable hlmt_function : hl_function option; (* None for interfaces constructors only *) } and hl_try_catch = { hltc_start : int; hltc_end : int; hltc_handle : int; hltc_type : hl_name option; hltc_name : hl_name option; } and hl_function = { hlf_stack_size : int; hlf_nregs : int; hlf_init_scope : int; hlf_max_scope : int; mutable hlf_code : hl_opcode array; hlf_trys : hl_try_catch array; hlf_locals : (hl_name * hl_name option * hl_slot * bool) array; (* bool = const - mostly false *) } and hl_method_kind = as3_method_kind and hl_method_field = { hlm_type : hl_method; hlm_final : bool; hlm_override : bool; hlm_kind : hl_method_kind; } and hl_var_field = { hlv_type : hl_name option; hlv_value : hl_value; hlv_const : bool; } and hl_metadata = { hlmeta_name : hl_ident; hlmeta_data : (hl_ident option * hl_ident) array; } and hl_field_kind = | HFMethod of hl_method_field | HFVar of hl_var_field | HFFunction of hl_method | HFClass of hl_class (* only for hl_static fields *) and hl_field = { hlf_name : hl_name; hlf_slot : hl_slot; hlf_kind : hl_field_kind; hlf_metas : hl_metadata array option; } and hl_class = { hlc_index : int; hlc_name : hl_name; hlc_super : hl_name option; hlc_sealed : bool; hlc_final : bool; hlc_interface : bool; hlc_namespace : hl_namespace option; hlc_implements : hl_name array; mutable hlc_construct : hl_method; mutable hlc_fields : hl_field array; mutable hlc_static_construct : hl_method; mutable hlc_static_fields : hl_field array; } and hl_static = { hls_method : hl_method; hls_fields : hl_field array; } and hl_tag = hl_static list mtasc-1.14/ocaml/swflib/as3parse.ml0000640000175000017500000010112511152474463015641 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004-2006 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open As3 let parse_idents = true let parse_namespaces = true && parse_idents let parse_ns_sets = true && parse_namespaces let parse_names = true && parse_ns_sets let parse_mtypes = true && parse_names let parse_metadata = true && parse_mtypes let parse_classes = true && parse_metadata let parse_statics = true && parse_classes let parse_inits = true && parse_statics let parse_functions = true && parse_inits let parse_bytecode = true && parse_functions let magic_index (i : int) : 'a index = Obj.magic i let magic_index_nz (i : int) : 'a index_nz = Obj.magic i let index (t : 'a array) (i : int) : 'a index = if i <= 0 || i - 1 >= Array.length t then assert false; magic_index i let index_opt t i = if i = 0 then None else Some (index t i) let index_nz (t : 'a array) (i : int) : 'a index_nz = if i < 0 || i >= Array.length t then assert false; Obj.magic i let index_int (i : 'a index) = (Obj.magic i : int) let index_nz_int (i : 'a index_nz) = (Obj.magic i : int) let iget (t : 'a array) (i : 'a index) : 'a = t.(index_int i - 1) let no_nz (i : 'a index_nz) : 'a index = Obj.magic ((Obj.magic i) + 1) (* ************************************************************************ *) (* LENGTH *) let as3_empty_index ctx = let empty_index = ref 0 in try Array.iteri (fun i x -> if x = "" then begin empty_index := (i + 1); raise Exit; end) ctx.as3_idents; if parse_idents then assert false; magic_index 0 with Exit -> index ctx.as3_idents (!empty_index) let as3_int_length i = if Int32.compare (Int32.shift_right_logical i 28) 0l > 0 then 5 else if Int32.compare (Int32.shift_right i 21) 0l > 0 then 4 else if Int32.compare (Int32.shift_right i 14) 0l > 0 then 3 else if Int32.compare (Int32.shift_right i 7) 0l > 0 then 2 else 1 let as3_uint_length i = as3_int_length i let sum f l = List.fold_left (fun acc n -> acc + f n) 0 l let int_length i = as3_int_length (Int32.of_int i) let idx_length i = int_length (index_int i) let idx_length_nz i = int_length (index_nz_int i) let idx_opt_length = function | None -> int_length 0 | Some i -> idx_length i let as3_ident_length s = let n = String.length s in n + int_length n let as3_namespace_length ei = function | A3NStaticProtected o | A3NPrivate o -> 1 + (match o with None -> int_length 0 | Some n -> idx_length n) | A3NPublic o | A3NInternal o -> 1 + idx_length (match o with None -> ei | Some n -> n) | A3NExplicit n | A3NNamespace n | A3NProtected n -> 1 + idx_length n let as3_ns_set_length l = int_length (List.length l) + sum idx_length l let rec as3_name_length t = 1 + match t with | A3MMultiName (id,r) -> idx_opt_length id + idx_length r | A3MName (id,r) -> idx_length r + idx_length id | A3MRuntimeName i -> idx_length i | A3MRuntimeNameLate -> 0 | A3MMultiNameLate idx -> idx_length idx | A3MAttrib n -> as3_name_length n - 1 | A3MParams (id,pl) -> idx_length id + 1 + (sum idx_length pl) let as3_value_length extra = function | A3VNone -> if extra then 2 else 1 | A3VNull | A3VBool _ -> 2 | A3VString s -> 1 + idx_length s | A3VInt s -> 1 + idx_length s | A3VUInt s -> 1 + idx_length s | A3VFloat s -> 1 + idx_length s | A3VNamespace (_,s) -> 1 + idx_length s let as3_method_type_length m = 1 + idx_opt_length m.mt3_ret + sum idx_opt_length m.mt3_args + idx_opt_length m.mt3_debug_name + 1 + (match m.mt3_dparams with None -> 0 | Some l -> 1 + sum (as3_value_length true) l) + (match m.mt3_pnames with None -> 0 | Some l -> sum idx_opt_length l) let list_length f l = match Array.length l with | 0 -> int_length 0 | n -> Array.fold_left (fun acc x -> acc + f x) (int_length (n + 1)) l let list2_length f l = Array.fold_left (fun acc x -> acc + f x) (int_length (Array.length l)) l let as3_field_length f = idx_length f.f3_name + 1 + int_length f.f3_slot + (match f.f3_kind with | A3FMethod m -> idx_length_nz m.m3_type | A3FClass c -> idx_length_nz c | A3FFunction id -> idx_length_nz id | A3FVar v -> idx_opt_length v.v3_type + as3_value_length false v.v3_value) + match f.f3_metas with | None -> 0 | Some l -> list2_length idx_length_nz l let as3_class_length c = idx_length c.cl3_name + idx_opt_length c.cl3_super + 1 + (match c.cl3_namespace with None -> 0 | Some r -> idx_length r) + list2_length idx_length c.cl3_implements + idx_length_nz c.cl3_construct + list2_length as3_field_length c.cl3_fields let as3_static_length s = idx_length_nz s.st3_method + list2_length as3_field_length s.st3_fields let as3_metadata_length m = idx_length m.meta3_name + list2_length (fun (i1,i2) -> idx_opt_length i1 + idx_length i2) m.meta3_data let as3_try_catch_length t = int_length t.tc3_start + int_length t.tc3_end + int_length t.tc3_handle + idx_opt_length t.tc3_type + idx_opt_length t.tc3_name let as3_function_length f = let clen = Array.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in idx_length_nz f.fun3_id + int_length f.fun3_stack_size + int_length f.fun3_nregs + int_length f.fun3_init_scope + int_length f.fun3_max_scope + int_length clen + clen + list2_length as3_try_catch_length f.fun3_trys + list2_length as3_field_length f.fun3_locals let as3_length ctx = let ei = as3_empty_index ctx in String.length ctx.as3_unknown + 4 + list_length as3_int_length ctx.as3_ints + list_length as3_uint_length ctx.as3_uints + list_length (fun _ -> 8) ctx.as3_floats + if parse_idents then list_length as3_ident_length ctx.as3_idents + if parse_namespaces then list_length (as3_namespace_length ei) ctx.as3_namespaces + if parse_ns_sets then list_length as3_ns_set_length ctx.as3_nsets + if parse_names then list_length as3_name_length ctx.as3_names + if parse_mtypes then list2_length as3_method_type_length ctx.as3_method_types + if parse_metadata then list2_length as3_metadata_length ctx.as3_metadatas + if parse_classes then list2_length as3_class_length ctx.as3_classes + if parse_statics then Array.fold_left (fun acc x -> acc + as3_static_length x) 0 ctx.as3_statics + if parse_inits then list2_length as3_static_length ctx.as3_inits + if parse_functions then list2_length as3_function_length ctx.as3_functions else 0 else 0 else 0 else 0 else 0 else 0 else 0 else 0 else 0 else 0 (* ************************************************************************ *) (* PARSING *) let read_as3_int ch = let a = IO.read_byte ch in if a < 128 then Int32.of_int a else let a = a land 127 in let b = IO.read_byte ch in if b < 128 then Int32.of_int ((b lsl 7) lor a) else let b = b land 127 in let c = IO.read_byte ch in if c < 128 then Int32.of_int ((c lsl 14) lor (b lsl 7) lor a) else let c = c land 127 in let d = IO.read_byte ch in if d < 128 then Int32.of_int ((d lsl 21) lor (c lsl 14) lor (b lsl 7) lor a) else let d = d land 127 in let e = IO.read_byte ch in if e > 15 then assert false; let small = Int32.of_int ((d lsl 21) lor (c lsl 14) lor (b lsl 7) lor a) in let big = Int32.shift_left (Int32.of_int e) 28 in Int32.logor big small let read_as3_uint ch = read_as3_int ch let read_int ch = Int32.to_int (read_as3_int ch) let read_ident ch = IO.nread ch (read_int ch) let read_namespace idents ch = let k = IO.read_byte ch in let p = index_opt idents (read_int ch) in match k with | 0x05 -> A3NPrivate p | 0x08 -> (match p with | None -> assert false | Some idx -> A3NNamespace idx) | 0x16 -> (match p with | None -> assert false | Some p when iget idents p = "" -> A3NPublic None | _ -> A3NPublic p) | 0x17 -> (match p with | None -> assert false | Some p when iget idents p = "" -> A3NInternal None | _ -> A3NInternal p) | 0x18 -> (match p with | None -> assert false | Some idx -> A3NProtected idx) | 0x19 -> (match p with | None -> assert false | Some idx -> A3NExplicit idx) | 0x1A -> A3NStaticProtected p | _ -> assert false let read_ns_set namespaces ch = let rec loop n = if n = 0 then [] else let r = index namespaces (read_int ch) in r :: loop (n - 1) in loop (IO.read_byte ch) let rec read_name ctx ?k ch = let k = (match k with None -> IO.read_byte ch | Some k -> k) in match k with | 0x07 -> let ns = index ctx.as3_namespaces (read_int ch) in let id = index ctx.as3_idents (read_int ch) in (* both ns and id can be 0 <=> '*' *) A3MName (id,ns) | 0x09 -> let id = index_opt ctx.as3_idents (read_int ch) in let ns = index ctx.as3_nsets (read_int ch) in A3MMultiName (id,ns) | 0x0D -> A3MAttrib (read_name ctx ~k:0x07 ch) | 0x0E -> A3MAttrib (read_name ctx ~k:0x09 ch) | 0x0F -> let id = index ctx.as3_idents (read_int ch) in A3MRuntimeName id | 0x10 -> A3MAttrib (read_name ctx ~k:0x0F ch) | 0x11 -> A3MRuntimeNameLate | 0x12 -> A3MAttrib (read_name ctx ~k:0x11 ch) | 0x1B -> let ns = index ctx.as3_nsets (read_int ch) in A3MMultiNameLate ns | 0x1C -> A3MAttrib (read_name ctx ~k:0x1B ch) | 0x1D -> let rec loop n = if n = 0 then [] else let name = magic_index (read_int ch) in name :: loop (n - 1) in let id = magic_index (read_int ch) in A3MParams (id,loop (IO.read_byte ch)) | n -> prerr_endline (string_of_int n); assert false let read_value ctx ch extra = let idx = read_int ch in if idx = 0 then begin if extra && IO.read_byte ch <> 0 then assert false; A3VNone end else match IO.read_byte ch with | 0x01 -> A3VString (index ctx.as3_idents idx) | 0x03 -> A3VInt (index ctx.as3_ints idx) | 0x04 -> A3VUInt (index ctx.as3_uints idx) | 0x06 -> A3VFloat (index ctx.as3_floats idx) | 0x08 | 0x16 | 0x17 | 0x18 | 0x19 | 0x1A | 0x05 as n-> A3VNamespace (n,index ctx.as3_namespaces idx) | 0x0A -> if idx <> 0x0A then assert false; A3VBool false | 0x0B -> if idx <> 0x0B then assert false; A3VBool true | 0x0C -> if idx <> 0x0C then assert false; A3VNull | _ -> assert false let read_method_type ctx ch = let nargs = IO.read_byte ch in let tret = index_opt ctx.as3_names (read_int ch) in let targs = Array.to_list (Array.init nargs (fun _ -> index_opt ctx.as3_names (read_int ch))) in let dname = index_opt ctx.as3_idents (read_int ch) in let flags = IO.read_byte ch in let dparams = (if flags land 0x08 <> 0 then Some (Array.to_list (Array.init (IO.read_byte ch) (fun _ -> read_value ctx ch true))) else None ) in let pnames = (if flags land 0x80 <> 0 then Some (Array.to_list (Array.init nargs (fun _ -> index_opt ctx.as3_idents (read_int ch)))) else None ) in { mt3_ret = tret; mt3_args = targs; mt3_var_args = flags land 0x04 <> 0; mt3_native = flags land 0x20 <> 0; mt3_new_block = flags land 0x02 <> 0; mt3_debug_name = dname; mt3_dparams = dparams; mt3_pnames = pnames; mt3_arguments_defined = flags land 0x01 <> 0; mt3_uses_dxns = flags land 0x40 <> 0; mt3_unused_flag = flags land 0x10 <> 0; } let read_list ch f = match read_int ch with | 0 -> [||] | n -> Array.init (n - 1) (fun _ -> f ch) let read_list2 ch f = Array.init (read_int ch) (fun _ -> f ch) let read_field ctx ch = let name = index ctx.as3_names (read_int ch) in let kind = IO.read_byte ch in let has_meta = kind land 0x40 <> 0 in let slot = read_int ch in let kind = (match kind land 0xF with | 0x00 | 0x06 -> let t = index_opt ctx.as3_names (read_int ch) in let value = read_value ctx ch false in A3FVar { v3_type = t; v3_value = value; v3_const = kind = 0x06; } | 0x02 | 0x03 | 0x01 -> let meth = index_nz ctx.as3_method_types (read_int ch) in let final = kind land 0x10 <> 0 in let override = kind land 0x20 <> 0 in A3FMethod { m3_type = meth; m3_final = final; m3_override = override; m3_kind = (match kind land 0xF with 0x01 -> MK3Normal | 0x02 -> MK3Getter | 0x03 -> MK3Setter | _ -> assert false); } | 0x04 -> let c = index_nz ctx.as3_classes (read_int ch) in A3FClass c | 0x05 -> let f = index_nz ctx.as3_method_types (read_int ch) in A3FFunction f | _ -> assert false ) in let metas = (if has_meta then Some (read_list2 ch (fun _ -> index_nz ctx.as3_metadatas (read_int ch))) else None ) in { f3_name = name; f3_slot = slot; f3_kind = kind; f3_metas = metas; } let read_class ctx ch = let name = index ctx.as3_names (read_int ch) in let csuper = index_opt ctx.as3_names (read_int ch) in let flags = IO.read_byte ch in let namespace = if flags land 8 <> 0 then let r = index ctx.as3_namespaces (read_int ch) in Some r else None in let impls = read_list2 ch (fun _ -> index ctx.as3_names (read_int ch)) in let construct = index_nz ctx.as3_method_types (read_int ch) in let fields = read_list2 ch (read_field ctx) in { cl3_name = name; cl3_super = csuper; cl3_sealed = (flags land 1) <> 0; cl3_final = (flags land 2) <> 0; cl3_interface = (flags land 4) <> 0; cl3_namespace = namespace; cl3_implements = impls; cl3_construct = construct; cl3_fields = fields; } let read_static ctx ch = let meth = index_nz ctx.as3_method_types (read_int ch) in let fields = read_list2 ch (read_field ctx) in { st3_method = meth; st3_fields = fields; } let read_metadata ctx ch = let name = index ctx.as3_idents (read_int ch) in let data = read_list2 ch (fun _ -> index_opt ctx.as3_idents (read_int ch)) in let data = Array.map (fun i1 -> i1 , index ctx.as3_idents (read_int ch)) data in { meta3_name = name; meta3_data = data; } let read_try_catch ctx ch = let start = read_int ch in let pend = read_int ch in let handle = read_int ch in let t = index_opt ctx.as3_names (read_int ch) in let name = index_opt ctx.as3_names (read_int ch) in { tc3_start = start; tc3_end = pend; tc3_handle = handle; tc3_type = t; tc3_name = name; } let read_function ctx ch = let id = index_nz ctx.as3_method_types (read_int ch) in let ss = read_int ch in let nregs = read_int ch in let init_scope = read_int ch in let max_scope = read_int ch in let size = read_int ch in let code = if parse_bytecode then As3code.parse ch size else Array.init size (fun _ -> A3Unk (IO.read ch)) in let trys = read_list2 ch (read_try_catch ctx) in let local_funs = read_list2 ch (read_field ctx) in { fun3_id = id; fun3_stack_size = ss; fun3_nregs = nregs; fun3_init_scope = init_scope; fun3_max_scope = max_scope; fun3_code = code; fun3_trys = trys; fun3_locals = local_funs; } let header_magic = 0x002E0010 let parse ch len = let data = IO.nread ch len in let ch = IO.input_string data in if IO.read_i32 ch <> header_magic then assert false; let ints = read_list ch read_as3_int in let uints = read_list ch read_as3_uint in let floats = read_list ch IO.read_double in let idents = (if parse_idents then read_list ch read_ident else [||]) in let namespaces = (if parse_namespaces then read_list ch (read_namespace idents) else [||]) in let nsets = (if parse_ns_sets then read_list ch (read_ns_set namespaces) else [||]) in let ctx = { as3_ints = ints; as3_uints = uints; as3_floats = floats; as3_idents = idents; as3_namespaces = namespaces; as3_nsets = nsets; as3_names = [||]; as3_method_types = [||]; as3_metadatas = [||]; as3_classes = [||]; as3_statics = [||]; as3_inits = [||]; as3_functions = [||]; as3_unknown = ""; } in if parse_names then ctx.as3_names <- read_list ch (read_name ctx); if parse_mtypes then ctx.as3_method_types <- read_list2 ch (read_method_type ctx); if parse_metadata then ctx.as3_metadatas <- read_list2 ch (read_metadata ctx); if parse_classes then ctx.as3_classes <- read_list2 ch (read_class ctx); if parse_statics then ctx.as3_statics <- Array.map (fun _ -> read_static ctx ch) ctx.as3_classes; if parse_inits then ctx.as3_inits <- read_list2 ch (read_static ctx); if parse_functions then ctx.as3_functions <- read_list2 ch (read_function ctx); ctx.as3_unknown <- IO.read_all ch; if parse_functions && String.length ctx.as3_unknown <> 0 then assert false; let len2 = as3_length ctx in if len2 <> len then begin Printf.printf "%d != %d" len len2; assert false; end; ctx (* ************************************************************************ *) (* WRITING *) let write_as3_int ch i = let e = Int32.to_int (Int32.shift_right_logical i 28) in let d = Int32.to_int (Int32.shift_right i 21) land 0x7F in let c = Int32.to_int (Int32.shift_right i 14) land 0x7F in let b = Int32.to_int (Int32.shift_right i 7) land 0x7F in let a = Int32.to_int (Int32.logand i 0x7Fl) in if b <> 0 || c <> 0 || d <> 0 || e <> 0 then begin IO.write_byte ch (a lor 0x80); if c <> 0 || d <> 0 || e <> 0 then begin IO.write_byte ch (b lor 0x80); if d <> 0 || e <> 0 then begin IO.write_byte ch (c lor 0x80); if e <> 0 then begin IO.write_byte ch (d lor 0x80); IO.write_byte ch e; end else IO.write_byte ch d; end else IO.write_byte ch c; end else IO.write_byte ch b; end else IO.write_byte ch a let write_as3_uint = write_as3_int let write_int ch i = write_as3_int ch (Int32.of_int i) let write_index ch n = write_int ch (index_int n) let write_index_nz ch n = write_int ch (index_nz_int n) let write_index_opt ch = function | None -> write_int ch 0 | Some n -> write_index ch n let write_as3_ident ch id = write_int ch (String.length id); IO.nwrite ch id let write_namespace empty_index ch = function | A3NPrivate n -> IO.write_byte ch 0x05; (match n with | None -> write_int ch 0 | Some n -> write_index ch n); | A3NPublic n -> IO.write_byte ch 0x16; (match n with | None -> write_index ch empty_index | Some n -> write_index ch n); | A3NInternal n -> IO.write_byte ch 0x17; (match n with | None -> write_index ch empty_index | Some n -> write_index ch n); | A3NProtected n -> IO.write_byte ch 0x18; write_index ch n | A3NNamespace n -> IO.write_byte ch 0x08; write_index ch n | A3NExplicit n -> IO.write_byte ch 0x19; write_index ch n | A3NStaticProtected n -> IO.write_byte ch 0x1A; (match n with | None -> write_int ch 0 | Some n -> write_index ch n) let write_rights ch l = IO.write_byte ch (List.length l); List.iter (write_index ch) l let rec write_name ch ?k x = let b n = match k with None -> n | Some v -> v in match x with | A3MMultiName (id,r) -> IO.write_byte ch (b 0x09); write_index_opt ch id; write_index ch r; | A3MName (id,r) -> IO.write_byte ch (b 0x07); write_index ch r; write_index ch id | A3MRuntimeName i -> IO.write_byte ch (b 0x0F); write_index ch i | A3MRuntimeNameLate -> IO.write_byte ch (b 0x11); | A3MMultiNameLate id -> IO.write_byte ch (b 0x1B); write_index ch id | A3MAttrib n -> write_name ch ~k:(match n with | A3MName _ -> 0x0D | A3MMultiName _ -> 0x0E | A3MRuntimeName _ -> 0x10 | A3MRuntimeNameLate -> 0x12 | A3MMultiNameLate _ -> 0x1C | A3MAttrib _ | A3MParams _ -> assert false ) n | A3MParams (id,pl) -> IO.write_byte ch (b 0x1D); write_index ch id; IO.write_byte ch (List.length pl); List.iter (write_index ch) pl let write_value ch extra v = match v with | A3VNone -> IO.write_byte ch 0x00; if extra then IO.write_byte ch 0x00; | A3VNull -> IO.write_byte ch 0x0C; IO.write_byte ch 0x0C; | A3VBool b -> IO.write_byte ch (if b then 0x0B else 0x0A); IO.write_byte ch (if b then 0x0B else 0x0A); | A3VString s -> write_index ch s; IO.write_byte ch 0x01; | A3VInt s -> write_index ch s; IO.write_byte ch 0x03; | A3VUInt s -> write_index ch s; IO.write_byte ch 0x04; | A3VFloat s -> write_index ch s; IO.write_byte ch 0x06 | A3VNamespace (n,s) -> write_index ch s; IO.write_byte ch n let write_method_type ch m = let nargs = List.length m.mt3_args in IO.write_byte ch nargs; write_index_opt ch m.mt3_ret; List.iter (write_index_opt ch) m.mt3_args; write_index_opt ch m.mt3_debug_name; let flags = (if m.mt3_arguments_defined then 0x01 else 0) lor (if m.mt3_new_block then 0x02 else 0) lor (if m.mt3_var_args then 0x04 else 0) lor (if m.mt3_dparams <> None then 0x08 else 0) lor (if m.mt3_unused_flag then 0x10 else 0) lor (if m.mt3_native then 0x20 else 0) lor (if m.mt3_uses_dxns then 0x40 else 0) lor (if m.mt3_pnames <> None then 0x80 else 0) in IO.write_byte ch flags; (match m.mt3_dparams with | None -> () | Some l -> IO.write_byte ch (List.length l); List.iter (write_value ch true) l); match m.mt3_pnames with | None -> () | Some l -> if List.length l <> nargs then assert false; List.iter (write_index_opt ch) l let write_list ch f l = match Array.length l with | 0 -> IO.write_byte ch 0 | n -> write_int ch (n + 1); Array.iter (f ch) l let write_list2 ch f l = write_int ch (Array.length l); Array.iter (f ch) l let write_field ch f = write_index ch f.f3_name; let flags = (if f.f3_metas <> None then 0x40 else 0) in (match f.f3_kind with | A3FMethod m -> let base = (match m.m3_kind with MK3Normal -> 0x01 | MK3Getter -> 0x02 | MK3Setter -> 0x03) in let flags = flags lor (if m.m3_final then 0x10 else 0) lor (if m.m3_override then 0x20 else 0) in IO.write_byte ch (base lor flags); write_int ch f.f3_slot; write_index_nz ch m.m3_type; | A3FClass c -> IO.write_byte ch (0x04 lor flags); write_int ch f.f3_slot; write_index_nz ch c | A3FFunction i -> IO.write_byte ch (0x05 lor flags); write_int ch f.f3_slot; write_index_nz ch i | A3FVar v -> IO.write_byte ch (flags lor (if v.v3_const then 0x06 else 0x00)); write_int ch f.f3_slot; write_index_opt ch v.v3_type; write_value ch false v.v3_value); match f.f3_metas with | None -> () | Some l -> write_list2 ch write_index_nz l let write_class ch c = write_index ch c.cl3_name; write_index_opt ch c.cl3_super; let flags = (if c.cl3_sealed then 1 else 0) lor (if c.cl3_final then 2 else 0) lor (if c.cl3_interface then 4 else 0) lor (if c.cl3_namespace <> None then 8 else 0) in IO.write_byte ch flags; (match c.cl3_namespace with | None -> () | Some r -> write_index ch r); write_list2 ch write_index c.cl3_implements; write_index_nz ch c.cl3_construct; write_list2 ch write_field c.cl3_fields let write_static ch s = write_index_nz ch s.st3_method; write_list2 ch write_field s.st3_fields let write_metadata ch m = write_index ch m.meta3_name; write_list2 ch (fun _ (i1,_) -> write_index_opt ch i1) m.meta3_data; Array.iter (fun (_,i2) -> write_index ch i2) m.meta3_data let write_try_catch ch t = write_int ch t.tc3_start; write_int ch t.tc3_end; write_int ch t.tc3_handle; write_index_opt ch t.tc3_type; write_index_opt ch t.tc3_name let write_function ch f = write_index_nz ch f.fun3_id; write_int ch f.fun3_stack_size; write_int ch f.fun3_nregs; write_int ch f.fun3_init_scope; write_int ch f.fun3_max_scope; let clen = Array.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in write_int ch clen; Array.iter (As3code.write ch) f.fun3_code; write_list2 ch write_try_catch f.fun3_trys; write_list2 ch write_field f.fun3_locals let write ch1 ctx = let ch = IO.output_string() in let empty_index = as3_empty_index ctx in IO.write_i32 ch header_magic; write_list ch write_as3_int ctx.as3_ints; write_list ch write_as3_uint ctx.as3_uints; write_list ch IO.write_double ctx.as3_floats; if parse_idents then write_list ch write_as3_ident ctx.as3_idents; if parse_namespaces then write_list ch (write_namespace empty_index) ctx.as3_namespaces; if parse_ns_sets then write_list ch write_rights ctx.as3_nsets; if parse_names then write_list ch (write_name ?k:None) ctx.as3_names; if parse_mtypes then write_list2 ch write_method_type ctx.as3_method_types; if parse_metadata then write_list2 ch write_metadata ctx.as3_metadatas; if parse_classes then write_list2 ch write_class ctx.as3_classes; if parse_statics then Array.iter (write_static ch) ctx.as3_statics; if parse_inits then write_list2 ch write_static ctx.as3_inits; if parse_functions then write_list2 ch write_function ctx.as3_functions; IO.nwrite ch ctx.as3_unknown; let str = IO.close_out ch in IO.nwrite ch1 str (* ************************************************************************ *) (* DUMP *) let dump_code_size = ref true let ident_str ctx i = iget ctx.as3_idents i let namespace_str ctx i = match iget ctx.as3_namespaces i with | A3NPrivate None -> "private" | A3NPrivate (Some n) -> "private:" ^ ident_str ctx n | A3NPublic None -> "public" | A3NPublic (Some n) -> "public:" ^ ident_str ctx n | A3NInternal None -> "internal" | A3NInternal (Some n) -> "internal:" ^ ident_str ctx n | A3NProtected n -> "protected:" ^ ident_str ctx n | A3NExplicit n -> "explicit:" ^ ident_str ctx n | A3NStaticProtected None -> "static_protected" | A3NStaticProtected (Some n) -> "static_protectec:" ^ ident_str ctx n | A3NNamespace n -> "namespace:" ^ ident_str ctx n let ns_set_str ctx i = let l = iget ctx.as3_nsets i in String.concat " " (List.map (fun r -> namespace_str ctx r) l) let rec name_str ctx kind t = let rec loop = function | A3MName (id,r) -> Printf.sprintf "%s %s%s" (namespace_str ctx r) kind (ident_str ctx id) | A3MMultiName (id,r) -> Printf.sprintf "[%s %s%s]" (ns_set_str ctx r) kind (match id with None -> "NO" | Some i -> ident_str ctx i) | A3MRuntimeName id -> Printf.sprintf "'%s'" (ident_str ctx id) | A3MRuntimeNameLate -> "RTLATE" | A3MMultiNameLate id -> Printf.sprintf "late:(%s)" (ns_set_str ctx id) | A3MAttrib n -> "attrib " ^ loop n | A3MParams (id,pl) -> Printf.sprintf "%s<%s>" (name_str ctx kind id) (String.concat "," (List.map (name_str ctx kind) pl)) in loop (iget ctx.as3_names t) let value_str ctx v = match v with | A3VNone -> "" | A3VNull -> "null" | A3VString s -> "\"" ^ ident_str ctx s ^ "\"" | A3VBool b -> if b then "true" else "false" | A3VInt s -> Printf.sprintf "%ld" (iget ctx.as3_ints s) | A3VUInt s -> Printf.sprintf "%ld" (iget ctx.as3_uints s) | A3VFloat s -> Printf.sprintf "%f" (iget ctx.as3_floats s) | A3VNamespace (_,s) -> "ns::" ^ namespace_str ctx s let metadata_str ctx i = let m = iget ctx.as3_metadatas i in let data = List.map (fun (i1,i2) -> Printf.sprintf "%s=\"%s\"" (match i1 with None -> "NO" | Some i -> ident_str ctx i) (ident_str ctx i2)) (Array.to_list m.meta3_data) in Printf.sprintf "%s(%s)" (ident_str ctx m.meta3_name) (String.concat ", " data) let method_str ?(infos=false) ctx m = let m = iget ctx.as3_method_types m in let pcount = ref 0 in Printf.sprintf "%s(%s%s)%s" (if m.mt3_native then " native " else "") (String.concat ", " (List.map (fun a -> let id = (match m.mt3_pnames with | None -> "p" ^ string_of_int !pcount | Some l -> match List.nth l !pcount with | None -> "p" ^ string_of_int !pcount | Some i -> ident_str ctx i ) in let p = (match a with None -> id | Some t -> name_str ctx (id ^ " : ") t) in let p = (match m.mt3_dparams with | None -> p | Some l -> let vargs = List.length m.mt3_args - List.length l in if !pcount >= vargs then let v = List.nth l (!pcount - vargs) in p ^ " = " ^ value_str ctx v else p ) in incr pcount; p ) m.mt3_args)) (if m.mt3_var_args then " ..." else "") (match m.mt3_ret with None -> "" | Some t -> " : " ^ name_str ctx "" t) ^ (if infos then begin let name = (match m.mt3_debug_name with None -> "" | Some idx -> Printf.sprintf " '%s'" (ident_str ctx idx)) in Printf.sprintf "%s blk:%b args:%b dxns:%b%s" name m.mt3_new_block m.mt3_arguments_defined m.mt3_uses_dxns (if m.mt3_unused_flag then " SPECIAL-FLAG" else "") end else "") let dump_field ctx ch stat f = (* (match f.f3_metas with | None -> () | Some l -> Array.iter (fun i -> IO.printf ch " [%s]\n" (metadata_str ctx (no_nz i))) l); *) IO.printf ch " "; if stat then IO.printf ch "static "; (match f.f3_kind with | A3FVar v -> IO.printf ch "%s" (name_str ctx (if v.v3_const then "const " else "var ") f.f3_name); (match v.v3_type with | None -> () | Some id -> IO.printf ch " : %s" (name_str ctx "" id)); if v.v3_value <> A3VNone then IO.printf ch " = %s" (value_str ctx v.v3_value); | A3FClass c -> let c = iget ctx.as3_classes (no_nz c) in IO.printf ch "%s = %s" (name_str ctx "CLASS " c.cl3_name) (name_str ctx "class " f.f3_name); | A3FFunction id -> IO.printf ch "%s = %s" (method_str ~infos:false ctx (no_nz id)) (name_str ctx "method " f.f3_name); | A3FMethod m -> if m.m3_final then IO.printf ch "final "; if m.m3_override then IO.printf ch "override "; let k = "function " ^ (match m.m3_kind with | MK3Normal -> "" | MK3Getter -> "get " | MK3Setter -> "set " ) in IO.printf ch "%s%s #%d" (name_str ctx k f.f3_name) (method_str ctx (no_nz m.m3_type)) (index_nz_int m.m3_type); ); if f.f3_slot <> 0 then IO.printf ch " = [SLOT:%d]" f.f3_slot; IO.printf ch ";\n" let dump_class ctx ch idx c = let st = if parse_statics then ctx.as3_statics.(idx) else { st3_method = magic_index_nz (-1); st3_fields = [||] } in if not c.cl3_sealed then IO.printf ch "dynamic "; if c.cl3_final then IO.printf ch "final "; (match c.cl3_namespace with | None -> () | Some r -> IO.printf ch "%s " (namespace_str ctx r)); let kind = (if c.cl3_interface then "interface " else "class ") in IO.printf ch "%s " (name_str ctx kind c.cl3_name); (match c.cl3_super with | None -> () | Some s -> IO.printf ch "extends %s " (name_str ctx "" s)); (match Array.to_list c.cl3_implements with | [] -> () | l -> IO.printf ch "implements %s " (String.concat ", " (List.map (fun i -> name_str ctx "" i) l))); IO.printf ch "{\n"; Array.iter (dump_field ctx ch false) c.cl3_fields; Array.iter (dump_field ctx ch true) st.st3_fields; IO.printf ch "} constructor#%d statics#%d\n\n" (index_nz_int c.cl3_construct) (index_nz_int st.st3_method) let dump_init ctx ch idx s = IO.printf ch "init #%d {\n" (index_nz_int s.st3_method); Array.iter (dump_field ctx ch false) s.st3_fields; IO.printf ch "}\n\n" let dump_try_catch ctx ch t = IO.printf ch " try %d %d %d (%s) (%s)\n" t.tc3_start t.tc3_end t.tc3_handle (match t.tc3_type with None -> "*" | Some idx -> name_str ctx "" idx) (match t.tc3_name with None -> "NO" | Some idx -> name_str ctx "" idx) let dump_function ctx ch idx f = IO.printf ch "function #%d %s\n" (index_nz_int f.fun3_id) (method_str ~infos:true ctx (no_nz f.fun3_id)); IO.printf ch " stack:%d nregs:%d scope:%d-%d\n" f.fun3_stack_size f.fun3_nregs f.fun3_init_scope f.fun3_max_scope; Array.iter (dump_field ctx ch false) f.fun3_locals; Array.iter (dump_try_catch ctx ch) f.fun3_trys; let pos = ref 0 in Array.iter (fun op -> IO.printf ch "%4d %s\n" !pos (As3code.dump ctx op); if !dump_code_size then pos := !pos + As3code.length op else incr pos; ) f.fun3_code; IO.printf ch "\n" let dump_ident ctx ch idx _ = IO.printf ch "I%d = %s\n" (idx + 1) (ident_str ctx (index ctx.as3_idents (idx + 1))) let dump_namespace ctx ch idx _ = IO.printf ch "N%d = %s\n" (idx + 1) (namespace_str ctx (index ctx.as3_namespaces (idx + 1))) let dump_ns_set ctx ch idx _ = IO.printf ch "S%d = %s\n" (idx + 1) (ns_set_str ctx (index ctx.as3_nsets (idx + 1))) let dump_name ctx ch idx _ = IO.printf ch "T%d = %s\n" (idx + 1) (name_str ctx "" (index ctx.as3_names (idx + 1))) let dump_method_type ctx ch idx _ = IO.printf ch "M%d = %s\n" (idx + 1) (method_str ~infos:true ctx (index ctx.as3_method_types (idx + 1))) let dump_metadata ctx ch idx _ = IO.printf ch "D%d = %s\n" (idx + 1) (metadata_str ctx (index ctx.as3_metadatas (idx + 1))) let dump_int ctx ch idx i = IO.printf ch "INT %d = 0x%lX\n" (idx + 1) i let dump_float ctx ch idx f = IO.printf ch "FLOAT %d = %f\n" (idx + 1) f let dump ch ctx id = (match id with | None -> IO.printf ch "\n---------------- AS3 -------------------------\n\n"; | Some (id,f) -> IO.printf ch "\n---------------- AS3 %s [%d] -----------------\n\n" f id); (* Array.iteri (dump_int ctx ch) ctx.as3_ints; Array.iteri (dump_float ctx ch) ctx.as3_floats; Array.iteri (dump_ident ctx ch) ctx.as3_idents; IO.printf ch "\n"; Array.iteri (dump_namespace ctx ch) ctx.as3_namespaces; IO.printf ch "\n"; Array.iteri (dump_ns_set ctx ch) ctx.as3_nsets; IO.printf ch "\n"; Array.iteri (dump_name ctx ch) ctx.as3_names; IO.printf ch "\n"; *) (* Array.iteri (dump_metadata ctx ch) ctx.as3_metadatas; *) Array.iteri (dump_class ctx ch) ctx.as3_classes; Array.iteri (dump_init ctx ch) ctx.as3_inits; Array.iteri (dump_function ctx ch) ctx.as3_functions; IO.printf ch "\n" ;; As3code.f_int_length := int_length; As3code.f_int_read := read_int; As3code.f_int_write := write_int; mtasc-1.14/ocaml/swflib/swf.ml0000640000175000017500000002652611041363545014725 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type float16 = int type unknown = string type action_count = int type rgb = { cr : int; cg : int; cb : int; } type rgba = { r : int; g : int; b : int; a : int; } type color = | ColorRGB of rgb | ColorRGBA of rgba type gradient = | GradientRGB of ((int * rgb) list * int) | GradientRGBA of ((int * rgba) list * int) type rect = { rect_nbits : int; left : int; right : int; top : int; bottom : int; } type big_rect = { brect_nbits : int; bleft : int list; bright : int list; btop : int list; bbottom : int list; } type matrix_part = { m_nbits : int; mx : int; my : int; } type matrix = { scale : matrix_part option; rotate : matrix_part option; trans : matrix_part; } type color_transform_alpha = { cxa_nbits : int; cxa_add : rgba option; cxa_mult : rgba option; } type function_decl = { f_name : string; f_args : string list; mutable f_codelen : action_count; } type func2_flags = | ThisRegister | ThisNoVar | ArgumentsRegister | ArgumentsNoVar | SuperRegister | SuperNoVar | RootRegister | ParentRegister | GlobalRegister type function_decl2 = { f2_name : string; f2_flags : func2_flags list; f2_args : (int * string) list; mutable f2_nregs : int; mutable f2_codelen : action_count; } type try_style = | TryRegister of int | TryVariable of string type try_block = { tr_style : try_style; mutable tr_trylen : action_count; mutable tr_catchlen : action_count option; mutable tr_finallylen : action_count option } type push_item = | PString of string | PFloat of int32 | PNull | PUndefined | PReg of int | PBool of bool | PDouble of float | PInt of int32 | PStack of int | PStack2 of int type property = | PX | PY | PXScale | PYScale | PCurrentFrame | PTotalFrames | PAlpha | PVisible | PWidth | PHeight | PRotation | PTarget | PFramesLoaded | PName | PDropTarget | PUrl | PHighQuality | PFocusRect | PSoundBufTime | PQuality | PXMouse | PYMouse type action = | AEnd | ANextFrame | APrevFrame | APlay | AStop | AToggleHighQuality | AStopSounds | AAddNum | ASubtract | AMultiply | ADivide | ACompareNum | AEqualNum | ALogicalAnd | ALogicalOr | ANot | AStringEqual | AStringLength | ASubString | APop | AToInt | AEval | ASet | ATellTarget | AStringAdd | AGetProperty | ASetProperty | ADuplicateMC | ARemoveMC | ATrace | AStartDrag | AStopDrag | AThrow | ACast | AImplements | AFSCommand2 | ARandom | AMBStringLength | AOrd | AChr | AGetTimer | AMBStringSub | AMBOrd | AMBChr | ADeleteObj | ADelete | ALocalAssign | ACall | AReturn | AMod | ANew | ALocalVar | AInitArray | AObject | ATypeOf | ATargetPath | AEnum | AAdd | ACompare | AEqual | AToNumber | AToString | ADup | ASwap | AObjGet | AObjSet | AIncrement | ADecrement | AObjCall | ANewMethod | AInstanceOf | AEnum2 | AAnd | AOr | AXor | AShl | AShr | AAsr | APhysEqual | AGreater | AStringGreater | AExtends | AGotoFrame of int | AGetURL of string * string | ASetReg of int | AStringPool of string list | AWaitForFrame of int * int | ASetTarget of string | AGotoLabel of string | AWaitForFrame2 of int | AFunction2 of function_decl2 | ATry of try_block | AWith of int | APush of push_item list | AJump of action_count | AGetURL2 of int | AFunction of function_decl | ACondJump of action_count | ACallFrame (* no data *) | AGotoFrame2 of bool * int option | AUnknown of int * unknown type actions = action DynArray.t type header = { mutable h_version : int; mutable h_size : rect; mutable h_fps : float16; mutable h_frame_count : int; mutable h_compressed : bool; } type export = { mutable exp_id : int; exp_name : string; } type do_init_action = { mutable dia_id : int; dia_actions : actions; } type sound = { mutable so_id : int; so_flags : int; so_samples : int; so_data : unknown; } type start_sound = { mutable sts_id : int; sts_data : unknown; } type sfs_bitmap = { sfb_repeat : bool; sfb_smooth : bool; mutable sfb_cid : int; sfb_mpos : matrix; } type shape_fill_style = | SFSSolid of rgb | SFSSolid3 of rgba | SFSLinearGradient of matrix * gradient | SFSRadialGradient of matrix * gradient * int option | SFSBitmap of sfs_bitmap type shape_line_style = { sls_width : int; sls_color : color; sls_flags : int option; sls_fill : shape_fill_style option; sls_miter : int option; } type shape_new_styles = { sns_fill_styles : shape_fill_style list; sns_line_styles : shape_line_style list; sns_nlbits : int; sns_nfbits : int; } type shape_change_style_record = { scsr_move : (int * int * int) option; scsr_fs0 : int option; scsr_fs1 : int option; scsr_ls : int option; scsr_new_styles : shape_new_styles option; } type shape_curved_edge_record = { scer_nbits : int; scer_cx : int; scer_cy : int; scer_ax : int; scer_ay : int; } type shape_straight_edge_record = { sser_nbits : int; sser_line : int option * int option; } type shape_record = | SRStyleChange of shape_change_style_record | SRCurvedEdge of shape_curved_edge_record | SRStraightEdge of shape_straight_edge_record type shape_records = { srs_nlbits : int; srs_nfbits : int; srs_records : shape_record list; } type shape_with_style = { sws_fill_styles : shape_fill_style list; sws_line_styles : shape_line_style list; sws_records : shape_records; } type shape = { mutable sh_id : int; sh_bounds : rect; sh_bounds2 : (rect * int) option; sh_style : shape_with_style; } type filter_gradient = { fgr_colors : (rgba * int) list; fgr_data : unknown; } type filter = | FDropShadow of unknown | FBlur of unknown | FGlow of unknown | FBevel of unknown | FGradientGlow of filter_gradient | FAdjustColor of unknown | FGradientBevel of filter_gradient type bitmap_jpg = { mutable jpg_id : int; jpg_data : string; } type bitmap_jpg2 = { mutable jp2_id : int; jp2_table : string; jp2_data : string; } type bitmap_jpg3 = { mutable jp3_id : int; jp3_table : string; jp3_data : string; jp3_alpha_data : string; } type bitmap_lossless = { mutable bll_id : int; bll_format : int; bll_width : int; bll_height : int; bll_data : unknown; } type morph_shape = { mutable msh_id : int; msh_start_bounds : rect; msh_end_bounds : rect; msh_data : unknown; } type font2 = { mutable ft2_id : int; ft2_data : unknown; } type font3 = { mutable ft3_id : int; ft3_data : unknown; } type font_glyphs = { mutable fgl_id : int; fgl_data : unknown; } type text_glyph = { txg_index : int; txg_advanced : int; } type text_record = { mutable txr_font : (int * int) option; txr_color : color option; txr_dx : int option; txr_dy : int option; txr_glyphs : text_glyph list; } type text = { mutable txt_id : int; txt_bounds : big_rect; txt_matrix : matrix; txt_ngbits : int; txt_nabits : int; txt_records : text_record list; } type button_record = { btr_flags : int; mutable btr_cid : int; btr_depth : int; btr_mpos : matrix; btr_color : color_transform_alpha option; btr_filters : filter list option; } type button_action = { bta_flags : int; bta_actions : actions; } type button2 = { mutable bt2_id : int; bt2_track_as_menu : bool; bt2_records : button_record list; bt2_actions : button_action list; } type remove_object = { mutable rmo_id : int; rmo_depth : int; } type edit_text_layout = { edtl_align : int; edtl_left_margin : int; edtl_right_margin : int; edtl_indent : int; edtl_leading : int; } type edit_text = { mutable edt_id : int; edt_bounds : rect; mutable edt_font : (int * int) option; edt_color : rgba option; edt_maxlen : int option; edt_layout : edit_text_layout option; edt_variable : string; edt_text : string option; edt_wordwrap : bool; edt_multiline : bool; edt_password : bool; edt_readonly : bool; edt_autosize : bool; edt_noselect : bool; edt_border : bool; edt_html : bool; edt_outlines : bool; } type f9class = { mutable f9_cid : int option; f9_classname : string; } type sandbox = | SBLocal | SBNetwork | SBUnknown of int type tag_data = | TEnd | TShowFrame | TShape of shape | TRemoveObject of remove_object | TBitsJPEG of bitmap_jpg | TJPEGTables of string | TSetBgColor of rgb | TText of text | TDoAction of actions | TSound of sound | TStartSound of start_sound | TBitsLossless of bitmap_lossless | TBitsJPEG2 of bitmap_jpg2 | TShape2 of shape | TProtect | TPlaceObject2 of place_object | TRemoveObject2 of int | TShape3 of shape | TText2 of text | TButton2 of button2 | TBitsJPEG3 of bitmap_jpg3 | TBitsLossless2 of bitmap_lossless | TEditText of edit_text | TClip of clip | TProductInfo of unknown | TFrameLabel of string * char option | TSoundStreamHead2 of unknown | TMorphShape of morph_shape | TFont2 of font2 | TExport of export list | TDoInitAction of do_init_action | TVideoStream of unknown | TVideoFrame of unknown | TDebugID of unknown | TEnableDebugger2 of int * string | TScriptLimits of int * int | TSandbox of sandbox | TPlaceObject3 of place_object | TFontGlyphs of font_glyphs | TTextInfo of unknown | TFont3 of font3 | TF9Classes of f9class list | TMetaData of string | TActionScript3 of (int * string) option * As3.as3_tag | TShape4 of shape | TShape5 of int * string | TF9Scene of string | TUnknown of int * unknown and tag = { mutable tid : int; mutable textended : bool; mutable tdata : tag_data; } and clip_event = { cle_events : int; cle_key : char option; cle_actions : actions; } and place_object = { po_depth : int; po_move : bool; mutable po_cid : int option; po_matrix : matrix option; po_color : color_transform_alpha option; po_ratio : float16 option; po_inst_name : string option; po_clip_depth : int option; po_events : clip_event list option; po_filters : filter list option; po_blend : int option; po_bcache : int option; } and clip = { mutable c_id : int; c_frame_count : int; c_tags : tag list; } type swf = header * tag list let __deflate = ref (fun (_:unit IO.output) -> assert false) let __inflate = ref (fun _ -> assert false) let __parser = ref (fun _ -> assert false) let __printer = ref (fun (_:unit IO.output) _ -> ()) exception Error of string let error msg = raise (Error msg) let warnings = ref true let to_float16 f = let sign , f = (if f < 0. then true , 0. -. f else false , f) in let high = int_of_float f in let low = int_of_float ((f -. (float high)) *. 256.) in if high > 127 then failwith "to_float16"; (high lsl 8) lor (if sign then low lor (1 lsl 15) else low) let parse (ch : IO.input) = (!__parser ch : swf) let write (ch : 'a IO.output) (data : swf) = !__printer (Obj.magic ch) data let deflate (ch : 'a IO.output) = (Obj.magic (!__deflate (Obj.magic ch) : unit IO.output) : 'a IO.output) let inflate (ch : IO.input) = (!__inflate ch : IO.input) mtasc-1.14/ocaml/swflib/png.mli0000640000175000017500000000414310242776216015057 0ustar pabspabs(* * PNG File Format Library * Copyright (c)2005 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type grey_bits = | GBits1 | GBits2 | GBits4 | GBits8 | GBits16 type grey_alpha_bits = | GABits8 | GABits16 type true_bits = | TBits8 | TBits16 type index_bits = | IBits1 | IBits2 | IBits4 | IBits8 type alpha = | NoAlpha | HaveAlpha type color = | ClGreyScale of grey_bits | ClGreyAlpha of grey_alpha_bits | ClTrueColor of true_bits * alpha | ClIndexed of index_bits type header = { png_width : int; png_height : int; png_color : color; png_interlace : bool; } type chunk_id = string type chunk = | CEnd | CHeader of header | CData of string | CPalette of string | CUnknown of chunk_id * string type png = chunk list type error_msg = | Invalid_header | Invalid_file | Truncated_file | Invalid_CRC | Invalid_colors | Unsupported_colors | Invalid_datasize | Invalid_filter of int | Invalid_array exception Error of error_msg val error_msg : error_msg -> string val is_critical : chunk_id -> bool val is_public : chunk_id -> bool val is_reseverd : chunk_id -> bool val is_safe_to_copy : chunk_id -> bool val header : png -> header val data : png -> string val color_bits : color -> int val parse : IO.input -> png val write : 'a IO.output -> png -> unit val filter : png -> string -> string val make : width:int -> height:int -> pixel:(int -> int -> int32) -> compress:(string -> string) -> png mtasc-1.14/ocaml/swflib/as3code.ml0000640000175000017500000005341011111342565015434 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2004-2006 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open IO open As3 let s = Printf.sprintf let f_int_length : (int -> int) ref = ref (fun _ -> assert false) let f_int_read : (IO.input -> int) ref = ref (fun _ -> assert false) let f_int_write : (unit IO.output -> int -> unit) ref = ref (fun _ _ -> assert false) let int_length i = (!f_int_length) i let read_int ch = (!f_int_read) ch let write_int (ch : 'a IO.output) i = (!f_int_write) (Obj.magic ch) i let int_index (x : 'a index) : int = Obj.magic x let index_int (x : int) : 'a index = Obj.magic x let int_index_nz (x : 'a index_nz) : int = Obj.magic x let index_nz_int (x : int) : 'a index_nz = Obj.magic x let read_index ch = index_int (read_int ch) let write_index ch i = write_int ch (int_index i) let read_index_nz ch = index_nz_int (read_int ch) let write_index_nz ch i = write_int ch (int_index_nz i) let iget (t : 'a array) (i : 'a index) : 'a = t.(Obj.magic i - 1) let write_signed_byte = write_byte let max_i24 = 1 lsl 23 - 1 let read_i24 ch = let a = read_byte ch in let b = read_byte ch in let c = read_byte ch in let n = a lor (b lsl 8) lor (c lsl 16) in if c land 128 <> 0 then n - (1 lsl 24) else n let rec write_i24 ch n = if n < -max_i24 || n > max_i24 then assert false; let n = (if n land (1 lsl 23) <> 0 then n + (1 lsl 24) else n) in write_byte ch n; write_byte ch (n lsr 8); write_byte ch (n lsr 16) let ops , ops_ids = let h = Hashtbl.create 0 in let h2 = Hashtbl.create 0 in List.iter (fun (o,b) -> Hashtbl.add h b o; Hashtbl.add h2 o b) [ A3OAs, 0x87; A3ONeg, 0x90; A3OIncr, 0x91; (* 0x92 : REGINCR *) A3ODecr, 0x93; (* 0x94 : REGDECR *) (* 0x95 : TYPEOF *) A3ONot, 0x96; A3OBitNot, 0x97; A3OAdd, 0xA0; A3OSub, 0xA1; A3OMul, 0xA2; A3ODiv, 0xA3; A3OMod, 0xA4; A3OShl, 0xA5; A3OShr, 0xA6; A3OUShr, 0xA7; A3OAnd, 0xA8; A3OOr, 0xA9; A3OXor, 0xAA; A3OEq, 0xAB; A3OPhysEq, 0xAC; A3OLt, 0xAD; A3OLte, 0xAE; A3OGt, 0xAF; A3OGte, 0xB0; A3OIs, 0xB3; A3OIn, 0xB4; A3OIIncr, 0xC0; A3OIDecr, 0xC1; A3OINeg, 0xC4; A3OIAdd, 0xC5; A3OISub, 0xC6; A3OIMul, 0xC7; A3OMemGet8, 0x35; A3OMemGet16, 0x36; A3OMemGet32, 0x37; A3OMemGetFloat, 0x38; A3OMemGetDouble, 0x39; A3OMemSet8, 0x3A; A3OMemSet16, 0x3B; A3OMemSet32, 0x3C; A3OMemSetFloat, 0x3D; A3OMemSetDouble, 0x3E; A3OSign1, 0x50; A3OSign8, 0x51; A3OSign16, 0x52; ]; h , h2 let length = function | A3SmallInt _ -> 2 | A3Construct n | A3Object n | A3RegKill n | A3Catch n | A3IncrReg n | A3DecrReg n | A3IncrIReg n | A3DecrIReg n | A3Array n | A3Int n | A3CallStack n | A3ConstructSuper n | A3BreakPointLine n | A3ApplyType n | A3DebugLine n -> 1 + int_length n | A3GetSlot s | A3SetSlot s -> 1 + int_length s | A3ClassDef n -> 1 + int_length (int_index_nz n) | A3DxNs f | A3String f | A3DebugFile f -> 1 + int_length (int_index f) | A3IntRef f -> 1 + int_length (int_index f) | A3UIntRef f -> 1 + int_length (int_index f) | A3Float f -> 1 + int_length (int_index f) | A3Function f -> 1 + int_length (int_index_nz f) | A3Namespace f -> 1 + int_length (int_index f) | A3GetProp f | A3InitProp f | A3DeleteProp f | A3FindPropStrict f | A3FindProp f | A3FindDefinition f | A3GetLex f | A3SetProp f | A3Cast f | A3GetSuper f | A3GetDescendants f | A3SetSuper f -> 1 + int_length (int_index f) | A3Op _ | A3Undefined | A3Null | A3True | A3False | A3NaN | A3RetVoid | A3Ret | A3Pop | A3Dup | A3Swap | A3AsAny | A3ToString | A3ToXml | A3ToXmlAttr | A3ToInt | A3ToUInt | A3ToNumber | A3ToBool | A3ToObject | A3AsString | A3AsObject | A3This | A3Throw | A3Nop | A3Typeof | A3InstanceOf | A3Scope | A3ForIn | A3NewBlock | A3ForEach | A3PopScope | A3CheckIsXml | A3Label | A3BreakPoint | A3PushWith | A3HasNext | A3SetThis | A3Timestamp | A3DxNsLate | A3Unk _ -> 1 | A3AsType n | A3IsType n -> 1 + int_length (int_index n) | A3DebugReg (name,reg,line) -> 1 + 1 + int_length (int_index name) + int_length (reg - 1) + int_length line | A3GetGlobalScope -> 1 | A3GetScope n -> 1 + int_length n | A3Reg n | A3SetReg n -> if n >= 1 && n <= 3 then 1 else (1 + int_length n) | A3CallSuper (f,n) | A3CallProperty (f,n) | A3ConstructProperty (f,n) | A3CallPropLex (f,n) | A3CallPropVoid (f,n) | A3CallSuperVoid (f,n) -> 1 + int_length n + int_length (int_index f) | A3CallMethod (f,n) -> 1 + int_length n + int_length f | A3CallStatic (f,n) -> 1 + int_length n + int_length (int_index f) | A3Jump _ -> 4 | A3Next (a,b) -> 1 + int_length a + int_length b | A3Switch (_,cases) -> let ncases = List.length cases in 1 + 3 + int_length (ncases - 1) + 3 * ncases let jump ch kind = A3Jump (kind,read_i24 ch) let opcode ch = let op = (try read_byte ch with IO.No_more_input -> raise Exit) in match op with | 0x01 -> A3BreakPoint | 0x02 -> A3Nop | 0x03 -> A3Throw | 0x04 -> A3GetSuper (read_index ch) | 0x05 -> A3SetSuper (read_index ch) | 0x06 -> A3DxNs (read_index ch) | 0x07 -> A3DxNsLate | 0x08 -> A3RegKill (read_int ch) | 0x09 -> A3Label (* 0x0A -> NONE *) (* 0x0B -> NONE *) | 0x0C -> jump ch J3NotLt | 0x0D -> jump ch J3NotLte | 0x0E -> jump ch J3NotGt | 0x0F -> jump ch J3NotGte | 0x10 -> jump ch J3Always | 0x11 -> jump ch J3True | 0x12 -> jump ch J3False | 0x13 -> jump ch J3Eq | 0x14 -> jump ch J3Neq | 0x15 -> jump ch J3Lt | 0x16 -> jump ch J3Lte | 0x17 -> jump ch J3Gt | 0x18 -> jump ch J3Gte | 0x19 -> jump ch J3PhysEq | 0x1A -> jump ch J3PhysNeq | 0x1B -> let def = read_i24 ch in let rec loop n = if n = 0 then [] else let j = read_i24 ch in j :: loop (n - 1) in let cases = loop (read_int ch + 1) in A3Switch (def,cases) | 0x1C -> A3PushWith | 0x1D -> A3PopScope | 0x1E -> A3ForIn | 0x1F -> A3HasNext | 0x20 -> A3Null | 0x21 -> A3Undefined (* 0x22 -> NONE *) | 0x23 -> A3ForEach | 0x24 -> A3SmallInt (read_signed_byte ch) | 0x25 -> A3Int (read_int ch) | 0x26 -> A3True | 0x27 -> A3False | 0x28 -> A3NaN | 0x29 -> A3Pop | 0x2A -> A3Dup | 0x2B -> A3Swap | 0x2C -> A3String (read_index ch) | 0x2D -> A3IntRef (read_index ch) | 0x2E -> A3UIntRef (read_index ch) | 0x2F -> A3Float (read_index ch) | 0x30 -> A3Scope | 0x31 -> A3Namespace (read_index ch) | 0x32 -> let r1 = read_int ch in let r2 = read_int ch in A3Next (r1,r2) (* 0x33 - 0x3F -> NONE *) | 0x40 -> A3Function (read_index_nz ch) | 0x41 -> A3CallStack (read_int ch) | 0x42 -> A3Construct (read_int ch) | 0x43 -> let id = read_int ch in let nargs = read_int ch in A3CallMethod (id,nargs) | 0x44 -> let id = read_index ch in let nargs = read_int ch in A3CallStatic (id,nargs) | 0x45 -> let id = read_index ch in let nargs = read_int ch in A3CallSuper (id,nargs) | 0x46 -> let id = read_index ch in let nargs = read_int ch in A3CallProperty (id,nargs) | 0x47 -> A3RetVoid | 0x48 -> A3Ret | 0x49 -> A3ConstructSuper (read_int ch) | 0x4A -> let id = read_index ch in let nargs = read_int ch in A3ConstructProperty (id,nargs) (* 0x4B -> NONE *) | 0x4C -> let id = read_index ch in let nargs = read_int ch in A3CallPropLex (id,nargs) (* 0x4D -> NONE *) | 0x4E -> let id = read_index ch in let nargs = read_int ch in A3CallSuperVoid (id,nargs) | 0x4F -> let id = read_index ch in let nargs = read_int ch in A3CallPropVoid (id,nargs) (* 0x50 - 0x52 -> NONE *) | 0x53 -> A3ApplyType (read_int ch) (* 0x54 -> NONE *) | 0x55 -> A3Object (read_int ch) | 0x56 -> A3Array (read_int ch) | 0x57 -> A3NewBlock | 0x58 -> A3ClassDef (read_index_nz ch) | 0x59 -> A3GetDescendants (read_index ch) | 0x5A -> A3Catch (read_int ch) (* 0x5B -> NONE *) (* 0x5C -> NONE *) | 0x5D -> A3FindPropStrict (read_index ch) | 0x5E -> A3FindProp (read_index ch) | 0x5F -> A3FindDefinition (read_index ch) | 0x60 -> A3GetLex (read_index ch) | 0x61 -> A3SetProp (read_index ch) | 0x62 -> A3Reg (read_int ch) | 0x63 -> A3SetReg (read_int ch) | 0x64 -> A3GetGlobalScope | 0x65 -> A3GetScope (IO.read_byte ch) | 0x66 -> A3GetProp (read_index ch) (* 0x67 -> NONE *) | 0x68 -> A3InitProp (read_index ch) (* 0x69 -> NONE *) | 0x6A -> A3DeleteProp (read_index ch) (* 0x6B -> NONE *) | 0x6C -> A3GetSlot (read_int ch) | 0x6D -> A3SetSlot (read_int ch) (* 0x6E -> DEPRECATED getglobalslot *) (* 0x6F -> DEPRECATED setglobalslot *) | 0x70 -> A3ToString | 0x71 -> A3ToXml | 0x72 -> A3ToXmlAttr | 0x73 -> A3ToInt | 0x74 -> A3ToUInt | 0x75 -> A3ToNumber | 0x76 -> A3ToBool | 0x77 -> A3ToObject | 0x78 -> A3CheckIsXml (* 0x79 -> NONE *) | 0x80 -> A3Cast (read_index ch) (* 0x81 -> DEPRECATED asbool *) | 0x82 -> A3AsAny (* 0x83 -> DEPRECATED asint *) (* 0x84 -> DEPRECATED asnumber *) | 0x85 -> A3AsString | 0x86 -> A3AsType (read_index ch) (* 0x87 -> OP *) (* 0x88 -> DEPRECATED asuint *) | 0x89 -> A3AsObject (* 0x8A - 0x8F -> NONE *) (* 0x90 - 0x91 -> OP *) | 0x92 -> A3IncrReg (read_int ch) (* 0x93 -> OP *) | 0x94 -> A3DecrReg (read_int ch) | 0x95 -> A3Typeof (* 0x96 -> OP *) (* 0x97 -> OP *) (* 0x98 - 0x9F -> NONE *) (* 0xA0 - 0xB0 -> OP *) | 0xB1 -> A3InstanceOf | 0xB2 -> A3IsType (read_index ch) (* 0xB3 -> OP *) (* 0xB4 -> OP *) (* 0xB5 - 0xBF -> NONE *) (* 0xC0 -> OP *) (* 0xC1 -> OP *) | 0xC2 -> A3IncrIReg (read_int ch) | 0xC3 -> A3DecrIReg (read_int ch) (* 0xC4 - 0xC7 -> OP *) (* 0xC8 - 0xCF -> NONE *) | 0xD0 -> A3This | 0xD1 -> A3Reg 1 | 0xD2 -> A3Reg 2 | 0xD3 -> A3Reg 3 | 0xD4 -> A3SetThis | 0xD5 -> A3SetReg 1 | 0xD6 -> A3SetReg 2 | 0xD7 -> A3SetReg 3 (* 0xD8 - 0xEE -> NONE *) | 0xEF -> if IO.read_byte ch <> 1 then assert false; let name = read_index ch in let reg = read_int ch + 1 in let line = read_int ch in A3DebugReg (name,reg,line) | 0xF0 -> A3DebugLine (read_int ch) | 0xF1 -> A3DebugFile (read_index ch) | 0xF2 -> A3BreakPointLine (read_int ch) | 0xF3 -> A3Timestamp (* 0xF4 - 0xFF -> NONE *) | _ -> try A3Op (Hashtbl.find ops op) with Not_found -> Printf.printf "Unknown opcode 0x%.2X\n" op; A3Unk (char_of_int op) let parse ch len = let data = nread ch len in let ch = input_string data in let a = DynArray.create() in let rec loop() = DynArray.add a (opcode ch); loop(); in (try loop() with Exit -> ()); DynArray.to_array a let write ch = function | A3BreakPoint -> write_byte ch 0x01 | A3Nop -> write_byte ch 0x02 | A3Throw -> write_byte ch 0x03 | A3GetSuper f -> write_byte ch 0x04; write_index ch f | A3SetSuper f -> write_byte ch 0x05; write_index ch f | A3DxNs i -> write_byte ch 0x06; write_index ch i | A3DxNsLate -> write_byte ch 0x07 | A3RegKill n -> write_byte ch 0x08; write_int ch n | A3Label -> write_byte ch 0x09 | A3Jump (k,n) -> write_byte ch (match k with | J3NotLt -> 0x0C | J3NotLte -> 0x0D | J3NotGt -> 0x0E | J3NotGte -> 0x0F | J3Always -> 0x10 | J3True -> 0x11 | J3False -> 0x12 | J3Eq -> 0x13 | J3Neq -> 0x14 | J3Lt -> 0x15 | J3Lte -> 0x16 | J3Gt -> 0x17 | J3Gte -> 0x18 | J3PhysEq -> 0x19 | J3PhysNeq -> 0x1A ); write_i24 ch n | A3Switch (def,cases) -> write_byte ch 0x1B; write_i24 ch def; write_int ch (List.length cases - 1); List.iter (write_i24 ch) cases | A3PushWith -> write_byte ch 0x1C | A3PopScope -> write_byte ch 0x1D | A3ForIn -> write_byte ch 0x1E | A3HasNext -> write_byte ch 0x1F | A3Null -> write_byte ch 0x20 | A3Undefined -> write_byte ch 0x21 | A3ForEach -> write_byte ch 0x23 | A3SmallInt b -> write_byte ch 0x24; write_signed_byte ch b | A3Int i -> write_byte ch 0x25; write_int ch i | A3True -> write_byte ch 0x26 | A3False -> write_byte ch 0x27 | A3NaN -> write_byte ch 0x28 | A3Pop -> write_byte ch 0x29 | A3Dup -> write_byte ch 0x2A | A3Swap -> write_byte ch 0x2B | A3String s -> write_byte ch 0x2C; write_index ch s | A3IntRef i -> write_byte ch 0x2D; write_index ch i | A3UIntRef i -> write_byte ch 0x2E; write_index ch i | A3Float f -> write_byte ch 0x2F; write_index ch f | A3Scope -> write_byte ch 0x30 | A3Namespace f -> write_byte ch 0x31; write_index ch f | A3Next (r1,r2) -> write_byte ch 0x32; write_int ch r1; write_int ch r2 | A3Function f -> write_byte ch 0x40; write_index_nz ch f | A3CallStack n -> write_byte ch 0x41; write_int ch n | A3Construct n -> write_byte ch 0x42; write_int ch n | A3CallMethod (f,n) -> write_byte ch 0x43; write_int ch f; write_int ch n | A3CallStatic (f,n) -> write_byte ch 0x44; write_index ch f; write_int ch n | A3CallSuper (f,n) -> write_byte ch 0x45; write_index ch f; write_int ch n | A3CallProperty (f,n) -> write_byte ch 0x46; write_index ch f; write_int ch n | A3RetVoid -> write_byte ch 0x47 | A3Ret -> write_byte ch 0x48 | A3ConstructSuper n -> write_byte ch 0x49; write_int ch n | A3ConstructProperty (f,n) -> write_byte ch 0x4A; write_index ch f; write_int ch n | A3CallPropLex (f,n) -> write_byte ch 0x4C; write_index ch f; write_int ch n | A3CallSuperVoid (f,n) -> write_byte ch 0x4E; write_index ch f; write_int ch n | A3CallPropVoid (f,n) -> write_byte ch 0x4F; write_index ch f; write_int ch n | A3ApplyType n -> write_byte ch 0x53; write_int ch n | A3Object n -> write_byte ch 0x55; write_int ch n | A3Array n -> write_byte ch 0x56; write_int ch n | A3NewBlock -> write_byte ch 0x57 | A3ClassDef f -> write_byte ch 0x58; write_index_nz ch f | A3GetDescendants f -> write_byte ch 0x59; write_index ch f | A3Catch n -> write_byte ch 0x5A; write_int ch n | A3FindPropStrict f -> write_byte ch 0x5D; write_index ch f | A3FindProp f -> write_byte ch 0x5E; write_index ch f | A3FindDefinition f -> write_byte ch 0x5F; write_index ch f | A3GetLex f -> write_byte ch 0x60; write_index ch f | A3SetProp f -> write_byte ch 0x61; write_index ch f | A3Reg n -> if n >= 0 && n < 4 then write_byte ch (0xD0 + n) else begin write_byte ch 0x62; write_int ch n end | A3SetReg n -> if n >= 0 && n < 4 then write_byte ch (0xD4 + n) else begin write_byte ch 0x63; write_int ch n end | A3GetGlobalScope -> write_byte ch 0x64 | A3GetScope n -> write_byte ch 0x65; write_byte ch n | A3GetProp f -> write_byte ch 0x66; write_index ch f | A3InitProp f -> write_byte ch 0x68; write_index ch f | A3DeleteProp f -> write_byte ch 0x6A; write_index ch f | A3GetSlot n -> write_byte ch 0x6C; write_int ch n | A3SetSlot n -> write_byte ch 0x6D; write_int ch n | A3ToString -> write_byte ch 0x70 | A3ToXml -> write_byte ch 0x71 | A3ToXmlAttr -> write_byte ch 0x72 | A3ToInt -> write_byte ch 0x73 | A3ToUInt -> write_byte ch 0x74 | A3ToNumber -> write_byte ch 0x75 | A3ToBool -> write_byte ch 0x76 | A3ToObject -> write_byte ch 0x77 | A3CheckIsXml -> write_byte ch 0x78 | A3Cast f -> write_byte ch 0x80; write_index ch f | A3AsAny -> write_byte ch 0x82 | A3AsString -> write_byte ch 0x85 | A3AsType n -> write_byte ch 0x86; write_index ch n | A3AsObject -> write_byte ch 0x89 | A3IncrReg r -> write_byte ch 0x92; write_int ch r | A3DecrReg r -> write_byte ch 0x94; write_int ch r | A3Typeof -> write_byte ch 0x95 | A3InstanceOf -> write_byte ch 0xB1 | A3IsType n -> write_byte ch 0xB2; write_index ch n | A3IncrIReg r -> write_byte ch 0xC2; write_int ch r | A3DecrIReg r -> write_byte ch 0xC3; write_int ch r | A3This -> write_byte ch 0xD0 | A3SetThis -> write_byte ch 0xD4 | A3DebugReg (name,reg,line) -> write_byte ch 0xEF; write_byte ch 0x01; write_index ch name; write_int ch (reg - 1); write_int ch line; | A3DebugLine f -> write_byte ch 0xF0; write_int ch f; | A3DebugFile f -> write_byte ch 0xF1; write_index ch f; | A3BreakPointLine l -> write_byte ch 0xF2; write_int ch l | A3Timestamp -> write_byte ch 0xF3 | A3Op op -> write_byte ch (try Hashtbl.find ops_ids op with Not_found -> assert false) | A3Unk x -> write ch x let dump_op = function | A3OAs -> "as" | A3ONeg -> "neg" | A3OIncr -> "incr" | A3ODecr -> "decr" | A3ONot -> "not" | A3OBitNot -> "bitnot" | A3OAdd -> "add" | A3OSub -> "sub" | A3OMul -> "mul" | A3ODiv -> "div" | A3OMod -> "mod" | A3OShl -> "shl" | A3OShr -> "shr" | A3OUShr -> "ushr" | A3OAnd -> "and" | A3OOr -> "or" | A3OXor -> "xor" | A3OEq -> "eq" | A3OPhysEq -> "physeq" | A3OLt -> "lt" | A3OLte -> "lte" | A3OGt -> "gt" | A3OGte -> "gte" | A3OIs -> "is" | A3OIn -> "in" | A3OIIncr -> "iincr" | A3OIDecr -> "idecr" | A3OINeg -> "ineg" | A3OIAdd -> "iadd" | A3OISub -> "isub" | A3OIMul -> "imul" | A3OMemSet8 -> "mset8" | A3OMemSet16 -> "set16" | A3OMemSet32 -> "mset32" | A3OMemSetFloat -> "msetfloat" | A3OMemSetDouble -> "msetdouble" | A3OMemGet8 -> "mget8" | A3OMemGet16 -> "mget16" | A3OMemGet32 -> "mget32" | A3OMemGetFloat -> "mgetfloat" | A3OMemGetDouble -> "mgetdouble" | A3OSign1 -> "sign1" | A3OSign8 -> "sign8" | A3OSign16 -> "sign16" let dump_jump = function | J3NotLt -> "-nlt" | J3NotLte -> "-nlte" | J3NotGt -> "-ngt" | J3NotGte -> "-ngte" | J3Always -> "" | J3True -> "-if" | J3False -> "-ifnot" | J3Eq -> "-eq" | J3Neq -> "-neq" | J3Lt -> "-lt" | J3Lte -> "-lte" | J3Gt -> "-gt" | J3Gte -> "-gte" | J3PhysEq -> "-peq" | J3PhysNeq -> "-pneq" let dump ctx op = let ident n = ctx.as3_idents.(int_index n - 1) in let rec field n = let t = ctx.as3_names.(int_index n - 1) in match t with | A3MMultiName (Some ident,_) -> "[" ^ iget ctx.as3_idents ident ^ "]" | A3MName (ident,_) -> iget ctx.as3_idents ident | A3MMultiNameLate idx -> "~array" | A3MParams (t,params) -> field t ^ "<" ^ String.concat "." (List.map field params) ^ ">" | _ -> "???" in match op with | A3BreakPoint -> "bkpt" | A3Nop -> "nop" | A3Throw -> "throw" | A3GetSuper f -> s "getsuper %s" (field f) | A3SetSuper f -> s "setsuper %s" (field f) | A3DxNs i -> s "dxns %s" (ident i) | A3DxNsLate -> "dxnslate" | A3RegKill n -> s "kill %d" n | A3Label -> "label" | A3Jump (k,n) -> s "jump%s %d" (dump_jump k) n | A3Switch (def,cases) -> s "switch %d [%s]" def (String.concat "," (List.map (s "%d") cases)) | A3PushWith -> "pushwith" | A3PopScope -> "popscope" | A3ForIn -> "forin" | A3HasNext -> "hasnext" | A3Null -> "null" | A3Undefined -> "undefined" | A3ForEach -> "foreach" | A3SmallInt b -> s "int %d" b | A3Int n -> s "int %d" n | A3True -> "true" | A3False -> "false" | A3NaN -> "nan" | A3Pop -> "pop" | A3Dup -> "dup" | A3Swap -> "swap" | A3String n -> s "string [%s]" (ident n) | A3IntRef n -> s "int [%ld]" ctx.as3_ints.(int_index n - 1) | A3UIntRef n -> s "uint [%ld]" ctx.as3_uints.(int_index n - 1) | A3Float n -> s "float [%f]" ctx.as3_floats.(int_index n - 1) | A3Scope -> "scope" | A3Namespace f -> s "namespace [%d]" (int_index f) | A3Next (r1,r2) -> s "next %d %d" r1 r2 | A3Function f -> s "function #%d" (int_index_nz f) | A3CallStack n -> s "callstack (%d)" n | A3Construct n -> s "construct (%d)" n | A3CallMethod (f,n) -> s "callmethod %d (%d)" f n | A3CallStatic (f,n) -> s "callstatic %d (%d)" (int_index f) n | A3CallSuper (f,n) -> s "callsuper %s (%d)" (field f) n | A3CallProperty (f,n) -> s "callprop %s (%d)" (field f) n | A3RetVoid -> "retvoid" | A3Ret -> "ret" | A3ConstructSuper n -> s "constructsuper %d" n | A3ConstructProperty (f,n) -> s "constructprop %s (%d)" (field f) n | A3CallPropLex (f,n) -> s "callproplex %s (%d)" (field f) n | A3CallSuperVoid (f,n) -> s "callsupervoid %s (%d)" (field f) n | A3CallPropVoid (f,n) -> s "callpropvoid %s (%d)" (field f) n | A3ApplyType n -> s "applytype %d" n | A3Object n -> s "object %d" n | A3Array n -> s "array %d" n | A3NewBlock -> "newblock" | A3ClassDef n -> s "classdef %d" (int_index_nz n) | A3GetDescendants f -> s "getdescendants %s" (field f) | A3Catch n -> s "catch %d" n | A3FindPropStrict f -> s "findpropstrict %s" (field f) | A3FindProp f -> s "findprop %s" (field f) | A3FindDefinition f -> s "finddefinition %s" (field f) | A3GetLex f -> s "getlex %s" (field f) | A3SetProp f -> s "setprop %s" (field f) | A3Reg n -> s "reg %d" n | A3SetReg n -> s "setreg %d" n | A3GetGlobalScope -> "getglobalscope" | A3GetScope n -> s "getscope %d" n | A3GetProp f -> s "getprop %s" (field f) | A3InitProp f -> s "initprop %s" (field f) | A3DeleteProp f -> s "deleteprop %s" (field f) | A3GetSlot n -> s "getslot %d" n | A3SetSlot n -> s "setslot %d" n | A3ToString -> "tostring" | A3ToXml -> "toxml" | A3ToXmlAttr -> "toxmlattr" | A3ToInt -> "toint" | A3ToUInt -> "touint" | A3ToNumber -> "tonumber" | A3ToBool -> "tobool" | A3ToObject -> "toobject" | A3CheckIsXml -> "checkisxml" | A3Cast f -> s "cast %s" (field f) | A3AsAny -> "asany" | A3AsString -> "asstring" | A3AsType f -> s "astype %s" (field f) | A3AsObject -> "asobject" | A3IncrReg r -> s "incrreg %d" r | A3DecrReg r -> s "decrreg %d" r | A3Typeof -> "typeof" | A3InstanceOf -> "instanceof" | A3IsType f -> s "istype %s" (field f) | A3IncrIReg r -> s "incrireg %d" r | A3DecrIReg r -> s "decrireg %d" r | A3This -> "this" | A3SetThis -> "setthis" | A3DebugReg (name,reg,line) -> s ".reg %d:%s line:%d" reg (ident name) line | A3DebugLine l -> s ".line %d" l | A3DebugFile f -> s ".file %s" (ident f) | A3BreakPointLine l -> s ".bkptline %d" l | A3Timestamp -> ".time" | A3Op o -> dump_op o | A3Unk x -> s "??? 0x%X" (int_of_char x) mtasc-1.14/ocaml/swflib/swfPic.ml0000640000175000017500000001326311102626040015341 0ustar pabspabs(* * This file is part of SwfLib * Copyright (c)2005 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) open Png open Swf open ExtList type error_msg = | PngError of Png.error_msg | Interlaced | UnsupportedColorModel | UnsupportedExtension | UnzipFailed exception Error of error_msg exception File_not_found of string type picture = { pwidth : int; pheight : int; pid : int; pdata : tag_data; } let error_msg = function | PngError m -> Png.error_msg m | Interlaced -> "Interlaced mode is not supported" | UnsupportedColorModel -> "Unsupported color model" | UnsupportedExtension -> "Unsupported file extension" | UnzipFailed -> "Decompression failed" let error msg = raise (Error msg) let unsigned v n = if v < 0 then (- ( v + 1 )) lxor (1 lsl n - 1) else v let load_picture file id = let ch = IO.input_channel (try open_in_bin file with _ -> raise (File_not_found file)) in let len = String.length file in let p = (try String.rindex file '.' with Not_found -> len) in let ext = String.sub file (p + 1) (len - (p + 1)) in match String.uppercase ext with | "PNG" -> let png , header, data = (try let p = Png.parse ch in p , Png.header p, Png.data p with Png.Error msg -> IO.close_in ch; error (PngError msg) ) in IO.close_in ch; if header.png_interlace then error Interlaced; let data = (try Extc.unzip data with _ -> error UnzipFailed) in let w = header.png_width in let h = header.png_height in let data = (try Png.filter png data with Png.Error msg -> error (PngError msg)) in { pwidth = w; pheight = h; pid = id; pdata = (match header.png_color with | ClTrueColor (TBits8,NoAlpha) -> (* set alpha to 0 *) for p = 0 to w * h - 1 do String.unsafe_set data (p * 4) '\000'; done; TBitsLossless { bll_id = id; bll_format = 5; bll_width = w; bll_height = h; bll_data = Extc.zip data; } | ClTrueColor (TBits8,HaveAlpha) -> (* premultiply rgb by alpha *) for p = 0 to w * h - 1 do let k = p * 4 in let a = int_of_char (String.unsafe_get data k) in String.unsafe_set data (k + 1) (Char.unsafe_chr ((int_of_char (String.unsafe_get data (k + 1)) * a) / 0xFF)); String.unsafe_set data (k + 2) (Char.unsafe_chr ((int_of_char (String.unsafe_get data (k + 2)) * a) / 0xFF)); String.unsafe_set data (k + 3) (Char.unsafe_chr ((int_of_char (String.unsafe_get data (k + 3)) * a) / 0xFF)); done; TBitsLossless2 { bll_id = id; bll_format = 5; bll_width = w; bll_height = h; bll_data = Extc.zip data; } | _ -> error UnsupportedColorModel); } | _ -> IO.close_in ch; error UnsupportedExtension let make_clip name pics baseid = let npics = List.length pics in let ids = Array.of_list (List.map (fun p -> p.pid) pics) in let rec loop i p = let w = p.pwidth in let h = p.pheight in let rb = if 20 * max w h >= 1 lsl 14 then 15 else 14 in let nbits = rb in TShape { sh_id = baseid + i; sh_bounds = { rect_nbits = rb; left = 0; top = 0; right = w * 20; bottom = h * 20; }; sh_bounds2 = None; sh_style = { sws_fill_styles = [ SFSBitmap { sfb_repeat = true; sfb_smooth = true; sfb_cid = ids.(i); sfb_mpos = { scale = Some { m_nbits = 22; mx = 20 lsl 16; my = 20 lsl 16; }; rotate = None; trans = { m_nbits = 0; mx = 0; my = 0; }; }; }; ]; sws_line_styles = []; sws_records = { srs_nlbits = 0; srs_nfbits = 1; srs_records = [ SRStyleChange { scsr_move = None; scsr_fs0 = None; scsr_fs1 = Some 1; scsr_ls = None; scsr_new_styles = None; }; SRStraightEdge { sser_nbits = nbits; sser_line = Some (w * 20) , None; }; SRStraightEdge { sser_nbits = nbits; sser_line = None , Some (h * 20); }; SRStraightEdge { sser_nbits = nbits; sser_line = Some (unsigned (-w * 20) nbits), None; }; SRStraightEdge { sser_nbits = nbits; sser_line = None , Some (unsigned (-h * 20) nbits); }; ]; }; }; } in let shapes = List.mapi loop pics in let rec loop i = if i = npics then [] else TPlaceObject2 { po_depth = 0; po_move = (i > 0); po_cid = Some (baseid+i); po_color = None; po_matrix = None; po_ratio = None; po_inst_name = None; po_clip_depth = None; po_events = None; po_filters = None; po_blend = None; po_bcache = None; } :: TShowFrame :: loop (i+1) in let tid = ref 0 in let make_tag t = incr tid; { tid = - !tid; textended = false; tdata = t; } in let pics = List.map (fun p -> make_tag p.pdata) pics in let shapes = List.map make_tag shapes in pics @ shapes @ List.map make_tag [ TClip { c_id = baseid + npics; c_frame_count = npics; c_tags = List.map make_tag (loop 0); }; TExport [{ exp_id = baseid + npics; exp_name = name; }]; ] mtasc-1.14/ocaml/extc/0000750000175000017500000000000011155145531013234 5ustar pabspabsmtasc-1.14/ocaml/extc/test.ml0000640000175000017500000000173310140067355014552 0ustar pabspabs(* * Extc : C common OCaml bindings * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) prerr_endline (Extc.executable_path()); let contents = Std.input_file "test.ml" in let s = Extc.unzip (Extc.zip contents) in if s <> contents then failwith "zip + unzip failed"; mtasc-1.14/ocaml/extc/LICENSE0000640000175000017500000004313110140175134014237 0ustar pabspabs GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. mtasc-1.14/ocaml/extc/extc_stubs.c0000640000175000017500000001076310572775161015605 0ustar pabspabs/* * Extc : C common OCaml bindings * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA */ #include #include #include #include #ifdef _WIN32 # include #else # include # include #endif #ifdef __APPLE__ # include # include # include #endif #define zval(z) ((z_streamp)(z)) value zlib_new_stream() { value z = alloc((sizeof(z_stream) + sizeof(value) - 1) / sizeof(value),Abstract_tag); z_stream *s = zval(z); s->zalloc = NULL; s->zfree = NULL; s->opaque = NULL; s->next_in = NULL; s->next_out = NULL; return z; } CAMLprim value zlib_deflate_init(value lvl) { value z = zlib_new_stream(); if( deflateInit(zval(z),Int_val(lvl)) != Z_OK ) failwith("zlib_deflate_init"); return z; } CAMLprim value zlib_deflate( value zv, value src, value spos, value slen, value dst, value dpos, value dlen, value flush ) { z_streamp z = zval(zv); value res; int r; z->next_in = (Bytef*)(String_val(src) + Int_val(spos)); z->next_out = (Bytef*)(String_val(dst) + Int_val(dpos)); z->avail_in = Int_val(slen); z->avail_out = Int_val(dlen); if( (r = deflate(z,Int_val(flush))) < 0 ) failwith("zlib_deflate"); z->next_in = NULL; z->next_out = NULL; res = alloc_small(3, 0); Field(res, 0) = Val_bool(r == Z_STREAM_END); Field(res, 1) = Val_int(Int_val(slen) - z->avail_in); Field(res, 2) = Val_int(Int_val(dlen) - z->avail_out); return res; } CAMLprim value zlib_deflate_bytecode(value * arg, int nargs) { return zlib_deflate(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],arg[7]); } CAMLprim value zlib_deflate_end(value zv) { if( deflateEnd(zval(zv)) != 0 ) failwith("zlib_deflate_end"); return Val_unit; } CAMLprim value zlib_inflate_init() { value z = zlib_new_stream(); if( inflateInit(zval(z)) != Z_OK ) failwith("zlib_inflate_init"); return z; } CAMLprim value zlib_inflate( value zv, value src, value spos, value slen, value dst, value dpos, value dlen, value flush ) { z_streamp z = zval(zv); value res; int r; z->next_in = (Bytef*)(String_val(src) + Int_val(spos)); z->next_out = (Bytef*)(String_val(dst) + Int_val(dpos)); z->avail_in = Int_val(slen); z->avail_out = Int_val(dlen); if( (r = inflate(z,Int_val(flush))) < 0 ) failwith("zlib_inflate"); z->next_in = NULL; z->next_out = NULL; res = alloc_small(3, 0); Field(res, 0) = Val_bool(r == Z_STREAM_END); Field(res, 1) = Val_int(Int_val(slen) - z->avail_in); Field(res, 2) = Val_int(Int_val(dlen) - z->avail_out); return res; } CAMLprim value zlib_inflate_bytecode(value * arg, int nargs) { return zlib_inflate(arg[0],arg[1],arg[2],arg[3],arg[4],arg[5],arg[6],arg[7]); } CAMLprim value zlib_inflate_end(value zv) { if( inflateEnd(zval(zv)) != 0 ) failwith("zlib_inflate_end"); return Val_unit; } CAMLprim value executable_path(value u) { #ifdef _WIN32 char path[MAX_PATH]; if( GetModuleFileName(NULL,path,MAX_PATH) == 0 ) failwith("executable_path"); return caml_copy_string(path); #elif __APPLE__ char path[MAXPATHLEN+1]; uint32_t path_len = MAXPATHLEN; if ( _NSGetExecutablePath(path, &path_len) ) failwith("executable_path"); return caml_copy_string(path); #else const char *p = getenv("_"); if( p != NULL ) return caml_copy_string(p); { char path[200]; int length = readlink("/proc/self/exe", path, sizeof(path)); if( length < 0 || length >= 200 ) failwith("executable_path"); path[length] = '\0'; return caml_copy_string(path); } #endif } CAMLprim value get_full_path( value f ) { #ifdef _WIN32 char path[MAX_PATH]; if( GetFullPathName(String_val(f),MAX_PATH,path,NULL) == 0 ) failwith("get_full_path"); return caml_copy_string(path); #else char path[PATH_MAX]; if( realpath(String_val(f),path) == NULL ) failwith("get_full_path"); return caml_copy_string(path); #endif } mtasc-1.14/ocaml/extc/Makefile0000640000175000017500000000127010565070442014677 0ustar pabspabsZLIB = zlib.lib CFLAGS = -I zlib LIBS = -cclib $(ZLIB) -cclib extc_stubs.obj all: bytecode native test: bytecode ocamlc -custom -o test.exe -cclib $(ZLIB) extLib.cma extc.cma test.ml test-opt: native ocamlopt -o test.exe -cclib $(ZLIB) extLib.cmxa extc.cmxa test.ml bytecode: extc_stubs.obj ocamlc -a -o extc.cma $(LIBS) extc.mli extc.ml native: extc_stubs.obj ocamlopt -a -o extc.cmxa $(LIBS) extc.mli extc.ml extc_stubs.obj: extc_stubs.c ocamlc $(CFLAGS) extc_stubs.c clean: rm -f extc.cma extc.cmi test.cmi extc.cmx extc.cmxa extc.o extc.obj extc.lib extc_stubs.obj extc_stubs.o rm -f extc.a libextc.a libextc.lib extc.cmo test.cmo test.exe text-opt.exe test.cmx test.o test.obj mtasc-1.14/ocaml/extc/extc.mli0000640000175000017500000000165310570555003014707 0ustar pabspabs(* * Extc : C common OCaml bindings * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) val zip : string -> string val unzip : string -> string val executable_path : unit -> string val get_full_path : string -> string mtasc-1.14/ocaml/extc/extc.ml0000640000175000017500000000553710570555003014543 0ustar pabspabs(* * Extc : C common OCaml bindings * Copyright (c)2004 Nicolas Cannasse * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) type zstream type zflush = | Z_NO_FLUSH | Z_PARTIAL_FLUSH | Z_SYNC_FLUSH | Z_FULL_FLUSH | Z_FINISH type zresult = { z_finish : bool; z_read : int; z_wrote : int; } external zlib_deflate_init : int -> zstream = "zlib_deflate_init" external zlib_deflate : zstream -> src:string -> spos:int -> slen:int -> dst:string -> dpos:int -> dlen:int -> zflush -> zresult = "zlib_deflate_bytecode" "zlib_deflate" external zlib_deflate_end : zstream -> unit = "zlib_deflate_end" external zlib_inflate_init : unit -> zstream = "zlib_inflate_init" external zlib_inflate : zstream -> src:string -> spos:int -> slen:int -> dst:string -> dpos:int -> dlen:int -> zflush -> zresult = "zlib_inflate_bytecode" "zlib_inflate" external zlib_inflate_end : zstream -> unit = "zlib_inflate_end" external _executable_path : string -> string = "executable_path" external get_full_path : string -> string = "get_full_path" let executable_path() = let p = _executable_path Sys.argv.(0) in let p1 = (try String.rindex p '/' with Not_found -> String.length p + 1) in let p2 = (try String.rindex p '\\' with Not_found -> String.length p + 1) in match min p1 p2 with | x when x = String.length p + 1 -> "" | pos -> String.sub p 0 pos ^ "/" let zlib_op op z str = let bufsize = 1 lsl 14 in let tmp = String.create bufsize in let total = ref 0 in let rec loop pos len acc = let r = op z ~src:str ~spos:pos ~slen:len ~dst:tmp ~dpos:0 ~dlen:bufsize (if len = 0 then Z_FINISH else Z_SYNC_FLUSH) in total := !total + r.z_wrote; let acc = String.sub tmp 0 r.z_wrote :: acc in if r.z_finish then acc else loop (pos + r.z_read) (len - r.z_read) acc in let strings = loop 0 (String.length str) [] in let big = String.create !total in ignore(List.fold_left (fun p s -> let l = String.length s in let p = p - l in String.unsafe_blit s 0 big p l; p ) !total strings); big let zip str = let z = zlib_deflate_init 9 in let s = zlib_op zlib_deflate z str in zlib_deflate_end z; s let unzip str = let z = zlib_inflate_init() in let s = zlib_op zlib_inflate z str in zlib_inflate_end z; s