1module Main where 2 3import Graphics.UI.Gtk 4import Graphics.UI.Gtk.Gdk.EventM 5 6import System.Glib.GObject ( toGObject ) 7import System.FilePath 8import Control.Concurrent.MVar 9import Control.Monad ( liftM ) 10import Control.Monad.Trans ( liftIO ) 11import Data.Maybe ( fromMaybe ) 12import Data.List ( findIndex ) 13 14roomStrCol :: ColumnId String String 15roomStrCol = makeColumnIdString 1 16 17-- Define a string column and an image column on the store holding the 18-- computer types. 19compPicCol :: ColumnId CompType Pixbuf 20compPicCol = makeColumnIdPixbuf 1 21 22compStrCol :: ColumnId CompType String 23compStrCol = makeColumnIdString 2 24 25data Computer = Computer { 26 name :: String, 27 addr :: (Int, Int, Int, Int), 28 roomStore :: ListStore String, 29 roomSel :: Int, 30 cType :: CompType } 31 32data CompType 33 = MacBookPro 34 | MacBook 35 | Printer 36 | MacPro 37 | Xserve 38 | IMac 39 deriving (Enum, Bounded, Show) 40 41showCT :: CompType -> String 42showCT ct = case show ct of 43 'I':xs -> 'i':xs 44 xs -> xs 45 46main = do 47 initGUI 48 49 win <- windowNew 50 on win objectDestroy mainQuit 51 52 -- create a tag that we use as selection, target and selection type 53 compTypeTag <- atomNew "_CompType" 54 55 let pNames = map ("resListDND" </>) 56 ["laptop.png","laptopSmall.png","printer.png", 57 "tower.png","server.png","desktop.png"] 58 pics <- mapM pixbufNewFromFile pNames 59 60 smallPics <- mapM (\n -> pixbufNewFromFileAtScale n 48 48 True) pNames 61 62 [noRoom, publicRoom, restrictedRoom] <- mapM listStoreNew 63 [["Paul (Home)","John (Home)","Fred (Home)"], 64 ["N12","S112", "S113", "S114"], 65 ["Server Room Upstairs", "Server Room Downstairs"]] 66 67 -- define extractor function for the string column 68 treeModelSetColumn noRoom roomStrCol id 69 treeModelSetColumn publicRoom roomStrCol id 70 treeModelSetColumn restrictedRoom roomStrCol id 71 72 let genRoomStore MacBookPro = noRoom 73 genRoomStore MacBook = noRoom 74 genRoomStore Printer = publicRoom 75 genRoomStore MacPro = publicRoom 76 genRoomStore Xserve = restrictedRoom 77 genRoomStore IMac = publicRoom 78 79 -- the initial computer list - it's a coincidence that there's 80 -- one computer of each type 81 content <- listStoreNewDND 82 (map (\t -> Computer { name = showCT t, addr = (192,168,0,fromEnum t+1), 83 roomStore = genRoomStore t, roomSel = 0, cType = t}) 84 [minBound :: CompType .. maxBound]) 85 (Just listStoreDefaultDragSourceIface) 86 (Just DragDestIface { 87 treeDragDestRowDropPossible = \store path@(i:_) -> do 88 mCT <- selectionDataGet compTypeTag 89 case mCT :: Maybe [Int] of 90 Just [ct] -> return True 91 Nothing -> 92 (treeDragDestRowDropPossible listStoreDefaultDragDestIface) 93 store path 94 _ -> return False, 95 treeDragDestDragDataReceived = \store path@(i:_) -> do 96 mCT <- selectionDataGet compTypeTag 97 case mCT of 98 Just [ct] -> do 99 let t = toEnum ct 100 liftIO $ listStoreInsert store i 101 Computer { name = showCT t, addr = (192,168,0,254), 102 roomStore = genRoomStore t, roomSel = 0, 103 cType = t } 104 return True 105 Nothing -> 106 (treeDragDestDragDataReceived listStoreDefaultDragDestIface) 107 store path 108 }) 109 -- the area with the possible computer types 110 compTypes <- listStoreNewDND [minBound :: CompType .. maxBound] 111 (Just DragSourceIface { 112 treeDragSourceRowDraggable = \store (i:_) -> return True, 113 treeDragSourceDragDataGet = \store (i:_) -> do 114 ty <- selectionDataGetTarget 115 ct <- liftIO $ listStoreGetValue store i 116 selectionDataSet compTypeTag [fromEnum ct] 117 return True, 118 treeDragSourceDragDataDelete = \store path -> return True 119 }) 120 Nothing 121 122 -- define extractor functions for the two column 123 treeModelSetColumn compTypes compPicCol $ 124 \t -> pics !! fromEnum t 125 treeModelSetColumn compTypes compStrCol showCT 126 127 -- create an icon view of all the computer types 128 typesView <- iconViewNew 129 set typesView [iconViewModel := Just compTypes, 130 iconViewPixbufColumn := compPicCol, 131 iconViewTextColumn := compStrCol, 132 iconViewColumns := 6] 133 134 -- create an editable list of computers 135 inventory <- treeViewNewWithModel content 136 137 tyCol <- treeViewColumnNew 138 treeViewColumnSetTitle tyCol "Type" 139 picRen <- cellRendererPixbufNew 140 treeViewColumnPackStart tyCol picRen False 141 cellLayoutSetAttributes tyCol picRen content 142 (\Computer { cType = t} -> [cellPixbuf := smallPics !! fromEnum t]) 143 tyRen <- cellRendererTextNew 144 treeViewColumnPackStart tyCol tyRen False 145 cellLayoutSetAttributes tyCol tyRen content 146 (\Computer { cType = t} -> [cellText := showCT t]) 147 treeViewAppendColumn inventory tyCol 148 149 nameCol <- treeViewColumnNew 150 treeViewColumnSetTitle nameCol "Name" 151 treeViewColumnSetResizable nameCol True 152 treeViewColumnSetMinWidth nameCol 100 153 nameRen <- cellRendererTextNew 154 set nameRen [ cellTextEditable := True, 155 cellTextEditableSet := True, 156 cellTextEllipsize := EllipsizeEnd, 157 cellTextEllipsizeSet := True] 158 treeViewColumnPackStart nameCol nameRen True 159 cellLayoutSetAttributes nameCol nameRen content 160 (\Computer { name = n } -> [cellText := n]) 161 treeViewAppendColumn inventory nameCol 162 on nameRen edited $ \[i] str -> do 163 val <- listStoreGetValue content i 164 listStoreSetValue content i val { name = str } 165 166 addrCol <- treeViewColumnNew 167 treeViewColumnSetTitle addrCol "Address" 168 oct1 <- cellRendererTextNew 169 dot1 <- cellRendererTextNew 170 oct2 <- cellRendererTextNew 171 dot2 <- cellRendererTextNew 172 oct3 <- cellRendererTextNew 173 dot3 <- cellRendererTextNew 174 oct4 <- cellRendererTextNew 175 mapM_ (uncurry (cellLayoutPackStart addrCol)) 176 [(oct1, True), (dot1, False), (oct2, True), 177 (dot2, False), (oct3, True), (dot3, False), (oct4, True)] 178 mapM_ (\d -> set d [cellText := ".", 179 cellTextWidthChars := 0]) [dot1, dot2, dot3] 180 mapM_ (\o -> set o [cellXAlign := 1.0, 181 cellTextWidthChars := 3]) [oct1, oct2, oct3, oct4] 182 cellLayoutSetAttributes addrCol oct1 content 183 (\Computer { addr = (o1,_,_,_)} -> [cellText := show o1]) 184 cellLayoutSetAttributes addrCol oct2 content 185 (\Computer { addr = (_,o2,_,_)} -> [cellText := show o2]) 186 cellLayoutSetAttributes addrCol oct3 content 187 (\Computer { addr = (_,_,o3,_)} -> [cellText := show o3]) 188 cellLayoutSetAttributes addrCol oct4 content 189 (\Computer { addr = (_,_,_,o4)} -> [cellText := show o4]) 190 treeViewAppendColumn inventory addrCol 191 192 roomCol <- treeViewColumnNew 193 treeViewColumnSetTitle roomCol "Room" 194 treeViewColumnSetResizable roomCol True 195 treeViewColumnSetSizing roomCol TreeViewColumnAutosize 196 roomRen <- cellRendererComboNew 197 set roomRen [ cellTextEditable := True, 198 cellTextEditableSet := True, 199 cellComboHasEntry := True ] 200 treeViewColumnPackStart roomCol roomRen True 201 cellLayoutSetAttributes roomCol roomRen content 202 (\Computer { roomStore = t, roomSel = idx } -> 203 [cellText :=> listStoreGetValue t idx, 204 cellComboTextModel := (t, roomStrCol)]) 205 on roomRen edited $ \[i] str -> do 206 row@Computer { roomStore = t } <- listStoreGetValue content i 207 elems <- listStoreToList t 208 idx <- case (findIndex ((==) str) elems) of 209 Just idx -> return idx 210 Nothing -> listStoreAppend t str 211 listStoreSetValue content i row { roomSel = idx } 212 treeViewAppendColumn inventory roomCol 213 214 -- make typesView a drag source for compTypeTag values 215 tl <- targetListNew 216 targetListAdd tl compTypeTag [TargetSameApp] 0 217 iconViewEnableModelDragSource typesView [Button1] tl [ActionCopy] 218 219 -- Due to a bug in Gtk+, the treeDragSourceDragDataGet handler in 220 -- the DND source handler is not called unless the IconView is also 221 -- set to be a DND destination. Bugzilla 550528 222 tl <- targetListNew 223 iconViewEnableModelDragDest typesView tl [] 224 225 -- make the inventory widget a drag destination for compTypeTag values 226 tl <- targetListNew 227 targetListAdd tl compTypeTag [TargetSameApp] 0 228 targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 229 treeViewEnableModelDragDest inventory tl [ActionMove] 230 tl <- targetListNew 231 targetListAdd tl targetTreeModelRow [TargetSameWidget] 0 232 treeViewEnableModelDragSource inventory [Button1] tl [ActionMove] 233 234 -- Install drag and drop for permuting rows. This is now done above using 235 -- the explicit target 'targetTreeModelRow'. Calling the function below 236 -- will set a completely new 'TargetList' thereby removing our own 237 -- 'compTypeTag' from the inventory widget's target list. 238 239 --treeViewSetReorderable inventory True 240 241 -- arrange the widgets 242 v <- vPanedNew 243 panedAdd1 v typesView 244 panedAdd2 v inventory 245 containerAdd win v 246 247 widgetShowAll win 248 mainGUI 249