maingengui.hs

HTK系列的

-- -----------------------------------------------------------------------
--
-- $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) where

import HTk
import GenGUI
import Name
import ReferenceVariables
import System
import IOExts
import DialogWin

foldref :: Ref (Maybe (Item Obj))
foldref = unsafePerformIO (newRef Nothing)

imgpathref :: Ref (Maybe FilePath)
imgpathref =
  unsafePerformIO (newRef Nothing)
{-# NOINLINE imgpathref #-}

lastactiveref :: Ref Button
lastactiveref = unsafePerformIO (newRef (unsafePerformIO
                                           (newButton NONE [])))
{-# NOINLINE lastactiveref #-}

imgref :: Ref (IO Image)
imgref = unsafePerformIO (newRef folderImg)
{-# NOINLINE imgref #-}

data Col = Red | Green | Blue | Yellow deriving Eq

type Obj = (Name, IO Image, MyObject)

type Id = Int

data MyObject =
    MyContainer Id
  | MyColor Id Col
  | MyImage Id (IO Image)
  | MyTxt Id String
  | MyNum Id Int

getID :: MyObject -> Id
getID (MyContainer id) = id
getID (MyColor id _) = id
getID (MyImage id _) = id
getID (MyTxt id _) = id
getID (MyNum id _) = id

instance Eq MyObject where
  myobj1 == myobj2 = getID myobj1 == getID myobj2

instance CItem Obj where
  getIcon (_, ic, _) = ic
  getName (nm, _, _) = return nm

instance 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
      _ -> done

addCol :: 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