From 186557f6c0f0929c9ae87d081995a93f36750dfe Mon Sep 17 00:00:00 2001 From: hashirama Date: Thu, 20 Mar 2025 03:23:30 +0000 Subject: [PATCH] Add hardcodedCss.hs --- hardcodedCss.hs | 252 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 252 insertions(+) create mode 100644 hardcodedCss.hs diff --git a/hardcodedCss.hs b/hardcodedCss.hs new file mode 100644 index 0000000..0b91d35 --- /dev/null +++ b/hardcodedCss.hs @@ -0,0 +1,252 @@ +{-# LANGUAGE OverloadedStrings, OverloadedLabels, ImplicitParams #-} +-- Copyright © 2025 Hashirama Senju + +import System.Clock -- To measure time +import System.Console.ANSI -- For colored output +-- +import Z.Data.CBytes (pack, unpack) +import Z.IO.FileSystem (scandirRecursively) +import System.FilePath (takeDirectory, dropExtension, takeExtension) +import Data.List (groupBy, isSuffixOf, isPrefixOf, nub, find) +import System.IO +import qualified Data.Map as Map +import Control.Concurrent.Async (mapConcurrently) +import Control.Concurrent +import Control.Monad +import Data.Char (isSpace) +import Data.Maybe (mapMaybe, maybeToList) + + +import qualified GI.Gtk as Gtk +import GI.Gtk (Grid(..), Image(..), Orientable(..)) +import GI.Gio +import Control.Monad (void) +import qualified Data.Text as T + + +createScrollableToolbar :: [FilePath] -> IO Gtk.Widget +createScrollableToolbar iconPaths = do + -- Create scrolling container with infinite horizontal space + scrolled <- Gtk.scrolledWindowNew + Gtk.setScrolledWindowHscrollbarPolicy scrolled Gtk.PolicyTypeNever + + + -- Create toolbar with subtle styling + toolbar <- Gtk.boxNew Gtk.OrientationHorizontal 5 -- Reduced spacing + adjustment <- new Gtk.Adjustment [#value := 50, #lower := 0, #upper := 100, #stepIncrement := 1] + Gtk.scrolledWindowSetHadjustment scrolled (Just adjustment) + + + -- Add modern visual effects + cssProvider <- Gtk.cssProviderNew + Gtk.cssProviderLoadFromString cssProvider $ T.pack $ + ".glass-button {" + ++ "border: 1px solid rgba(255,255,255,0.2);" -- Thin white border + ++ "background-color: rgba(255,255,255,0.1);" -- Glass background + ++ "border-radius: 4px;" -- Rounded corners + ++ "backdrop-filter: blur(2px);" -- Blur effect + ++ "transition: all 0.2s ease;" + ++ "}" + ++ ".glass-button:hover {" + ++ "background-color: rgba(255,255,255,0.2);" + ++ "}" + + mapM_ (\path -> do + -- Create image with consistent aspect ratio + icon <- Gtk.imageNewFromFile path + Gtk.widgetSetSizeRequest icon 64 64 + Gtk.widgetSetHalign icon Gtk.AlignCenter + + + -- Create styled button container + btn <- Gtk.buttonNew + Gtk.widgetAddCssClass btn "glass-button" + Gtk.widgetSetSizeRequest btn 80 (-1) + Gtk.buttonSetChild btn (Just icon) + + -- Apply CSS styling + context <- Gtk.widgetGetStyleContext btn + Gtk.styleContextAddProvider context cssProvider 800 -- High priority + + + + Gtk.boxAppend toolbar btn + ) iconPaths + + Gtk.scrolledWindowSetChild scrolled (Just toolbar) + Gtk.toWidget scrolled + +--- + +type FileList = [(String, [String])] -- (Directory, Files) + +extractIcons :: FileList -> [String] -- List of icon paths +extractIcons = concatMap processGroup + where + processGroup (_, files) = maybeToList (findIcon files) + +findIcon :: [String] -> Maybe String +findIcon files = do + mdxFile <- find isMdxFile files + let baseName = dropExtension mdxFile + find (isIconFile baseName) files + where + isMdxFile file = takeExtension file == ".mdx" + isIconFile base file = + dropExtension file == base && + takeExtension file `elem` imageExtensions + +imageExtensions :: [String] +imageExtensions = [".png", ".jpg", ".jpeg", ".gif", ".bmp", ".svg"] + + + +-- Derived version with automatic string handling +scanDirectoryRecursivelyStr :: String -> IO [String] +scanDirectoryRecursivelyStr path = do + result <- scandirRecursively (pack path) (\p _ -> return True) + return (map unpack result) -- Ensures all results are decoded to Strings (UTF-8) + +-- Function to filter files with a specific extension +filterMdx :: [String] -> String -> [String] +filterMdx files ext = filter (isSuffixOf ext) files + +-- Custom implementation of takeDirectory for UTF-8 strings +takeDirectory' :: String -> String +takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path + +data FileGroup = FileGroup + { directory :: String -- The directory part of the file path (UTF-8 String) + , files :: [String] -- List of file paths in that directory (UTF-8 Strings) + } deriving (Show, Eq) + +-- Create a map from directory to list of .mdx files +groupMdxByDirectory :: [String] -> Map.Map String [String] +groupMdxByDirectory mdxFiles = + Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles] + +-- Group files by their directory, including additional files that belong to the same directory +groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup] +groupFilesByDirectory mdxFiles additionalFiles = do + -- Create a map of directories to .mdx files + let mdxMap = groupMdxByDirectory mdxFiles + + -- Function to process each directory group in parallel + let processGroup dir mdxFilesInDir = do + let -- Filter additional files that belong to the same directory + additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles + -- Remove matching files from additional files (those that are already in the .mdx list) + remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir + -- Combine and remove duplicates + allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles) + return $ FileGroup dir allFiles + + -- Process each directory group concurrently + groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap) + return groupedFiles + +-- Function to convert FileGroup to a string representation for file output +fileGroupToString :: FileGroup -> String +fileGroupToString (FileGroup dir files) = + "Directory: " ++ dir ++ "\n" ++ + unlines (map (" " ++) files) + + +-- Box-like animation function with green color +boxAnimation :: IO () +boxAnimation = do + let frames = ["[ ]", "[. ]", "[ . ]", "[ .]"] -- Frame progression for box + let loop frames' = do + mapM_ (\frame -> do + setSGR [SetColor Foreground Vivid Green] -- Set the box color to green + putStr "\r" -- Move cursor to the start of the line + putStr frame -- Print the current frame + hFlush stdout -- Flush output buffer + threadDelay 200000) frames' -- Wait 0.2 seconds between frames + loop frames' -- Recursively call to keep the loop running + loop frames -- Start the looping animation + + + +-- A simple trim function to remove leading/trailing whitespace +trim :: String -> String +trim = f . f + where f = reverse . dropWhile isSpace + +-- Process lines to produce a list of (directory, [file paths]) tuples. +-- It ignores lines until the first "Directory:" is found (and discards it), +-- then uses subsequent "Directory:" lines to start new groups. +processLines :: [String] -> [(String, [String])] +processLines = reverse . go False [] + where + -- The Bool flag indicates whether we've encountered the first "Directory:" line. + go :: Bool -> [(String, [String])] -> [String] -> [(String, [String])] + go _ acc [] = acc + -- Before the first "Directory:" has been seen: + go False acc (line:rest) + | "Directory:" `isPrefixOf` line = go True acc rest -- Skip first occurrence. + | otherwise = go False acc rest + -- After the first "Directory:" has been skipped, but before starting any group: + go True [] (line:rest) + | "Directory:" `isPrefixOf` line = + let dir = trim (drop 11 line) + in go True [(dir, [])] rest + | otherwise = go True [] rest -- Ignore non-directory lines until the second occurrence. + -- When a group has been started: + go True ((currentDir, files):xs) (line:rest) + | "Directory:" `isPrefixOf` line = + let dir = trim (drop 11 line) + in go True ((dir, []):(currentDir, files):xs) rest + | otherwise = + go True ((currentDir, files ++ [trim line]) : xs) rest + + +{- +this should be used that way: + + result <- getData "output.txt" + let finalresult = processLines result -- that way we maintain purity +-} + +getData :: FilePath -> IO [String] +getData f = do + content <- readFile f + return (lines content) + + + +main :: IO () +main = do + -- Get raw data through IO + rawData <- getData "output.txt" + + -- Pure transformations + let processed = processLines rawData + let icons = extractIcons processed + + -- Output results + mapM_ putStrLn icons + + app <- Gtk.applicationNew (Just "com.example.DictionaryIcons") [] + + void $ Gtk.on app #activate $ do + outer_toolbar <- new Gtk.Box [#orientation := Gtk.OrientationHorizontal, #spacing := 20, + #baselinePosition := Gtk.BaselinePositionTop, + #halign := Gtk.AlignFill, + #hexpand := True, #widthRequest := 300, + #marginTop := 10, #marginEnd := 10, #marginStart := 15] + + window <- Gtk.applicationWindowNew app + Gtk.windowSetTitle window (Just "Dictionary Toolbar") + Gtk.windowSetDefaultSize window 800 100 + + + window <- Gtk.applicationWindowNew app + toolbar <- createScrollableToolbar icons + #append outer_toolbar toolbar + Gtk.windowSetChild window (Just outer_toolbar) + + Gtk.widgetShow window + + _ <- applicationRun app Nothing + return ()