Drezil/ibhelper
1
1
Fork 0
Code Issues 12 Pull Requests Projects Releases Wiki Activity

#17 should be fixed, but needs testing.

Browse Source
This commit is contained in:
Nicole Dresselhaus 2022-09-24 16:36:24 +02:00
parent caf588201c
commit 783d47e190
3 changed files with 22 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
deps/dear-implot.hs vendored

@ -1 +1 @@
Subproject commit 2b3810f7927a83c7cf95612497eaeceed56ca5e8
Subproject commit da2b394f827c001cc3b51e0188be1007f40fa3d9

16
src/Chart.hs
View File

@ -58,8 +58,9 @@ newChart contract = do
unless (null cacheErrors) $ forM_ cacheErrors $ \err -> logError (displayShow err)
let (unknownDates, cacheData') = partition (isNothing . fst) cacheData
unless (null unknownDates) $ logError $ display $ T.pack $ show (length unknownDates) <> " files had no parsable Date."
let cacheData'' :: HashMap Day (FingerTree TimeInterval ChartPoint) = HM.fromList $ bimap (fromMaybe today) FT.fromList <$> cacheData'
let cacheData'' :: HashMap Day (FingerTree TimeInterval ChartPoint) = HM.fromList $ bimap (fromMaybe today) (FT.fromList . L.sortOn (intervalFrom . timeOfDay)) <$> cacheData'
logError $ displayShow $ HM.keys cacheData''
logInfo $ displayShow(fromMaybe FT.empty $ cacheData'' HM.!? today)
c <- liftIO $ newTVarIO $ Chart con
(fromMaybe FT.empty $ cacheData'' HM.!? today)
(HM.delete today cacheData'')
@ -124,7 +125,16 @@ toChartData :: [ChartStudyType] -> [(TimeInterval, [ChartPoint])] -> (Maybe Char
toChartData studytypes chunkedChart = (lastDataPoint, foldedData)
where (!foldedData,lastDataPoint,_) = foldl' folder ([], Nothing, mempty) chunkedChart
folder :: ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float]) -> (TimeInterval, [ChartPoint]) -> ([ChartPoint], Maybe ChartPoint, HM.HashMap Int [Float])
folder (acc, Nothing , smaMap) (tp , []) = (ChartPoint tp 0 0 []:acc, Nothing, smaMap)
folder (acc, Nothing , smaMap) (tp , []) = (ChartPoint tp 0 0 studies:acc, Nothing, smaMap)
where
studies = catMaybes $ studytypes <&> \case
ChartStudyTypeOpen -> Just $ OLHC 0 0 0 0
ChartStudyTypeHigh -> Nothing
ChartStudyTypeLow -> Nothing
ChartStudyTypeClose -> Nothing
ChartStudyTypeDirect -> Nothing
ChartStudyTypeSMA w -> Nothing --TODO: fixme #13, do the calculation & use data inside smaMap and return (SMA x y, smaUpdate)
ChartStudyTypeVolume -> Just $ Volume 0
folder (acc, Just lastPoint, smaMap) (tp , []) = (lastPoint{ timeOfDay = tp, pointVolume = 0}:acc, Just lastPoint, foldl' (.) id smaUpdates smaMap)
where
(studies, smaUpdates) = unzip $ catMaybes $ studytypes <&> \case
@ -259,7 +269,7 @@ getUpdatedChartCache Chart{..} chartCacheSettings' = do
return (Just $ TimePoint lUpdate, ChartCacheData ccData' ccAxis' (Just newRange) fillRange)
getChunkedDay :: Chart -> Maybe Int -> (Maybe TimePoint, [ChartPoint])
getChunkedDay Chart{..} chunkResolution = case toChartData (chartStudySettings chartSettings) chunkedData of
getChunkedDay Chart{..} chunkResolution = case toChartData [] chunkedData of
(Nothing, x) -> (Nothing, x)
(Just ChartPoint{..}, x)
| timeOfDay == mempty -> (Nothing, x)

17
src/Run.hs
View File

@ -58,11 +58,11 @@ shutdownApp = do
let chartData' = filter (\ChartPoint{..} -> 0 /= pointVolume) . snd $ getChunkedDay c (Just 5)
newData = HM.toList
. fmap (filter (\ChartPoint{..} -> 0 /= pointVolume))
. HM.alter (Just . maybe chartData' (<>chartData')) today
. HM.alter (traceShowCommentId "todays data for saving" . Just . maybe chartData' (<>chartData')) today
. fmap toList
$ chartHistData
forM_ newData $ \(day, dat) -> do
liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") dat
liftIO $ encodeFile ("cache/" <> show chartContractID <> "/" <> show day <> ".json") $ traceShowCommentId ("data for "<> show day) dat
logInfo $ display $ ppShow' settings'
renderLoop :: RIO App ()
@ -242,15 +242,14 @@ renderLoop = do
dataSliceLine = if t-f < 1 then VS.slice (max 0 $ f-1) 2 else VS.slice f (t-f+1) -- need at least 2 points to make a line... duh!
when (t-f < 0 || t-f >= cTicks) $ logError $ displayShow ("t/f", t-f, t, f)
when (isJust direct) $ do
plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
return ()
plotLine (T.unpack symbol) (dataSliceLine x) (dataSliceLine $ fromJust direct)
-- Show the ImGui demo window
showDemoWindow
-- Show the ImPlot demo window
showPlotDemoWindow
-- -- Show the ImGui demo window
-- showDemoWindow
--
-- -- Show the ImPlot demo window
-- showPlotDemoWindow
-- Render
liftIO $ glClear GL_COLOR_BUFFER_BIT