diff --git a/cl-bible.asd b/cl-bible.asd index 043c7e9..c7dfa26 100644 --- a/cl-bible.asd +++ b/cl-bible.asd @@ -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"))) diff --git a/cl-bible.lisp b/cl-bible.lisp index 3e8b5de..70ba2bd 100644 --- a/cl-bible.lisp +++ b/cl-bible.lisp @@ -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 () diff --git a/clog.lisp b/clog.lisp new file mode 100644 index 0000000..9c74218 --- /dev/null +++ b/clog.lisp @@ -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))) diff --git a/data.lisp b/data.lisp new file mode 100644 index 0000000..17564ba --- /dev/null +++ b/data.lisp @@ -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=))))) diff --git a/lift-search.lisp b/lift-search.lisp index 7ef420b..f5d6aae 100644 --- a/lift-search.lisp +++ b/lift-search.lisp @@ -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))) diff --git a/package.lisp b/package.lisp index 66320dc..a838223 100644 --- a/package.lisp +++ b/package.lisp @@ -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)) diff --git a/search.lisp b/search.lisp index 4bd8d9d..289f952 100644 --- a/search.lisp +++ b/search.lisp @@ -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
~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)) diff --git a/verse.lisp b/verse.lisp new file mode 100644 index 0000000..4c08716 --- /dev/null +++ b/verse.lisp @@ -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 "
")) + (format nil "~A ~A:~A~A ~A" (bsname verse) + (chapter verse) + (vnumber verse) + separator + (text verse)))