Add hardcodedCss.hs

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 ()