Skip to content

Commit

Permalink
Add dialog to pick files or directories
Browse files Browse the repository at this point in the history
  • Loading branch information
ad-si committed Dec 23, 2024
1 parent 7825274 commit eedbee1
Show file tree
Hide file tree
Showing 21 changed files with 8,385 additions and 29 deletions.
1 change: 1 addition & 0 deletions brillo-examples/README.md
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ Command | Result
`stack run brillo-lifespan` | <img src="picture/Lifespan/screenshot.png" style="max-height: 250px"/>
`stack run brillo-machina` | <img src="picture/Machina/screenshot.png" style="max-height: 250px"/>
`stack run brillo-occlusion` | <img src="picture/Occlusion/screenshot.png" style="max-height: 250px"/>
`stack run brillo-pickfiles` | <img src="picture/PickFiles/screenshot.png" style="max-height: 250px"/>
`stack run brillo-render` | <img src="picture/Render/screenshot.png" style="max-height: 250px"/>
`stack run brillo-styrene` | <img src="picture/Styrene/screenshot.png" style="max-height: 250px"/>
`stack run brillo-tree` | <img src="picture/Tree/screenshot.png" style="max-height: 250px"/>
Expand Down
10 changes: 10 additions & 0 deletions brillo-examples/brillo-examples.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -207,6 +207,16 @@ executable brillo-occlusion

ghc-options: -O2 -threaded -rtsopts

executable brillo-pickfiles
default-language: GHC2021
main-is: Main.hs
hs-source-dirs: picture/PickFiles
build-depends:
, base >=4.8 && <5
, brillo >=1.13.3 && <1.15

ghc-options: -O2 -Wall -threaded -rtsopts

executable brillo-styrene
default-language: GHC2021
main-is: Main.hs
Expand Down
105 changes: 105 additions & 0 deletions brillo-examples/picture/PickFiles/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Brillo.Data.Color (white)
import Brillo.Data.Display (Display (InWindow))
import Brillo.Data.FileDialog (
FileDialog (..),
SelectionMode (..),
)
import Brillo.Data.Picture (Picture (Pictures, Scale, Text, Translate))
import Brillo.Interface.Environment (openFileDialog)
import Brillo.Interface.IO.Game (
Event (EventKey),
Key (MouseButton),
KeyState (Down),
MouseButton (LeftButton, RightButton),
playIO,
)
import Data.Function ((&))
import Data.Functor ((<&>))


size :: (Num width, Num height) => (width, height)
size = (600, 600)


data State
= NotAsked
| Success [FilePath]
| Failure String


moveToTopLeftWithOffset :: Float -> Picture -> Picture
moveToTopLeftWithOffset offset = do
let
w = fst (size :: (Float, Float))
h = snd (size :: (Float, Float))
Translate (-(w / 2) + offset) (h / 2 - offset)


makePicture :: State -> IO Picture
makePicture state =
case state of
NotAsked ->
pure $
Pictures
[ moveToTopLeftWithOffset 50 $
Scale 0.2 0.2 $
Text "Left-click anywhere to pick files or"
, moveToTopLeftWithOffset 100 $
Scale 0.2 0.2 $
Text "right-click to pick a directory"
]
Failure errorMessage ->
pure $
Pictures
[moveToTopLeftWithOffset 30 $ Scale 0.1 0.1 $ Text errorMessage]
Success filePaths ->
pure $
Pictures $
filePaths & zip [(1 :: Int) ..] <&> \(i, filePath) ->
moveToTopLeftWithOffset 0 $
Translate 10 (fromIntegral (-(25 * i))) $
Scale 0.1 0.1 $
Text filePath


handleEvent :: Event -> State -> IO State
handleEvent event state =
case event of
EventKey (MouseButton mouseButton) Down _modifiers _point -> do
filePathsMb <-
openFileDialog $
FileDialog
{ title = "Pick Files"
, defaultPath = "."
, filterPatterns = []
, filterDescription = "All files"
, selectionMode = case mouseButton of
LeftButton -> MultiFileSelect
RightButton -> SingleDirectorySelect
_ -> MultiFileSelect
}
case filePathsMb of
Just filePaths -> return $ Success filePaths
Nothing -> return $ Failure "No files were picked"
_ -> return state


stepWorld :: Float -> State -> IO State
stepWorld _ = return


main :: IO ()
main = do
let state = NotAsked
playIO
(InWindow "PickFiles" size (0, 0))
white
100
state
makePicture
handleEvent
stepWorld
Binary file added brillo-examples/picture/PickFiles/screenshot.png
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
2 changes: 1 addition & 1 deletion brillo-rendering/Brillo/Internals/Rendering/VectorFont.hs
Original file line number Diff line number Diff line change
Expand Up @@ -285,7 +285,7 @@ canvastextFont = VectorFont $ fromList
,(3,8),(3,6),(4,3),(6,1),(8,0),(11,0),(13,1),(15,3)]]))
, ('b',(15,[[(4,11),(6,13),(8,14),(11,14),(13,13),(15,11),(16,8),(16,6),(15,3)
,(13,1),(11,0),(8,0),(6,1),(4,3)],[(4,0),(4,21)]]))
, ('c',(14,[[(15,3),(13,1),(11,0),(8,0),(6,1),(4,3),(3,6),(3,8),(4,11),(6,13)
, ('c',(15,[[(15,3),(13,1),(11,0),(8,0),(6,1),(4,3),(3,6),(3,8),(4,11),(6,13)
,(8,14),(11,14),(13,13),(15,11)]]))
, ('d',(14,[[(12,11),(10,13),(8,14),(6,14),(4,13),(2,11),(1,8),(1,6),(2,3)
,(4,1),(6,0),(8,0),(10,1),(12,3)],[(12,0),(12,21)]]))
Expand Down
1 change: 1 addition & 0 deletions brillo/.gitattributes
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
/cbits/* linguist-vendored
33 changes: 33 additions & 0 deletions brillo/Brillo/Data/FileDialog.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
module Brillo.Data.FileDialog (
FileDialog (..),
SelectionMode (..),
)
where

import Data.Text (Text)


data SelectionMode
= SingleFileSelect
| MultiFileSelect
| SingleDirectorySelect
deriving (Show, Eq)


{-| The 'FileDialog' represents a dialog
| that can be opened by the user to select files or directories.
-}
data FileDialog
= FileDialog
{ title :: !Text
-- ^ Title of the dialog
, defaultPath :: !Text
-- ^ Default path to open the dialog at
, filterPatterns :: ![Text]
-- ^ Filter patterns like `["*.jpg", "*.png"]`
, filterDescription :: !Text
-- ^ Filter description like `"text files"`
, selectionMode :: !SelectionMode
-- ^ Single or multiple selections
}
deriving (Show, Eq)
8 changes: 3 additions & 5 deletions brillo/Brillo/Data/ViewState.hs
Original file line number Diff line number Diff line change
Expand Up @@ -302,11 +302,9 @@ updateViewStateWithEventMaybe (EventMotion pos) viewState =
`mplus` motionTranslate (viewStateTranslateMark viewState) pos viewState
`mplus` motionRotate (viewStateRotateMark viewState) pos viewState

updateViewStateWithEventMaybe (EventResize _) _ =
Nothing

updateViewStateWithEventMaybe (EventDrop _) _ =
Nothing
updateViewStateWithEventMaybe (EventDrop _) _ = Nothing
updateViewStateWithEventMaybe (EventPick _) _ = Nothing
updateViewStateWithEventMaybe (EventResize _) _ = Nothing


-- | Zoom in a `ViewState` by the scale step.
Expand Down
12 changes: 12 additions & 0 deletions brillo/Brillo/Interface/Environment.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module Brillo.Interface.Environment where

import Data.IORef (newIORef)

import Brillo.Data.FileDialog (FileDialog)
import Brillo.Internals.Interface.Backend (defaultBackendState)
import Brillo.Internals.Interface.Backend.Types qualified as Backend.Types

Expand All @@ -16,3 +17,14 @@ getScreenSize = do
backendStateRef <- newIORef defaultBackendState
Backend.Types.initializeBackend backendStateRef False
Backend.Types.getScreenSize backendStateRef


{-| Open a file dialog to select files/directories.
Returns a list of paths, or `Nothing` if the dialog was cancelled.
-}
openFileDialog :: FileDialog -> IO (Maybe [FilePath])
openFileDialog fileDialog = do
backendStateRef <- newIORef defaultBackendState
Backend.Types.initializeBackend backendStateRef False
Backend.Types.openFileDialog backendStateRef fileDialog
31 changes: 31 additions & 0 deletions brillo/Brillo/Internals/Interface/Backend/GLFW.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# OPTIONS_HADDOCK hide #-}

-- | Support for using GLFW as the window manager backend.
Expand All @@ -8,12 +9,16 @@ where
import Control.Concurrent (threadDelay)
import Control.Exception qualified as X
import Control.Monad (unless, when)
import Data.Functor ((<&>))
import Data.IORef (IORef, modifyIORef', readIORef, writeIORef)
import Data.Maybe (fromJust)
import Data.Text qualified as T
import GHC.Desugar ((>>>))
import Graphics.Rendering.OpenGL (($=))
import Graphics.Rendering.OpenGL qualified as GL
import Graphics.UI.GLFW qualified as GLFW

import Brillo.Data.FileDialog (FileDialog (..), SelectionMode (..))
import Brillo.Internals.Interface.Backend.Types (
Backend (..),
Callback (..),
Expand All @@ -24,6 +29,8 @@ import Brillo.Internals.Interface.Backend.Types (
MouseButton (..),
SpecialKey (..),
)
import Brillo.Internals.TinyFileDialogs as TinyFileDialogs
import Data.List (singleton)


-- | State of the GLFW backend library.
Expand Down Expand Up @@ -85,6 +92,7 @@ instance Backend GLFWState where
postRedisplay = postRedisplayGLFW
getWindowDimensions ref = windowHandle ref >>= \win -> GLFW.getWindowSize win
getScreenSize = getScreenSizeGLFW
openFileDialog = openFileDialogGLFW
elapsedTime _ = GLFW.getTime >>= \mt -> return $ fromJust mt
sleep _ sec = threadDelay (floor (sec * 1000000.0)) -- GLFW.sleep sec)

Expand Down Expand Up @@ -184,6 +192,29 @@ getScreenSizeGLFW _state = do
pure (sizeX, sizeY)


-- | Open a file dialog. Return `Nothing` if the user cancels the dialog.
openFileDialogGLFW :: IORef GLFWState -> FileDialog -> IO (Maybe [FilePath])
openFileDialogGLFW _state fileDialog = do
case fileDialog.selectionMode of
SingleDirectorySelect -> do
dirPathMb <-
TinyFileDialogs.selectFolderDialog
fileDialog.title
fileDialog.defaultPath

return (dirPathMb <&> T.unpack >>> singleton)
_ -> do
filePathsMb <-
TinyFileDialogs.openFileDialog
fileDialog.title
fileDialog.defaultPath
fileDialog.filterPatterns
fileDialog.filterDescription
(fileDialog.selectionMode == MultiFileSelect)

return $ filePathsMb <&> (<&> T.unpack)


-- Dump State -----------------------------------------------------------------

-- | Print out the internal GLFW state.
Expand Down
10 changes: 8 additions & 2 deletions brillo/Brillo/Internals/Interface/Backend/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,8 @@ module Brillo.Internals.Interface.Backend.Types (
where

import Brillo.Data.Display
import Data.IORef ( IORef )
import Brillo.Data.FileDialog (FileDialog)
import Data.IORef (IORef)


{-| The functions every backend window managed backend needs to support.
Expand Down Expand Up @@ -64,7 +65,7 @@ class Backend a where
installMotionCallback :: IORef a -> [Callback] -> IO ()


-- | Install the mouse motion callbacks.
-- | Install the file/directory drop callbacks.
installDropCallback :: IORef a -> [Callback] -> IO ()


Expand All @@ -88,6 +89,10 @@ class Backend a where
getScreenSize :: IORef a -> IO (Int, Int)


-- | Open a file dialog to pick files/directories.
openFileDialog :: IORef a -> FileDialog -> IO (Maybe [FilePath])


-- | Function that reports the time elapsed since the application started.
-- (in seconds)
elapsedTime :: IORef a -> IO Double
Expand Down Expand Up @@ -130,6 +135,7 @@ type DropCallback =
type ReshapeCallback =
forall a. (Backend a) => IORef a -> (Int, Int) -> IO ()


-------------------------------------------------------------------------------
data Callback
= Display DisplayCallback
Expand Down
1 change: 0 additions & 1 deletion brillo/Brillo/Internals/Interface/Callback.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,4 +13,3 @@ module Brillo.Internals.Interface.Callback (
where

import Brillo.Internals.Interface.Backend.Types

11 changes: 11 additions & 0 deletions brillo/Brillo/Internals/Interface/Event.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@ module Brillo.Internals.Interface.Event (
keyMouseEvent,
motionEvent,
dropEvent,
pickEvent,
)
where

Expand All @@ -18,6 +19,7 @@ data Event
| EventMotion (Float, Float)
| EventResize (Int, Int)
| EventDrop [FilePath]
| EventPick [FilePath]
deriving (Eq, Show)


Expand Down Expand Up @@ -53,6 +55,15 @@ dropEvent
dropEvent _backendRef paths =
return $ EventDrop paths

pickEvent
:: forall a
. (Backend a)
=> IORef a
-> [FilePath]
-> IO Event
pickEvent _backendRef paths =
return $ EventPick paths

convertPoint
:: forall a
. (Backend a)
Expand Down
5 changes: 2 additions & 3 deletions brillo/Brillo/Internals/Interface/Window.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,11 +78,10 @@ createWindow
eatBackend backendStateRef

when debug $
do putStr $ "* entering mainloop..\n"
do putStr "* entering mainloop..\n"

-- Start the main backend loop
runMainLoop backendStateRef

when debug $
putStr $
"* all done\n"
putStr "* all done\n"
Loading

0 comments on commit eedbee1

Please sign in to comment.