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