update the plot sizing

R/hooks.R

@@ -1,6 +1,6 @@
-knitr_opts_current <- function(x, default = FALSE){
+knitr_opts_current <- function(x, default = FALSE) {
   x <- knitr::opts_current$get(x)
-  if(is.null(x)) x <- default
+  if (is.null(x)) x <- default
   x
 }
 
@@ -11,59 +11,91 @@ knitr_opts_current <- function(x, default = FALSE){
 #' captions.
 #' @noRd
 plot_word_fig_caption <- function(x, options) {
-
-  if(!is.character(options$fig.cap)) options$fig.cap <- NULL
-  if(!is.character(options$fig.alt)) options$fig.alt <- NULL
-  if(is.null(options$fig.id))
+  if (!is.character(options$fig.cap)) options$fig.cap <- NULL
+  if (!is.character(options$fig.alt)) options$fig.alt <- NULL
+  if (is.null(options$fig.id)) {
     fig.id <- options$label
-  else fig.id <- options$fig.id
-  if(!is.logical(options$fig.topcaption)) options$fig.topcaption <- FALSE
+  } else {
+    fig.id <- options$fig.id
+  }
+  if (!is.logical(options$fig.topcaption)) options$fig.topcaption <- FALSE
 
   tnd <- knitr_opts_current("fig.cap.tnd", default = 0)
   tns <- knitr_opts_current("fig.cap.tns", default = "-")
   fig.fp_text <- knitr_opts_current("fig.cap.fp_text", default = fp_text_lite(bold = TRUE))
 
 
-  bc <- block_caption(label =  options$fig.cap, style = options$fig.cap.style,
-                      autonum = run_autonum(
-                        seq_id = gsub(":$", "", options$fig.lp),
-                        pre_label = options$fig.cap.pre,
-                        post_label = options$fig.cap.sep,
-                        bkm = fig.id, bkm_all = FALSE,
-                        tnd = tnd, tns = tns,
-                        prop = fig.fp_text
-                      ))
+  bc <- block_caption(
+    label = options$fig.cap, style = options$fig.cap.style,
+    autonum = run_autonum(
+      seq_id = gsub(":$", "", options$fig.lp),
+      pre_label = options$fig.cap.pre,
+      post_label = options$fig.cap.sep,
+      bkm = fig.id, bkm_all = FALSE,
+      tnd = tnd, tns = tns,
+      prop = fig.fp_text
+    )
+  )
   cap_str <- to_wml(bc, knitting = TRUE)
 
+  # physical size of plots
   fig.width <- opts_current$get("fig.width")
-  if(is.null(fig.width)) fig.width <- 5
+  if (is.null(fig.width)) fig.width <- 5
   fig.height <- opts_current$get("fig.height")
-  if(is.null(fig.height)) fig.height <- 5
+  if (is.null(fig.height)) fig.height <- 5
 
-  img <- external_img(src = x[1], width = fig.width, height = fig.height, alt = options$fig.alt)
+  # out.width and out.height in percent
+  fig.out.width <- opts_current$get("out.width")
+  has_fig_out_width <- !is.null(fig.out.width)
+  is_pct_width <- has_fig_out_width && grepl("%", fig.out.width)
+  if (is_pct_width) {
+    fig.out.width <- gsub("%", "", fig.out.width, fixed = TRUE)
+    fig.out.width <- as.numeric(fig.out.width) / 100
+    fig.out.height <- fig.out.width
+  } else {
+    fig.out.height <- opts_current$get("out.height")
+    has_fig_out_height <- !is.null(fig.out.height)
+    is_pct_height <- !is_pct_width && has_fig_out_height && grepl("%", fig.out.height)
+    if (is_pct_height) {
+      fig.out.height <- gsub("%", "", fig.out.height, fixed = TRUE)
+      fig.out.height <- as.numeric(fig.out.height) / 100
+      fig.out.width <- fig.out.height
+    }
+  }
+
+  if (!has_fig_out_width && !has_fig_out_height) {
+    fig.out.width <- 1
+    fig.out.height <- 1
+  }
+
+  fig.width <- fig.width * fig.out.width
+  fig.height <- fig.height * fig.out.height
 
+  img <- external_img(src = x[1], width = fig.width, height = fig.height, alt = options$fig.alt)
   doc <- get_reference_rdocx()
   si <- styles_info(doc)
   fig.style_id <- style_id(opts_current$get("fig.style"), type = "paragraph", si)
 
-  if(length(fig.style_id) != 1 ){
+  if (length(fig.style_id) != 1) {
     warning("paragraph style for plots ", shQuote(opts_current$get("fig.style")),
-            " has not been found in the reference_docx document.",
-            " Style 'Normal' will be used instead.",
-            call. = FALSE)
+      " has not been found in the reference_docx document.",
+      " Style 'Normal' will be used instead.",
+      call. = FALSE
+    )
     fig.style_id <- style_id("Normal", type = "paragraph", si)
-
   }
   ooxml <- "<w:p><w:pPr><w:jc w:val=\"%s\"/><w:pStyle w:val=\"%s\"/></w:pPr>"
   ooxml <- sprintf(ooxml, opts_current$get("fig.align"), fig.style_id)
-  ooxml <- paste0(ooxml,
-         to_wml(img),
-         "</w:p>"
-         )
+  ooxml <- paste0(
+    ooxml,
+    to_wml(img),
+    "</w:p>"
+  )
   img_wml <- paste("```{=openxml}", ooxml, "```", sep = "\n")
 
-  if (options$fig.topcaption)
+  if (options$fig.topcaption) {
     paste("", cap_str, img_wml, sep = "\n\n")
-  else
+  } else {
     paste("", img_wml, cap_str, sep = "\n\n")
+  }
 }