An image generated by `imageMem` doesn't respond any events

I want to make an application that shows a part of an image file and move the part with arrow keys. The repository is here. (Note that this repository doesn't contain a font file. Please copy the one from the monomer-starter repository.)

When I press the arrow keys, the values of _position in AppModel change, but the image doesn't change.

simplescreenrecorder-2021-11-16_14.16.40.mp4

However, if I change the initial position, the result is what I expected.

So I thought the image generated by imageMem didn't respond to any events. Is this the expected behavior?

GHC version: 8.10.7
cabal version: 3.6.2.0

I figured out what happened here. I didn't change the logical name of the image, so this branch

monomer/src/Monomer/Widgets/Singles/Image.hs

Lines 326 to 329 in 332b35e

    
           result 
        
             | oldSource == imgSource = resultNode sameImgNode 
        
             | isImageMem = resultReqs newNode newMemReqs 
        
             | otherwise = resultReqs newNode newImgReqs

always goes to oldSource == imgSource.
If I change the image name on every event, the image is updated. (link)

simplescreenrecorder-2021-11-17_11.05.25.mp4

I don't know whether this is the expected behavior or not, but since my problem is solved, I'll close this issue. Thank you.

Hi! Looks good! The only issue I see is this method would be recreating the image every time the user presses the arrow keys. I tested a couple of alternatives:

Using a scroll widget and its ScrollTo event. I think this is the ideal solution, but there seems to be a bug with ScrollTo that I will look into as soon as I get some time.
Using the padding property to offset the image. This is kind of cheating since it relies on how the image widget calculates its available space/renders the image, and that's why I consider the scroll version the correct one. Just in case, the box wrapper is there to avoid having the image have full-screen width (vstack assigns all the available horizontal space to its children).

I paste below the solution I tested. You will notice some scroll-related things (the image was previously wrapped in a scroll with key "imageScroll"). I left it there because I want to review it later, but you can ignore it. Only the padding part is interesting at this point:

{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Main
  ( main
  ) where

import qualified Codec.Picture                   as Pic
import           Codec.Picture.Extra             (crop)
import           Control.Lens                    (makeLenses, (&), (+~), (^.))
import qualified Data.ByteString                 as B
import qualified Data.Text                       as T
import           Data.Vector.Storable.ByteString (vectorToByteString)
import           Linear.V2                       (V2 (V2))
import           Monomer                         (AppEventResponse,
                                                  EventResponse (Event, Message, Model),
                                                  Rect (Rect), ScrollMessage (ScrollTo),
                                                  Size (Size), WidgetEnv,
                                                  WidgetNode, appFontDef,
                                                  appTheme, box_, darkTheme, image, imageMem,
                                                  keystroke, label, nodeKey, scroll, startApp,
                                                  styleBasic, vstack, width, height, alignLeft, paddingL, paddingT)
import           TextShow                        (TextShow (showt))

import qualified Monomer.Lens as L

data AppModel =
  AppModel
    { _position :: V2 Int,
      _imageSize :: (Int, Int)
    }
  deriving (Eq)

makeLenses ''AppModel

data Event
  = MoveUp
  | MoveDown
  | MoveRight
  | MoveLeft
  | UpdateScroll

vpWidth :: Double
vpWidth = 100

handleEvent ::
     WidgetEnv AppModel Event
  -> WidgetNode AppModel Event
  -> AppModel
  -> Event
  -> [AppEventResponse AppModel Event]
handleEvent _ _ model event =
  case event of
    MoveUp    -> [Model $ model & position +~ V2 0 (-1), Event UpdateScroll]
    MoveDown  -> [Model $ model & position +~ V2 0 1, Event UpdateScroll]
    MoveRight -> [Model $ model & position +~ V2 1 0, Event UpdateScroll]
    MoveLeft  -> [Model $ model & position +~ V2 (-1) 0, Event UpdateScroll]
    UpdateScroll -> [Message "imageScroll" (ScrollTo visibleRect)]
  where
    V2 x y = model ^. position
    visibleRect = Rect (fromIntegral x) (fromIntegral y) 1 1

buildUI :: WidgetEnv AppModel Event -> AppModel -> WidgetNode AppModel Event
buildUI wenv model = widgetTree
  where
    V2 px py = model ^. position
    widgetTree =
      withKeys $
      vstack
        [ box_ [alignLeft] $ image "dog.jpg"
            `nodeKey` "imageScroll"
            `styleBasic` [width 100, height 100, paddingL (fromIntegral px), paddingT (fromIntegral py)]
        ]
    withKeys =
      keystroke
        [ ("Up", MoveUp)
        , ("Down", MoveDown)
        , ("Right", MoveRight)
        , ("Left", MoveLeft)
        ]

main :: IO ()
main = do
  img <-
    Pic.convertRGBA8 .
    (\case
       Right x -> x
       Left _  -> error "Failed to load the image.") <$>
    Pic.readImage "./dog.jpg"
  let model = AppModel (V2 0 0) (Pic.imageWidth img, Pic.imageHeight img)
  startApp
    model
    handleEvent
    buildUI
    [appTheme darkTheme, appFontDef "Regular" "Roboto-Regular.ttf"]

I'll keep you posted regarding the scroll alternative.

Hi! Sorry for the delay. I added an onChange event to the scroll widget that provides information about the position of the scrollbars; this information allows for better control to handle your use case. The idea is to rely on the existing widgets, without having to manually load images. You can still create an image from a memory block if you're doing generative art but, once the image widget is created, you should not need to worry about updating it.

The updated example below should work fine if you add a file named cabal.project in the root of your project with this content:

packages: .

source-repository-package
    type: git
    location: https://github.com/fjvallarino/monomer.git
    tag: 41bb66744559c8b075746b34eeedf8808a0b916a

This is the updated example:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module Main
  ( main
  ) where

import Control.Lens
import Data.Default
import Monomer
import TextShow

import qualified Monomer.Lens as L

data AppModel =
  AppModel
    {
      _scrollInfo :: ScrollStatus,
      _rectX :: Double,
      _rectY :: Double
    }
  deriving (Eq)

makeLenses ''AppModel

data Event
  = MoveUp
  | MoveDown
  | MoveRight
  | MoveLeft
  | UpdateScroll
  | ScrollChanged ScrollStatus

step :: Double
step = 20

handleEvent ::
     WidgetEnv AppModel Event
  -> WidgetNode AppModel Event
  -> AppModel
  -> Event
  -> [AppEventResponse AppModel Event]
handleEvent _ _ model event =
  case event of
    MoveUp    -> [
      Model $ model
        & rectY .~ max 0 (deltaY + sy - step),
        Event UpdateScroll]
    MoveDown  -> [
        Model $ model
          & rectY .~ min (sy + ch) (deltaY + sy + vph + step),
        Event UpdateScroll]
    MoveRight -> [
      Model $ model
        & rectX .~ min (sx + cw) (deltaX + sx + vpw + step),
      Event UpdateScroll]
    MoveLeft  -> [
      Model $ model
        & rectX .~ max 0 (deltaX + sx - step),
        Event UpdateScroll]
    UpdateScroll -> [Message "imageScroll" (ScrollTo visibleRect)]
    ScrollChanged info -> [
        Model $ model
          & scrollInfo .~ info
      ]
  where
    deltaX = -1 * scrollDeltaX (model ^. scrollInfo)
    deltaY = -1 * scrollDeltaY (model ^. scrollInfo)
    Rect sx sy _ _ = scrollRect (model ^. scrollInfo)
    Size vpw vph = scrollVpSize (model ^. scrollInfo)
    Size cw ch = scrollChildSize (model ^. scrollInfo)
    visibleRect = Rect (model ^. rectX) (model ^. rectY) 1 1

buildUI :: WidgetEnv AppModel Event -> AppModel -> WidgetNode AppModel Event
buildUI wenv model = widgetTree
  where
    widgetTree =
      withKeys $
      vstack
        [ box_ [alignLeft] $ scroll_ [scrollInvisible, onChange ScrollChanged] (image "dog.jpg")
            `nodeKey` "imageScroll"
            `styleBasic` [width 200, height 200]
        ] `styleBasic` [padding 50]
    withKeys =
      keystroke
        [ ("Up", MoveUp)
        , ("Down", MoveDown)
        , ("Right", MoveRight)
        , ("Left", MoveLeft)
        ]

main :: IO ()
main = do
  let model = AppModel def 0 0
  startApp
    model
    handleEvent
    buildUI
    [appTheme darkTheme, appFontDef "Regular" "assets/fonts/Roboto-Regular.ttf"]

I think this functionality should be available out of the box (optionally). However, I'm still on the fence on whether adding it to scroll is the best option or having a separate widget that can wrap an existing scroll is the best option.

If you have a chance to test it, let me know if it covers your use case. Thanks!

Happy new year, and sorry for the delay. I confirmed that your code works. Thank you.

If you have a chance to test it, let me know if it covers your use case. Thanks!

Yes, I believe this satisfies my use case. (In fact, my original purpose was to make a roguelike game, and I was trying to implement the smooth map scrolling when the player moves.)

I'll close this issue for the time being. I'll look into adding a native keyboard-based scrolling solution in version 1.4.

If you have any other questions, please re-open the issue or create a new one. Thanks!

	result
	\| oldSource == imgSource = resultNode sameImgNode
	\| isImageMem = resultReqs newNode newMemReqs
	\| otherwise = resultReqs newNode newImgReqs