diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-16 19:27:59 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-16 19:27:59 -0400 |
commit | 2eb4c404499b11068e137527110bd55c72572d0d (patch) | |
tree | 584483fae966a7774532ceb6175d50680c7c49e5 | |
parent | 8196b2799d596c732fc9df6df788b62c707d1ef6 (diff) |
Test code to populate treeview.
-rw-r--r-- | MeshSketch.hs | 33 |
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 | ||
338 | addToGroupsPane :: Gtk.ListStore -> Bool -> Text -> IO () | ||
339 | addToGroupsPane 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 | ||
339 | newGroupsListWidget = do | 345 | newGroupsListWidget = 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 | ||
682 | onEvent :: IsWidget w => w -> Realized -> Event -> IO Bool | 697 | onEvent :: MeshSketch -> Realized -> Event -> IO Bool |
683 | onEvent w realized ev = do | 698 | onEvent 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 |