Make sure image is registered when rendering

README.md

@@ -1 +1,25 @@
-# hs-music
+# Monomer
+
+An easy to use, Elm inspired, GUI library.
+
+## Objectives
+
+- It should be easy to use, in particular for newcomers
+- It should be possible to extend with custom widgets
+- It should work on Windows, Linux and macOS
+- It should not rely on OS specific APIs (currently it uses OpenGL through NanoVG)
+- It should have good documentation
+- It should have good examples
+
+### Ideally, this project will
+
+- Be able to run in mobile
+- Support Vulkan/Metal
+- Have few bugs
+
+### These are NOT objectives for this project
+
+- Have a native look and feel
+- Provide multi-platform support beyond what SDL already provides
+- Use advanced type level techniques to avoid user errors
+- Be a research project pushing the boundaries on how GUIs are created

docs/design-decisions.md

@@ -0,0 +1 @@
+Why do you use hidden internal state instead of having the user use the hidden type explicitely in their model?

src/Monomer/Graphics/NanoVGRenderer.hs

@@ -43,8 +43,8 @@ data Image = Image {
 
 data ImageReq = ImageReq {
   _irName :: String,
-  _irWidth :: Int,
-  _irHeight :: Int,
+  _irWidth :: Double,
+  _irHeight :: Double,
   _irImgData :: Maybe BS.ByteString,
   _irAction :: Action
 }
@@ -271,8 +271,9 @@ newRenderer c dpr lock envRef = Renderer {..} where
       textRect = computeTextRect rect font fontSize align message
       CRect tx ty _ _ = rectToCRect textRect dpr
 
-  addImage name w h replace imgData = addPending lock envRef imageReq where
+  addImage name size replace imgData = addPending lock envRef imageReq where
     action = if replace then AddReplace else AddKeep
+    Size w h = size
     imageReq = ImageReq name w h (Just imgData) action
 
   updateImage name imgData = addPending lock envRef imageReq where
@@ -281,6 +282,10 @@ newRenderer c dpr lock envRef = Renderer {..} where
   deleteImage name = addPending lock envRef imageReq where
     imageReq = ImageReq name 0 0 Nothing Delete
 
+  existsImage name = unsafePerformIO $ do
+    env <- readIORef envRef
+    return $ M.member name (imagesMap env)
+
   renderImage rect name = do
     env <- readIORef envRef
     mapM_ (handleRender c dpr rect) $ M.lookup name (imagesMap env)
@@ -335,8 +340,8 @@ handlePendingImage c imagesMap imageReq
   where
     name = _irName imageReq
     action = _irAction imageReq
-    cw = fromIntegral $ _irWidth imageReq
-    ch = fromIntegral $ _irHeight imageReq
+    cw = round $ _irWidth imageReq
+    ch = round $ _irHeight imageReq
     imgData = fromJust $ _irImgData imageReq
     mimage = M.lookup name imagesMap
     imageExists = isJust mimage

src/Monomer/Graphics/Types.hs

@@ -120,9 +120,10 @@ data Renderer = Renderer {
   computeTextRect :: Rect -> Font -> FontSize -> Align -> Text -> Rect,
   renderText :: Rect -> Font -> FontSize -> Align -> Text -> IO Rect,
   -- Image
-  addImage :: String -> Int -> Int -> Bool -> ByteString -> IO (),
+  addImage :: String -> Size -> Bool -> ByteString -> IO (),
   updateImage :: String -> ByteString -> IO (),
   deleteImage :: String -> IO (),
+  existsImage :: String -> Bool,
   renderImage :: Rect -> String -> IO ()
 }
 

src/Monomer/Widget/Widgets/Image.hs

@@ -1,6 +1,8 @@
 module Monomer.Widget.Widgets.Image (image) where
 
 import Codec.Picture (DynamicImage, Image(..), convertRGBA8, readImage)
+import Control.Monad (when)
+import Data.ByteString (ByteString)
 import Data.Default
 import Data.Maybe
 import Data.Typeable (cast)
@@ -13,16 +15,17 @@ import Monomer.Widget.BaseSingle
 import Monomer.Widget.Types
 import Monomer.Widget.Util
 
-newtype ImageState = ImageState {
-  isSize :: Maybe Size
+data ImageState = ImageState {
+  isImageData :: Maybe ByteString,
+  isImageSize :: Maybe Size
 }
 
 data ImageMessage
-  = ImageLoaded Size
+  = ImageLoaded ImageState
   | ImageFailed
 
 imageState :: ImageState
-imageState = ImageState Nothing
+imageState = ImageState Nothing Nothing
 
 image :: String -> WidgetInstance s e
 image path = defaultWidgetInstance "image" (makeImage path imageState)
@@ -51,22 +54,29 @@ makeImage imgPath state = widget where
     result = cast message >>= useImage inst
 
   useImage inst ImageFailed = Nothing
-  useImage inst (ImageLoaded newSize) = Just $ resultReqs [Resize] newInst where
+  useImage inst (ImageLoaded newState) = result where
     newInst = inst {
-      _wiWidget = makeImage imgPath (ImageState $ Just newSize)
+      _wiWidget = makeImage imgPath newState
     }
+    result = Just $ resultReqs [Resize] newInst
 
   getSizeReq wenv inst = sizeReq where
     theme = activeTheme wenv inst
     style = activeStyle wenv inst
-    size = fromMaybe def (isSize state)
+    size = fromMaybe def (isImageSize state)
     sizeReq = SizeReq size FlexibleSize FlexibleSize
 
-  render renderer wenv inst =
+  render renderer wenv inst = do
+    when (imageLoaded && not imageExists) $
+      addImage renderer imgPath (fromJust imgSize) False (fromJust imgData)
+
     drawStyledImage renderer contentRect style imgPath
     where
       style = activeStyle wenv inst
       contentRect = getContentRect style inst
+      ImageState imgData imgSize = state
+      imageLoaded = isJust imgData
+      imageExists = existsImage renderer imgPath
 
 loadImage :: WidgetEnv s e -> String -> IO ImageMessage
 loadImage wenv path = do
@@ -87,8 +97,8 @@ registerImg
   -> IO ImageMessage
 registerImg wenv name Left{} = return ImageFailed
 registerImg wenv name (Right dimg) = do
-  addImage renderer name cw ch False bs
-  return $ ImageLoaded size
+  addImage renderer name size False bs
+  return $ ImageLoaded newState
   where
     renderer = _weRenderer wenv
     img = convertRGBA8 dimg
@@ -96,3 +106,7 @@ registerImg wenv name (Right dimg) = do
     ch = imageHeight img
     size = Size (fromIntegral cw) (fromIntegral ch)
     bs = vectorToByteString $ imageData img
+    newState = ImageState {
+      isImageData = Just bs,
+      isImageSize = Just size
+    }