component example card3d

.Rbuildignore

@@ -7,4 +7,6 @@ docs/
 .sqlite
 nodemon.json
 package-lock.json
-package.json
+package.json
+.sesskey
+__pycache__

.gitignore

@@ -9,4 +9,6 @@
 *.Rproj
 node_modules/
 package-lock.json
-.Renviron
+.Renviron
+*.sesskey
+__pycache__

DESCRIPTION

@@ -13,24 +13,27 @@ RoxygenNote: 7.3.1.9000
 Depends: 
     R (>= 4.4)
 Suggests: 
+    dbplyr,
     devtools,
     ggplot2,
     pak,
     pkgdown,
     scilis (>= 0.0.0.9000),
     signaculum (>= 0.0.0.9000),
+    testthat,
     usethis,
+    withr,
     zeallot
 Imports: 
     ambiorix (>= 2.1.0),
     b64,
     DBI,
-    dbplyr,
     dplyr,
     glue,
     htmltools,
     pool,
     purrr,
+    readr,
     rlang,
     RSQLite,
     stringr,

NAMESPACE

@@ -16,6 +16,10 @@ export(process_logout_get)
 export(render_page)
 export(render_plot)
 export(render_tags)
+export(script)
+export(script_from_js_tpl)
 export(send_page)
+export(style)
+export(style_from_css_tpl)
 export(textarea)
 export(ul)

R/ambhtmx.R

@@ -249,29 +249,56 @@ ambhtmx_app <- \(
 #' 
 #' @param main htmltools object of the body of the html page
 #' @param page_title the title tag contents of the page
+#' @param head_tags optional htmltools object of the head of the html page
 #' @returns the rendered html of the full html page with dependencies
 #' @export
-render_page <- \(main = NULL, page_title = NULL) {
-  if (is.null(page_title)){
-    penv <- rlang::env_parent()
+render_page <- \(main = NULL, page_title = NULL, head_tags = NULL) {
+  penv <- rlang::env_parent()
+  genv <- rlang::global_env()
+  if (is.null(page_title)){    
     page_title <- penv[["page_title"]]
   }
-  if (is.null(main)){
-    penv <- rlang::env_parent()
+  if (is.null(page_title)){    
+    page_title <- genv[["page_title"]]
+  }
+  if (is.null(page_title)){    
+    page_title <- "ambhtmx"
+  }
+  if (is.null(main)){    
     main <- penv[["main"]]
   }
-  html_tags <- htmltools::tagList(
-    tags$head(
-      tags$title(page_title),
-      tags$style("body {background-color:white;}"),
+  if (is.null(main)){    
+    main <- genv[["main"]]
+  }
+  if (is.null(head_tags)){    
+    head_tags <- penv[["head_tags"]]
+  }
+  if (is.null(head_tags)){    
+    head_tags <- genv[["head_tags"]]
+  }
+  if (is.null(head_tags)) {
+    head_tags <- htmltools::tagList(      
       tags$link(href = "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css", rel = "stylesheet", integrity="sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH",  crossorigin="anonymous"),
       tags$script(src = "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js", integrity="sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz", crossorigin="anonymous"),
-      tags$script(src = "https://unpkg.com/htmx.org@2.0.1")
-    ),
-    tags$body(
-      `hx-encoding` = "multipart/form-data",
-      main
-    ) 
+      htmltools::HTML('<script src="https://cdn.jsdelivr.net/gh/gnat/surreal@main/surreal.js"></script><script src="https://cdn.jsdelivr.net/gh/gnat/css-scope-inline@main/script.js"></script>')
+    )
+  }
+  tryCatch(
+    expr = {
+      html_tags <- htmltools::tagList(
+        tags$head(
+          tags$title(page_title),
+          tags$style("body {background-color:white;}"),
+          tags$script(src = "https://unpkg.com/htmx.org@2.0.1"),
+          head_tags,      
+        ),
+        tags$body(
+          `hx-encoding` = "multipart/form-data",
+          main
+        ) 
+      )
+    },
+    error = \(e) print(e)
   )
   render_html(html_tags) 
 }
@@ -305,6 +332,24 @@ replace_hx_attrs <- function(x) {
   return(x)
 }
 
+#' @noRd
+replace_css_var_attrs <- function(x) {
+  if (is.list(x)) {
+    # Check if the element has a named list called 'attribs'
+    if ("attribs" %in% names(x)) {
+      # Replace 'hx_' with 'hx-' in attribute names
+      names(x$attribs) <- gsub("hx_", "hx-", names(x$attribs))
+    }
+
+    # Apply the function recursively to all elements of the list
+    original_class <- class(x)
+    x <- lapply(x, replace_hx_attrs)
+    class(x) <- original_class
+  }
+  return(x)
+}
+
+
 #' @noRd
 replace_hx_attrs <- function(x) {
   if (is.list(x)) {

R/dev.R

@@ -33,7 +33,10 @@ rebuild_docs_and_check <- function() {
       "devtools",
       "usethis",
       "ggplot2",
-      "zeallot"      
+      "zeallot",
+      "withr",
+      "testthat",
+      "dbplyr"
   )
   suggests_packages |> purrr::map(
       \(x){usethis::use_package(x, type = "Suggests"); x} 
@@ -49,8 +52,8 @@ rebuild_docs_and_check <- function() {
       "stringr",
       "DBI",
       "RSQLite",
-      "dbplyr",
       "pool",
+      "readr",
       "uwu"
   )
   imports_packages |> purrr::map(

R/extra-tags.R

@@ -61,4 +61,92 @@ ol <- htmltools::tags$ol
 
 #' @rdname builder
 #' @export
-form <- htmltools::tags$form
+form <- htmltools::tags$form
+
+#' @rdname builder
+#' @export
+style <- htmltools::tags$style
+
+#' @rdname builder
+#' @export
+script <- htmltools::tags$script
+
+#' Generate style from css template
+#' 
+#' @rdname style_from_css_tpl
+#' @param file path to a js file
+#' @param ... mutiple named arguments with the value to replaces
+#' @examples
+#' if (FALSE){
+#'   # replaces "var(--tpl-background)" to "red"
+#'   style_from_css_tpl("styles.css", background = "red")
+#' }
+#' @export
+style_from_css_tpl <- \(file, ...) {
+  html <- ""
+  raw_content <- readr::read_file(file)
+  content <- style_tpl_css_vars_replace(raw_content, ...)
+  tryCatch(
+    expr = {
+      html <- htmltools::HTML("<style>", content, "</style>")
+    },
+    error = \(e) {
+      print(e)
+    }
+  )
+  return(html)
+}
+
+
+#' @noRd
+style_tpl_css_vars_replace <- \(content, ...){
+  props <- rlang::dots_list(...)    
+  values <- paste0(props)
+  if(length(values) == 0) {
+    return(content)
+  }  
+  tpls <- paste0("var(--tpl-", names(props), ")")    
+  names(values) <- tpls
+  stringr::str_replace_all(content, stringr::fixed(values))
+}
+
+
+#' Generate script from js template
+#' 
+#' @rdname script_from_js_tpl
+#' @param file path to a js file
+#' @param ... mutiple named arguments with the value to replace
+#' @examples
+#' if (FALSE){
+#'   # replaces "{init}" to "0"
+#'   script_from_js_tpl("script.js", init = "init")
+#' }
+#' @export
+script_from_js_tpl <- \(file, ...) {
+  html <- ""
+  raw_content <- readr::read_file(file)
+  content <- script_tpl_js_vars_replace(raw_content, ...)
+  tryCatch(
+    expr = {
+      html <- htmltools::HTML("<script>", content, "</script>")
+    },
+    error = \(e) {
+      print(e)
+    }
+  )
+  return(html)
+}
+
+
+#' @noRd
+script_tpl_js_vars_replace <- \(content, ...){
+  props <- rlang::dots_list(...)    
+  values <- paste0(props)
+  if(length(values) == 0) {
+    return(content)
+  }  
+  tpls <- paste0("{", names(props), "}")
+  names(values) <- tpls
+  stringr::str_replace_all(content, stringr::fixed(values))
+}
+

README.md

@@ -71,9 +71,17 @@ AMBHTMX_PORT=<to change port default 3000>
 ### [Password protected CRUD (Create, Read, Update, and Delete) example with ambhtmx](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/07-crud.R)
 [![](https://raw.githubusercontent.com/jrosell/ambhtmx/main/inst/examples/07.png)](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/07-crud.R)
 
-### [Cleaner and shorter code hx_ to hx- replacement](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/07-hx_attributes.R)
+
+### [Cleaner and shorter code hx_ to hx- replacement](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/08-hx_attributes.R)
 [![](https://raw.githubusercontent.com/jrosell/ambhtmx/main/inst/examples/08.png)](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/08-hx_attributes.R)
 
+
+### [Customizable web components: Port to R of card3d from FastHTML](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/09-card3d.R)
+[![](https://raw.githubusercontent.com/jrosell/ambhtmx/main/inst/examples/09.png)](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/09-card3d.R)
+* [Python implementation from fastht.ml](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/09-card3d.py), Design credit: https://codepen.io/markmiro/pen/wbqMPa
+[![](https://raw.githubusercontent.com/jrosell/ambhtmx/main/inst/examples/09py.png)](https://github.com/jrosell/ambhtmx/blob/main/inst/examples/09-card3d.py)
+
+
 ## Deployment examples (WIP)
 
 If you create a Dockerfile you can deploy your ambhtmx app to HuggingFace Spaces, Digital Ocean, Google Cloud, etc.

docs/pkgdown.yml

@@ -2,5 +2,5 @@ pandoc: 3.1.12.3
 pkgdown: 2.0.9
 pkgdown_sha: ~
 articles: {}
-last_built: 2024-08-04T02:35Z
+last_built: 2024-08-05T11:55Z