diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp index 0744793..5babbab 100644 --- a/source/clog-gui.lisp +++ b/source/clog-gui.lisp @@ -66,6 +66,9 @@ (set-on-window-size-done generic-function) "CLOG-GUI - Dialog Boxes" + (alert-dialog function) + (input-dialog function) + (confirm-dialog function) (server-file-dialog function)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1097,22 +1100,191 @@ interactions. Use window-end-modal to undo.")) ;; Implementation - Dialog Boxes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; to add - alert box, input box, form by list +;; to add - form by list + +(defun alert-dialog (obj content &key (modal t) + (title "About") + (left nil) (top nil) + (width 300) (height 200) + (client-movement nil) + (html-id nil)) + "Create an alert dialog box with CONTENT centered." + (unless html-id + (setf html-id (clog-connection:generate-id))) + (let* ((body (connection-data-item obj "clog-body")) + (win (create-gui-window obj + :title title + :content (format nil +"
+
~A

+ +
+
" content html-id) + :top top + :left left + :width width + :height height + :client-movement client-movement + :html-id html-id)) + (btn (attach-as-child win (format nil "~A-btn" html-id)))) + (unless top + (setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0) + (/ (height win) 2.0))))) + (unless left + (setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0) + (/ (width win) 2.0))))) + (when modal + (window-make-modal win)) + (set-on-click btn (lambda (obj) + (declare (ignore obj)) + (window-end-modal win) + (window-close win))) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (when modal + (window-end-modal win)))))) + +(defun input-dialog (obj content on-input &key (modal t) + (title "Input") + (left nil) (top nil) + (width 300) (height 200) + (client-movement nil) + (html-id nil)) + "Create an input dialog box with CONTENT centered and an input box. +Calls on-input with input box contents or nil if canceled." + (unless html-id + (setf html-id (clog-connection:generate-id))) + (let* ((body (connection-data-item obj "clog-body")) + (win (create-gui-window obj + :title title + :content (format nil +"
+
~A

+
+

+ + +
+
+
" content + html-id ; input + html-id ; ok + html-id) ; cancel + :top top + :left left + :width width + :height height + :client-movement client-movement + :html-id html-id)) + (input (attach-as-child win (format nil "~A-input" html-id) + :clog-type 'clog:clog-form-element)) + (ok (attach-as-child win (format nil "~A-ok" html-id))) + (cancel (attach-as-child win (format nil "~A-cancel" html-id)))) + (unless top + (setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0) + (/ (height win) 2.0))))) + (unless left + (setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0) + (/ (width win) 2.0))))) + (when modal + (window-make-modal win)) + (set-on-click cancel (lambda (obj) + (declare (ignore obj)) + (window-close win)) + :one-time t) + (set-on-click ok (lambda (obj) + (declare (ignore obj)) + (set-on-window-close win nil) + (when modal + (window-end-modal win)) + (window-close win) + (funcall on-input (value input))) + :one-time t) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (when modal + (window-end-modal win)) + (funcall on-input nil))))) + +(defun confirm-dialog (obj content on-input &key (modal t) + (title "Confirm") + (ok-text "OK") + (cancel-text "Cancel") + (left nil) (top nil) + (width 300) (height 200) + (client-movement nil) + (html-id nil)) + "Create a confirmation dialog box with CONTENT centered. +Calls on-input with t if confirmed or nil if canceled." + (unless html-id + (setf html-id (clog-connection:generate-id))) + (let* ((body (connection-data-item obj "clog-body")) + (win (create-gui-window obj + :title title + :content (format nil +"
+
~A

+
+ + +
+
+
" content + html-id ok-text ; ok + html-id cancel-text) ; cancel + :top top + :left left + :width width + :height height + :client-movement client-movement + :html-id html-id)) + (ok (attach-as-child win (format nil "~A-ok" html-id))) + (cancel (attach-as-child win (format nil "~A-cancel" html-id)))) + (unless top + (setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0) + (/ (height win) 2.0))))) + (unless left + (setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0) + (/ (width win) 2.0))))) + (when modal + (window-make-modal win)) + (set-on-click cancel (lambda (obj) + (declare (ignore obj)) + (window-close win)) + :one-time t) + (set-on-click ok (lambda (obj) + (declare (ignore obj)) + (set-on-window-close win nil) + (when modal + (window-end-modal win)) + (window-close win) + (funcall on-input t)) + :one-time t) + (set-on-window-close win (lambda (obj) + (declare (ignore obj)) + (when modal + (window-end-modal win)) + (funcall on-input nil))))) (defun server-file-dialog (obj title initial-dir on-file-name - &key (left nil) (top nil) (width 400) (height 375) + &key (modal t) + (left nil) (top nil) (width 400) (height 375) (maximize nil) - (initial-filename nil)) + (initial-filename nil) + (client-movement nil) + (html-id nil)) "Create a local file dialog box called TITLE using INITIAL-DIR on server machine, upon close ON-FILE-NAME called with filename or nil if failure." (let* ((body (connection-data-item obj "clog-body")) - (win (create-gui-window obj - :title title - :maximize maximize - :top top - :left left - :width width - :height height)) + (win (create-gui-window obj + :title title + :maximize maximize + :top top + :left left + :width width + :height height + :client-movement client-movement + :html-id nil)) (box (create-div (window-content win) :class "w3-panel")) (form (create-form box)) (dirs (create-select form)) @@ -1134,7 +1306,8 @@ machine, upon close ON-FILE-NAME called with filename or nil if failure." (setf (box-width input) "100%") (setf (width ok) "7em") (setf (width cancel) "7em") - (window-make-modal win) + (when modal + (window-make-modal win)) (flet ((populate-dirs (dir) (setf (inner-html dirs) "") (add-select-option dirs (format nil "~A" dir) ".") @@ -1176,16 +1349,19 @@ machine, upon close ON-FILE-NAME called with filename or nil if failure." (click ok)))) (set-on-window-close win (lambda (obj) (declare (ignore obj)) - (window-end-modal win) + (when modal + (window-end-modal win)) (funcall on-file-name nil))) (set-on-click cancel (lambda (obj) (declare (ignore obj)) - (window-close win))) + (window-close win)) + :one-time t) (set-on-click ok (lambda (obj) (declare (ignore obj)) (setf (disabledp obj) t) (set-on-window-close win nil) - (window-end-modal win) + (when modal + (window-end-modal win)) (window-close win) (funcall on-file-name (value input))) :one-time t))) diff --git a/tutorial/22-tutorial.lisp b/tutorial/22-tutorial.lisp index b594f6f..43624ec 100644 --- a/tutorial/22-tutorial.lisp +++ b/tutorial/22-tutorial.lisp @@ -15,9 +15,9 @@ (create-div (window-content win) :content n)))) (defun on-file-browse (obj) - (let* ((win (create-gui-window obj :title "Browse")) - (browser (create-child (window-content win) - ""))))) + (let* ((win (create-gui-window obj :title "Browse"))) + (create-child (window-content win) + ""))) (defun on-file-drawing (obj) (let* ((win (create-gui-window obj :title "Drawing")) @@ -48,12 +48,32 @@ :left 0 :width 100 :height 100))) - (flet ((can-do (obj)())) + (flet ((can-do (obj)(declare (ignore obj))())) (set-on-window-can-close win #'can-do) (set-on-window-can-size win #'can-do)) (window-keep-on-top win) (create-div win :content "I am pinned"))) +(defun on-dlg-alert (obj) + (alert-dialog obj "This is a modal alert box")) + +(defun on-dlg-confirm (obj) + (confirm-dialog obj "Shall we play a game?" + (lambda (input) + (if input + (alert-dialog obj "How about Global Thermonuclear War.") + (alert-dialog obj "You are no fun!"))) + :ok-text "Yes" :cancel-text "No")) + +(defun on-dlg-input (obj) + (input-dialog obj "Would you like to play a game?" + (lambda (input) + (alert-dialog obj input)))) + +(defun on-dlg-file (obj) + (server-file-dialog obj "Server files" "./" (lambda (fname) + (alert-dialog obj fname)))) + (defun on-help-about (obj) (let* ((about (create-gui-window obj :title "About" @@ -85,9 +105,19 @@ (tmp (create-gui-menu-item win :content "Maximize All" :on-click #'maximize-all-windows)) (tmp (create-gui-menu-item win :content "Normalize All" :on-click #'normalize-all-windows)) (tmp (create-gui-menu-window-select win)) + (dlg (create-gui-menu-drop-down menu :content "Dialogs")) + (tmp (create-gui-menu-item dlg :content "Alert Dialog Box" :on-click #'on-dlg-alert)) + (tmp (create-gui-menu-item dlg :content "Input Dialog Box" :on-click #'on-dlg-input)) + (tmp (create-gui-menu-item dlg :content "Confirm Dialog Box" :on-click #'on-dlg-confirm)) + (tmp (create-gui-menu-item dlg :content "Server File Dialog Box" :on-click #'on-dlg-file)) (help (create-gui-menu-drop-down menu :content "Help")) (tmp (create-gui-menu-item help :content "About" :on-click #'on-help-about)) - (tmp (create-gui-menu-full-screen menu)))) + (tmp (create-gui-menu-full-screen menu))) + (declare (ignore tmp))) + (set-on-before-unload (window body) (lambda(obj) + (declare (ignore obj)) + ;; return empty string to prevent nav off page + "")) (run body)) (defun start-tutorial ()