Silas Vedder
3 years ago
commit
993ab079d1
12 changed files with 145484 additions and 0 deletions
@ -0,0 +1,9 @@
|
||||
# cl-bible |
||||
### _Your Name <your.name@example.com>_ |
||||
|
||||
This is a project to do ... something. |
||||
|
||||
## License |
||||
|
||||
Specify license here |
||||
|
@ -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)))) |
@ -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"))) |
@ -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)) |
@ -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)) |
@ -0,0 +1,4 @@
|
||||
;;;; package.lisp |
||||
|
||||
(defpackage #:cl-bible |
||||
(:use #:cl #:clog #:clog-gui)) |
@ -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…
Reference in new issue