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

Merge pull request #1 from silasfox/oo 

Oo
master
Silas Vedder 2 years ago committed by GitHub
parent
be89912b74 636bfea8c4
commit
e252462f60
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 221 additions and 137 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 3
      cl-bible.asd
  2. 123
      cl-bible.lisp
  3. 108
      clog.lisp
  4. 24
      data.lisp
  5. 4
      lift-search.lisp
  6. 39
      package.lisp
  7. 17
      search.lisp
  8. 40
      verse.lisp

3
cl-bible.asd
Unescape View File

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

123
cl-bible.lisp
Unescape View File

@ -2,129 +2,8 @@
(in-package #:cl-bible) (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 () (defun start ()
(initialize #'on-new-window) (initialize #'c:on-new-window)
(open-browser)) (open-browser))
(defun main () (defun main ()

108
clog.lisp
Unescape 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
Unescape 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
Unescape View File

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

39
package.lisp
Unescape View File

@ -1,6 +1,45 @@
;;;; package.lisp ;;;; 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 (defpackage #:cl-bible
(:use #:cl #:clog #:clog-gui) (:use #:cl #:clog #:clog-gui)
(:local-nicknames (#:c #:cl-bible.clog))
(:export start (:export start
build)) build))

17
search.lisp
Unescape View File

@ -1,21 +1,12 @@
;;;; search.lisp ;;;; search.lisp
(in-package #:cl-bible) (in-package #:cl-bible.search)
(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)))
(defun find-in-bible (bible phrase) (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) (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) (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
Unescape 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)))
Write Preview
Loading…
Cancel
Save