From 0720d433de118f9bd4ca73e1e4a07eb287152e87 Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Sun, 27 Aug 2023 17:52:35 +0200
Subject: Started on branding

---
 web/static/images/CMOR.jpg | Bin 0 -> 161664 bytes
 web/view/brand/msk.scm     |  44 ++++++++++++++++++++++++++++++++++++++++++++
 web/view/view.scm          |  18 ++++++++++++++++++
 web/webserver.scm          |  44 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 106 insertions(+)
 create mode 100644 web/static/images/CMOR.jpg
 create mode 100644 web/view/brand/msk.scm
 create mode 100644 web/view/view.scm

(limited to 'web')

diff --git a/web/static/images/CMOR.jpg b/web/static/images/CMOR.jpg
new file mode 100644
index 0000000..7a97885
Binary files /dev/null and b/web/static/images/CMOR.jpg differ
diff --git a/web/view/brand/msk.scm b/web/view/brand/msk.scm
new file mode 100644
index 0000000..9215c20
--- /dev/null
+++ b/web/view/brand/msk.scm
@@ -0,0 +1,44 @@
+;; Branding module for MSK
+(define-module (web view brand msk)
+  #:use-module (json)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 string-fun)
+  #:use-module (sxml simple)
+  #:use-module (web sxml)
+  #:export (msk-html))
+
+
+(define* (msk-html #:key
+                 (head '())
+                 (body '())
+                 (title "GN4MSK: GeneNetwork for Musculoskeletal Genetics")
+                 (info "")
+                 (meta "")
+                 (data "")
+                 (back "")
+                 )
+  `((doctype "html")
+    (html (@ (lang "en"))
+     (head
+      (title ,title)
+      (meta (@ (http-equiv "Content-Type") (content "text/html; charset=UTF-8")))
+      (meta (@ (name "author") (content "GN4MSK team (https://msk.genenetwork.org/)")))
+      (meta (@ (name "viewport")
+               (content "width=device-width, initial-scale=1")))
+      (link
+       (@ (rel "stylesheet")
+          (media "screen")
+          (type "text/css")
+          (href "./css/gn-doc.css")))
+      ,@head)
+     (body (h1 ,title)
+           (p ,info)
+           (footer
+            (p "Copyright © 2005—2023 by the GeneNetwork community with a touch of " (span (@ (class "lambda")) "λ") "!")
+            (p "This is free software. Download the "
+               (a (@ (href "https://ci.genenetwork.org/"))
+                  "source code") "."))
+           ))))
diff --git a/web/view/view.scm b/web/view/view.scm
new file mode 100644
index 0000000..e3b4ee1
--- /dev/null
+++ b/web/view/view.scm
@@ -0,0 +1,18 @@
+(define-module (web view view)
+  #:use-module (json)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 string-fun)
+  #:use-module (sxml simple)
+  #:use-module (web sxml)
+  #:use-module (web view brand msk)
+
+  #:export (view-brand))
+
+(define* (view-brand path)
+  (msk-html #:info
+            '((h2 "HI")
+              (img (@ (src "static/images/CMOR.jpg"))
+  ))))
diff --git a/web/webserver.scm b/web/webserver.scm
index a60f477..91ff6d6 100755
--- a/web/webserver.scm
+++ b/web/webserver.scm
@@ -19,6 +19,7 @@
  (srfi srfi-1)
  (srfi srfi-11) ; let-values
  (srfi srfi-26)
+ (rnrs io ports) ; bytevector-all
  (web http)
  (web client)
  (web request)
@@ -31,6 +32,7 @@
  (gn data species)
  (gn data group)
  (web sxml)
+ (web view view)
  (web view doc))
 
 
@@ -71,12 +73,50 @@ otherwise search for set/group data"
   (list (build-response #:code 404)
         (string-append "Resource not found: " (uri->string uri))))
 
+
+(define file-mime-types
+  '(("css" . (text/css))
+    ("js"  . (text/javascript))
+    ("svg" . (image/svg+xml))
+    ("png" . (image/png))
+    ("gif" . (image/gif))
+    ("jpg" . (image/jpg))
+    ("woff" . (application/font-woff))
+    ("ttf"  . (application/octet-stream))
+    ("html" . (text/html))))
+
+(define (file-extension file-name)
+  (last (string-split file-name #\.)))
+
+(define* (render-static-image path #:key (extra-headers '()))
+  (list `((content-type
+           . ,(assoc-ref file-mime-types
+                         (file-extension "CMOR.jpg"))) ; (last-modified . ,(time-utc->date modified))
+          )
+        (call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all)))
+
+#!
+(call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all)
+(list (append extra-headers
+              '((content-type . (application/octet-stream)))
+              (lambda (port)
+                (put-bytevector port
+                                (call-with-input-file "./static/images/CMOR.jpg" get-bytevector-all)
+                                )
+!#
+
 (define* (render-doc path page #:optional rec #:key (extra-headers '()))
   (list (append extra-headers
                 '((content-type . (text/html))))
         (lambda (port)
           (sxml->html (view-doc path page rec) port))))
 
+(define* (render-brand path #:optional rec #:key (extra-headers '()))
+  (list (append extra-headers
+                '((content-type . (text/html))))
+        (lambda (port)
+          (sxml->html (view-brand path) port))))
+
 (define (render-json json)
   (list '((content-type . (application/json)))
         (lambda (port)
@@ -95,6 +135,10 @@ otherwise search for set/group data"
      (render-json info))
     (('GET "version")
      (render-json get-version))
+    (('GET "static" "images" path)
+     (render-static-image path))
+    (('GET "brand" path)
+     (render-brand path))
     (('GET "doc" "species.html")
      (render-doc "doc" "species.html" (get-species-meta)))
     (('GET "doc" taxon)
-- 
cgit v1.2.3