cl-bible/clog.lisp

;;;; cl-bible.lisp

(in-package #:cl-bible.clog)

(defvar *body*)

(defun lift-search-window (body search)
  (let ((result (mapcar #'car (l:lift-search search)))
        (win (create-gui-window body)))
    (create-p (window-content win)
              :content (str:join ", " (if result
                                          result
                                          '("No results"))))))

(defun ergebnis/se (n)
  (format nil "~A Ergebnis~A" n (if (= n 1) "" "se")))

(defun test (canvas)
  (create-gui-window canvas :title "Test"
                            :height 400
                            :width 300))

(defun test (canvas)
  (let* ((win (window-content
              (create-gui-window canvas :title "Test"
                                        :height 300
                                        :width 400)))
         (button (create-button win :content "click me!"))
         (div (create-div win)))
    (create-p div :content "foo")
    (set-on-click button (lambda (obj)
                           (declare (ignore obj))
                           (format t "Clicked button!")))
    div))

(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 500)))
         (lift-search (create-button win :content "Lift Search"))
         (div (create-div win))
         (results (s:find-in-bible bible phrase)))
    (set-on-click lift-search (lambda (obj)
                                (declare (ignore obj))
                                (lift-search-window canvas results)))
    (create-p div :content (ergebnis/se
                            (length results)))
    (mapc (lambda (verse)
            (clog:set-on-click
             (v:verse-to-clog verse div :translation d:*translation*)
             (lambda (obj)
               (declare (ignore obj))
               (ch:load-chapter canvas
                                (v:bname verse)
                                (v:chapter verse)))))
          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 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))
                 (lambda (data)
                   (search-with-chapter window data))
                 :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)
    (ch:load-position canvas
                      (second (assoc "pos" data :test #'string=)))))

(defun get-chapter (window body)
  (lambda (obj)
    (declare (ignore obj))
    (form-dialog window "Which passage do you want?"
                 '(("" "pos" :text))
                 (load-book-or-chapter body)
                 :title "Load a Passage")))

(defun setup-window (body)
  (let ((window (create-gui-window body :title "background"
                                        :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)
                                            :if (or (null win)
                                                    (string= (window-title win)
                                                             "background"))
                                              :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 *body* body)
  (setf (title (html-document body)) "Bible")
  (clog-gui-initialize body)
  (setup-menu-bar body (setup-window body)))