;;;; 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)))