current state
This commit is contained in:
parent
befb1ab1eb
commit
80b5f09d95
1
.gitignore
vendored
1
.gitignore
vendored
@ -6,3 +6,4 @@ imgui.ini
|
||||
settings.json
|
||||
*.lock
|
||||
tags
|
||||
dist-newstyle/
|
||||
|
99
app/Main.hs
99
app/Main.hs
@ -7,18 +7,19 @@ import Data.Aeson (eitherDecodeFileStrict')
|
||||
import Control.Monad.Managed
|
||||
import Control.Concurrent
|
||||
import DearImGui
|
||||
import DearImGui.Plot
|
||||
import DearImGui.OpenGL3
|
||||
import DearImGui.GLFW
|
||||
import DearImGui.GLFW.OpenGL
|
||||
import DearImGui.SDL
|
||||
import DearImGui.SDL.OpenGL
|
||||
import Run
|
||||
import RIO.Process
|
||||
import System.Directory
|
||||
import Options.Applicative.Simple
|
||||
import qualified Paths_ibhelper
|
||||
import qualified Graphics.UI.GLFW as GLFW
|
||||
import qualified Data.Text as T
|
||||
import Prelude (putStrLn)
|
||||
import AppFiller
|
||||
import SDL
|
||||
|
||||
|
||||
main :: IO ()
|
||||
@ -50,59 +51,55 @@ main = do
|
||||
withLogFunc lo $ \lf -> do
|
||||
-- let bare_log = unLogFunc $ view logFuncL lf
|
||||
-- logErr = liftIO . bare_log callStack "" LevelError
|
||||
initialized <- GLFW.init
|
||||
unless initialized $ error "GLFW init failed"
|
||||
initializeAll
|
||||
|
||||
liftIO $ runManaged $ do
|
||||
mwin <- managed $ bracket
|
||||
(GLFW.createWindow (settings ^. windowParams . windowWidth) (settings ^. windowParams . windowHeight) "IB-Helper" Nothing Nothing)
|
||||
(maybe (return ()) GLFW.destroyWindow)
|
||||
case mwin of
|
||||
Just win -> do
|
||||
liftIO $ do
|
||||
GLFW.makeContextCurrent (Just win)
|
||||
GLFW.swapInterval 1
|
||||
win <- do
|
||||
let title = "IB-Helper"
|
||||
let config = defaultWindow { windowGraphicsContext = OpenGLContext defaultOpenGL
|
||||
, windowInitialSize = V2 (settings ^. windowParams . windowWidth . to fromIntegral) (settings ^. windowParams . windowHeight . to fromIntegral)
|
||||
, windowResizable = True
|
||||
}
|
||||
managed $ bracket (createWindow title config) destroyWindow
|
||||
|
||||
-- Create an ImGui context
|
||||
_ <- managed $ bracket createContext destroyContext
|
||||
-- Create OpenGL Context
|
||||
glContext <- managed $ bracket (glCreateContext win) glDeleteContext
|
||||
|
||||
-- Create an ImPlot context
|
||||
-- _ <- managed $ bracket createPlotContext destroyPlotContext
|
||||
-- Create an ImGui context
|
||||
_ <- managed $ bracket createContext destroyContext
|
||||
|
||||
-- Initialize ImGui's GLFW backend
|
||||
_ <- managed_ $ bracket_ (glfwInitForOpenGL win True) glfwShutdown
|
||||
-- Create an ImPlot context
|
||||
_ <- managed $ bracket createPlotContext destroyPlotContext
|
||||
|
||||
-- Initialize ImGui's OpenGL backend
|
||||
_ <- managed_ $ bracket_ openGL3Init openGL3Shutdown
|
||||
-- Initialize ImGui's SDL2 backend
|
||||
_ <- managed_ $ bracket_ (sdl2InitForOpenGL win glContext) sdl2Shutdown
|
||||
|
||||
twsConnectionRefsHost <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . host . to T.unpack
|
||||
twsConnectionRefsPort <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . port . to T.unpack
|
||||
twsConnectionStatus <- liftIO $ atomically $ newTVar $ TWSDisconnected
|
||||
twsConnectionSend <- liftIO $ atomically $ newTQueue
|
||||
twsConnectionRecieve <- liftIO $ atomically $ newTQueue
|
||||
let twsConnectionRefs = TWSConnectionRefs{..}
|
||||
liftIO $ atomically $ writeTQueue twsConnectionSend $ Msg_IB_OUT $ IB_RequestMarketDataType DelayedFrozen
|
||||
currentAccount <- liftIO $ newTVarIO $ Nothing
|
||||
tickerIdToSymbol <- liftIO $ newTVarIO $ mempty
|
||||
appCharts <- liftIO $ newTVarIO $ mempty
|
||||
appData <- liftIO $ DataRefs
|
||||
<$> newTVarIO mempty
|
||||
<*> newTVarIO Nothing
|
||||
<*> newTVarIO mempty
|
||||
<*> newTVarIO mempty
|
||||
let app = App
|
||||
{ appSettings = settings
|
||||
, appLogFunc = lf
|
||||
, appProcessContext = pc
|
||||
, appOptions = options
|
||||
, appWindow = win
|
||||
, appRefs = AppRefs{..}
|
||||
, appData = appData
|
||||
}
|
||||
void $ liftIO $ forkIO $ appFiller app
|
||||
liftIO $ runRIO app run
|
||||
Nothing -> do
|
||||
error "GLFW createWindow failed"
|
||||
|
||||
GLFW.terminate
|
||||
-- Initialize ImGui's OpenGL backend
|
||||
_ <- managed_ $ bracket_ openGL3Init openGL3Shutdown
|
||||
|
||||
twsConnectionRefsHost <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . host . to T.unpack
|
||||
twsConnectionRefsPort <- liftIO $ atomically $ newTVar $ settings ^. twsConnection . port . to T.unpack
|
||||
twsConnectionStatus <- liftIO $ atomically $ newTVar $ TWSDisconnected
|
||||
twsConnectionSend <- liftIO $ atomically $ newTQueue
|
||||
twsConnectionRecieve <- liftIO $ atomically $ newTQueue
|
||||
let twsConnectionRefs = TWSConnectionRefs{..}
|
||||
liftIO $ atomically $ writeTQueue twsConnectionSend $ Msg_IB_OUT $ IB_RequestMarketDataType DelayedFrozen
|
||||
currentAccount <- liftIO $ newTVarIO $ Nothing
|
||||
tickerIdToSymbol <- liftIO $ newTVarIO $ mempty
|
||||
appCharts <- liftIO $ newTVarIO $ mempty
|
||||
appData <- liftIO $ DataRefs
|
||||
<$> newTVarIO mempty
|
||||
<*> newTVarIO Nothing
|
||||
<*> newTVarIO mempty
|
||||
<*> newTVarIO mempty
|
||||
let app = App
|
||||
{ appSettings = settings
|
||||
, appLogFunc = lf
|
||||
, appProcessContext = pc
|
||||
, appOptions = options
|
||||
, appWindow = win
|
||||
, appRefs = AppRefs{..}
|
||||
, appData = appData
|
||||
}
|
||||
void $ liftIO $ forkIO $ appFiller app
|
||||
liftIO $ runRIO app run
|
||||
|
7
cabal.project
Normal file
7
cabal.project
Normal file
@ -0,0 +1,7 @@
|
||||
packages: deps/dear-imgui.hs
|
||||
deps/dear-implot.hs
|
||||
*.cabal
|
||||
package ibhelper
|
||||
ghc-options: -Wall -Wcompat -fno-warn-unused-do-bind
|
||||
shared: false
|
||||
static: true
|
1
deps/dear-imgui.hs
vendored
1
deps/dear-imgui.hs
vendored
@ -1 +0,0 @@
|
||||
Subproject commit e5969f6b358dab01d9e2bea8d3538fdfbee0c2f1
|
1
deps/dear-imgui.hs
vendored
Symbolic link
1
deps/dear-imgui.hs
vendored
Symbolic link
@ -0,0 +1 @@
|
||||
dear-implot.hs/dear-imgui.hs/
|
2
deps/dear-implot.hs
vendored
2
deps/dear-implot.hs
vendored
@ -1 +1 @@
|
||||
Subproject commit 78f7df091ceb88f57eaacdb0a1e2d43cbce04566
|
||||
Subproject commit 9a62697e8d50aae80536b6c4dbe6cef67062a71d
|
166
ibhelper.cabal
166
ibhelper.cabal
@ -1,9 +1,10 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
-- This file has been generated from package.yaml by hpack version 0.27.0.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: db89b15a8762e7924ae32ea1dcce94b46e75d067b37cc058d3be20c1e0b98964
|
||||
|
||||
cabal-version: >= 1.10
|
||||
name: ibhelper
|
||||
version: 0.1.0.0
|
||||
description: Please see the README.md
|
||||
@ -15,9 +16,10 @@ copyright: 2022 Stefan Dresselhaus
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
README.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
@ -37,55 +39,22 @@ library
|
||||
Paths_ibhelper
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
BinaryLiterals
|
||||
ConstraintKinds
|
||||
DataKinds
|
||||
DefaultSignatures
|
||||
DeriveDataTypeable
|
||||
DeriveFoldable
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DoAndIfThenElse
|
||||
EmptyDataDecls
|
||||
ExistentialQuantification
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
FunctionalDependencies
|
||||
GADTs
|
||||
GeneralizedNewtypeDeriving
|
||||
InstanceSigs
|
||||
KindSignatures
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NoImplicitPrelude
|
||||
OverloadedStrings
|
||||
PartialTypeSignatures
|
||||
PatternGuards
|
||||
PolyKinds
|
||||
RankNTypes
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
TypeSynonymInstances
|
||||
ViewPatterns
|
||||
DuplicateRecordFields
|
||||
default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints
|
||||
include-dirs:
|
||||
deps/dear-implot.hs/implot
|
||||
deps/dear-imgui.hs/imgui
|
||||
extra-libraries:
|
||||
HSdear-imgui-1.4.0-inplace
|
||||
build-depends:
|
||||
GLFW-b
|
||||
, StateVar
|
||||
StateVar
|
||||
, aeson
|
||||
, base >=4.11 && <10
|
||||
, binary
|
||||
, bytestring
|
||||
, data-default
|
||||
, dear-imgui
|
||||
, dear-imgui >=1.4.0
|
||||
, dear-implot
|
||||
, directory
|
||||
, fingertree
|
||||
, gl
|
||||
@ -94,6 +63,7 @@ library
|
||||
, network
|
||||
, pretty-show
|
||||
, rio >=0.1.12.0
|
||||
, sdl2
|
||||
, stm
|
||||
, text
|
||||
, time
|
||||
@ -107,55 +77,22 @@ executable ibhelper-exe
|
||||
Paths_ibhelper
|
||||
hs-source-dirs:
|
||||
app
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
BinaryLiterals
|
||||
ConstraintKinds
|
||||
DataKinds
|
||||
DefaultSignatures
|
||||
DeriveDataTypeable
|
||||
DeriveFoldable
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DoAndIfThenElse
|
||||
EmptyDataDecls
|
||||
ExistentialQuantification
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
FunctionalDependencies
|
||||
GADTs
|
||||
GeneralizedNewtypeDeriving
|
||||
InstanceSigs
|
||||
KindSignatures
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NoImplicitPrelude
|
||||
OverloadedStrings
|
||||
PartialTypeSignatures
|
||||
PatternGuards
|
||||
PolyKinds
|
||||
RankNTypes
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
TypeSynonymInstances
|
||||
ViewPatterns
|
||||
DuplicateRecordFields
|
||||
default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||
include-dirs:
|
||||
deps/dear-implot.hs/implot
|
||||
deps/dear-imgui.hs/imgui
|
||||
extra-libraries:
|
||||
HSdear-imgui-1.4.0-inplace
|
||||
build-depends:
|
||||
GLFW-b
|
||||
, StateVar
|
||||
StateVar
|
||||
, aeson
|
||||
, base >=4.11 && <10
|
||||
, binary
|
||||
, bytestring
|
||||
, data-default
|
||||
, dear-imgui
|
||||
, dear-imgui >=1.4.0
|
||||
, dear-implot
|
||||
, directory
|
||||
, fingertree
|
||||
, gl
|
||||
@ -166,6 +103,7 @@ executable ibhelper-exe
|
||||
, optparse-simple
|
||||
, pretty-show
|
||||
, rio >=0.1.12.0
|
||||
, sdl2
|
||||
, stm
|
||||
, text
|
||||
, time
|
||||
@ -181,55 +119,22 @@ test-suite ibhelper-test
|
||||
Paths_ibhelper
|
||||
hs-source-dirs:
|
||||
test
|
||||
default-extensions:
|
||||
BangPatterns
|
||||
BinaryLiterals
|
||||
ConstraintKinds
|
||||
DataKinds
|
||||
DefaultSignatures
|
||||
DeriveDataTypeable
|
||||
DeriveFoldable
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DoAndIfThenElse
|
||||
EmptyDataDecls
|
||||
ExistentialQuantification
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
FunctionalDependencies
|
||||
GADTs
|
||||
GeneralizedNewtypeDeriving
|
||||
InstanceSigs
|
||||
KindSignatures
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
MultiWayIf
|
||||
NamedFieldPuns
|
||||
NoImplicitPrelude
|
||||
OverloadedStrings
|
||||
PartialTypeSignatures
|
||||
PatternGuards
|
||||
PolyKinds
|
||||
RankNTypes
|
||||
RecordWildCards
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeFamilies
|
||||
TypeSynonymInstances
|
||||
ViewPatterns
|
||||
DuplicateRecordFields
|
||||
default-extensions: BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns DuplicateRecordFields
|
||||
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
|
||||
include-dirs:
|
||||
deps/dear-implot.hs/implot
|
||||
deps/dear-imgui.hs/imgui
|
||||
extra-libraries:
|
||||
HSdear-imgui-1.4.0-inplace
|
||||
build-depends:
|
||||
GLFW-b
|
||||
, StateVar
|
||||
StateVar
|
||||
, aeson
|
||||
, base >=4.11 && <10
|
||||
, binary
|
||||
, bytestring
|
||||
, data-default
|
||||
, dear-imgui
|
||||
, dear-imgui >=1.4.0
|
||||
, dear-implot
|
||||
, directory
|
||||
, fingertree
|
||||
, gl
|
||||
@ -240,6 +145,7 @@ test-suite ibhelper-test
|
||||
, network
|
||||
, pretty-show
|
||||
, rio >=0.1.12.0
|
||||
, sdl2
|
||||
, stm
|
||||
, text
|
||||
, time
|
||||
|
12
package.yaml
12
package.yaml
@ -19,6 +19,13 @@ extra-source-files:
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README.md
|
||||
|
||||
include-dirs:
|
||||
- deps/dear-implot.hs/implot
|
||||
- deps/dear-imgui.hs/imgui
|
||||
|
||||
extra-libraries:
|
||||
- HSdear-imgui-1.4.0-inplace
|
||||
|
||||
default-extensions:
|
||||
- BangPatterns
|
||||
- BinaryLiterals
|
||||
@ -62,8 +69,7 @@ default-extensions:
|
||||
dependencies:
|
||||
- base >= 4.11 && < 10
|
||||
- rio >= 0.1.12.0
|
||||
- dear-imgui
|
||||
- GLFW-b
|
||||
- dear-imgui >= 1.4.0
|
||||
- managed
|
||||
- gl
|
||||
- aeson
|
||||
@ -81,6 +87,8 @@ dependencies:
|
||||
- time
|
||||
- unordered-containers
|
||||
- fingertree
|
||||
- dear-implot
|
||||
- sdl2
|
||||
|
||||
ghc-options:
|
||||
- -Wall
|
||||
|
@ -22,7 +22,7 @@ data FillerException = QuitFiller
|
||||
|
||||
instance Exception FillerException
|
||||
|
||||
deriving via Integer instance Hashable Day
|
||||
--deriving via Integer instance Hashable Day
|
||||
|
||||
newChart :: IBContract -> RIO App ()
|
||||
newChart contract = do
|
||||
|
80
src/Run.hs
80
src/Run.hs
@ -11,11 +11,12 @@ import Data.Aeson (encodeFile)
|
||||
import Data.Bits
|
||||
import Data.FingerTree (ViewL(..), ViewR(..), viewl, viewr, split, FingerTree)
|
||||
import DearImGui
|
||||
import DearImGui.Plot
|
||||
import DearImGui.OpenGL3
|
||||
import DearImGui.GLFW
|
||||
import DearImGui.SDL
|
||||
import Graphics.GL
|
||||
import SDL
|
||||
import Data.StateVar
|
||||
import qualified Graphics.UI.GLFW as GLFW
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.FingerTree as FT
|
||||
@ -30,29 +31,42 @@ run = do
|
||||
|
||||
-- close connections to IB
|
||||
|
||||
shutdownApp :: RIO App ()
|
||||
shutdownApp = do
|
||||
win <- appWindow <$> ask
|
||||
-- save settings & config
|
||||
(V2 w h) <- liftIO $ get $ windowSize win
|
||||
settings <- appSettings <$> ask
|
||||
refs <- appRefs <$> ask
|
||||
host' <- liftIO . readTVarIO . twsConnectionRefsHost . twsConnectionRefs $ refs
|
||||
port' <- liftIO . readTVarIO . twsConnectionRefsPort . twsConnectionRefs $ refs
|
||||
let settings' = settings & windowParams . windowWidth .~ fromIntegral w
|
||||
& windowParams . windowHeight .~ fromIntegral h
|
||||
& twsConnection . host .~ T.pack host'
|
||||
& twsConnection . port .~ T.pack port'
|
||||
liftIO $ encodeFile "settings.json" settings'
|
||||
logInfo $ display ("Settings Saved" :: Text)
|
||||
-- save cached data
|
||||
|
||||
logInfo $ display $ T.pack $ ppShow settings'
|
||||
|
||||
renderLoop :: RIO App ()
|
||||
renderLoop = do
|
||||
win <- appWindow <$> ask
|
||||
|
||||
liftIO GLFW.pollEvents
|
||||
close <- liftIO $ GLFW.windowShouldClose win
|
||||
let checkEvents = do
|
||||
pollEventWithImGui >>= \case
|
||||
Nothing ->
|
||||
return False
|
||||
Just event ->
|
||||
(isQuit event ||) <$> checkEvents
|
||||
|
||||
isQuit event =
|
||||
SDL.eventPayload event == SDL.QuitEvent
|
||||
|
||||
close <- liftIO checkEvents
|
||||
if close
|
||||
then do
|
||||
-- save settings & config
|
||||
(w,h) <- liftIO $ GLFW.getWindowSize win
|
||||
settings <- appSettings <$> ask
|
||||
refs <- appRefs <$> ask
|
||||
host' <- liftIO . readTVarIO . twsConnectionRefsHost . twsConnectionRefs $ refs
|
||||
port' <- liftIO . readTVarIO . twsConnectionRefsPort . twsConnectionRefs $ refs
|
||||
let settings' = settings & windowParams . windowWidth .~ w
|
||||
& windowParams . windowHeight .~ h
|
||||
& twsConnection . host .~ T.pack host'
|
||||
& twsConnection . port .~ T.pack port'
|
||||
liftIO $ encodeFile "settings.json" settings'
|
||||
logInfo $ display ("Settings Saved" :: Text)
|
||||
-- save cached data
|
||||
|
||||
logInfo $ display $ T.pack $ ppShow settings'
|
||||
then shutdownApp
|
||||
else do
|
||||
refs' <- appRefs <$> ask
|
||||
data' <- appData <$> ask
|
||||
@ -61,7 +75,7 @@ renderLoop = do
|
||||
-- Tell ImGui we're starting a new frame
|
||||
liftIO $ do
|
||||
openGL3NewFrame
|
||||
glfwNewFrame
|
||||
sdl2NewFrame
|
||||
newFrame
|
||||
|
||||
|
||||
@ -70,7 +84,7 @@ renderLoop = do
|
||||
withMenuOpen "File" $ do
|
||||
menuItem "Quit" >>= \case
|
||||
False -> return ()
|
||||
True -> liftIO $ GLFW.setWindowShouldClose win True
|
||||
True -> shutdownApp
|
||||
let cr = twsConnectionRefs refs'
|
||||
accs <- fmap HM.keys $ liftIO $ readTVarIO $ Types.accounts data'
|
||||
withComboOpen "Account" (maybe "Select account" T.unpack selectedAccount) $ do
|
||||
@ -146,12 +160,12 @@ renderLoop = do
|
||||
forM_ ((accs HM.! aid) ^.. accountPortfolio . traverse) $ \(IBPortfolioValue c p mp mv ac up rp) ->
|
||||
do
|
||||
tableNextRow
|
||||
whenM tableNextColumn (text $ T.unpack $ localSymbol c)
|
||||
whenM tableNextColumn (text $ show p)
|
||||
whenM tableNextColumn (text $ show up)
|
||||
whenM tableNextColumn (text $ show rp)
|
||||
whenM tableNextColumn (text $ show mp)
|
||||
whenM tableNextColumn (text $ show mv)
|
||||
tableNextColumn $ text $ T.unpack $ localSymbol c
|
||||
tableNextColumn $ text $ show p
|
||||
tableNextColumn $ text $ show up
|
||||
tableNextColumn $ text $ show rp
|
||||
tableNextColumn $ text $ show mp
|
||||
tableNextColumn $ text $ show mv
|
||||
|
||||
bracket_ (begin "Search Symbols") end $ do
|
||||
readTVarIO (currentAccount refs') >>= \case
|
||||
@ -177,7 +191,7 @@ renderLoop = do
|
||||
tableSetupColumn "Primary exchange"
|
||||
tableSetupColumn "Currency"
|
||||
tableSetupColumn "Available derivatives"
|
||||
withSortableTable $ \(mustSort, sortSpecs) -> do
|
||||
withSortableTable $ \mustSort sortSpecs -> do
|
||||
when mustSort $ liftIO $ pPrint sortSpecs
|
||||
tableHeadersRow
|
||||
lResult <- readTVarIO $ symbolLookupResults data'
|
||||
@ -190,9 +204,9 @@ renderLoop = do
|
||||
True -> do
|
||||
logInfo $ display $ "new chart open for: " <> _symbol
|
||||
newChart $ def { conId = _symbolId, symbol = _symbol, secType = _secType, exchange = "SMART", primaryExchange = _primaryExchange, currency = _currency}
|
||||
let printDatum x = whenM tableNextColumn $ text $ T.unpack x
|
||||
let printDatum x = tableNextColumn $ text $ T.unpack x
|
||||
tableNextRow
|
||||
whenM tableNextColumn $ do
|
||||
tableNextColumn $ do
|
||||
void $ selectableWith (defSelectableOptions { flags = ImGuiSelectableFlags_SpanAllColumns }) (T.unpack _symbol)
|
||||
openPopupOnItemClick popupName ImGuiPopupFlags_MouseButtonRight
|
||||
printDatum _secType
|
||||
@ -217,7 +231,7 @@ renderLoop = do
|
||||
showDemoWindow
|
||||
|
||||
-- Show the ImPlot demo window
|
||||
--showPlotDemoWindow
|
||||
showPlotDemoWindow
|
||||
|
||||
-- Render
|
||||
liftIO $ glClear GL_COLOR_BUFFER_BIT
|
||||
@ -225,6 +239,6 @@ renderLoop = do
|
||||
render
|
||||
liftIO $ openGL3RenderDrawData =<< getDrawData
|
||||
|
||||
liftIO $ GLFW.swapBuffers win
|
||||
liftIO $ glSwapWindow win
|
||||
|
||||
renderLoop
|
||||
|
@ -18,7 +18,7 @@ import Data.Time
|
||||
import Data.FingerTree
|
||||
import Data.Semigroup
|
||||
import GHC.Generics
|
||||
import Graphics.UI.GLFW (Window)
|
||||
import SDL (Window)
|
||||
import DearImGui
|
||||
import RIO
|
||||
import RIO.Process
|
||||
|
@ -31,6 +31,7 @@ resolver: lts-18.24
|
||||
packages:
|
||||
- .
|
||||
- deps/dear-imgui.hs
|
||||
- deps/dear-implot.hs
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver.
|
||||
# These entries can reference officially published versions as well as
|
||||
# forks / in-progress versions pinned to a git hash. For example:
|
||||
@ -50,8 +51,8 @@ allow-newer: true
|
||||
flags:
|
||||
dear-imgui:
|
||||
# libraries
|
||||
glfw: true
|
||||
sdl: false
|
||||
glfw: false
|
||||
sdl: true
|
||||
vulkan: false
|
||||
# hardware-requirements
|
||||
opengl3: true
|
||||
@ -73,7 +74,8 @@ flags:
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
# extra-lib-dirs: [/path/to/dir]
|
||||
extra-lib-dirs:
|
||||
- deps/dear-imgui.hs/build/
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
||||
|
Loading…
Reference in New Issue
Block a user