Changed structure, introduced oop.

3 years ago · 76c6708b82
8 changed files with 218 additions and 149 deletions
--- 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")))
--- 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 ()
--- a/clog.lisp
+++ b/clog.lisp
@ -0,0 +1,105 @@
+;;;; 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 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 (format nil "~A 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 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 (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)))
--- a/data.lisp
+++ 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=)))))
--- 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)))

--- 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))
--- a/search.lisp
+++ b/search.lisp
@ -1,33 +1,12 @@
 ;;;; search.lisp

-(in-package #:cl-bible)
-
-(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)))
-
-(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 (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 (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 (chapter verse))) book))
--- a/verse.lisp
+++ 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 "<br/>"))
+  (format nil "~A ~A:~A~A ~A" (bsname verse)
+          (chapter verse)
+          (vnumber verse)
+          separator
+          (text verse)))