RGB Terminal Colors with Haskell and Brick - haskell

I know that the Brick and the VTY hackage do not support escape sequences. VTY only supports 240 colors.
Is there any workaround to use true RGB colors and not mess up the layout?
This is an example I made, but I can't get the border right:
module BrickTest where
import Brick (simpleMain, Widget, str)
import Brick.Widgets.Border (border)
import Text.Printf (printf)
main :: IO ()
main = simpleMain $ colorWidget (255, 0, 0)
type RGB = (Int, Int, Int)
colorWidget :: RGB -> Widget ()
colorWidget (r, g, b) = border $ str (prefix ++ "a" ++ postfix)
where
prefix = printf "\ESC[38;2;%d;%d;%dm" r g b
postfix = "\ESC[0m"
output:
┌──────────────────┐
│a│
└──────────────────┘

I found a workaround. I managed to implement a function zeroWidthStr that can print any string, and Brick handles it as if it has width 0. But I can't really explain how this is working internally, and it might have some other side effects.
module BrickTest where
import Brick (Widget, raw, simpleMain, str,
(<+>))
import Brick.Widgets.Border (border)
import Data.List (intercalate)
import Data.Text.Lazy (pack)
import Graphics.Vty (defAttr)
import Graphics.Vty.Image.Internal (Image (HorizText))
import Text.Printf (printf)
main :: IO ()
main = simpleMain $ colorWidget (255, 0, 0)
type RGB = (Int, Int, Int)
colorWidget :: RGB -> Widget ()
colorWidget (r, g, b) = border $ prefix <+> str "a" <+> postfix
where
prefix = zeroWidthStr $ printf "\ESC[38;2;%d;%d;%dm" r g b
postfix = zeroWidthStr $ "\ESC[0m"
zeroWidthStr :: String -> Widget ()
-- | workaround to print any string in terminal, and hackage Brick (vty) handles it as if it has width 0
zeroWidthStr str = raw image
where
image = HorizText defAttr (pack modStr) 0 0
modStr = str ++ repeatN "\ESC\ESCa" (length str)
repeatN :: String -> Int -> String
repeatN str n = intercalate "" $ take n $ repeat str
output:

Related

How to adjust transparency and color of a Haskell GNUPlot

this is somewhat of a two part question.
I am trying to adjust the colour of a plot, using Haskell GNUPlot:
https://hackage.haskell.org/package/gnuplot
The code I have so far is:
import qualified Graphics.Gnuplot.Frame as Frame
import qualified Graphics.Gnuplot.Frame.OptionSet as Opts
import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D
import qualified Graphics.Gnuplot.Advanced as GP
import qualified Graphics.Gnuplot.LineSpecification as LineSpec
import qualified Graphics.Gnuplot.ColorSpecification as Color
test :: [(Double, Double, Double)] -> Frame.T (Graph2D.T Double Double)
test input =
let x = [a | (a,b,c) <- input]
lower = [b | (a,b,c) <- input]
upper = [c | (a,b,c) <- input]
inputTuple = zip x (zip lower upper)
lineSpec =
Graph2D.lineSpec $
LineSpec.title "runtimes" $
LineSpec.lineWidth 2.5 $
LineSpec.lineColor (Color.rgb 0 0 1) $
LineSpec.deflt
frameOpts =
Opts.xLabel "input size" $
Opts.yLabel "runtime (ms)" $
Opts.title ("Graph from ") $
Opts.deflt
in Frame.cons frameOpts $ fmap lineSpec $
Plot2D.list Graph2D.filledStripe inputTuple
Specifically for
LineSpec.lineColor (Color.rgb 0 0 0), this is of type Color.T but for some reason, whenever I try to run this code:
GP.plotDefault test (zip3 [1,2,3] [1,2,3] [2,3,4])
, it doesn't show anything.
However, if I switch this code to
LineSpec.lineColor (Color.blue) for example, then the code returns the wanted plot. However, Color.blue is also of type Color.T, so I am not sure as to why this works, but Color.rgb 0 0 0 doesn't...
Also, is it possible to make the plot colour transparent?
I know that it is possible for Gnuplot.Simple. but I have no managed to figure out how it is possible in Gnuplot.Advanced?

Make variable from input accessible from the whole code

Is this even possible? I have a main that saves an Int (width) given by the user as a variable, but I need that variable in a bunch of other functions... Is there a way to do this other than adding 'width' as an argument to every function?
I'll show a simple example of reader monad usage.
This code:
area :: Double -> Double -> Double
area height width = height * width
main = do
width <- fmap read getLine
let result = area 42 width
print result
Becomes:
import Control.Monad.Reader
area :: MonadReader Double m => Double -> m Double
area height = do
width <- ask
return (width * height)
main :: IO ()
main = do
width <- fmap read getLine
let result = runReader (area 42) width
print result
This seems more complicated, but it's actually quite nice when you have a lot of "configuration" parameters to pass around.
import Control.Monad.Reader
data Config = Config { width :: Double, color :: String, etc :: String }
area :: MonadReader Config m => Double -> m Double
area height = do
w <- asks width
return (w * height)
main :: IO ()
main = do
w <- fmap read getLine
c <- undefined -- todo get color param
e <- undefined -- todo get etc param
let result = runReader (area 42) (Config w c e)
print result

Why does this not run in constant memory?

I am trying to write a very large amount of data to a file in constant memory.
import qualified Data.ByteString.Lazy as B
{- Creates and writes num grids of dimensions aa x aa -}
writeGrids :: Int -> Int -> IO ()
writeGrids num aa = do
rng <- newPureMT
let (grids,shuffleds) = createGrids rng aa
createDirectoryIfMissing True "data/grids/"
B.writeFile (gridFileName num aa)
(encode (take num grids))
B.writeFile (shuffledFileName num aa)
(encode (take num shuffleds))
However this consumes memory proportional to the size of num. I know createGrids is a sufficiently lazy function because I have tested it by appending error "not lazy enough" (as suggested by the Haskell wiki here) to the end of the lists it returns and no errors are raised. take is a lazy function that is defined in Data.List. encode is also a lazy function defined in Data.Binary. B.writeFile is defined in Data.ByteString.Lazy.
Here is the complete code so you can execute it:
import Control.Arrow (first)
import Data.Binary
import GHC.Float (double2Float)
import System.Random (next)
import System.Random.Mersenne.Pure64 (PureMT, newPureMT, randomDouble)
import System.Random.Shuffle (shuffle')
import qualified Data.ByteString.Lazy as B
main :: IO ()
main = writeGrids 1000 64
{- Creates and writes num grids of dimensions aa x aa -}
writeGrids :: Int -> Int -> IO ()
writeGrids num aa = do
rng <- newPureMT
let (grids,shuffleds) = createGrids rng aa
B.writeFile "grids.bin" (encode (take num grids))
B.writeFile "shuffleds.bin" (encode (take num shuffleds))
{- a random number generator, dimension of grids to make
returns a pair of lists, the first is a list of grids of dimensions
aa x aa, the second is a list of the shuffled grids corresponding to the first list -}
createGrids :: PureMT -> Int -> ([[(Float,Float)]],[[(Float,Float)]])
createGrids rng aa = (grids,shuffleds) where
rs = randomFloats rng
grids = map (getGridR aa) (chunksOf (2 * aa * aa) rs)
shuffleds = shuffler (aa * aa) rng grids
{- length of each grid, a random number generator, a list of grids
returns a the list with each grid shuffled -}
shuffler :: Int -> PureMT -> [[(Float,Float)]] -> [[(Float,Float)]]
shuffler n rng (xs:xss) = shuffle' xs n rng : shuffler n (snd (next rng)) xss
shuffler _ _ [] = []
{- divides list into chunks of size n -}
chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go
where go xs = case splitAt n xs of
(ys,zs) | null ys -> []
| otherwise -> ys : go zs
{- dimension of grid, list of random floats [0,1]
returns a list of (x,y) points of length n^2 such that all
points are in the range [0,1] and the points are a randomly
perturbed regular grid -}
getGridR :: Int -> [Float] -> [(Float,Float)]
getGridR n rs = pts where
nn = n * n
(irs,jrs) = splitAt nn rs
n' = fromIntegral n
grid = [ (p,q) | p <- [0..n'-1], q <- [0..n'-1] ]
pts = zipWith (\(p,q) (ir,jr) -> ((p+ir)/n',(q+jr)/n')) grid (zip irs jrs)
{- an infinite list of random floats in range [0,1] -}
randomFloats :: PureMT -> [Float]
randomFloats rng = let (d,rng') = first double2Float (randomDouble rng)
in d : randomFloats rng'
The required packages are:
, bytestring
, binary
, random
, mersenne-random-pure64
, random-shuffle
Two reasons for the memory usage:
First, Data.Binary.encode doesn't seem to run in constant space. The following program uses 910 MB memory:
import Data.Binary
import qualified Data.ByteString.Lazy as B
len = 10000000 :: Int
main = B.writeFile "grids.bin" $ encode [0..len]
If we leave a 0 out from len we get 97 MB memory usage.
In contrast, the following program uses 1 MB:
import qualified Data.ByteString.Lazy.Char8 as B
main = B.writeFile "grids.bin" $ B.pack $ show [0..(1000000::Int)]
Second, in your program shuffleds contains references to contents of grids, which prevents garbage collection of grids. So when we print grids, we also evaluate it and then it has to sit in memory until we finish printing shuffleds. The following version of your program still consumes lots of memory, but it uses constant space if we comment out one of the two lines with B.writeFile.
import qualified Data.ByteString.Lazy.Char8 as B
writeGrids :: Int -> Int -> IO ()
writeGrids num aa = do
rng <- newPureMT
let (grids,shuffleds) = createGrids rng aa
B.writeFile "grids.bin" (B.pack $ show (take num grids))
B.writeFile "shuffleds.bin" (B.pack $ show (take num shuffleds))
For what it's worth, here is a full solution combining the ideas of everyone here. Memory consumption is constant at ~6MB (compiled with -O2).
import Control.Arrow (first)
import Control.Monad.State (state, evalState)
import Data.Binary
import GHC.Float (double2Float)
import System.Random (next)
import System.Random.Mersenne.Pure64 (PureMT, newPureMT, randomDouble)
import System.Random.Shuffle (shuffle')
import qualified Data.ByteString as B (hPut)
import qualified Pipes.Binary as P (encode)
import qualified Pipes.Prelude as P (zip, mapM, drain)
import Pipes (runEffect, (>->))
import System.IO (withFile, IOMode(AppendMode))
main :: IO ()
main = writeGrids 1000 64
{- Creates and writes num grids of dimensions aa x aa -}
writeGrids :: Int -> Int -> IO ()
writeGrids num aa = do
rng <- newPureMT
let (grids, shuffleds) = createGrids rng aa
gridFile = "grids.bin"
shuffledFile = "shuffleds.bin"
encoder = P.encode . SerList . take num
writeFile gridFile ""
writeFile shuffledFile ""
withFile gridFile AppendMode $ \hGr ->
withFile shuffledFile AppendMode $ \hSh ->
runEffect
$ P.zip (encoder grids) (encoder shuffleds)
>-> P.mapM (\(ch1, ch2) -> B.hPut hGr ch1 >> B.hPut hSh ch2)
>-> P.drain -- discards the stream of () results.
{- a random number generator, dimension of grids to make
returns a pair of lists, the first is a list of grids of dimensions
aa x aa, the second is a list of the shuffled grids corresponding to the first list -}
createGrids :: PureMT -> Int -> ( [[(Float,Float)]], [[(Float,Float)]] )
createGrids rng aa = unzip gridsAndShuffleds where
rs = randomFloats rng
grids = map (getGridR aa) (chunksOf (2 * aa * aa) rs)
gridsAndShuffleds = shuffler (aa * aa) rng grids
{- length of each grid, a random number generator, a list of grids
returns a the list with each grid shuffled -}
shuffler :: Int -> PureMT -> [[(Float,Float)]] -> [( [(Float,Float)], [(Float,Float)] )]
shuffler n rng xss = evalState (traverse oneShuffle xss) rng
where
oneShuffle xs = state $ \r -> ((xs, shuffle' xs n r), snd (next r))
newtype SerList a = SerList { runSerList :: [a] }
deriving (Show)
instance Binary a => Binary (SerList a) where
put (SerList (x:xs)) = put False >> put x >> put (SerList xs)
put _ = put True
get = do
stop <- get :: Get Bool
if stop
then return (SerList [])
else do
x <- get
SerList xs <- get
return (SerList (x : xs))
{- divides list into chunks of size n -}
chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go
where go xs = case splitAt n xs of
(ys,zs) | null ys -> []
| otherwise -> ys : go zs
{- dimension of grid, list of random floats [0,1]
returns a list of (x,y) points of length n^2 such that all
points are in the range [0,1] and the points are a randomly
perturbed regular grid -}
getGridR :: Int -> [Float] -> [(Float,Float)]
getGridR n rs = pts where
nn = n * n
(irs,jrs) = splitAt nn rs
n' = fromIntegral n
grid = [ (p,q) | p <- [0..n'-1], q <- [0..n'-1] ]
pts = zipWith (\(p,q) (ir,jr) -> ((p+ir)/n',(q+jr)/n')) grid (zip irs jrs)
{- an infinite list of random floats in range [0,1] -}
randomFloats :: PureMT -> [Float]
randomFloats rng = let (d,rng') = first double2Float (randomDouble rng)
in d : randomFloats rng'
Comments on the changes:
shuffler is now a traversal with the State functor. It produces, in a single pass through the input list, a list of pairs, in which each grid is paired with its shuffled version. createGrids then (lazily) unzips this list.
The files are written to using pipes machinery, in a way loosely inspired by this answer (I originally wrote this using P.foldM). Note that the hPut I used is the strict bytestring one, for it acts on strict chunks supplied by the producer made with P.zip (which, in spirit, is a pair of lazy bytestrings that supplies chunks in pairs).
SerList is there to hold the custom Binary instance Thomas M. DuBuisson alludes to. Note that I haven't thought too much about laziness and strictness in the get method of the instance. If that causes you trouble, this question looks useful.

Simple Graph Generator [Haste]

Could someone please help me with this? I'm kinda stuck and don't know why i get this error message :
not in scope type constructor or class 'Point'
--import Haste hiding (eval)
--import Haste.Graphics.Canvas
import Data.Maybe
import Expr
-- calculates all points of the graph in pixels
points :: Expr -> Double -> (Int,Int) -> [Point]
points exp sca (w,h) = [(x,realToPix(eval exp(pixToReal x))) | x<- [0..w]]
where
pixToReal :: Int -> Double
pixToReal x = sca*((fromIntegral x)-(fromIntegral w)/2)
realToPix :: Double -> Int
realToPix x = round ((x/sca) + ((fromIntegral w)/2))
-- calculates the lines that are going to be drawn between the points
linez :: Expr -> Double -> (Int,Int) -> [(Point,Point)]
linez exp sca (w,h) = zip (points exp sca (w,h)) (drop 1 (points exp sca (w,h)))
-- width and height of the window
sizeX, sizeY :: Int
sizeX = 300
sizeY = 300
--main :: IO ()
--main = do
--Just can <- getCanvasById "canvas"
--Just canElem <- elemById "canvas"
--Just func <- elemById "formula"
--Just d <- elemById "draw"
--onEvent d OnClick $ \_ (x,y) -> do
--f <- getProp func "value"
--w <- getProp canElem "width"
--h <- getProp canElem "height"
--render can (stroke (path (points (fromJust (readExpr f)) 0.04 (read w,read h))))
--return()
You have to import "Haste.Graphics.Canvas" which defines type alias for "Point".

check if element exists on the sub-list

I can have many Figures on my list. Each Figure can have many Rectangles on its list. I have a problem with my function checkNewRectangleId - this function should ask user about new rectangle id until he write really new id and then it should return this id - but I have an error: couldn't match expected type IO t against inferred type Maybe figureType line (Figure id width height rectangles) <- findFigure idFigure x in my function - could you help ?
import IO
import Char
import System.Exit
import Maybe
import Data.Time.Calendar
import System.Time
checkNewRectangleId :: Int -> [FigureType] -> IO Int
checkNewRectangleId idFigure x = do
idRectangle <- getInt "Give me new rectangle id: "
(Figure id width height rectangles) <- findFigure idFigure x
if isJust (findRectangle idRectangle rectangles) then do
putStrLn ("We have yet rectangle with id " ++ show idRectangle)
checkNewRectangleId idFigure x
else return idRectangle
data FigureType = Figure Int Int Int [RectangleType] deriving(Show, Read)
data RectangleType = Rectangle Int CalendarTime deriving(Show, Read)
findFigure :: Int -> [FigureType] -> Maybe FigureType
findFigure _ [] = Nothing
findFigure n ((Figure id width height rectangles) : xs) =
if n == id then Just (Figure id width height rectangles)
else findFigure n xs
findRectangle :: Int -> [RectangleType] -> Maybe RectangleType
findRectangle _ [] = Nothing
findRectangle n ((Rectangle id date) : xs) =
if n == id then Just (Rectangle id date)
else findRectangle n xs
isInt i = not (null i) && all isDigit i
getInt :: String -> IO Int
getInt q = do
putStr q;
i <- getLine
if isInt i == False then do
putStrLn "Bad number"
getInt q
else return (read i)
Since you say idFigure is guaranteed to exist, you can use fromJust in the Data.Maybe module to convert a Maybe FigureType into a FigureType:
let (Figure id width height rectangles) = fromJust $ findFigure idFigure x
findFigure operates in the Maybe monad, but checkNewRectangleId operates in the IO monad. Haskell will not automatically translate failures (or successes) in one monad into failures (or successes) in another, because the types don't match. So, you have to ask yourself the question, what do you want to happen if findFigure fails to find anything?

Resources