-- --------------------------------------------------------------------------- $Source: /repository/uni/htk/examples/gengui/MaingenGUI.hs,v $---- HTk - a GUI toolkit for Haskell  -  (c) Universitaet Bremen---- $Revision: 1.5 $ from $Date: 2002/05/30 15:00:16 $-- Last modification by $Author: ger $---- -----------------------------------------------------------------------module Main (main) whereimport HTkimport GenGUIimport Nameimport ReferenceVariablesimport Systemimport IOExtsimport DialogWinfoldref :: Ref (Maybe (Item Obj))foldref = unsafePerformIO (newRef Nothing)imgpathref :: Ref (Maybe FilePath)imgpathref =  unsafePerformIO (newRef Nothing){-# NOINLINE imgpathref #-}lastactiveref :: Ref Buttonlastactiveref = unsafePerformIO (newRef (unsafePerformIO                                           (newButton NONE []))){-# NOINLINE lastactiveref #-}imgref :: Ref (IO Image)imgref = unsafePerformIO (newRef folderImg){-# NOINLINE imgref #-}data Col = Red | Green | Blue | Yellow deriving Eqtype Obj = (Name, IO Image, MyObject)type Id = Intdata MyObject =    MyContainer Id  | MyColor Id Col  | MyImage Id (IO Image)  | MyTxt Id String  | MyNum Id IntgetID :: MyObject -> IdgetID (MyContainer id) = idgetID (MyColor id _) = idgetID (MyImage id _) = idgetID (MyTxt id _) = idgetID (MyNum id _) = idinstance Eq MyObject where  myobj1 == myobj2 = getID myobj1 == getID myobj2instance CItem Obj where  getIcon (_, ic, _) = ic  getName (nm, _, _) = return nminstance Eq Obj where  (_, _, myobj1) == (_, _, myobj2) = myobj1 == myobj2------------------------------------------ external adding of folders / items ------------------------------------------addNum :: IO Id -> GenGUI Obj -> String -> String -> IO ()addNum newID gui name ent = putStrLn "not yet implemented"addTxt :: IO Id -> GenGUI Obj -> String -> String -> IO ()addTxt newID gui name ent =  do    mpar <- getRef foldref    case mpar of      Just par ->        do          id <- newID          let nm = createName name              ic = txtImg              val = MyTxt id ent          addItem gui par (LeafItem (nm, ic, val) Nothing)          done      _ -> doneaddCol :: IO Id -> GenGUI Obj -> String -> String -> IO ()addCol newID gui name ent =  do    mpar <- getRef foldref     case mpar of      Just par ->         do          id <- newID          let nm = createName name              ic = case ent of "Red" -> redImg                               "Blue" -> blueImg                               "Green" -> greenImg                               "Yellow" -> yellowImg              val = MyColor id (case ent of "Red" -> Red                                            "Blue" -> Blue                                            "Green" -> Green                                            "Yellow" -> Yellow)          addItem gui par (LeafItem (nm, ic, val) Nothing)          done      _ -> done{-addImg :: String -> Maybe FilePath -> IO ()addImg nm mimgpath =  do    mpar <- getRef foldref    case mpar of      Just par ->        case mimgpath of          Just imgpath -> do                            let img = newImage [filename imgpath]                            pval <- newProp (toDyn img)                            pname <- newProp (createName nm)                            picon <- newProp imgImg                            addItem par                                    (LeafItem (MyObject pname picon pval))                            done          _ -> done      _ -> done-}{-addFolder :: String -> IO ()addFolder nm =  do    mpar <- getRef foldref    case mpar of      Just par ->        do          pval <- newProp (toDyn nm)          pname <- newProp (createName nm)          img <- getRef imgref          picon <- newProp img          addItem par (FolderItem (MyContainer pname picon pval) [])          done      _ -> done-}--------------------- example items ---------------------addExampleFolders :: IO Id -> GenGUI Obj -> IO ()addExampleFolders newID gui =  let mkNumItem :: IO Id -> String -> (Int, (Int, IO Image)) ->                   IO (NewItem Obj)      mkNumItem newID name (i, (num, ic)) =        do          id <- newID          let val = MyNum id num              nm = createName (name ++ show i)           return (LeafItem (nm, ic, val) Nothing)      addNumFolder :: IO Id -> GenGUI Obj -> Item Obj -> String ->                      IO Image -> String -> [(Int, IO Image)] -> Int ->                      IO ()      addNumFolder newID gui par name ic subnm vals_icons i =        do          let nm = createName (name ++ show i)          items <- mapM (mkNumItem newID subnm)                        (zip [1..(length vals_icons)] vals_icons)          id <- newID          addItem gui par (FolderItem (nm, ic, MyContainer id) items                                      Nothing)          done      mkTxtItem :: IO Id -> String -> (Int, (String, IO Image)) ->                   IO (NewItem Obj)      mkTxtItem newID name (i, (str, ic)) =        do          id <- newID          let val = MyTxt id str              nm = createName (name ++ show i)          return (LeafItem (nm, ic, val) Nothing)      addTxtFolder :: IO Id -> GenGUI Obj -> Item Obj -> String ->                      IO Image -> String -> [(String, IO Image)] -> Int ->                      IO ()      addTxtFolder newID gui par name ic subnm vals_icons i =        do          let nm = createName (name ++ show i)          items <- mapM (mkTxtItem newID subnm)                        (zip [1..(length vals_icons)] vals_icons)          id <- newID          addItem gui par (FolderItem (nm, ic, MyContainer id) items                                      Nothing)          done      mkImgItem :: IO Id -> String -> (Int, (IO Image, IO Image)) ->                   IO (NewItem Obj)      mkImgItem newID name (i, (img, ic)) =        do          id <- newID          let val = MyImage id img              nm = createName (name ++ show i)          return (LeafItem (nm, ic, val) Nothing)      addImgFolder :: IO Id -> GenGUI Obj -> Item Obj -> String ->                      IO Image -> String -> [(IO Image, IO Image)] ->                      Int -> IO ()      addImgFolder newID gui par name ic subnm vals_icons i =        do          let nm = createName (name ++ show i)          items <- mapM (mkImgItem newID subnm)                        (zip [1..(length vals_icons)] vals_icons)          id <- newID          addItem gui par (FolderItem (nm, ic, MyContainer id) items                                      Nothing)          done      mkColItem :: IO Id -> String -> (Int, (Col, IO Image)) ->                   IO (NewItem Obj)      mkColItem newID name (i, (col, ic)) =        do          id <- newID          let val = MyColor id col              nm = createName (name ++ show i)          return (LeafItem (nm, ic, val) Nothing)      addColFolder :: IO Id -> GenGUI Obj -> Item Obj -> String ->                      IO Image -> String -> [(Col, IO Image)] -> Int ->                      IO ()      addColFolder newID gui par name ic subnm vals_icons i =        do          let nm = createName (name ++ show i)          items <- mapM (mkColItem newID subnm)                        (zip [1..(length vals_icons)] vals_icons)          id <- newID          addItem gui par (FolderItem (nm, ic, MyContainer id) items