silasfox/cl-bible
1
0
Fork 0
Code Issues 3 Pull Requests Projects 1 Releases Wiki Activity

Lot of changes

Browse Source
This commit is contained in:
Silas Vedder 2022-05-25 11:51:32 +02:00
parent c9f5ae2b9c
commit 26fca1d1e3
6 changed files with 113 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
README.md
View File

@ -9,10 +9,8 @@ Then do
$ git clone https://github.com/silasfox/cl-bible.git ~/quicklisp/local-projects
$ mkdir -p ~/.bible
$ cp ~/quicklisp/local-projects/cl-bible/resources/*.sexp ~/.bible/
$ sbcl
* (ql:quickload :cl-bible)
* (in-package :cl-bible-user)
* (start)
$ make
$ sudo make install
```
## bibles

BIN
bible Executable file
View File

Binary file not shown.

74
clog.lisp
View File

@ -3,28 +3,30 @@
(in-package #:cl-bible.clog)
(defun lift-search-window (body search)
(lambda (obj)
(declare (ignore obj))
(let ((result (mapcar #'car (l:lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
:content (str:join ", " result)))))
(let ((result (mapcar #'car (l:lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
:content (str:join ", " (if result
result
'("No results"))))))
(defun ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
(defun search-in-bible (phrase bible canvas)
(let* ((win (window-content
(create-gui-window canvas :title
(format nil "~A: ~A"
d:*translation*
phrase)
(create-gui-window canvas
:title (format nil "~A: ~A"
d:*translation*
phrase)
:height 400
:width 650)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(set-on-click lift-search (lambda (obj)
(declare (ignore obj))
(lift-search-window canvas results)))
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
@ -39,14 +41,13 @@
book
(s:find-chapter book chapter)))))
(defun search-with-chapter (window)
(lambda (data)
(let ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(phrase (cadr (assoc "phrase" data :test #'string=))))
(search-in-bible phrase
(%bible-book-or-chapter d:*bible* book chapter)
window))))
(defun search-with-chapter (window data)
(let ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(phrase (cadr (assoc "phrase" data :test #'string=))))
(search-in-bible phrase
(%bible-book-or-chapter d:*bible* book chapter)
window)))
(defun searcher (window)
(lambda (obj)
@ -55,7 +56,8 @@
'(("Phrase" "phrase" :text)
("Book" "book" :text)
("Chapter" "chapter" :text))
(search-with-chapter window)
(lambda (data)
(search-with-chapter window data))
:title "Search a phrase")))
(defun reload (window)
@ -84,28 +86,29 @@
(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* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A"
d:*translation*
book)
:height 400
:width 650)))
(div (create-div win)))
(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* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A ~A"
d:*translation*
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
(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))))
@ -158,7 +161,6 @@
(declare (ignore obj))
(d:load-bibles)))))
(defun on-new-window (body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)

27
lift-search.lisp
View File

@ -2,10 +2,26 @@
(in-package #:cl-bible.lift-search)
(defun frequent-words () (str:words "der die das dir mir wir ihr sie sein mein dein euer unser dem den in zu und"))
(defun frequent-words ()
(str:words "der die das dir mir wir ihr sie sein mein dein euer unser dem den in zu und"))
(defparameter *punctuation*
'(#\; #\: #\' #\" #\. #\, #\« #\» #\( #\) #\[ #\] #\{ #\} #\! #\? #\-))
(defun normalize-string (str)
(map 'string (lambda (char)
(if (member char *punctuation*)
#\space
char))
str))
(defun compose (f1 f2)
(lambda (&rest args)
(funcall f1 (apply f2 args))))
(defun lift-search (search-result)
(comb (diff-verses (mapcar #'v:get-text search-result))
(comb (diff-verses (mapcar (compose #'normalize-string #'v:get-text)
search-result))
(length search-result)))
(defun count-words (words)
@ -19,9 +35,10 @@
(> (cdr x) (cdr y))))))
(defun diff-verses (verses)
(count-words (remove-if (lambda (word) (member word
(frequent-words)
:test #'string=))
(count-words (remove-if (lambda (word)
(member word
(frequent-words)
:test #'string=))
(mapcan #'str:words verses))))
(defun comb (freqs length)

3
search.lisp
View File

@ -3,8 +3,7 @@
(in-package #:cl-bible.search)
(defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase
(v:get-text verse)))
(remove-if-not (lambda (verse) (search phrase (v:get-text verse)))
bible))
(defun find-book (bible book)

72
verse.lisp
View File

@ -49,35 +49,61 @@
separator
(cdr (assoc translation (translations verse)))))
(defgeneric verse-to-latex (verse &key translation port))
(defmethod verse-to-latex ((verse verse) &key translation (port t))
(declare (ignore translation))
(format port "~A ~A ^{~A} ~%~{~A~%~} \\\\~%"
(bname verse)
(chapter verse)
(vnumber verse)
(mapcar (lambda (trans) (assoc trans
(translations verse)))
'(:mng :luth1545 :luth1912 :sch1951 :elb1871 :neue))))
(defgeneric get-text (verse))
(defmethod get-text ((verse verse))
(cdr (assoc cl-bible.data:*translation* (translations verse))))
(cdr (assoc cl-bible.data:*translation*
(translations verse))))
(defun %format-notes (notes)
(if notes
(format nil "~{~A~^<br/>~}" notes)
"No notes found"))
(defun %create-notes-window (verse parent)
(let ((win (clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Notes"
:content (%format-notes
(notes verse))))))
(clog:create-br win)
(clog:create-button win
:content "Add notes")))
(defgeneric show-notes (verse parent))
(defmethod show-notes ((verse verse) (parent clog:clog-obj))
(let* ((win (clog-gui:create-gui-window parent
:title "Notes"
:content (let ((notes (notes verse)))
(if notes
(format nil "~{~A~^<br/>~}" notes)
"No notes found"))))
(_ (clog:create-br (clog-gui:window-content win)))
(button (clog:create-button (clog-gui:window-content win)
:content "Add notes")))
(declare (ignore _))
(let ((button (%create-notes-window verse parent)))
(clog:set-on-click button
(lambda (obj)
(declare (ignore obj))
(add-notes verse parent)))))
(defun %create-add-notes-window (parent)
(let* ((form (clog:create-form
(clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Add note"))))
(text (clog:create-text-area form :rows 4
:columns 40)))
(clog:create-br form)
(values text
(clog:create-button form :content "submit"))))
(defgeneric add-notes (verse parent))
(defmethod add-notes ((verse verse) (parent clog:clog-obj))
(let* ((win (clog-gui:window-content
(clog-gui:create-gui-window parent
:title "Add note")))
(form (clog:create-form win))
(text (clog:create-text-area form :rows 4))
(_ (clog:create-br form))
(button (clog:create-button form :content "submit")))
(declare (ignore _))
(multiple-value-bind (text button)
(%create-add-notes-window parent)
(clog:set-on-click button
(lambda (obj)
(declare (ignore obj))
@ -85,9 +111,10 @@
(defgeneric verse-to-clog (verse parent &key translation))
(defmethod verse-to-clog ((verse verse) (parent clog:clog-obj) &key (translation :mng))
(let* ((verse-string (verse-to-string verse :translation translation))
(display (clog:create-p parent
:content verse-string)))
(let ((display
(clog:create-p parent
:content (verse-to-string verse
:translation translation))))
(clog:set-on-click display
(lambda (obj)
(declare (ignore obj))
@ -116,4 +143,3 @@
(defun from-sexp (bible)
(mapcar #'verse-from-sexp bible))