R/iNZPlotToolbar.R

In iNZightVIT/iNZight: A GUI for Data Exploration and Visualisation

#--------------------------------------------------
# This used to be a gtoolbar in gWidgets
# gWidgets2 only allows toolbars attached to the main gwindow
# Therefore we create a subclass of GToolBar from the gWidgets2RGtk2 package
# that does not have this constraint
# have to give a container to this class so that the toolbar is added
# directly in the class initialization and not through add()
#--------------------------------------------------

##' @importFrom iNZightTools newdevice
iNZPlotToolbar <- setRefClass(
    "iNZPlotToolbar",
    fields = list(
        GUI = "ANY",
        plotWidget = "ANY",
        menu = "ANY",
        popOut = "ANY",
        toolbarcont = "ANY",
        iconbar = "ANY",
        altbar = "ANY",
        exportplotBtn = "ANY"
    ),
    methods = list(
        initialize = function(gui, cont) {
            initFields(
                GUI = gui,
                plotWidget = gui$plotWidget,
                popOut = gui$preferences$popout
            )

            toolbarcont <<- ggroup(
                container = cont,
                spacing = 0,
                fill = TRUE,
                expand = TRUE
            )
            iconbar <<- ggroup(
                horizontal = !popOut,
                container = toolbarcont,
                spacing = 15,
                fill = TRUE,
                expand = TRUE
            )

            makeToolbar()
        },
        ## update the toolbar (as opposed to initialize it)
        update = function(btns = c("add", "rmv", "inf"),
                          refresh = NULL, export = NULL,
                          extra = NULL) {
            visible(iconbar) <<- FALSE

            if (length(toolbarcont$children) > 1) {
                delete(toolbarcont, toolbarcont$children[[2]])
            }

            altbar <<- ggroup(
                horizontal = !popOut,
                container = toolbarcont,
                spacing = 15,
                fill = TRUE,
                expand = TRUE
            )

            makeToolbar(btns,
                refresh.fn = refresh,
                export.fn = export,
                extra,
                cont = altbar
            )
        },
        restore = function() {
            update(c("add", "rmv", "inf", "export"))
        },
        ## create the toolbar!
        makeToolbar = function(btns = c("add", "rmv", "inf", "export"),
                               refresh.fn = NULL,
                               export.fn = NULL,
                               extra,
                               cont = iconbar) {
            ## link the menu:
            setPlotMenu(btns, refresh.fn, extra)

            if (is.null(refresh.fn)) {
                refreshFn <- GUI$updatePlot
            } else {
                refreshFn <- GUI$activeModule[[refresh.fn]]
            }

            if (is.null(export.fn)) {
                exportFn <- function() {
                    try({
                        # Grab identification var
                        plot.settings <- GUI$getActiveDoc()$getSettings()

                        vars <- character()
                        if (isTRUE(length(plot.settings$locate.id) > 0)) {
                            if (isTRUE(plot.settings$locate.settings$txtVar != "id")) {
                                vars <- c(vars, plot.settings$locate.settings$txtVar)
                            }

                            if (isTRUE(plot.settings$locate.settings$matchChk)) {
                                vars <- c(vars, plot.settings$locate.settings$matchVar)
                            }
                        }

                        tmpurl <- iNZightPlots::exportHTML(
                            refreshFn,
                            file = tempfile(fileext = ".html"),
                            data = GUI$getActiveData(lazy = FALSE),
                            extra.vars = vars
                        )
                        if (inherits(tmpurl, "htmlwidget")) {
                            print(tmpurl)
                        } else {
                            browseURL(tmpurl)
                        }
                    })
                }
            } else {
                exportFn <- export.fn
            }

            img.add2plot <- system.file("images/toolbar-add.png", package = "iNZight")
            img.rmvplot <- system.file("images/toolbar-remove.png", package = "iNZight")
            img.infinfo <- system.file("images/toolbar-inference.png", package = "iNZight")
            img.export <- system.file("images/toolbar-interact.png", package = "iNZight")

            newplotBtn <- gimagebutton(
                stock.id = "newplot",
                size = "button",
                name = "newplotbutton",
                tooltip = "New Graphics Window"
            )
            addHandlerClicked(
                newplotBtn,
                function(h, ...) newPlotWindow(refreshFn)
            )

            newtabBtn <- gimagebutton(
                stock.id = "new",
                size = "button",
                tooltip = "New Plot Tab"
            )
            addHandlerClicked(
                newtabBtn,
                function(h, ...) plotWidget$addPlot()
            )

            refreshplotBtn <- gimagebutton(
                stock.id = "refresh",
                size = "button",
                tooltip = "Redraw Plot"
            )
            addHandlerClicked(
                refreshplotBtn,
                function(h, ...) refreshFn()
            )

            renametabBtn <- gimagebutton(
                stock.id = "editor",
                size = "button",
                tooltip = "Rename Plot Tab"
            )
            addHandlerClicked(
                renametabBtn,
                function(h, ...) plotWidget$renamePlot()
            )

            saveplotBtn <- gimagebutton(
                stock.id = "save",
                size = "button",
                tooltip = "Save Plot"
            )
            addHandlerClicked(
                saveplotBtn,
                function(h, ...) plotWidget$savePlot(refreshFn)
            )

            closetabBtn <- gimagebutton(
                stock.id = "close",
                size = "button",
                tooltip = "Close Plot Tab"
            )
            addHandlerClicked(
                closetabBtn,
                function(h, ...) plotWidget$closePlot()
            )

            ## -- IMAGES
            addtoplotBtn <- gimagebutton(
                filename = img.add2plot,
                size = "button",
                tooltip = "Add to Plot"
            )
            addHandlerClicked(
                addtoplotBtn,
                function(h, ...) addToPlot()
            )

            removeaddBtn <- gimagebutton(
                filename = img.rmvplot,
                size = "button",
                tooltip = "Remove Additions"
            )
            addHandlerClicked(
                removeaddBtn,
                function(h, ...) iNZPlotRmveModWin$new(GUI)
            )

            inferenceBtn <- gimagebutton(
                filename = img.infinfo,
                size = "button",
                tooltip = "Add Inference Information"
            )
            addHandlerClicked(
                inferenceBtn,
                function(h, ...) addInf()
            )

            exportplotBtn <<- gimagebutton(
                filename = img.export,
                size = "button",
                tooltip = "Export Interacive Plot"
            )
            addHandlerClicked(
                exportplotBtn,
                function(h, ...) {
                    if (enabled(h$obj)) exportFn()
                }
            )
            enabled(exportplotBtn) <<- FALSE

            addSpace(cont, 10)

            add(cont, newplotBtn)
            if (!popOut) add(cont, newtabBtn)
            add(cont, refreshplotBtn)
            if (!popOut) add(cont, renametabBtn)

            addSpace(cont, 10)

            add(cont, saveplotBtn)
            if (!popOut) add(cont, closetabBtn)

            addSpring(cont)

            if ("add" %in% btns) {
                add(cont, addtoplotBtn)
            }

            if ("rmv" %in% btns) {
                add(cont, removeaddBtn)
            }

            if ("inf" %in% btns) {
                add(cont, inferenceBtn)
            }

            if ("export" %in% btns) {
                add(cont, exportplotBtn)
            }

            if (!missing(extra)) {
                addSpace(cont, 10)
                lapply(extra, function(x) add(cont, x))
            }

            addSpace(cont, 10)
        },
        ## Plot Menu
        setPlotMenu = function(btns = c("add", "rmv", "inf", "export"),
                               refresh.fn = NULL,
                               extra) {
            if (is.null(refresh.fn)) {
                refreshFn <- GUI$updatePlot
            } else {
                refreshFn <- GUI$activeModule[[refresh.fn]]
            }

            pmenu <- list(
                gaction("Add to plot ...",
                    handler = function(h, ...) addToPlot()
                ),
                gaction("Remove additions ...",
                    handler = function(h, ...) iNZPlotRmveModWin$new(GUI)
                ),
                gaction("Add inference ...",
                    handler = function(h, ...) addInf()
                ),
                gseparator(),
                gaction(
                    label = "New Tab",
                    icon = "new",
                    handler = function(h, ...) plotWidget$addPlot()
                ),
                gaction(
                    label = "Close Tab",
                    icon = "close",
                    handler = function(h, ...) plotWidget$closePlot()
                ),
                gaction(
                    label = "Rename Tab",
                    icon = "editor",
                    handler = function(h, ...) plotWidget$renamePlot()
                ),
                gseparator(),
                gaction(
                    label = "New Plot Window",
                    icon = "newplot",
                    handler = function(h, ...) newPlotWindow()
                ),
                gaction(
                    label = "Redraw Plot",
                    icon = "refresh",
                    handler = function(h, ...) refreshFn()
                ),
                gaction(
                    label = "Save Plot",
                    icon = "save",
                    handler = function(h, ...) plotWidget$savePlot(refreshFn)
                )
            )

            if (popOut) {
                pmenu[5:8] <- NULL
            }

            pmenu[which(!c("add", "rmv", "inf", "export") %in% btns)] <- NULL

            GUI$menuBarWidget$setPlotMenu(pmenu)
        },
        ## function to open a new plot window
        newPlotWindow = function(f) {
            newdevice()
            f()
        },
        ## function to open the correct plot modification win
        ## depending on the currently selected variable types
        addToPlot = function(message = TRUE) {
            curSet <- GUI$getActiveDoc()$getSettings()
            err <- FALSE
            if (is.null(GUI$plotType)) {
                err <- TRUE
            }
            if (GUI$plotType == "none") {
                err <- TRUE
            }

            if (err) {
                if (message) {
                    gmessage(
                        "Hmm... you'll have to create a plot before you can add to it!",
                        title = "No plot!"
                    )
                }
            } else if (GUI$plotType == "custom") {
                if (message) {
                    gmessage("Add to Plot only works with `inzplot` functions.",
                        title = "Plot type not supported"
                    )
                }
            } else {
                iNZPlotMod$new(GUI)
            }

            invisible(!err)
        },
        addInf = function(message = TRUE) {
            if (!is.null(GUI$getActiveDoc()$getModel()$getDesign())) {
                if (message) {
                    gmessage(
                        paste(
                            "Inferential markup of plots for survey data is still in development.",
                            "If nothing shows up, it's because we haven't got to it yet.",
                            "If you notice errors (wrong values for data you know) let us know."
                        ),
                        icon = "warning",
                        parent = GUI$win,
                        title = "Developmental Feature"
                    )
                }
            }

            curSet <- GUI$getActiveDoc()$getSettings()
            err <- FALSE
            if (is.null(GUI$plotType)) {
                err <- TRUE
            }
            if (GUI$plotType == "none") {
                err <- TRUE
            }

            if (err) {
                if (message) {
                    gmessage(
                        paste(
                            "It looks like you haven't created a plot yet!",
                            "Do that, then you can add inference to it!"
                        ),
                        title = "No variable selected",
                        parent = GUI$win
                    )
                }
            } else if (GUI$plotType == "custom") {
                if (message) {
                    gmessage("Add Inference only works with `inzplot` functions.",
                        title = "Plot type not supported"
                    )
                }
            } else {
                switch(GUI$plotType,
                    "bar" = iNZBarchartInf$new(GUI),
                    "hist" = ,
                    "dot" = iNZDotchartInf$new(GUI),
                    "grid" = ,
                    "hex" = ,
                    "scatter" = {
                        if (is.null(curSet$trend) && curSet$smooth == 0) {
                            gmessage(
                                "Use the Add to Plot menu to add a trend(s) and/or smoother.",
                                title = "No trend or smoother",
                                parent = GUI$win
                            )
                        } else {
                            iNZScatterInf$new(GUI)
                        }
                    }
                )
            }
        }
    )
)