-
Notifications
You must be signed in to change notification settings - Fork 1
/
clog.lisp
165 lines (148 loc) · 6.67 KB
/
clog.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
;;;; 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 ergebnis/se (n)
(format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))
(defun search-in-bible (phrase bible canvas)
(let* ((win (window-content
(create-gui-window canvas :title
(format nil "~A: ~A"
d:*translation*
phrase)
:height 400
:width 650)))
(lift-search (create-button win :content "Lift Search"))
(div (create-div win))
(results (s:find-in-bible bible phrase)))
(set-on-click lift-search (lift-search-window canvas results))
(create-p div :content (ergebnis/se
(length results)))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
results)))
(defun %bible-book-or-chapter (bible book chapter)
(if (string= book "")
bible
(let ((book (s:find-book bible book)))
(if (string= chapter "")
book
(s:find-chapter book chapter)))))
(defun search-with-chapter (window)
(lambda (data)
(let ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=)))
(phrase (cadr (assoc "phrase" data :test #'string=))))
(search-in-bible phrase
(%bible-book-or-chapter d:*bible* book chapter)
window))))
(defun searcher (window)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "What do you want to search?"
'(("Phrase" "phrase" :text)
("Book" "book" :text)
("Chapter" "chapter" :text))
(search-with-chapter window)
:title "Search a phrase")))
(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)
("Elberfelder Übersetzung 1871" :elb1871)
("NEÜ" :neue)
("Luther 1545" :luth1545)
("Luther 1912" :luth1912)
("Schlachter 1951" :sch1951)
("Ukrainische Version" :ukr))))
(lambda (results)
(d:update-bible (cadar results))
:title "Load a Bible"))))
(defun load-book-or-chapter (canvas)
(lambda (data)
(let* ((book (cadr (assoc "book" data :test #'string=)))
(chapter (cadr (assoc "chapter" data :test #'string=))))
(if (string= chapter "")
(load-book canvas book)
(load-chapter canvas book chapter)))))
(defun load-book (canvas book)
(let* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A"
d:*translation*
book)
:height 400
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
(s:find-book d:*bible* book))))
(defun load-chapter (canvas book chapter)
(let* ((win (window-content
(create-gui-window canvas :title (format nil "~A: ~A ~A"
d:*translation*
book
chapter)
:height 400
:width 650)))
(div (create-div win)))
(mapc (lambda (verse)
(v:verse-to-clog verse div :translation d:*translation*))
(s:find-chapter (s:find-book d:*bible* book) chapter))))
(defun get-chapter (window body)
(lambda (obj)
(declare (ignore obj))
(form-dialog window "Which chapter do you want?"
'(("Book" "book" :text)
("Chapter" "chapter" :text))
(load-book-or-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))))
(create-gui-menu-item mbar
:content "Save notes"
:on-click (lambda (obj)
(declare (ignore obj))
(d:persist)))
(create-gui-menu-item mbar
:content "Load notes"
:on-click (lambda (obj)
(declare (ignore obj))
(d:load-bibles)))))
(defun on-new-window (body)
(setf (title (html-document body)) "Bible")
(clog-gui-initialize body)
(setup-menu-bar body (setup-window body)))