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

Merge pull request #1 from silasfox/oo

Browse Source 
Oo
This commit is contained in:
Silas Vedder 2022-05-06 08:28:20 +02:00 committed by GitHub
commit e252462f60
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 221 additions and 137 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
cl-bible.asd
View File

@ -8,7 +8,10 @@
:serial t
:depends-on (#:str #:clog)
:components ((:file "package")
(:file "verse")
(:file "search")
(:file "lift-search")
(:file "annotate")
(:file "data")
(:file "clog")
(:file "cl-bible")))

123
cl-bible.lisp
View File

@ -2,129 +2,8 @@
(in-package #:cl-bible)
(defun init-bible (&optional (bible "mng"))
(setf *bible*
(mapcar #'string->verse
(uiop:read-file-lines
(format nil "resources/~A.tsv" bible)))))
(defvar *bible*)
(defvar *mng* (init-bible))
(defvar *vul* (init-bible "vul"))
(defvar *grb* (init-bible "grb"))
(defvar *kjv* (init-bible "kjv"))
(defun lift-search-window (body search)
(lambda (obj)
(declare (ignore obj))
(let ((result (mapcar #'car (lift-search search)))
(win (create-gui-window body)))
(create-p (window-content win)
:content (str:join ", " result)))))
(defun search-in-bible (phrase canvas)
(let* ((win (window-content (create-gui-window canvas :title phrase
:height 400
:width 650)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (find-in-bible *bible* phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(create-p div :content (format nil "~A Ergebnis(se)"
(length results)))
(mapc (lambda (verse)
(create-p div :content
(verse-to-string verse)))
results)))
(defun searcher (window)
(lambda (obj)
(declare (ignore obj))
(input-dialog window "What do you want to search?"
(lambda (phrase)
(search-in-bible phrase window)))))
(defun update-bible (str)
(let ((bibles `(("mng" . ,*mng*)
("kjv" . ,*kjv*)
("vul" . ,*vul*)
("grb" . ,*grb*))))
(setf *bible* (cdr (assoc str bibles :test #'string=)))))
(defun reload (window)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which bible do you want?"
'(("Bible" "bible" :select (("Menge" "mng")
("King James Version" "kjv")
("Vulgata" "vul")
("Greek Bible" "grb"))))
(lambda (results)
(update-bible (cadar results))
:title "Load a Bible"))))
(defun load-chapter (canvas)
(lambda (data)
(let* ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(win (window-content
(create-gui-window canvas :title (format nil "~A ~A"
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(create-p div :content
(verse-to-string verse)))
(find-chapter (find-book *bible* book) chapter)))))
(defun chapter (window body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which bible do you want?"
'(("Book" "book" :text "Book")
("Chapter" "chapter" :text "Chapter"))
(load-chapter body)
:title "Load a Chapter")))
(defun setup-window (body)
(let ((window (create-gui-window body :title "Search"
:hidden t)))
(window-normalize window)
(window-center window)
window))
(defun setup-menu-bar (body window)
(let* ((mbar (create-gui-menu-bar body))
(drop-down (create-gui-menu-drop-down mbar
:content "Options")))
(create-gui-menu-full-screen mbar)
(create-gui-menu-item drop-down
:content "Search"
:on-click (searcher window))
(create-gui-menu-item drop-down
:content "Get Chapter"
:on-click (chapter window body))
(create-gui-menu-item drop-down
:content "Load Bible"
:on-click (reload window))
(create-gui-menu-item mbar
:content "Close all windows"
:on-click (lambda (obj)
(declare (ignore obj))
(loop for win = (current-window body)
unless win do (return)
do (window-close win))))))
(defun on-new-window (body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)
(setup-menu-bar body (setup-window body)))
(defun start ()
(initialize #'on-new-window)
(initialize #'c:on-new-window)
(open-browser))
(defun main ()

108
clog.lisp Normal file
View File

@ -0,0 +1,108 @@
;;;; cl-bible.lisp
(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)))))
(defun ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se" )))
(defun search-in-bible (phrase canvas)
(let* ((win (window-content (create-gui-window canvas :title phrase
:height 400
:width 650)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible d:*bible* phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
(create-p div :content
(v:verse-to-string verse)))
results)))
(defun searcher (window)
(lambda (obj)
(declare (ignore obj))
(input-dialog window "What do you want to search?"
(lambda (phrase)
(search-in-bible phrase window)))))
(defun reload (window)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which bible do you want?"
'(("Bible" "bible" :select (("Menge" "mng")
("King James Version" "kjv")
("Vulgata" "vul")
("Greek Bible" "grb"))))
(lambda (results)
(d:update-bible (cadar results))
:title "Load a Bible"))))
(defun load-chapter (canvas)
(lambda (data)
(let* ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(win (window-content
(create-gui-window canvas :title (format nil "~A ~A"
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(create-p div :content
(v:verse-to-string verse)))
(s:find-chapter (s:find-book d:*bible* book) chapter)))))
(defun get-chapter (window body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which chapter do you want?"
'(("Book" "book" :text "Book")
("Chapter" "chapter" :text "Chapter"))
(load-chapter body)
:title "Load a Chapter")))
(defun setup-window (body)
(let ((window (create-gui-window body :title "Search"
:hidden t)))
(window-normalize window)
(window-center window)
window))
(defun setup-menu-bar (body window)
(let* ((mbar (create-gui-menu-bar body))
(drop-down (create-gui-menu-drop-down mbar
:content "Options")))
(create-gui-menu-full-screen mbar)
(create-gui-menu-item drop-down
:content "Search"
:on-click (searcher window))
(create-gui-menu-item drop-down
:content "Get Chapter"
:on-click (get-chapter window body))
(create-gui-menu-item drop-down
:content "Load Bible"
:on-click (reload window))
(create-gui-menu-item mbar
:content "Close all windows"
:on-click (lambda (obj)
(declare (ignore obj))
(loop for win = (current-window body)
unless win do (return)
do (window-close win))))))
(defun on-new-window (body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)
(setup-menu-bar body (setup-window body)))

24
data.lisp Normal file
View File

@ -0,0 +1,24 @@
;;;; cl-bible.lisp
(in-package #:cl-bible.data)
(defun init-bible (&optional (bible "mng"))
(setf *bible*
(mapcar #'v:string-to-verse
(uiop:read-file-lines
(asdf:system-relative-pathname
"cl-bible"
(format nil "resources/~A.tsv" bible))))))
(defvar *bible*)
(defvar *mng* (init-bible))
(defvar *vul* (init-bible "vul"))
(defvar *grb* (init-bible "grb"))
(defvar *kjv* (init-bible "kjv"))
(defun update-bible (str)
(let ((bibles `(("mng" . ,*mng*)
("kjv" . ,*kjv*)
("vul" . ,*vul*)
("grb" . ,*grb*))))
(setf *bible* (cdr (assoc str bibles :test #'string=)))))

4
lift-search.lisp
View File

@ -1,11 +1,11 @@
;;;; lift-search.lisp
(in-package #:cl-bible)
(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 lift-search (search-result)
(comb (diff-verses (mapcar (lambda (verse) (nth 5 verse))
(comb (diff-verses (mapcar #'v:text
search-result))
(length search-result)))

39
package.lisp
View File

@ -1,6 +1,45 @@
;;;; package.lisp
(defpackage #:cl-bible.verse
(:use #:cl)
(:export verse-to-string
string-to-verse
bname
bsname
chapter
vnumber
text))
(defpackage #:cl-bible.search
(:use #:cl)
(:local-nicknames (#:v #:cl-bible.verse))
(:export find-in-bible
find-book
find-chapter))
(defpackage #:cl-bible.lift-search
(:use #:cl)
(:local-nicknames (#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
(:export lift-search))
(defpackage #:cl-bible.data
(:use #:cl)
(:local-nicknames (#:s #:cl-bible.search)
(#:v #:cl-bible.verse))
(:export update-bible
*bible*))
(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))
(:export on-new-window))
(defpackage #:cl-bible
(:use #:cl #:clog #:clog-gui)
(:local-nicknames (#:c #:cl-bible.clog))
(:export start
build))

17
search.lisp
View File

@ -1,21 +1,12 @@
;;;; search.lisp
(in-package #:cl-bible)
(defun string->verse (string)
(uiop:split-string string :separator '(#\Tab)))
(defun verse-to-string (verse)
(format nil "~A ~A:~A<br/> ~A" (cadr verse)
(nth 3 verse)
(nth 4 verse)
(nth 5 verse)))
(in-package #:cl-bible.search)
(defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase (nth 5 verse))) bible))
(remove-if-not (lambda (verse) (search phrase (v:text verse))) bible))
(defun find-book (bible book)
(remove-if-not (lambda (verse) (search book (car verse))) bible))
(remove-if-not (lambda (verse) (search book (v:bname verse))) bible))
(defun find-chapter (book chapter)
(remove-if-not (lambda (verse) (string= chapter (nth 3 verse))) book))
(remove-if-not (lambda (verse) (string= chapter (v:chapter verse))) book))

40
verse.lisp Normal file
View File

@ -0,0 +1,40 @@
;;;; search.lisp
(in-package #:cl-bible.verse)
(defclass verse ()
((%bname :initarg :bname
:reader bname)
(%bsname :initarg :bsname
:reader bsname)
(%chapter :initarg :chapter
:reader chapter)
(%number :initarg :number
:reader vnumber)
(%text :initarg :text
:reader text)))
(defmethod print-object ((verse verse) stream)
(format stream (verse-to-string verse " ")))
(defun string-to-verse (string)
(let ((verse (uiop:split-string string :separator '(#\Tab))))
(make-instance 'verse :bname (car verse)
:bsname (nth 1 verse)
:chapter (nth 3 verse)
:number (nth 4 verse)
:text (nth 5 verse))))
(defgeneric verse-to-string (verse &optional separator))
(defmethod verse-to-string (verse &optional (separator " "))
(format nil "~A ~A:~A~A~A" (cadr verse)
(nth 3 verse)
(nth 4 verse)
separator
(nth 5 verse)))
(defmethod verse-to-string ((verse verse) &optional (separator "<br/>"))
(format nil "~A ~A:~A~A ~A" (bsname verse)
(chapter verse)
(vnumber verse)
separator
(text verse)))