From 1495b412475ae90a04c52c52a46030b11b61c4bd Mon Sep 17 00:00:00 2001 From: Silas Vedder Date: Thu, 16 Jun 2022 21:46:47 +0200 Subject: [PATCH] You can change translations of a displayed chapter text. --- chapter.lisp | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++ cl-bible.asd | 1 + cl-bible.lisp | 4 +++- clog.lisp | 52 +++++++++++++++++++++------------------------- data.lisp | 11 ++++++++++ package.lisp | 12 ++++++++++- verse.lisp | 3 ++- 7 files changed, 108 insertions(+), 32 deletions(-) create mode 100644 chapter.lisp diff --git a/chapter.lisp b/chapter.lisp new file mode 100644 index 0000000..852e4ca --- /dev/null +++ b/chapter.lisp @@ -0,0 +1,57 @@ +(in-package #:cl-bible.chapter) + +(defun book/chapter-window (canvas title) + (let* ((win (window-content + (create-gui-window canvas + :title title + :height 400 + :width 650))) + (mbar (create-gui-menu-bar win)) + (drop-down (create-gui-menu-drop-down mbar :content "Translations"))) + (values (create-div win) + drop-down))) + +(defmacro translations-drop-down () + `(progn + ,@(mapcar + (lambda (translation) + `(labels ((verse-to-clog (verse) + (v:verse-to-clog verse + div + :translation ,(second translation))) + (hide-verse (verse) (setf (hiddenp verse) t)) + (callback (obj) + (declare (ignore obj)) + (mapc #'hide-verse display) + (setf display (mapcar #'verse-to-clog verses)))) + (create-gui-menu-item drop-down + :content ,(first translation) + :on-click #'callback))) + d:*translations*))) + +(defun display-chapter-or-book (canvas title verses) + (multiple-value-bind (div drop-down) + (book/chapter-window canvas title) + (flet ((verse-to-clog (verse) + (v:verse-to-clog verse + div + :translation d:*translation*))) + (let ((display (mapcar #'verse-to-clog verses))) + (translations-drop-down))))) + +(defun load-chapter (canvas book chapter) + (display-chapter-or-book canvas + (format nil "~A: ~A ~A" + d:*translation* + book + chapter) + (s:find-chapter + (s:find-book d:*bible* book) + chapter))) + +(defun load-book (canvas book) + (display-chapter-or-book canvas + (format nil "~A: ~A" + d:*translation* + book) + (s:find-book d:*bible* book))) diff --git a/cl-bible.asd b/cl-bible.asd index 6cf92cc..77e2d62 100644 --- a/cl-bible.asd +++ b/cl-bible.asd @@ -8,6 +8,7 @@ :serial t :depends-on (#:str #:clog) :components ((:file "package") + (:file "chapter") (:file "verse") (:file "search") (:file "lift-search") diff --git a/cl-bible.lisp b/cl-bible.lisp index bce3f30..34bf855 100644 --- a/cl-bible.lisp +++ b/cl-bible.lisp @@ -3,7 +3,9 @@ (in-package #:cl-bible) (defun start () - (initialize #'c:on-new-window) + (initialize (lambda (body) + (setf cl-bible.clog::body body) + (c:on-new-window body))) (open-browser)) (defun main () diff --git a/clog.lisp b/clog.lisp index dfa0203..3677634 100644 --- a/clog.lisp +++ b/clog.lisp @@ -2,6 +2,8 @@ (in-package #:cl-bible.clog) +(defvar *body*) + (defun lift-search-window (body search) (let ((result (mapcar #'car (l:lift-search search))) (win (create-gui-window body))) @@ -13,6 +15,24 @@ (defun ergebnis/se (n) (format nil "~A Ergebnis~A" n (if (= n 1) "" "se"))) +(defun test (canvas) + (create-gui-window canvas :title "Test" + :height 400 + :width 300)) + +(defun test (canvas) + (let* ((win (window-content + (create-gui-window canvas :title "Test" + :height 300 + :width 400))) + (button (create-button win :content "click me!")) + (div (create-div win))) + (create-p div :content "foo") + (set-on-click button (lambda (obj) + (declare (ignore obj)) + (format t "Clicked button!"))) + div)) + (defun search-in-bible (phrase bible canvas) (let* ((win (window-content (create-gui-window canvas @@ -83,35 +103,8 @@ (let* ((book (cadr (assoc "book" data :test #'string=))) (chapter (cadr (assoc "chapter" data :test #'string=)))) (if (string= chapter "") - (load-book canvas book) - (load-chapter canvas book chapter))))) - -(defun book/chapter-window (canvas title) - (create-div - (window-content - (create-gui-window canvas - :title title - :height 400 - :width 650)))) - -(defun load-book (canvas book) - (let ((div (book/chapter-window canvas - (format nil "~A: ~A" - d:*translation* - book)))) - (mapc (lambda (verse) - (v:verse-to-clog verse div :translation d:*translation*)) - (s:find-book d:*bible* book)))) - -(defun load-chapter (canvas book chapter) - (let ((div (book/chapter-window canvas - (format nil "~A: ~A ~A" - d:*translation* - book - chapter)))) - (mapc (lambda (verse) - (v:verse-to-clog verse div :translation d:*translation*)) - (s:find-chapter (s:find-book d:*bible* book) chapter)))) + (ch:load-book canvas book) + (ch:load-chapter canvas book chapter))))) (defun get-chapter (window body) (lambda (obj) @@ -162,6 +155,7 @@ (d:load-bibles))))) (defun on-new-window (body) + (setf *body* body) (setf (title (html-document body)) "Bible") (clog-gui-initialize body) (setup-menu-bar body (setup-window body))) diff --git a/data.lisp b/data.lisp index 24d2d9c..906712b 100644 --- a/data.lisp +++ b/data.lisp @@ -2,6 +2,17 @@ (in-package #:cl-bible.data) +(defvar *translations* '(("Menge" :mng) + ("King James Version" :kjv) + ("Vulgata" :vul) + ("Greek Bible" :grb) + ("Elberfelder Übersetzung 1871" :elb1871) + ("NEÜ" :neue) + ("Luther 1545" :luth1545) + ("Luther 1912" :luth1912) + ("Schlachter 1951" :sch1951) + ("Ukrainische Version" :ukr))) + (defun load-bible (filename) (v:from-sexp (read-from-string diff --git a/package.lisp b/package.lisp index 74e1a62..e4ac912 100644 --- a/package.lisp +++ b/package.lisp @@ -29,6 +29,7 @@ (:export update-bible *bible* *translation* + *translations* persist load-bibles)) @@ -39,12 +40,21 @@ (#:d #:cl-bible.data)) (:export lift-search)) +(defpackage #:cl-bible.chapter + (:use #:cl #:clog #:clog-gui) + (:local-nicknames (#:d #:cl-bible.data) + (#:s #:cl-bible.search) + (#:v #:cl-bible.verse)) + (:export load-chapter + load-book)) + (defpackage #:cl-bible.clog (:use #:cl #:clog #:clog-gui) (:local-nicknames (#:l #:cl-bible.lift-search) (#:d #:cl-bible.data) (#:s #:cl-bible.search) - (#:v #:cl-bible.verse)) + (#:v #:cl-bible.verse) + (#:ch #:cl-bible.chapter)) (:export on-new-window)) (defpackage #:cl-bible diff --git a/verse.lisp b/verse.lisp index e80d6a0..1d1dd51 100644 --- a/verse.lisp +++ b/verse.lisp @@ -118,7 +118,8 @@ (clog:set-on-click display (lambda (obj) (declare (ignore obj)) - (show-notes verse parent))))) + (show-notes verse parent))) + display)) (defgeneric to-sexp (verse)) (defmethod to-sexp ((verse verse))