Permalink
Browse files

saving epochs and events with int time

  • Loading branch information...
1 parent f6bd1d4 commit ff5eb313a6399759f70057bd020f367292e242ac Tom Nielsen committed Jun 17, 2009
Showing with 18 additions and 14 deletions.
  1. +10 −8 Database.hs
  2. +7 −5 Driver.hs
  3. +1 −1 RunLoom.hs
View
@@ -129,16 +129,18 @@ addRunToSession decls t0 tmax dt ress sess@(Session basedir sesst0)
let ntics = round $ t0/dt
saveBinary (dir++"/"++showHex ntics "") obj
in do -- Session newEvs newSigSegs newEps ((t0,t0+tmax, decls):programsRun sess) (qenv sess) (sessPrelude sess)
- print "saving sessopm"
+ putStrLn $ "saving session: "++show nmsToStore
forM sigsToStore $ \(nm,sig) -> do
- putStrLn $"saving "++ nm
+ putStrLn $"saving signal "++ nm
saveInSubDir "signals" nm sig
putStrLn "done"
forM (tStartEvs++evtsToStore) $ \(nm, ListV evs) -> do
+ putStrLn $"saving events "++ nm
saveInSubDir "events" nm evs
forM (progEp:epsToStore) $ \(nm, ListV eps) -> do
+ putStrLn $"saving epochs "++ nm
saveInSubDir "epochs" nm eps
- print "done saving sessopm"
+ print "done saving session"
return ()
@@ -169,10 +171,10 @@ evTag (PairV (NumV (NReal t)) v) = v
epTs (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) _) = (t1,t2)
epTag (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) v) = v
-isEpoch (PairV (PairV (NumV (NReal _)) ((NumV (NReal _)))) _) = True
+isEpoch (PairV (PairV (NumV _) ((NumV _))) _) = True
isEpoch _ = False
-isEvent (PairV (NumV (NReal _)) _) = True
+isEvent (PairV (NumV _) _) = True
isEvent _ = False
isEvents (ListV vs) = all isEvent vs
@@ -197,9 +199,9 @@ guardBy (Just x) p | p x = Just x
shiftSig ts (SigV t1 t2 dt sf) = SigV (t1+ts) (t2+ts) dt $ \t->sf(t-(round $ ts/dt))
-shiftEvt ts (PairV (NumV (NReal t)) v) = (PairV (NumV (NReal $ t+ts)) v)
-shiftEp ts (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) v) =
- (PairV (PairV (NumV (NReal $t1+ts)) ((NumV (NReal $t2+ts)))) v)
+shiftEvt ts (PairV (NumV t) v) = (PairV (NumV $ t+(NReal ts)) v)
+shiftEp ts (PairV (PairV (NumV t1) ((NumV t2))) v) =
+ (PairV (PairV (NumV $ t1 +(NReal ts)) ((NumV $ t2 + (NReal ts)))) v)
mkList :: V -> [V]
mkList (ListV vs) = vs
View
@@ -36,10 +36,12 @@ main = do
dispPullMv <- newEmptyMVar
sess <- lastSession "/home/tomn/sessions/"
print sess
- let outFileName = oneTrailingSlash(baseDir sess)++"driver_output.txt"
- putStrLn $"redirecting stdout to "++outFileName
- hout<- openFile outFileName AppendMode
- hDuplicateTo hout stdout
+ let redirect = not $ "-nr" `elem` args
+ when redirect $ do
+ let outFileName = oneTrailingSlash(baseDir sess)++"driver_output.txt"
+ putStrLn $"redirecting stdout to "++outFileName
+ hout<- openFile outFileName AppendMode
+ hDuplicateTo hout stdout
let ds= DS sess dispPullMv runningMv []
whenM (doesFileExist $ cmdFile ds) $ removeFile (cmdFile ds)
@@ -48,7 +50,7 @@ main = do
forkOS (initGlScreen (not $ "-w" `elem` args) dispPullMv runningMv)
waitSecs 0.5
- catchForever $ loop ds
+ catchForever $ (loop ds >> hFlush stdout)
return ()
View
@@ -9,7 +9,7 @@ import Numbers
main = go runLoom
-runLoom = do wait 240
+runLoom = do wait 10
dplc <- uniform (-0.1) (0.1)
trace "displacement" dplc
use "DisplacedLoom" ["angle" =: dbl dplc]

0 comments on commit ff5eb31

Please sign in to comment.