summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-06-16 19:27:59 -0400
committerJoe Crayne <joe@jerkface.net>2019-06-16 19:27:59 -0400
commit2eb4c404499b11068e137527110bd55c72572d0d (patch)
tree584483fae966a7774532ceb6175d50680c7c49e5
parent8196b2799d596c732fc9df6df788b62c707d1ef6 (diff)
Test code to populate treeview.
-rw-r--r--MeshSketch.hs33
1 files changed, 25 insertions, 8 deletions
diff --git a/MeshSketch.hs b/MeshSketch.hs
index 3253008..07e29e4 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -335,14 +335,27 @@ new = do
335 panedPack1 panes g True True 335 panedPack1 panes g True True
336 return panes 336 return panes
337 337
338addToGroupsPane :: Gtk.ListStore -> Bool -> Text -> IO ()
339addToGroupsPane liststore isEnabled groupName = do
340 gvalue <- toGValue (Just groupName)
341 gtrue <- toGValue isEnabled
342 iter <- listStoreAppend liststore
343 listStoreSet liststore iter [0,1] [gtrue,gvalue]
338 344
339newGroupsListWidget = do 345newGroupsListWidget = do
340 liststore <- listStoreNew [gtypeBoolean,gtypeString] 346 liststore <- listStoreNew [gtypeBoolean,gtypeString]
341 treeView <- treeViewNewWithModel liststore 347 treeView <- treeViewNewWithModel liststore
348 treeViewSetHeadersVisible treeView False
342 togc <- do 349 togc <- do
343 togr <- cellRendererToggleNew 350 togr <- cellRendererToggleNew
344 togc <- treeViewColumnNew 351 togc <- treeViewColumnNew
345 treeViewColumnPackStart togc togr False 352 treeViewColumnPackStart togc togr False
353 setCellRendererToggleActive togr True
354 cellLayoutSetCellDataFunc togc togr $ Just $ \col cel store itr -> do
355 Just c <- castTo CellRendererToggle cel
356 gval <- treeModelGetValue store itr 0
357 b <- fromGValue gval
358 setCellRendererToggleActive c b
346 return togc 359 return togc
347 groupc <- do 360 groupc <- do
348 groupr <- cellRendererTextNew 361 groupr <- cellRendererTextNew
@@ -352,16 +365,18 @@ newGroupsListWidget = do
352 -- setCellRendererTextForegroundRgba groupr grey 365 -- setCellRendererTextForegroundRgba groupr grey
353 -- -- rGBAFree grey 366 -- -- rGBAFree grey
354 groupc <- treeViewColumnNew 367 groupc <- treeViewColumnNew
368 cellLayoutSetCellDataFunc groupc groupr $ Just $ \col cel store itr -> do
369 Just c <- castTo CellRendererText cel
370 gval <- treeModelGetValue store itr 1
371 mtxt <- fromGValue gval
372 case mtxt of Nothing -> clearCellRendererTextText c
373 Just txt -> setCellRendererTextText c txt
355 -- treeViewColumnSetTitle groupc "group" 374 -- treeViewColumnSetTitle groupc "group"
356 treeViewColumnPackStart groupc groupr False 375 treeViewColumnPackStart groupc groupr False
357 return groupc 376 return groupc
358 one <- treeViewAppendColumn treeView togc 377 one <- treeViewAppendColumn treeView togc
359 two <- treeViewAppendColumn treeView groupc 378 two <- treeViewAppendColumn treeView groupc
360 iter <- listStoreAppend liststore 379 addToGroupsPane liststore False "sample text"
361 gvalue <- toGValue (Just "sample text" :: Maybe Text)
362 gtrue <- toGValue True
363 listStoreSetValue liststore iter 0 gtrue
364 listStoreSetValue liststore iter 1 gvalue
365 return (treeView,liststore) 380 return (treeView,liststore)
366 381
367 382
@@ -408,7 +423,7 @@ onRealize mesh pipeline schema mm = do
408 ] 423 ]
409 sige <- on w #event $ \ev -> do gLAreaMakeCurrent w 424 sige <- on w #event $ \ev -> do gLAreaMakeCurrent w
410 gLAreaAttachBuffers w 425 gLAreaAttachBuffers w
411 onEvent w r ev 426 onEvent mm r ev
412 sigr <- on w #render $ onRender w r 427 sigr <- on w #render $ onRender w r
413 sigs <- on w #resize $ onResize w r 428 sigs <- on w #resize $ onResize w r
414 429
@@ -679,8 +694,9 @@ pushRing w st endpt h k c = do
679 fitCurves st 694 fitCurves st
680 return d 695 return d
681 696
682onEvent :: IsWidget w => w -> Realized -> Event -> IO Bool 697onEvent :: MeshSketch -> Realized -> Event -> IO Bool
683onEvent w realized ev = do 698onEvent mm realized ev = do
699 let w = mmWidget mm
684 msrc <- eventGetSourceDevice ev 700 msrc <- eventGetSourceDevice ev
685 inputSource <- forM msrc $ \src -> do 701 inputSource <- forM msrc $ \src -> do
686 src <- get src #inputSource 702 src <- get src #inputSource
@@ -723,6 +739,7 @@ onEvent w realized ev = do
723 739
724 EventTypeButtonPress -> do 740 EventTypeButtonPress -> do
725 widgetGrabFocus w 741 widgetGrabFocus w
742 addToGroupsPane (mmListStore mm) True "clicked"
726 bev <- get ev #button 743 bev <- get ev #button
727 h <- get bev #x 744 h <- get bev #x
728 k <- get bev #y 745 k <- get bev #y