maingengui.hs

HTK系列的

                                      Nothing)
          done
  in do
       guiroot <- root gui

       let nm1 = createName "example_folder.1"
       exfolder1 <- do
                      id <- newID
                      addItem gui guiroot
                        (FolderItem (nm1, folderImg, MyContainer id) []
                                    Nothing)

       let nm2 = createName "example_folder.2"
       exfolder2 <- do
                      id <- newID
                      addItem gui guiroot
                        (FolderItem (nm2, folderImg, MyContainer id) []
                                    Nothing)

       mapM (addTxtFolder newID gui exfolder2 "texts." txtfolderImg
                          "text_item."
                          [("content of text item 1", txtImg),
                           ("content of text item 2", txtImg),
                           ("content of text item 3", txtImg),
                           ("content of text item 4", txtImg),
                           ("content of text item 5", txtImg),
                           ("content of text item 6", txtImg),
                           ("content of text item 7", txtImg),
                           ("content of text item 8", txtImg)]) [1..2]

       mapM (addTxtFolder newID gui guiroot "text_items_with_long_names."
                          txtfolderImg "text_item_with_a_long_name."
                          [("content of text item 1", txtImg),
                           ("content of text item 2", txtImg),
                           ("content of text item 3", txtImg),
                           ("content of text item 4", txtImg),
                           ("content of text item 5", txtImg),
                           ("content of text item 6", txtImg),
                           ("content of text item 7", txtImg),
                           ("content of text item 8", txtImg)]) [1]

       mapM (addNumFolder newID gui exfolder1 "numbers." numfolderImg
                          "number_item."
                          [(25 :: Int, numImg), (17, numImg), (8, numImg),
                           (73, numImg), (2451, numImg), (3, numImg),
                           (7182812, numImg), (2, numImg)]) [1..3]
       mapM (addColFolder newID gui exfolder2 "colors." colorfolderImg
                          "color_item."
                          [(Red, redImg), (Yellow, yellowImg),
                           (Green, greenImg), (Yellow, yellowImg),
                           (Yellow, yellowImg), (Red, redImg),
                           (Green, greenImg), (Blue, blueImg),
                           (Blue, blueImg)]) [1..3]
       mapM (addImgFolder newID gui guiroot "images." imgfolderImg
                          "image_item."
                          [(img1, imgImg), (img2, imgImg)]) [1..2]
       done

{-
chooseImageFile :: Button () -> IO ()
chooseImageFile b =
  do
    homedir <- getEnv "HOME"
    fd <- fileDialog "Open file" homedir
    interactor (\i -> fileChosen fd >>>= \mfp -> case mfp of
                                                   Just fp ->
                                                     b # text(short fp) >>
                                                     setRef imgpathref
                                                            (Just fp)
                                                   _ -> done)
  where short :: String -> String
        short str =
          if length str > 20 then (".."  ++ drop (length str - 18) str)
          else str
-}


----------
-- init --
----------

main :: IO ()
main =
  do
    idref <- newRef 0

    let newID :: IO Id
        newID = do
                  id <- getRef idref
                  setRef idref (id + 1)
                  return id

    main <- initHTk [text "GenGUI example"]

    -- construct gui
    gui <- newGenGUI Nothing True :: IO (GenGUI Obj)

    -- create menu content
    m <- createMenu main False []
    pulldown1 <- createMenuCascade (genGUIMainMenu gui)
                                   [text "File", menu m]
    inf <- createMenuCommand m [text "GenGUI Info"]
    clickedinf <- clicked inf
    spawnEvent
      (forever (clickedinf >>>
                createAlertWin "This is an example for the GenGUI module."
                            []))

    createMenuSeparator m []
    quit <- createMenuCommand m [text "Quit"]
    clickedquit <- clicked quit
    spawnEvent (clickedquit >>> destroy main)

    top <- newVFBox main []
    pack top [PadX 5, PadY 5, Fill X, Expand On]

    l <- newLabel top [text "add items to selected folder:",
                       anchor Center, font (Helvetica, 12 :: Int)]
    pack l [PadX 100, Fill X, Expand On]

    foldlab <- newLabel top [text "no folder selected", relief Sunken,
                             anchor Center, fg "blue"]
    pack foldlab [PadX 100, Fill X, Expand On]

{-
    boximg <- newHFBox main []
    pack boximg [PadX 10, PadY 10]

    addimg <- newButton boximg [pad Vertical 5, pad Horizontal 5,
                                height 3, text "add image item", width 28]
                :: IO (Button String)
    pack addimg [PadX 5, PadY 5, Fill X, Expand On]

    imgentries <- newVBox boximg []
    pack imgentries []

    imgnmbox <- newHBox []
    pack imgnmbox []

    l <- newLabel [text "name:", font (Helvetica, 12::Int), width 8]
    pack l []

    imgnm <- newEntry [pad Vertical 5, pad Horizontal 5, width 30,
                       background "white", parent imgnmbox,
                       text "(default)"] :: IO (Entry String)
    imgvalbox <- newHBox [parent imgentries]
    imgbutton <- newButton [text "choose image", width 30,
                            parent imgvalbox, command (\ () -> return ())]
                   :: IO (Button String)
-}
{-
    boxtxt <- newFrame main []
    pack boxtxt [PadX 10, PadY 10, Fill X, Expand On]
    addtxt <- newButton boxtxt [height 3, text "add text item", width 28]
                :: IO (Button String)
    pack addtxt [PadX 5, PadY 5, Side AtLeft]

    txtentries <- newFrame boxtxt []
    pack txtentries [Side AtRight]
    txtnmbox <- newFrame txtentries []
    pack txtnmbox []
    lab <- newLabel txtnmbox [text "name:", font (Helvetica, 12::Int),
                              width 8]
    pack lab [Side AtLeft]
    txtnm_var <- createTkVariable "(default)"
    txtnm <- newEntry txtnmbox [width 30, background "white",
                                variable txtnm_var] :: IO (Entry String)
    pack txtnm [PadX 5, PadY 5, Side AtRight]

    txtvalbox <- newFrame txtentries []
    pack txtvalbox []
    lab <- newLabel txtvalbox [text "content:",
                               font (Helvetica, 12 :: Int), width 8]
    pack lab [Side AtLeft]
    txtval_var <- createTkVariable ""
    txtval <- newEntry txtvalbox [width 30, variable txtval_var,
                                  background "white"] :: IO (Entry String)
    pack txtval [PadX 5, PadY 5, Side AtRight]
    clickedaddtxt <- clicked addtxt
    spawnEvent (forever (clickedaddtxt >>
                         always (do
                                   nm <- readTkVariable txtnm_var
                                   val <- readTkVariable txtval_var
                                   addTxt nm val
                                   done)))
-}
{-
    boxnum <- newHFBox [pad Vertical 10, pad Horizontal 10, parent main]
    addnum <- newButton [pad Vertical 5, pad Horizontal 5, height 3,
                         text "add number item", width 28, parent boxnum,
                         command (\ () -> return ())]
                :: IO (Button String)
    numentries <- newVBox [parent boxnum]
    numnmbox <- newHBox [parent numentries]
    newLabel [text "name:", font (Helvetica, 12 :: Int), width 8,
              parent numnmbox]
    numnm <- newEntry [pad Vertical 5, pad Horizontal 5, width 30,
                       background "white", parent numnmbox,
                       text "(default)"]
    numvalbox <- newHBox [parent numentries]
    newLabel [text "value:", font (Helvetica, 12 :: Int), width 8,
              parent numvalbox]
    numval <- newEntry [pad Vertical 5, pad Horizontal 5, width 30,
                        background "white", parent numvalbox] :: IO (Entry String)
-}

    boxcol <- newFrame main []
    pack boxcol [PadX 10, PadY 10, Fill X, Expand On]
    addcol <- newButton boxcol [height 3, text "add color item", width 28]
    pack addcol [PadX 10, PadY 10, Side AtLeft]
    colentries <- newFrame boxcol []
    pack colentries [Side AtRight]
    colnmbox <- newFrame colentries []
    pack colnmbox []
    lab <- newLabel colnmbox [text "name:", font (Helvetica, 12 :: Int),
                              width 8]
    pack lab [Side AtLeft]
    colnm_var <- createTkVariable "(default)"
    colnm <- newEntry colnmbox [width 30, background "white",
                                variable colnm_var] :: IO (Entry String)
    pack colnm [PadX 5, PadY 5, Side AtRight]
    colmenu <- newOptionMenu colentries ["Red", "Green", "Blue", "Yellow"]
                                        [width 20]
    pack colmenu []
    clickedaddcol <- clicked addcol
    spawnEvent (forever (clickedaddcol >>
                         always (do
                                   nm <- readTkVariable colnm_var
                                   val <- getValue colmenu
                                   addCol newID gui nm val)))
{-
    boxfold <- newHFBox [pad Vertical 10, pad Horizontal 10, parent main]
    addfold <- newButton [pad Vertical 5, pad Horizontal 5, height 3,
                          text "add folder", width 28,
                          parent boxfold,
                          command (\ () -> return ())]
                :: IO (Button String)
    foldentries <- newVBox [parent boxfold]
    foldnmbox <- newHBox [parent foldentries]
    newLabel [text "name:", font (Helvetica, 12 :: Int), width 8,
              parent foldnmbox]