Initial commit

.gitignore

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

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
+

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))))

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")))

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))

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))

package.lisp

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

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))