(defpackage #:clog-tut-22 (:use #:cl #:clog #:clog-gui) ; For this tutorial we include clog-gui (:export start-tutorial)) (in-package :clog-tut-22) ;;; Demostrate a virtual desktop using CLOG GUI (defun on-file-count (obj) (let ((win (create-gui-window obj :title "Count"))) (dotimes (n 100) ;; window-content is the root element for the clog-gui ;; windows (create-div (window-content win) :content n)))) (defun on-file-with-menu (obj) (let ((win (create-gui-window obj :title "Window With Menu"))) (let* ((menu (create-gui-menu-bar (window-content win) :main-menu nil)) (file (create-gui-menu-drop-down menu :content "Menu 1")) (tmp (create-gui-menu-item file :content "Count" :on-click 'on-file-count)) (file (create-gui-menu-drop-down menu :content "Menu 2")) (tmp (create-gui-menu-item file :content "Count" :on-click 'on-file-count))) (declare (ignore tmp)) (add-class menu "w3-small") (create-div (window-content win) :content "Some Text")))) (defun on-file-browse (obj) (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")) (canvas (create-canvas (window-content win) :width 600 :height 400)) (cx (create-context2d canvas))) (set-border canvas :thin :solid :black) (setf (fill-style cx) :green) (fill-rect cx 10 10 150 100) (setf (fill-style cx) :blue (font-style cx) "bold 24px serif") (fill-text cx "Hello World" 10 150) (setf (fill-style cx) :red) (begin-path cx) (ellipse cx 200 200 50 7 0.78 0 6.29) (path-stroke cx) (path-fill cx))) (defun on-file-movies (obj) (let* ((win (create-gui-window obj :title "Movie")) (movie (create-video (window-content win) :source "https://www.w3schools.com/html/mov_bbb.mp4"))) (set-geometry movie :units "%" :width 100 :height 100))) (defun on-file-on-top (obj) (let ((win (create-gui-window obj :title "Pin me!" :has-pinner nil :keep-on-top t :top 200 :left 0 :width 200 :height 200))) (create-div (window-content win) :content "I am always on top"))) (defun on-file-pinned (obj) (let ((win (create-gui-window obj :title "Pin me!" :has-pinner t :keep-on-top nil :top 200 :left 0 :width 200 :height 200))) (create-div (window-content win) :content "I can be pinned but do not stay on top. Just click the pin on window bar."))) (defun on-file-pinned-on-top (obj) (let ((win (create-gui-window obj :title "Pin me!" :has-pinner t :keep-on-top t :top 200 :left 0 :width 200 :height 200))) (create-div (window-content win) :content "I can be pinned and stay on top. Just click the pin on window bar."))) (defun on-file-pop-tab (obj) (let ((pop (open-clog-popup obj))) (cond (pop ; pop is the body of the new browser tab/window (clog-gui-initialize pop) (add-class pop "w3-cyan") (create-div pop :content "I am a popup browser tab")) (t (alert-toast obj "Popup failure" "Unable to open popup tab"))))) (defun on-file-pop-win (obj) (let ((pop (open-clog-popup obj :specs "width=320,height=320"))) (cond (pop ; pop is the body of the new browser tab/window (clog-gui-initialize pop ) (add-class pop "w3-cyan") (create-div pop :content "I am a popup window when the browser allows it otherwise a tab")) (t (alert-toast obj "Popup failure" "Unable to open popup tab"))))) (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-dlg-form (obj) (form-dialog obj "Please enter your information." '(("Title" "title" :select (("Mr." "mr") ("Mrs." "mrs" :selected) ("Ms." "ms") ("Other" "other"))) ("Eye Color" "color" :radio (("Blue" "blue") ("Brown" "brown") ("Green" "green" :checked) ("Other" "other"))) ("Send Mail" "send-mail" :checkbox t) ("Name" "name" :text "Real Name") ("Address" "address") ("City" "city") ("State" "st") ("Zip" "zip") ("E-Mail" "email" :email)) (lambda (results) (alert-dialog obj results)) :height 550)) (defun on-dlg-prompt (obj) (flet ((make-completion (selection &key (test #'search)) (lambda (str) (remove-if-not (alexandria:curry test str) selection)))) (let ((options '("white" "red" "orange" "yellow" "green" "blue" "indigo" "violet" "brown" "black" "grey"))) (prompt-dialog obj (lambda (color) (alert-dialog obj color)) :title "Color Prompt" :completion (make-completion options) :validation (lambda (str) (find str options :test #'equal)))))) (defun on-toast-alert (obj) (alert-toast obj "Stop!" "To get rid of me, click the X. I have no time-out")) (defun on-toast-warn (obj) (alert-toast obj "Warning!" "To get rid of me, click the X. I time-out in 5 seconds" :color-class "w3-yellow" :time-out 5)) (defun on-toast-success (obj) (alert-toast obj "Success!" "To get rid of me, click the X. I time-out in 2 seconds" :color-class "w3-green" :time-out 2)) (defun on-help-about (obj) (let* ((about (create-gui-window obj :title "About" :content "