Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

saving epochs and events with int time

  • Loading branch information...
commit ff5eb313a6399759f70057bd020f367292e242ac 1 parent f6bd1d4
Tom Nielsen authored

Showing 3 changed files with 18 additions and 14 deletions. Show diff stats Hide diff stats

  1. +10 8 Database.hs
  2. +7 5 Driver.hs
  3. +1 1  RunLoom.hs
18 Database.hs
@@ -129,16 +129,18 @@ addRunToSession decls t0 tmax dt ress sess@(Session basedir sesst0)
129 129 let ntics = round $ t0/dt
130 130 saveBinary (dir++"/"++showHex ntics "") obj
131 131 in do -- Session newEvs newSigSegs newEps ((t0,t0+tmax, decls):programsRun sess) (qenv sess) (sessPrelude sess)
132   - print "saving sessopm"
  132 + putStrLn $ "saving session: "++show nmsToStore
133 133 forM sigsToStore $ \(nm,sig) -> do
134   - putStrLn $"saving "++ nm
  134 + putStrLn $"saving signal "++ nm
135 135 saveInSubDir "signals" nm sig
136 136 putStrLn "done"
137 137 forM (tStartEvs++evtsToStore) $ \(nm, ListV evs) -> do
  138 + putStrLn $"saving events "++ nm
138 139 saveInSubDir "events" nm evs
139 140 forM (progEp:epsToStore) $ \(nm, ListV eps) -> do
  141 + putStrLn $"saving epochs "++ nm
140 142 saveInSubDir "epochs" nm eps
141   - print "done saving sessopm"
  143 + print "done saving session"
142 144 return ()
143 145
144 146
@@ -169,10 +171,10 @@ evTag (PairV (NumV (NReal t)) v) = v
169 171 epTs (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) _) = (t1,t2)
170 172 epTag (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) v) = v
171 173
172   -isEpoch (PairV (PairV (NumV (NReal _)) ((NumV (NReal _)))) _) = True
  174 +isEpoch (PairV (PairV (NumV _) ((NumV _))) _) = True
173 175 isEpoch _ = False
174 176
175   -isEvent (PairV (NumV (NReal _)) _) = True
  177 +isEvent (PairV (NumV _) _) = True
176 178 isEvent _ = False
177 179
178 180 isEvents (ListV vs) = all isEvent vs
@@ -197,9 +199,9 @@ guardBy (Just x) p | p x = Just x
197 199
198 200
199 201 shiftSig ts (SigV t1 t2 dt sf) = SigV (t1+ts) (t2+ts) dt $ \t->sf(t-(round $ ts/dt))
200   -shiftEvt ts (PairV (NumV (NReal t)) v) = (PairV (NumV (NReal $ t+ts)) v)
201   -shiftEp ts (PairV (PairV (NumV (NReal t1)) ((NumV (NReal t2)))) v) =
202   - (PairV (PairV (NumV (NReal $t1+ts)) ((NumV (NReal $t2+ts)))) v)
  202 +shiftEvt ts (PairV (NumV t) v) = (PairV (NumV $ t+(NReal ts)) v)
  203 +shiftEp ts (PairV (PairV (NumV t1) ((NumV t2))) v) =
  204 + (PairV (PairV (NumV $ t1 +(NReal ts)) ((NumV $ t2 + (NReal ts)))) v)
203 205
204 206 mkList :: V -> [V]
205 207 mkList (ListV vs) = vs
12 Driver.hs
@@ -36,10 +36,12 @@ main = do
36 36 dispPullMv <- newEmptyMVar
37 37 sess <- lastSession "/home/tomn/sessions/"
38 38 print sess
39   - let outFileName = oneTrailingSlash(baseDir sess)++"driver_output.txt"
40   - putStrLn $"redirecting stdout to "++outFileName
41   - hout<- openFile outFileName AppendMode
42   - hDuplicateTo hout stdout
  39 + let redirect = not $ "-nr" `elem` args
  40 + when redirect $ do
  41 + let outFileName = oneTrailingSlash(baseDir sess)++"driver_output.txt"
  42 + putStrLn $"redirecting stdout to "++outFileName
  43 + hout<- openFile outFileName AppendMode
  44 + hDuplicateTo hout stdout
43 45
44 46 let ds= DS sess dispPullMv runningMv []
45 47 whenM (doesFileExist $ cmdFile ds) $ removeFile (cmdFile ds)
@@ -48,7 +50,7 @@ main = do
48 50 forkOS (initGlScreen (not $ "-w" `elem` args) dispPullMv runningMv)
49 51 waitSecs 0.5
50 52
51   - catchForever $ loop ds
  53 + catchForever $ (loop ds >> hFlush stdout)
52 54
53 55 return ()
54 56
2  RunLoom.hs
@@ -9,7 +9,7 @@ import Numbers
9 9
10 10 main = go runLoom
11 11
12   -runLoom = do wait 240
  12 +runLoom = do wait 10
13 13 dplc <- uniform (-0.1) (0.1)
14 14 trace "displacement" dplc
15 15 use "DisplacedLoom" ["angle" =: dbl dplc]

0 comments on commit ff5eb31

Please sign in to comment.
Something went wrong with that request. Please try again.