mirror of
https://github.com/fjvallarino/monomer.git
synced 2024-10-26 19:49:50 +03:00
Use stderr for diagnostic and error messages (#172)
This commit is contained in:
parent
fa526493c1
commit
353b4977fb
@ -28,6 +28,7 @@ import qualified Data.Text as T
|
||||
import Monomer.Common.BasicTypes
|
||||
import Monomer.Graphics.FFI
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Helper (putStrLnErr)
|
||||
|
||||
-- | Creates a font manager instance.
|
||||
makeFontManager
|
||||
@ -40,7 +41,7 @@ makeFontManager fonts dpr = do
|
||||
validFonts <- foldM (loadFont ctx) [] fonts
|
||||
|
||||
when (null validFonts) $
|
||||
putStrLn "Could not find any valid fonts. Text size calculations will fail."
|
||||
putStrLnErr "Could not find any valid fonts. Text size calculations will fail."
|
||||
|
||||
return $ newManager ctx
|
||||
|
||||
@ -104,7 +105,7 @@ loadFont ctx fonts (FontDef name path) = do
|
||||
res <- fmCreateFont ctx name path
|
||||
if res >= 0
|
||||
then return $ path : fonts
|
||||
else putStrLn ("Failed to load font: " ++ T.unpack name) >> return fonts
|
||||
else putStrLnErr ("Failed to load font: " ++ T.unpack name) >> return fonts
|
||||
|
||||
setFont :: FMContext -> Double -> Font -> FontSize -> FontSpace -> IO ()
|
||||
setFont ctx scale (Font name) (FontSize size) (FontSpace spaceH) = do
|
||||
|
@ -42,6 +42,7 @@ import qualified NanoVG.Internal.Image as VGI
|
||||
|
||||
import Monomer.Common
|
||||
import Monomer.Graphics.Types
|
||||
import Monomer.Helper (putStrLnErr)
|
||||
|
||||
import qualified Monomer.Common.Lens as L
|
||||
import qualified Monomer.Graphics.Lens as L
|
||||
@ -99,7 +100,7 @@ makeRenderer fonts dpr = do
|
||||
validFonts <- foldM (loadFont c) Set.empty fonts
|
||||
|
||||
when (null validFonts) $
|
||||
putStrLn "Could not find any valid fonts. Text will fail to be displayed."
|
||||
putStrLnErr "Could not find any valid fonts. Text will fail to be displayed."
|
||||
|
||||
envRef <- newIORef $ Env {
|
||||
overlays = Seq.empty,
|
||||
@ -356,7 +357,7 @@ loadFont c fonts (FontDef name path) = do
|
||||
res <- VG.createFont c name (VG.FileName path)
|
||||
case res of
|
||||
Just{} -> return $ Set.insert name fonts
|
||||
_ -> putStrLn ("Failed to load font: " ++ T.unpack name) >> return fonts
|
||||
_ -> putStrLnErr ("Failed to load font: " ++ T.unpack name) >> return fonts
|
||||
|
||||
setFont
|
||||
:: VG.Context
|
||||
@ -483,7 +484,7 @@ imgDelete name imagesMap = newImageMap where
|
||||
|
||||
clearImagesMap :: VG.Context -> ImagesMap -> IO ()
|
||||
clearImagesMap c imagesMap = do
|
||||
putStrLn "Clearing images map"
|
||||
putStrLnErr "Clearing images map"
|
||||
forM_ (M.elems imagesMap) $ \image ->
|
||||
VG.deleteImage c (_imNvImage image)
|
||||
|
||||
|
@ -16,6 +16,7 @@ module Monomer.Helper where
|
||||
import Control.Exception (SomeException, catch)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Data.Sequence (Seq(..))
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
|
||||
import qualified Data.Sequence as Seq
|
||||
|
||||
@ -76,3 +77,6 @@ catchAny = catch
|
||||
headMay :: [a] -> Maybe a
|
||||
headMay [] = Nothing
|
||||
headMay (x : _) = Just x
|
||||
|
||||
putStrLnErr :: String -> IO ()
|
||||
putStrLnErr msg = hPutStrLn stderr msg
|
||||
|
@ -50,7 +50,7 @@ import Monomer.Main.Types
|
||||
import Monomer.Main.Util
|
||||
import Monomer.Main.WidgetTask
|
||||
import Monomer.Graphics
|
||||
import Monomer.Helper (catchAny)
|
||||
import Monomer.Helper (catchAny, putStrLnErr)
|
||||
import Monomer.Widgets.Composite
|
||||
|
||||
import qualified Monomer.Lens as L
|
||||
@ -200,8 +200,8 @@ runAppLoop window glCtx channel widgetRoot config = do
|
||||
|
||||
case setupRes of
|
||||
RenderSetupMakeCurrentFailed msg -> do
|
||||
liftIO . putStrLn $ "Setup of the rendering thread failed: " ++ msg
|
||||
liftIO . putStrLn $ "Falling back to rendering in the main thread. "
|
||||
liftIO . putStrLnErr $ "Setup of the rendering thread failed: " ++ msg
|
||||
liftIO . putStrLnErr $ "Falling back to rendering in the main thread. "
|
||||
++ "The content may not be updated while resizing the window."
|
||||
|
||||
makeMainThreadRenderer
|
||||
@ -283,7 +283,7 @@ mainLoop window fontManager config loopArgs = do
|
||||
let baseSystemEvents = convertEvents convertCfg mousePos eventsPayload
|
||||
|
||||
-- when newSecond $
|
||||
-- liftIO . putStrLn $ "Frames: " ++ show _mlFrameCount
|
||||
-- liftIO . putStrLnErr $ "Frames: " ++ show _mlFrameCount
|
||||
|
||||
when quit $
|
||||
L.exitApplication .= True
|
||||
|
@ -52,7 +52,7 @@ import qualified SDL.Raw.Types as SDLT
|
||||
import Monomer.Core
|
||||
import Monomer.Event
|
||||
import Monomer.Graphics
|
||||
import Monomer.Helper (headMay, seqStartsWith)
|
||||
import Monomer.Helper (headMay, putStrLnErr, seqStartsWith)
|
||||
import Monomer.Main.Types
|
||||
import Monomer.Main.Util
|
||||
|
||||
@ -436,7 +436,7 @@ handleSetCursorIcon wid icon previousStep = do
|
||||
cursor <- Map.lookup icon <$> use L.cursorIcons
|
||||
|
||||
when (isNothing cursor) $
|
||||
liftIO . putStrLn $ "Invalid handleSetCursorIcon: " ++ show icon
|
||||
liftIO . putStrLnErr $ "Invalid handleSetCursorIcon: " ++ show icon
|
||||
|
||||
forM_ cursor SDLE.setCursor
|
||||
|
||||
@ -601,7 +601,6 @@ handleRaiseEvent
|
||||
-> HandlerStep s e
|
||||
-> m (HandlerStep s e)
|
||||
handleRaiseEvent message step = do
|
||||
--liftIO . putStrLn $ message ++ show (typeOf message)
|
||||
return step
|
||||
where
|
||||
message = "Invalid state. RaiseEvent reached main handler. Type: "
|
||||
@ -891,7 +890,7 @@ restoreCursorOnWindowEnter = do
|
||||
let sdlCursor = cursorPair >>= (`Map.lookup` cursorIcons) . snd
|
||||
|
||||
when (isNothing sdlCursor && isJust cursorPair) $
|
||||
liftIO. putStrLn $ "Invalid restoreCursorOnWindowEnter: " ++ show cursorPair
|
||||
liftIO. putStrLnErr $ "Invalid restoreCursorOnWindowEnter: " ++ show cursorPair
|
||||
|
||||
when (not prevInside && currInside && isJust sdlCursor) $ do
|
||||
SDLE.setCursor (fromJust sdlCursor)
|
||||
|
@ -43,7 +43,7 @@ import qualified SDL.Internal.Types as SIT
|
||||
import qualified SDL.Video.Renderer as SVR
|
||||
|
||||
import Monomer.Common
|
||||
import Monomer.Helper (catchAny)
|
||||
import Monomer.Helper (catchAny, putStrLnErr)
|
||||
import Monomer.Main.Types
|
||||
|
||||
foreign import ccall unsafe "initGlew" glewInit :: IO CInt
|
||||
@ -60,9 +60,10 @@ initSDLWindow config = do
|
||||
SDL.HintRenderScaleQuality $= SDL.ScaleLinear
|
||||
setDisableCompositorHint compositingFlag
|
||||
|
||||
do renderQuality <- SDL.get SDL.HintRenderScaleQuality
|
||||
when (renderQuality /= SDL.ScaleLinear) $
|
||||
putStrLn "Warning: Linear texture filtering not enabled!"
|
||||
renderQuality <- SDL.get SDL.HintRenderScaleQuality
|
||||
|
||||
when (renderQuality /= SDL.ScaleLinear) $
|
||||
putStrLnErr "Warning: Linear texture filtering not enabled!"
|
||||
|
||||
platform <- getPlatform
|
||||
initDpiAwareness
|
||||
@ -110,7 +111,7 @@ initSDLWindow config = do
|
||||
|
||||
err <- SRE.getError
|
||||
err <- STR.peekCString err
|
||||
putStrLn err
|
||||
putStrLnErr err
|
||||
|
||||
ctxRender <- SDL.glCreateContext window
|
||||
|
||||
@ -155,13 +156,12 @@ setWindowIcon (SIT.Window winPtr) config =
|
||||
(Raw.setWindowIcon winPtr iconSurfacePtr)
|
||||
(SVR.freeSurface iconSurface)
|
||||
where
|
||||
handleException err = putStrLn $
|
||||
handleException err = putStrLnErr $
|
||||
"Failed to set window icon. Does the file exist?\n\t" ++ show err ++ "\n"
|
||||
|
||||
-- | Destroys the provided window, shutdowns the video subsystem and SDL.
|
||||
detroySDLWindow :: SDL.Window -> IO ()
|
||||
detroySDLWindow window = do
|
||||
putStrLn "About to destroyWindow"
|
||||
SDL.destroyWindow window
|
||||
Raw.quitSubSystem Raw.SDL_INIT_VIDEO
|
||||
SDL.quit
|
||||
|
@ -28,7 +28,7 @@ import Data.Typeable
|
||||
import qualified Data.Sequence as Seq
|
||||
|
||||
import Monomer.Core
|
||||
import Monomer.Helper (collectJustM)
|
||||
import Monomer.Helper (collectJustM, putStrLnErr)
|
||||
import Monomer.Main.Handlers
|
||||
import Monomer.Main.Lens
|
||||
import Monomer.Main.Util
|
||||
@ -90,7 +90,7 @@ processTaskResult
|
||||
-> Either SomeException i
|
||||
-> m (HandlerStep s e)
|
||||
processTaskResult wenv widgetRoot _ (Left ex) = do
|
||||
liftIO . putStrLn $ "Error processing Widget task result: " ++ show ex
|
||||
liftIO . putStrLnErr $ "Error processing Widget task result: " ++ show ex
|
||||
return (wenv, widgetRoot, Seq.empty)
|
||||
processTaskResult wenv widgetRoot widgetId (Right taskResult)
|
||||
= processTaskEvent wenv widgetRoot widgetId taskResult
|
||||
|
Loading…
Reference in New Issue
Block a user