Silas Vedder
3 years ago
8 changed files with 218 additions and 149 deletions
@ -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))) |
@ -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=))))) |
@ -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)) |
||||||
|
@ -1,33 +1,12 @@ |
|||||||
;;;; search.lisp |
;;;; search.lisp |
||||||
|
|
||||||
(in-package #:cl-bible) |
(in-package #:cl-bible.search) |
||||||
|
|
||||||
(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))) |
|
||||||
|
|
||||||
(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 (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 (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 (chapter verse))) book)) |
||||||
|
@ -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))) |
Loading…
Reference in new issue