Browse Source

Initial commit

master
Silas Vedder 3 years ago
commit
993ab079d1
  1. 1
      .gitignore
  2. 9
      README.md
  3. 22
      annotate.lisp
  4. 14
      cl-bible.asd
  5. 117
      cl-bible.lisp
  6. 31
      lift-search.lisp
  7. 4
      package.lisp
  8. 39222
      resources/grb.tsv
  9. 36642
      resources/kjv.tsv
  10. 35488
      resources/mng.tsv
  11. 33913
      resources/vul.tsv
  12. 21
      search.lisp

1
.gitignore vendored

@ -0,0 +1 @@
*.fasl

9
README.md

@ -0,0 +1,9 @@
# cl-bible
### _Your Name <your.name@example.com>_
This is a project to do ... something.
## License
Specify license here

22
annotate.lisp

@ -0,0 +1,22 @@
;;;; annotate.lisp
(in-package #:cl-bible)
(defstruct metadata
notes
tags)
(defun add-metadata (verse metadata)
(cons verse metadata))
(defun get-notes (verse)
(metadata-notes (cdr verse)))
(defun get-tags (verse)
(metadata-tags (cdr verse)))
(defun add-note (verse note)
(setf (metadata-notes (cdr verse)) (cons note (get-notes verse))))
(defun add-tag (verse tag)
(setf (metadata-tags (cdr verse)) (cons tag (get-tags verse))))

14
cl-bible.asd

@ -0,0 +1,14 @@
;;;; cl-bible.asd
(asdf:defsystem #:cl-bible
:description "Describe cl-bible here"
:author "Your Name <your.name@example.com>"
:license "Specify license here"
:version "0.0.1"
:serial t
:depends-on (#:str #:clog)
:components ((:file "package")
(:file "search")
(:file "lift-search")
(:file "annotate")
(:file "cl-bible")))

117
cl-bible.lisp

@ -0,0 +1,117 @@
;;;; cl-bible.lisp
(in-package #:cl-bible)
(defvar *bible* '())
(defun init-bible (&optional (bible "mng"))
(setf *bible*
(mapcar #'string->verse
(uiop:read-file-lines
(format nil "resources/~A.tsv" bible)))))
(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 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)
(init-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)
(open-browser))

31
lift-search.lisp

@ -0,0 +1,31 @@
;;;; lift-search.lisp
(in-package #:cl-bible)
(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))
search-result))
(length search-result)))
(defun count-words (words)
(let (result)
(mapc (lambda (word)
(if (assoc word result :test #'string=)
(incf (cdr (assoc word result :test #'string=)))
(setf result (acons word 1 result))))
words)
(sort result (lambda (x y)
(> (cdr x) (cdr y))))))
(defun diff-verses (verses)
(count-words (remove-if (lambda (word) (member word
(frequent-words)
:test #'string=))
(mapcan #'str:words verses))))
(defun comb (freqs length)
(remove-if (lambda (word)
(< (cdr word) (* 0.25 length)))
freqs))

4
package.lisp

@ -0,0 +1,4 @@
;;;; package.lisp
(defpackage #:cl-bible
(:use #:cl #:clog #:clog-gui))

39222
resources/grb.tsv

File diff suppressed because it is too large Load Diff

36642
resources/kjv.tsv

File diff suppressed because it is too large Load Diff

35488
resources/mng.tsv

File diff suppressed because it is too large Load Diff

33913
resources/vul.tsv

File diff suppressed because it is too large Load Diff

21
search.lisp

@ -0,0 +1,21 @@
;;;; 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)))
(defun find-in-bible (bible phrase)
(remove-if-not (lambda (verse) (search phrase (nth 5 verse))) bible))
(defun find-book (bible book)
(remove-if-not (lambda (verse) (search book (car verse))) bible))
(defun find-chapter (book chapter)
(remove-if-not (lambda (verse) (string= chapter (nth 3 verse))) book))
Loading…
Cancel
Save