packages feed

LslPlus 0.4.1.1 → 0.4.2

raw patch · 7 files changed

+57/−8 lines, 7 files

Files

LslPlus.cabal view
@@ -1,5 +1,5 @@ Name:           LslPlus
-version:        0.4.1.1
+version:        0.4.2
 Synopsis:	    An execution and testing framework for the Linden Scripting Language (LSL)
 Description:	
 	Provides a framework for executing Linden Scripting Language scripts offline,
src/Language/Lsl/Internal/CompilationServer.hs view
@@ -188,17 +188,39 @@                     Nothing -> []
                     Just (Right _) -> []
                     Just (Left errs) -> map toErrInfo errs
-    in return (cs,xmlSerialize Nothing (ModuleResponse (m,errs')) "")
+    in return (cs,xmlSerialize Nothing (ModuleResponse (simplifyModule m,errs')) "")
 handleCommand cs (CheckScript (CodeElement name text)) =
     let (s, errs) = alternateScriptParser name text
         lib = libFromAugLib $ M.toList (modules cs)
         errs' = map parseErrorToErrInfo errs ++ case compileLSLScript' lib s of
             Left errs -> map toErrInfo errs
             _ -> []
-    in return (cs,xmlSerialize Nothing (ScriptResponse (s,errs')) "")
+    in return (cs,xmlSerialize Nothing (ScriptResponse (simplifyScript s,errs')) "")
 
+-- take the detail out of a script, leaving just the skeleton...
+simplifyScript :: LSLScript -> LSLScript
+simplifyScript (LSLScript _ gs ss) = LSLScript "" (map simpG gs) (map simpCS ss)
+    where simpCS (Ctx sc s) = (Ctx (simpSC sc) (simpS s))
+          simpS (State cn chs) = (State (simpCN cn) (map simpCH chs))
+          simpCH (Ctx sc h) = (Ctx (simpSC sc) (simpH h))
+          simpH (Handler cn _ _) = Handler (simpCN cn) [] []
+
+-- take the detail out of a script, leaving just the skeleton...
+simplifyModule :: LModule -> LModule
+simplifyModule (LModule gs _) = LModule (map simpG gs) []
+
+simpG (GV cv _) = GV (simpCV cv) Nothing
+simpG (GF cf) = GF (simpCF cf)
+simpG (GI cn _ _) = GI (simpCN cn) [] ""
+simpCV (Ctx sc v) = (Ctx (simpSC sc) v)
+simpCF (Ctx sc f) = (Ctx (simpSC sc) (simpF f))
+simpCN (Ctx sc n) = (Ctx (simpSC sc) n)
+simpSC Nothing = Nothing
+simpSC (Just (SourceContext tl _ _ _)) = (Just (SourceContext tl "" "" []))
+simpF (Func fd _) = (Func fd [])
+          
 compilationServer :: IO ()
-compilationServer = processLinesSIO emptyCState "quit" handler
+compilationServer = processLinesSIOB emptyCState "quit" handler
 
 codeGen loc pkg = do
     setCurrentDirectory loc
src/Language/Lsl/Internal/Constants.hs view
@@ -28,6 +28,9 @@ cChangedInventory = 0x1;llcChangedInventory :: RealFloat a => LSLValue a; llcChangedInventory = IVal cChangedInventory cChangedAllowedDrop = 0x40;llcChangedAllowedDrop :: RealFloat a => LSLValue a; llcChangedAllowedDrop = IVal cChangedAllowedDrop +cChangedRegionStart = 0x400 :: Int+llcChangedRegionStart = IVal cChangedRegionStart+ cMaskBase = 0;llcMaskBase :: RealFloat a => LSLValue a; llcMaskBase = IVal cMaskBase cMaskOwner = 1;llcMaskOwner :: RealFloat a => LSLValue a; llcMaskOwner = IVal cMaskOwner cMaskGroup = 2;llcMaskGroup :: RealFloat a => LSLValue a; llcMaskGroup = IVal cMaskGroup@@ -217,6 +220,7 @@     Constant "CHANGED_LINK" llcChangedLink,     Constant "CHANGED_OWNER" (IVal 0x80),     Constant "CHANGED_REGION" (IVal 0x100),+    Constant "CHANGED_REGION_START" llcChangedRegionStart,     Constant "CHANGED_SCALE" (IVal 0x8),     Constant "CHANGED_SHAPE" (IVal 0x4),     Constant "CHANGED_TELEPORT" (IVal 0x200),@@ -523,6 +527,8 @@     Constant "TYPE_ROTATION" (IVal 6),     Constant "TYPE_STRING" (IVal 3),     Constant "TYPE_VECTOR" (IVal 5),+    Constant "URL_REQUEST_DENIED" (SVal "URL_REQUEST_DENIED"),+    Constant "URL_REQUEST_GRANTED" (SVal "URL_REQUEST_GRANTED"),     Constant "VEHICLE_ANGULAR_DEFLECTION_EFFICIENCY" (IVal 32),     Constant "VEHICLE_ANGULAR_DEFLECTION_TIMESCALE" (IVal 33),     Constant "VEHICLE_ANGULAR_FRICTION_TIMESCALE" (IVal 17),
src/Language/Lsl/Internal/EventSigs.hs view
@@ -30,6 +30,8 @@      "raised when data is received from the dataserver (in response to one of a variety of ll-function calls)"),
     ("email",[(LLString,"time"),(LLString,"address"),(LLString,"subj"),(LLString,"message"),(LLInteger,"num_left")], EventDeliveryScript, [],
      "raised when the llGetNextEmail function call is answered"),
+    ("http_request",[(LLKey,"request_id"),(LLString,"method"),(LLString,"body")], EventDeliveryScript, [],
+     "raised when an script receives an http request"),
     ("http_response",[(LLKey,"request_id"),(LLInteger,"status"),(LLList,"metadata"),(LLString,"body")], EventDeliveryScript, [],
      "raised when an http response is received for an http request that is pending"),
     ("land_collision",[(LLVector,"pos")], EventDeliveryPrim, [],
@@ -87,4 +89,4 @@ 
 simpleLslEventDescriptors =
     map (\ (name,params,_,_,_) ->
-            (name, map (\ (t,_) -> t) params)) lslEventDescriptors+            (name, map (\ (t,_) -> t) params)) lslEventDescriptors
src/Language/Lsl/Internal/Util.hs view
@@ -20,6 +20,7 @@     processLines,
     processLinesS,
     processLinesSIO,
+    processLinesSIOB,
     generatePermutation,
     fac,
     fst3,
@@ -30,7 +31,9 @@ 
 import Control.Monad(liftM,when)
 import Control.Monad.Error(MonadError(..),Error(..))
+import Data.Char
 import Data.List(find,elemIndex,isPrefixOf,tails)
+import qualified Data.ByteString.Lazy.Char8 as B
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 
@@ -148,6 +151,21 @@            processLinesSIO newState term f
     where escape = escapeURIString isUnescapedInURI
     
+    
+processLinesSIOB state term f = B.getContents >>= go state . B.lines
+  where bterm = B.pack term
+        go state (s:ss) = when (bterm /= s) $ do
+             (newState,s') <- f state (unescapeB s)
+             B.putStrLn (escape s')
+             hFlush stdout
+             go newState ss
+        escape = B.pack  . escapeURIString isUnescapedInURI
+        unescapeB s | B.length s == 0 = ""
+                    | otherwise = case (B.unpack (B.take 3 s), B.drop 3 s) of
+                        ('%':x1:x2:[],s') | isHexDigit x1 && isHexDigit x2 ->
+                            chr (digitToInt x1 * 16 + digitToInt x2) : unescapeB s'
+                        _ -> B.head s : (unescapeB (B.tail s))
+
 -- TODO: fix this definition!
 fac :: Integer -> Integer
 fac 0 = 1
src/Language/Lsl/Sim.hs view
@@ -470,9 +470,10 @@ llMessageLinked info@(ScriptInfo oid pid sid pkey _) [IVal link,IVal val,SVal msg,KVal key] =
     do  LSLObject { primKeys = links } <- (getObject oid) <||> throwError ("object not found!")
         when (null links) $ throwError ("object is has no links!")
+        let sender = if length links > 1 then pid + 1 else pid
         let targetLinkIndices = targetLinks (length links) link pid
         let targetLinks = map (links !!) targetLinkIndices
-        let event = (Event "link_message" [IVal pid, IVal val, SVal msg, KVal key] M.empty)
+        let event = (Event "link_message" [IVal sender, IVal val, SVal msg, KVal key] M.empty)
         lift $ mapM_ (\ pk -> pushDeferredScriptEventToPrim event pk 0) targetLinks
         continueWith VoidVal
src/LslPlus.hs view
@@ -13,8 +13,8 @@ import System
 import System.Exit
 
-version="0.4.1.1"
-usage progName = "Usage: " ++ progName ++ " [Version|MetaData|Compiler|ExpressionHandler|SimMetaData|SystemTester|UnitTester]"
+version="0.4.2"
+usage progName = "Usage: " ++ progName ++ " [Version|MetaData|Compiler|ExpressionHandler|SimMetaData|SystemTester|UnitTester|CompilationServer]"
 main = do
     progName <- getProgName
     args <- getArgs