diff options
Diffstat (limited to 'service/browse.lisp')
| -rw-r--r-- | service/browse.lisp | 217 |
1 files changed, 217 insertions, 0 deletions
diff --git a/service/browse.lisp b/service/browse.lisp new file mode 100644 index 0000000..1d310f5 --- /dev/null +++ b/service/browse.lisp @@ -0,0 +1,217 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package #:music-dispensary) + +;; ========================================================================== ;; + +(defparameter *papersizes* '((:name "letter" :size "(8.5 x 11.0 in)") + (:name "arch a" :size "(9.0 x 12.0 in)") + (:name "ledger" :size "(17.0 x 11.0 in)") + (:name "a4" :size "(210 x 297 mm)") + (:name "a10" :size "(26 x 37 mm)") + (:name "a9" :size "(37 x 52 mm)") + (:name "a8" :size "(52 x 74 mm)") + (:name "a7" :size "(74 x 105 mm)") + (:name "a6" :size "(105 x 148 mm)") + (:name "a5" :size "(148 x 210 mm)") + (:name "a3" :size "(297 x 420 mm)") + (:name "a2" :size "(420 x 594 mm)") + (:name "a1" :size "(594 x 841 mm)") + (:name "a0" :size "(841 x 1189 mm)") + (:name "b10" :size "(31 x 44 mm)") + (:name "b9" :size "(44 x 62 mm)") + (:name "b8" :size "(62 x 88 mm)") + (:name "b7" :size "(88 x 125 mm)") + (:name "b6" :size "(125 x 176 mm)") + (:name "b5" :size "(176 x 250 mm)") + (:name "b4" :size "(250 x 353 mm)") + (:name "b3" :size "(353 x 500 mm)") + (:name "b2" :size "(500 x 707 mm)") + (:name "b1" :size "(707 x 1000 mm)") + (:name "b0" :size "(1000 x 1414 mm)") + (:name "4a0" :size "(1682 x 2378 mm)") + (:name "2a0" :size "(1189 x 1682 mm)") + (:name "c10" :size "(28 x 40 mm)") + (:name "c9" :size "(40 x 57 mm)") + (:name "c8" :size "(57 x 81 mm)") + (:name "c7" :size "(81 x 114 mm)") + (:name "c6" :size "(114 x 162 mm)") + (:name "c5" :size "(162 x 229 mm)") + (:name "c4" :size "(229 x 324 mm)") + (:name "c3" :size "(324 x 458 mm)") + (:name "c2" :size "(458 x 648 mm)") + (:name "c1" :size "(648 x 917 mm)") + (:name "c0" :size "(917 x 1297 mm)") + (:name "junior-legal" :size "(8.0 x 5.0 in)") + (:name "legal" :size "(8.5 x 14.0 in)") + (:name "tabloid" :size "(11.0 x 17.0 in)") + (:name "11x17" :size "(11.0 x 17.0 in)") + (:name "17x11" :size "(17.0 x 11.0 in)") + (:name "government-letter" :size "(8 x 10.5 in)") + (:name "government-legal" :size "(8.5 x 13.0 in)") + (:name "philippine-legal" :size "(8.5 x 13.0 in)") + (:name "ansi a" :size "(8.5 x 11.0 in)") + (:name "ansi b" :size "(17.0 x 11.0 in)") + (:name "ansi c" :size "(17.0 x 22.0 in)") + (:name "ansi d" :size "(22.0 x 34.0 in)") + (:name "ansi e" :size "(34.0 x 44.0 in)") + (:name "engineering f" :size "(28.0 x 40.0 in)") + (:name "arch b" :size "(12.0 x 18.0 in)") + (:name "arch c" :size "(18.0 x 24.0 in)") + (:name "arch d" :size "(24.0 x 36.0 in)") + (:name "arch e" :size "(36.0 x 48.0 in)") + (:name "arch e1" :size "(30.0 x 42.0 in)") + (:name "statement" :size "(5.5 x 8.5 in)") + (:name "half letter" :size "(5.5 x 8.5 in)") + (:name "quarto" :size "(8.0 x 10.0 in)") + (:name "octavo" :size "(6.75 x 10.5 in)") + (:name "executive" :size "(7.25 x 10.5 in)") + (:name "monarch" :size "(7.25 x 10.5 in)") + (:name "foolscap" :size "(8.27 x 13.0 in)") + (:name "folio" :size "(8.27 x 13.0 in)") + (:name "super-b" :size "(13.0 x 19.0 in)") + (:name "post" :size "(15.5 x 19.5 in)") + (:name "crown" :size "(15.0 x 20.0 in)") + (:name "large post" :size "(16.5 x 21.0 in)") + (:name "demy" :size "(17.5 x 22.5 in)") + (:name "medium" :size "(18.0 x 23.0 in)") + (:name "broadsheet" :size "(18.0 x 24.0 in)") + (:name "royal" :size "(20.0 x 25.0 in)") + (:name "elephant" :size "(23.0 x 28.0 in)") + (:name "double demy" :size "(22.5 x 35.0 in)") + (:name "quad demy" :size "(35.0 x 45.0 in)") + (:name "atlas" :size "(26.0 x 34.0 in)") + (:name "imperial" :size "(22.0 x 30.0 in)") + (:name "antiquarian" :size "(31.0 x 53.0 in)") + (:name "pa0" :size "(840 x 1120 mm)") + (:name "pa1" :size "(560 x 840 mm)") + (:name "pa2" :size "(420 x 560 mm)") + (:name "pa3" :size "(280 x 420 mm)") + (:name "pa4" :size "(210 x 280 mm)") + (:name "pa5" :size "(140 x 210 mm)") + (:name "pa6" :size "(105 x 140 mm)") + (:name "pa7" :size "(70 x 105 mm)") + (:name "pa8" :size "(52 x 70 mm)") + (:name "pa9" :size "(35 x 52 mm)") + (:name "pa10" :size "(26 x 35 mm)") + (:name "f4" :size "(210 x 330 mm)") + (:name "a8landscape" :size "(74 x 52 mm)"))) + +;; ========================================================================== ;; +;; browse + +(defclass browse (rest-service) + ((instructions :initarg :instructions + :initform nil + :accessor instructions)) + (:documentation "")) + +(defmethod initialize-instance :after ((browse browse) &key) + (setf (instructions browse) "Use the file browser to find a LilyPond file (ending in .ly). Select a paper size. Then click \"Generate PDF\" to create a PDF of the music for download.<br/>Or select a PDF and download it as-is.")) + +(defun browse-json () + (objects-to-json `(,(make-instance 'browse)))) + +;; ========================================================================== ;; +;; browse-browser + +(defclass browse-browser (rest-service) + ((location-p :initarg :location-p + :initform nil + :accessor location-p) + (relative-path :initarg :relative-path + :initform nil + :accessor relative-path) + (nodes :initarg :nodes + :initform nil + :accessor nodes)) + (:documentation "")) + +(defclass node (base-service) + ((node-type :initarg :node-type + :initform nil + :accessor node-type) + (path :initarg :path + :initform nil + :accessor path)) + (:documentation "")) + +(defun browse-browser-json (relative-path node) + (let ((file-browser (or (session-value :file-browser) + (make-instance 'file-browser + :document-root (make-webapp-path "music-dispensary/static/lilypond/") + :mime-extensions (mime-extensions *webapp*)))) + (browse-browser (make-instance 'browse-browser))) + (setf (relative-path file-browser) (if (null-or-empty-p relative-path) nil relative-path)) + (update-relative-path file-browser (if (null-or-empty-p node) nil node)) + (setf (session-value :file-browser) file-browser) + (setf (relative-path browse-browser) (relative-path file-browser)) + (setf (nodes browse-browser) (mapcar (lambda (node) + (make-instance 'node + :node-type (car node) + :path (cdr node))) + (directory-list file-browser))) + (objects-to-json `(,browse-browser)))) + +;; ========================================================================== ;; +;; browse-papersize + +(defclass browse-papersize (rest-service) + ((papersizes :initarg :papersizes + :initform nil + :accessor papersizes)) + (:documentation "")) + +(defclass papersize (base-service) + ((name :initarg :name + :initform nil + :accessor name) + (size :initarg :size + :initform nil + :accessor size)) + (:documentation "")) + +(defmethod initialize-instance :after ((browse-papersize browse-papersize) &key) + (setf (papersizes browse-papersize) (mapcar (lambda (x) + (make-instance 'papersize + :name (getf x :name) + :size (getf x :size))) + *papersizes*))) + +(defun browse-papersize-json () + (objects-to-json `(,(make-instance 'browse-papersize)))) + +;; ========================================================================== ;; +;; browse-generate + +(defclass browse-generate (rest-service) + ((url :initarg :url + :initform nil + :accessor url)) + (:documentation "")) + +(defun browse-generate-json (file papersize) + (let ((file-browser (session-value :file-browser)) + (url nil)) + (if (match-it ".*\.pdf$" file) + (setf url (format nil + "/static/lilypond/~a/~a" + (relative-path file-browser) + file)) + (let* ((output-file (format nil + "~a_~a" + (ppcre:regex-replace-all "\.ly" file "") + (ppcre:regex-replace-all " " papersize "_"))) + (lilypond-command (format nil + "pushd '~a' >/dev/null ; lilypond -d 'paper-size=\"~a\"' -o ~a ~a ; popd >/dev/null" + (absolute-path file-browser) + papersize + output-file + file))) + (shell-wrapper lilypond-command) + (setf url (format nil + "/static/lilypond/~a/~a" + (relative-path file-browser) + (format nil "~a.pdf" output-file))))) + (objects-to-json `(,(make-instance 'browse-generate :url url))))) |