-- | "Rowed Panel." -- Expandable framed panel with a two-dimensional layout-- (rows of widgets, but not with aligned columns like in a table).moduleSifflet.UI.RPanel(RPanel,newRPanel,rpanelId,rpanelRoot,rpanelContent,rpanelAddWidget,rpanelAddWidgets,rpanelNewRow,rpanelAddRows)whereimportControl.MonadimportSifflet.UI.LittleGtkimportSifflet.UtildebugTracing::BooldebugTracing=FalsedataRPanel=RPanel{-- PublicrpId::String-- ^ text for the expander button,rpRoot::GtkFrame-- ^ use the root to add rpanel to a container,rpContent::[[String]]-- ^ ids of widgets added, in rows-- Widgets that make up the RPanel,rpFrame::GtkFrame-- ^ frame, same as root,rpExpander::Expander-- ^ expander,rpVBox::VBox-- ^ vbox to contain the rows,rpCurrentRow::HBox-- ^ next element goes here if it fits-- Geometry book-keeping,rpCurrentRowFreeWidth::Int-- ^ free width in current row,rpMaxWidth::Int-- ^ maximum row width,rpHPad::Int-- ^ horizontal padding}rpanelId::RPanel->StringrpanelId=rpIdrpanelRoot::RPanel->GtkFramerpanelRoot=rpRootrpanelContent::RPanel->[[String]]rpanelContent=rpContentnewRPanel::String->Int->Int->Int->IORPanelnewRPanelcidhpadvpadmaxWidth=do{frame<-frameNew-- adds a border (not labeled, since the expander is);expander<-expanderNewcid;expanderSetExpandedexpanderTrue;setframe[containerChild:=expander];vbox<-vBoxNewFalsevpad-- non-homogeneous heights;widgetSetSizeRequestvboxmaxWidth(-1)-- height = don't care;setexpander[containerChild:=vbox];hbox<-hBoxNewFalsehpad-- non-homogeoneous widths;boxPackStartvboxhboxPackNatural0;return$RPanel{rpId=cid,rpRoot=frame,rpFrame=frame,rpExpander=expander,rpVBox=vbox,rpCurrentRow=hbox,rpContent=[[]],rpCurrentRowFreeWidth=maxWidth-hpad,rpMaxWidth=maxWidth-hpad,rpHPad=hpad}}-- | Given a list of (name, widget) pairs, add each of the widgets-- and its name to the rpanelrpanelAddWidgets::(WidgetClasswidget)=>RPanel->[(String,widget)]->IORPanelrpanelAddWidgetsrppairs=letaddPairrp'(widgetId,widget)=rpanelAddWidgetrp'widgetIdwidgetinfoldMaddPairrppairs-- | Add a single named widget to the RPanelrpanelAddWidget::(WidgetClasswidget)=>RPanel->String->widget->IORPanelrpanelAddWidgetrpwidgetIdwidget=do{RequisitionwidgetWidth_<-widgetSizeRequestwidget;letfreeWidth=rpCurrentRowFreeWidthrpfreeWidth'=freeWidth-widgetWidth-rpHPadrp;iffreeWidth'>=0||freeWidth==rpMaxWidthrp-- Either there is room enough, OR we're at the start of a row-- so starting another won't help -- in fact it would lead to-- infinite recursionthendo{letcontent'=insertLastLast(rpContentrp)widgetIdpackMode=-- PackNatural -- to left justifyPackGrow-- to fill-- PackRepel -- to center;boxPackStart(rpCurrentRowrp)widgetpackMode0-- ; widgetShow widget -- do this here???;whendebugTracing$putStr(unlines["Adding "++widgetId++" width "++showwidgetWidth,"Free width = "++showfreeWidth++" -> "++showfreeWidth',"Content -> "++showcontent']);return$rp{rpContent=content',rpCurrentRowFreeWidth=freeWidth'}}else-- We're out of room, but not at the start of the current row,-- so start a new rowdo{rp'<-rpanelNewRowrp;rpanelAddWidgetrp'widgetIdwidget}}-- | Force the RPanel to begin a new rowrpanelNewRow::RPanel->IORPanelrpanelNewRowrp=do{hbox<-hBoxNewFalse(rpHPadrp);boxPackStart(rpVBoxrp)hboxPackNatural0;return$rp{rpCurrentRow=hbox,rpContent=insertLast(rpContentrp)[],rpCurrentRowFreeWidth=rpMaxWidthrp}}-- | Given a list of lists, each sublist representing a row of widgets,-- add the widgets to the RPanel, preserving the row structure-- as much as possible.-- (Row structure will be broken if any intended row is too wide.)rpanelAddRows::(WidgetClasswidget)=>RPanel->[[(String,widget)]]->IORPanelrpanelAddRowsrprows=foldMrpanelAddRowrprows-- | Add a row of widgets to an RPanel.-- This does not start a new row before the first widget,-- but after the last, so at the end, the current row will be empty.rpanelAddRow::(WidgetClasswidget)=>RPanel->[(String,widget)]->IORPanelrpanelAddRowrprow=rpanelAddWidgetsrprow>>=rpanelNewRow