module Swf.Util where

-- arch-tag: fa740070-40b2-4c3e-a59a-224e8358bb00

import Data.Bits

import Swf.Assembly
import Swf.Tags
import Swf.Bin
-- import Swf.Compiler

import System.Environment

--tests
swf actions 
    = SwfHeader { shVersion = 6
		, shFrameSize = SwfRectS 15 0 8000 0 12000
		, shFrameRate = (12 `shiftL` 8)
		, shFrameCount = 1
		, shTags = [ SetBackgroundColor (0xff,0xff,0xff)
                           , dynText
                           , place 1 1
                           , outputText
                           , place 2 2
                           , actions
                           , ShowFrame
                           , End
                           ]
		}

dynText =
    DefineEditText { detCharacterId = 1
		   , detBounds = (SwfRect 0 8000 3000 12000)
		   , detInitialText = Just "Hello, World!\n"
		   , detWordWrap = False
		   , detMultiline = True
		   , detPassword = False
		   , detReadOnly = False
		   , detTextColor = Nothing
		   , detMaxLength = Nothing
		   , detFont = Nothing
		   , detAutosize = False
		   , detLayout = Nothing
		   , detNoSelect = False
		   , detBorder = True
		   , detHTML = False
		   , detUseOutlines = False
		   , detVariableName = "dynText"
		   }

outputText =
    DefineEditText { detCharacterId = 2
		   , detBounds = (SwfRect 0 8000 0 2000)
		   , detInitialText = Nothing
		   , detWordWrap = False
		   , detMultiline = True
		   , detPassword = False
		   , detReadOnly = False
		   , detTextColor = Nothing
		   , detMaxLength = Nothing
		   , detFont = Nothing
		   , detAutosize = False
		   , detLayout = Nothing
		   , detNoSelect = False
		   , detBorder = True
		   , detHTML = False
		   , detUseOutlines = False
		   , detVariableName = "outputText"
		   }

square = 
    DefineShape { dsShapeId = 1 
		, dsShapeBounds = (SwfRect 2010 4910 1670 4010)
		, dsShapes = ShapeWithStyle { swsFillStyles = []
					    , swsLineStyles = [ LineStyle { lsWidth = 20
									  , lsColor = (0,0,0,255)
									  }
							      ]
					    , swsShapeRecords = [ StyleChangeRecord { scrMoveDelta  = Just (4900,1680)
										    , scrFillStyle0 = Nothing
										    , scrFillStyle1 = Nothing
										    , scrLineStyle  = Just 1
										    , scrFillStyles  = Nothing
										    , scrLineStyles  = Nothing
										    }
								, StraightEdgeRecordV { deltaY = 2320
										      }
								, StraightEdgeRecordH { deltaX = -2880
										      }
								, StraightEdgeRecordV { deltaY = -2320
										      }
								, StraightEdgeRecordH { deltaX = 2880
										      }
								, EndShapeRecord
								]
					    }
		}

place charId depth = 
    PlaceObject2 { po2PlaceMove = 0
		 , po2Depth = depth
		 , po2CharacterId = Just charId
		 , po2Matrix = Nothing
		 , po2ColorTransform = Nothing
		 , po2Ratio = Nothing
		 , po2Name = Nothing
		 , po2ClipDepth = Nothing
		 }

-- schemeCode = "(if \"0\" (set! dynText \"Hello, Earth!\") (set! dynText \"Hello, Mars!\"))"

--actions = DoAction (doCompile "(set! dynText \"Hello, Earth!\")")
-- actions = DoAction (doCompile schemeCode)

{-
printHelp = 
    do progName <- getProgName
       putStrLn $ "Usage: " ++progName ++ " scheme_file"

testActions = 
    [ ActionStoreRegister 2
    , ActionGotoFrame 10
    , ActionGetURL "url" "target"
    , ActionWaitForFrame 20 30
    , ActionSetTarget "targetName"
    , ActionGotoLabel "label"
    , ActionGetURL2 2
    , ActionGotoFrame2 True
    , ActionSetTarget2
    , ActionConstantPool ["I","like","rars"]
    , ActionGetProperty
    , ActionSetProperty
    , ActionCloneSprite
    , ActionStartDrag
    , ActionWaitForFrame2 4
    , ActionEndDrag
    ]
-}
{-
test = 
    do args <- getArgs 
       case args of
	    [] -> printHelp
	    [file] -> 
		do scheme <- readFile file
		   let actions = (doCompile scheme)
		   mapM_ print actions
                   swfWrite "test.swf" (toBin (swf (DoAction actions)))
--                   swfWrite "test.swf" (toBin (swf (DoAction testActions)))

-}