module Swf.Assembly where
-- arch-tag: Swf Assembly Code
-- (add-hook 'haskell-mode-hook 'turn-on-haskell-ghci)

{-
TODO: 

 Add support for comments
-}

import Text.PrettyPrint.HughesPJ
import Data.Maybe
import Data.Word
import Data.Int

data PreSup = None | Preload | Suppress
                 
data SwfAssembly = 
		 -- SWF 3 / Player Control 
		   ActionGotoFrame Word16
		 | ActionGetURL String String
		 | ActionNextFrame
		 | ActionPreviousFrame
		 | ActionPlay
		 | ActionStop
		 | ActionToggleQuality
		 | ActionStopSounds
		 | ActionWaitForFrame Word16 Word8 -- frame,  skip count
		 | ActionSetTarget String -- target name
		 | ActionGotoLabel String -- frame label
                 -- Arithmetic
                 | ActionAdd
		 | ActionAdd2
		 | ActionSubtract
		 | ActionModulo
		 | ActionMultiply
		 | ActionDivide
		 -- Control Flow
		 | ActionIf String
		 | ActionJump String
		 | ActionCall
		 -- Logical Operators
		 | ActionAnd
		 | ActionOr
		 | ActionNot
		 -- Movie Control
		 | ActionGetURL2 Word8 ---
		 | ActionGotoFrame2 Bool ---
		 | ActionSetTarget2
		 | ActionGetProperty ---
		 | ActionSetProperty ---
		 | ActionCloneSprite
		 | ActionRemoveSprite
		 | ActionStartDrag
		 | ActionEndDrag
		 | ActionWaitForFrame2 Word8 --
		 -- Numerical Comparison
		 | ActionEquals
		 | ActionGreater
		 | ActionLess
		 | ActionLess2
		 | ActionStrictEquals
		 -- ScriptObject
		 | ActionCallFunction
		 | ActionCallMethod
		 | ActionConstantPool [String]
		 | ActionDefineFunction (Maybe String) [String] [SwfAssembly] -- name params body
		 | ActionDefineLocal
		 | ActionDefineLocal2
		 | ActionDelete
		 | ActionDelete2
		 | ActionEnumerate
		 | ActionEnumerate2
		 | ActionEquals2
		 | ActionGetMember
		 | ActionInitArray
		 | ActionInitObject
		 | ActioninstanceOf
		 | ActionNewMethod
		 | ActionNewObject
		 | ActionSetMember
		 | ActionTargetPath
		 | ActionWith Int String
		 | ActionInstanceOf
		   -- name, [(param,regnum)] numRegs preloadParent preloadRoot superFlag argFlag thisFlag preloadGlobal
		 | ActionDefineFunction2 String [(String,Word8)] Word8 Bool Bool PreSup PreSup PreSup Bool
		 | ActionExtends
		 | ActionImplementsOp
		 -- (Either varName regNum) (Maybe catchBlock) (Maybe finallyBlock)
		 | ActionTry (Either String Word8) (Maybe [SwfAssembly]) (Maybe [SwfAssembly])
		 | ActionThrow
		 -- Stack
		 | ActionPushString String
		 | ActionPushFloat Float
                 | ActionPushNull
                 | ActionPushUndefined
                 | ActionPushReg Word8
                 | ActionPushBool Bool
		 | ActionPushDouble Double
                 | ActionPushInt Word32
		 | ActionPop
		 -- Stack Operator
		 | ActionBitAnd
		 | ActionBitLShift
		 | ActionBitOr
		 | ActionBitRShift
		 | ActionBitURShift
		 | ActionBitXor
		 | ActionDecrement
		 | ActionIncrement
		 | ActionPushDuplicate
		 | ActionReturn
		 | ActionStackSwap
		 | ActionStoreRegister Word8
		 -- String Manipulation
		 | ActionStringEquals
		 | ActionStringLength
		 | ActionStringAdd
		 | ActionStringExtract
		 | ActionStringLess
		 | ActionStringGreater
		 | ActionMBStringLength
		 | ActionMBStringExtract
		 -- Type
		 | ActionToNumber
		 | ActionToString
		 | ActionTypeOf
		 | ActionToInteger
		 | ActionCharToAscii
		 | ActionAsciiToChar
		 | ActionMBCharToAscii
		 | ActionMBAsciiToChar
		 | ActionCastOp
		 -- Utilities
		 | ActionTrace
		 | ActionGetTime
		 | ActionRandomNumber
		 -- Variables
		 | ActionGetVariable
		 | ActionSetVariable
		 -- Misc
		 | Frame Integer [SwfAssembly]
		 | Movie String [SwfAssembly]
		 | Label String
                 | Comment String

instance Show SwfAssembly where
    show o = show (ppSwfAssembly o)

ppSwfAssembly o =
    case o of 
	   -- Arithmetic
	   ActionAdd		-> (nest 4 (text "add"))
	   ActionSubtract	-> (nest 4 (text "subtract"))
	   ActionMultiply	-> (nest 4 (text "multiply"))
	   ActionDivide		-> (nest 4 (text "divide"))
	   -- Numerical Comparison
	   ActionEquals         -> (nest 4 (text "equals"))
	   ActionLess		-> (nest 4 (text "less"))
	   ActionGreater	-> (nest 4 (text "greater"))
           ActionStrictEquals	-> (nest 4 (text "actionStrictEquals"))
	   -- Control Flow
	   ActionIf label	-> (nest 4 (text ("branchiftrue " ++ label)))
	   ActionJump label	-> (nest 4 (text ("branch " ++ label)))
           -- Logical
           ActionAnd		-> (nest 4 (text "and"))
           ActionOr		-> (nest 4 (text "or"))
           ActionNot		-> (nest 4 (text "not"))
	   -- ScriptObject
	   ActionCallMethod	-> (nest 4 (text "callMethod"))
	   ActionCallFunction	-> (nest 4 (text "callFunction"))
	   ActionDefineFunction name formals body -> 
               (nest 4 ((text "function") <+> (maybe empty text name) <+> (parens (hsep (punctuate comma  (map (text .show) formals))))
			                      $$ (vcat (map ppSwfAssembly body))
                                                     $$ (text "end")))
           ActionDefineLocal	-> (nest 4 (text "definelocal"))
           ActionDelete		-> (nest 4 (text "delete"))
           ActionDelete2	-> (nest 4 (text "delete2"))
           ActionEnumerate	-> (nest 4 (text "enumerate"))
           ActionEnumerate2	-> (nest 4 (text "enumerate2"))
           ActionEquals2	-> (nest 4 (text "equals2"))
           ActionGetMember	-> (nest 4 (text "getMember"))
           ActionSetMember	-> (nest 4 (text "setMember"))
           ActionInitArray	-> (nest 4 (text "initArray"))
           ActionInitObject	-> (nest 4 (text "initObject"))
	   -- Stack
	   ActionPushString s	-> (nest 4 ((text "push") <+> (text (show s))))
	   ActionPushFloat f	-> (nest 4 ((text "push") <+> (text (show f))))
           ActionPushReg r	-> (nest 4 ((text "push") <+> (text (show r))))
	   ActionPushDouble d	-> (nest 4 ((text "push") <+> (text (show d))))
           ActionPushNull	-> (nest 4 ((text "push") <+> (text "null")))
           ActionPushUndefined	-> (nest 4 ((text "push") <+> (text "undefined")))
           ActionPushBool b	-> (nest 4 ((text "push") <+> (text (show b))))
           ActionPushInt i	-> (nest 4 ((text "push") <+> (text (show i))))
	   ActionPop		-> (nest 4 (text "pop"))
	   -- Stack Operator
	   ActionReturn		-> (nest 4 (text "return"))
           ActionStackSwap	-> (nest 4 (text "swap"))
           ActionPushDuplicate	-> (nest 4 (text "pushDuplicate"))
           -- String Functions
           ActionStringEquals	-> (nest 4 (text "stringEquals"))
           ActionStringLength	-> (nest 4 (text "stringLength"))
           ActionStringAdd	-> (nest 4 (text "stringAdd"))
           ActionStringExtract	-> (nest 4 (text "stringExtract"))
           ActionStringLess	-> (nest 4 (text "stringLess"))
           ActionStringGreater  -> (nest 4 (text "stringGreater"))
           ActionMBStringLength	-> (nest 4 (text "mbStringLength"))
           ActionMBStringExtract -> (nest 4 (text "mbStringExtract"))
						
	   -- Utilities
	   ActionTrace		-> (nest 4 (text "trace"))
							 
	   -- Variables
	   ActionGetVariable	-> (nest 4 (text "getVariable"))
	   ActionSetVariable	-> (nest 4 (text "setVariable"))

	   -- Misc -- these aren't real actions
	   Frame i opcodes	-> nest 4 (text "frame" <+> text (show i) $$
				   (vcat (map ppSwfAssembly opcodes)) $$
				   text "end")

	   Movie file opcodes   -> text ("movie '" ++ file ++ "'") $$
				   (vcat (map ppSwfAssembly opcodes)) $$
				   text "end"

           Label name		-> text (name ++ ":")
           Comment str		-> text (';':' ':str)
				   
ppSwfAssemblies :: [SwfAssembly] -> Doc
ppSwfAssemblies assemblies =
    vcat (map ppSwfAssembly assemblies)