clog-learn.lisp

(ql:quickload '(:cl-who :clog :cl-markdown))
	      
(defpackage :clog-learn
  (:use :cl :clog #:clog-gui)
  (:import-from :cl-who :with-html-output
		:with-html-output-to-string :htm :str :fmt)
  (:export :start))

(in-package :clog-learn)

;; Utilities

;; html

(defvar *html*)
(defmacro html* (&body body)
  `(who:with-html-output (*html*)
     ,@body))
(defmacro html (&body body)
  `(who:with-html-output-to-string (*html*)
     ,@body))

;; declarative gui spec

(defmacro with-gui (obj spec &body body)
  (let ((let-bindings ())
	(used-bindings ()))
    (labels ((create-from-spec (spec parent-binding)
	       (destructuring-bind (gui-func-name args &body children)
		   spec
		 (let* ((gui-func-args (alexandria:remove-from-plist args :bind))
			(bind (getf args :bind))
			(binding (or bind (gensym)))
			(create-func-name (intern (concatenate 'string "CREATE-" (symbol-name gui-func-name)))))
		   (push `(,binding (,create-func-name ,parent-binding ,@gui-func-args)) let-bindings)
		   (when (or bind children)
		     (push binding used-bindings))
		   (dolist (child-spec children)
		     (create-from-spec child-spec binding))))))
      (create-from-spec spec obj)
      `(let* ,(reverse let-bindings)
	 (declare (ignore ,@(set-difference (mapcar #'first let-bindings) used-bindings)))
	 ,@body))))

;; arrows

(defmacro -> (first &rest rest)
  (let ((binding (gensym)))
    `(let ((,binding ,first))
       ,@(loop for r in rest
	      collect (list* (first r)
			     binding
			     (rest r))))))

(defmethod element-value ((obj clog-obj))
  (clog-connection:query (clog::connection-id obj)
			 (format nil "$('#~A').val()" (html-id obj))))


;;; 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 browse-in-window (obj title url)
  (let ((win (create-gui-window obj :title title)))
    (create-child (window-content win)
		  (html (:iframe :style "width:100%;height:97%;"
				 :src url)))))

(defun about-common-lisp (obj)
  (browse-in-window obj "About Common Lisp" "https://common-lisp.net/"))

(defun open-clog-manual (obj)
  (browse-in-window obj "CLOG manual" "https://rabbibotton.github.io/clog/clog-manual.html"))

(defun open-markdown-in-window (obj title markdown-file)
  (let ((win (create-gui-window obj :title title))
	(html (with-output-to-string (s)
		(cl-markdown:markdown markdown-file :stream s))))
    (create-div (window-content win) :content html)))

(defun open-learn-clog-window (obj)
  ;;(browse-in-window obj "Learn CLOG" "https://github.com/rabbibotton/clog/blob/main/LEARN.md")
  (open-markdown-in-window obj "Learn CLOG" (asdf:system-relative-pathname :clog "LEARN.md")))

(defun open-readme-window (obj)
  (open-markdown-in-window obj "README" (asdf:system-relative-pathname :clog "README.md")))

(defun open-clog-concept-window (obj)
  (open-markdown-in-window obj "CONCEPT" (asdf:system-relative-pathname :clog "CONCEPT.md")))

(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)    
    (fill-style cx :green)
    (fill-rect cx 10 10 150 100)
    (fill-style cx :blue)
    (font-style cx "bold 24px serif")
    (fill-text cx "Hello World" 10 150)
    (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-pinned (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 win :content "I can be pinned. Just click the pin on window bar.")))

(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-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 "<div class='w3-black'>
                                         <center><img src='/img/clogwicon.png'></center>
	                                 <center>CLOG</center>
	                                 <center>The Common Lisp Omnificent GUI</center></div>
			                 <div><p><center>CLOG Learning Center</center>
                                         <center>(c) 2021 - David Botton</center></p></div>"
				   :hidden  t
				   :width   200
				   :height  215)))
    (window-center about)
    (setf (visiblep about) t)
    (set-on-window-can-size about (lambda (obj)
				    (declare (ignore obj))()))))

;; tutorials browser

(defparameter *tutorials*
  '(("01-demo.lisp" "CLOG-DEMO-1::ON-NEW-WINDOW" "Demo 01 - Sparkey the Snake Game" "Sparkey the Snake Game")
    ("02-demo.lisp" "CLOG-DEMO-2::ON-NEW-WINDOW" "Demo 02 - Chat" "Private instant messenger")
    ("03-demo.lisp" "CLOG-DEMO-3::ON-NEW-WINDOW" "Demo 03 - IDE" "A very simple common lisp IDE (see source if editor dosen't load)")
    ("01-tutorial.lisp" "CLOG-TUT-1::ON-NEW-WINDOW" "Tutorial 01 - Hello world" "Hello world tutorial")
    ("02-tutorial.lisp" "CLOG-TUT-2::ON-NEW-WINDOW" "Tutorial 02 - Closures in CLOG" "Closures in CLOG")
    ("03-tutorial.lisp" "CLOG-TUT-3::ON-NEW-WINDOW" "Tutorial 03 - Events fire in parallel"
     "Running this version of the last tutorial and clicking quickly on the (click me!) will demonstrate an important aspect of CLOG, events can happen in _parallel_.")
    ("04-tutorial.lisp" "CLOG-TUT-4::ON-NEW-WINDOW" "Tutorial 04 - Event target" "The event target, reusing event handlers")
    ("05-tutorial.lisp" "CLOG-TUT-5::ON-NEW-WINDOW" "Tutorial 05 - Connection data item" "Connection data item")
    ("06-tutorial.lisp" "CLOG-TUT-6::ON-NEW-WINDOW" "Tutorial 06 - Tasking and events" "Tasking and events")
    ("07-tutorial.lisp" "CLOG-TUT-7::ON-NEW-WINDOW" "Tutorial 07 - First video game" "First video game")
    ("08-tutorial.lisp" "CLOG-TUT-8::ON-NEW-WINDOW" "Tutorial 08 - Mice love containers" "Mice love containers")
    ("09-tutorial.lisp" "CLOG-TUT-9::ON-NEW-WINDOW" "Tutorial 09 - Tabs, panels and forms" "Tabs, panels and forms")
    ("10-tutorial.lisp" "CLOG-TUT-10::ON-NEW-WINDOW" "Tutorial 10 - Canvas" "Canvas")
    ("11-tutorial.lisp" "CLOG-TUT-11::ON-NEW-WINDOW" "Tutorial 11 - Attaching to existing HTML" "Attaching to existing HTML")
    ("15-tutorial.lisp" "CLOG-TUT-15::ON-NEW-WINDOW" "Tutorial 15 - Multi-media" "Multi-media")
    ("18-tutorial.lisp" "CLOG-TUT-18::ON-NEW-WINDOW" "Tutorial 18 - Drag and drop" "Drag and drop demonstration")
    ("20-tutorial.lisp" "CLOG-TUT-20::ON-NEW-WINDOW" "Tutorial 20 - CLOG Plugin" "Toggler CLOG Plugin")
    ("21-tutorial.lisp" "CLOG-TUT-21::ON-NEW-WINDOW" "Tutorial 21 - Drop list" "In this tutorial we will create a Common Lisp CLOG version of the plugin from the previous two tutorials.")
    ("22-tutorial.lisp" "CLOG-TUT-22::ON-NEW-WINDOW" "Tutorial 22 - Desktop demo" "Demonstration of a CLOG desktop using CLOG-GUI")
    ("23-tutorial.lisp" "CLOG-TUT-23::ON-NEW-WINDOW" "Tutorial 23 - Semaphores"
     "This is a simple demo using semaphores to wait for user input ask demonstrates the mechanics in general and the modal dialog example show a more practical example.")
    ("24-tutorial.lisp" "CLOG-TUT-24::ON-NEW-WINDOW" "Tutorial 24 - CLOG-WEB and Mobile"
     "In this tutorial we use clog-web to create a dynamic modern mobile compatible web page using various clog-web containers.")
    ("25-tutorial.lisp" "CLOG-TUT-25::ON-NEW-WINDOW" "Tutorial 25 - Local app"
     "In this tutorial we are going to use clog-web for a local app.")
    ("26-tutorial.lisp" "CLOG-TUT-26::ON-NEW-WINDOW" "Tutorial 26 - Website" "In this tutorial we are going to use clog-web for a website.")
    ("27-tutorial.lisp" "CLOG-TUT-27::ON-NEW-WINDOW" "Tutorial 27 - Panel box layout" "This tutorial demonstrates the panel box layout method")
    ("29-tutorial.lisp" "CLOG-TUT-29::ON-NEW-WINDOW" "Tutorial 29 - Presentations and JQuery" "Demonstrate CLOG-presentations and CLOG-jQuery")
    ))

(defun create-tutorials-select (obj)
  (let ((sel (create-select obj)))
    (dolist (tutorial *tutorials*)
      (create-option sel
		     :value (first tutorial)
		     :content (third tutorial)))
    (setf (attribute sel "size") "10")
    sel))

(defun find-tutorial-file (filename)
  (cond
    ((search "tutorial" filename)
     (or (probe-file (asdf:system-relative-pathname :clog
						    (format nil "tutorial/~a" filename)))
	 (error "Tutorial not found: ~s" filename)))
    ((search "demo" filename)
     (or (probe-file (asdf:system-relative-pathname :clog
						    (format nil "demos/~a" filename)))
	 (error "Demo not found: ~s" filename)))
    (t (error "Tutorial not found: ~s" filename))))

(defun run-clog-tutorial (tutorial obj)
  (load (find-tutorial-file (first tutorial)))
  (clog:set-on-new-window (read-from-string (second tutorial))
			  :path (format nil "/tutorials/~a" (first tutorial)))
  (browse-in-window obj (first tutorial) (format nil "http://127.0.0.1:8080/tutorials/~a" (first tutorial))))

(defun show-tutorial-source (tutorial obj)
  (let* ((tutorial-file (find-tutorial-file (first tutorial)))
	 (wnd (create-gui-window obj :title (third tutorial)))
	 (btn (create-button (window-content wnd) :content "Run" :class "w3-button w3-teal"))
	 (pre (create-child (window-content wnd) (html (:pre)))))
    (setf (text pre)
	  (alexandria:read-file-into-string tutorial-file))
    (clog::set-style btn "position" "fixed")
    (clog::set-style pre "margin-top" "50px")
    (set-on-click btn (lambda (o)
			(declare (ignore o))
			(run-clog-tutorial tutorial obj)))))


(defun open-tutorials-window (obj)
  (let* ((wnd (create-gui-window obj :title "Tutorials"))
	 (div (create-div (window-content wnd) :class "w3-container w3-cell"))
	 (sel (create-tutorials-select div))
	 (content1 (create-div (window-content wnd) :class "w3-container w3-cell"))
	 content)
    (set-on-change sel (lambda (obj)
			 (declare (ignore obj))
			 (let ((tutorial (find (element-value sel) *tutorials* :key #'first :test 'string=)))
			   (setf (text content) (fourth tutorial)))))
    (-> (create-button content1 :content "Run" :class "w3-button w3-teal")
       (set-on-click (lambda (o)
		       (declare (ignore o))
		       (let ((tutorial (find (element-value sel) *tutorials* :key #'first :test 'string=)))
			 (run-clog-tutorial tutorial obj)))))
    (-> (create-button content1 :content "Source" :class "w3-button w3-khaki")
       (set-on-click (lambda (obj) (let ((tutorial (find (element-value sel) *tutorials* :key #'first :test 'string=)))
				(show-tutorial-source tutorial obj)))))
    (setf content (create-div content1))))

(defun on-new-window (body)
  (setf (title (html-document body)) "Learn CLOG")  
  ;; For web oriented apps consider using the :client-movement option.
  ;; See clog-gui-initialize documentation.
  (clog-gui-initialize body)
  (add-class body "w3-cyan")
  (with-gui body
    (gui-menu-bar ()
      (gui-menu-icon (:on-click 'on-help-about))
      (gui-menu-drop-down (:content "Open")
	(gui-menu-item (:content "Tutorials" :on-click 'open-tutorials-window))		  
        (gui-menu-item (:content "Count" :on-click 'on-file-count))
	(gui-menu-item (:content "Drawing" :on-click 'on-file-drawing)))   
      (gui-menu-drop-down (:content "Window")
	(gui-menu-item (:content "Maximize All" :on-click 'maximize-all-windows))
	(gui-menu-item (:content "Normalize All" :on-click 'normalize-all-windows))
	(gui-menu-window-select ()))
      (gui-menu-drop-down (:content "Dialogs")
	(gui-menu-item (:content "Alert Dialog Box" :on-click 'on-dlg-alert))	 
	(gui-menu-item (:content "Input Dialog Box" :on-click 'on-dlg-input))
	(gui-menu-item (:content "Confirm Dialog Box" :on-click 'on-dlg-confirm))
	(gui-menu-item (:content "Form Dialog Box" :on-click 'on-dlg-form))
	(gui-menu-item (:content "Server File Dialog Box" :on-click 'on-dlg-file)))
      (gui-menu-drop-down (:content "Toasts")
	 (gui-menu-item (:content "Alert Toast" :on-click 'on-toast-alert))
	 (gui-menu-item (:content "Warning Toast" :on-click 'on-toast-warn))
	 (gui-menu-item (:content "Success Toast" :on-click 'on-toast-success)))
      (gui-menu-drop-down (:content "Help")
	 (gui-menu-item (:content "About" :on-click 'on-help-about))
	 (gui-menu-item (:content "About Common Lisp" :on-click 'about-common-lisp))
	 (gui-menu-item (:content "CLOG manual" :on-click 'open-clog-manual))
	 (gui-menu-item (:content "README" :on-click 'open-readme-window))
	 (gui-menu-item (:content "LEARN" :on-click 'open-learn-clog-window))
	 (gui-menu-item (:content "CONCEPT" :on-click 'open-clog-concept-window)))
      (gui-menu-full-screen ())))
  (set-on-before-unload (window body) (lambda(obj)
					(declare (ignore obj))
					;; return empty string to prevent nav off page
					""))
  (open-learn-clog-window body)
  (open-clog-manual body)
  (open-tutorials-window body)
  (open-readme-window body))


(defun start ()
  "Start desktop."
  (initialize 'on-new-window)
  (open-browser))

screenshot.png

Thanks for having a look. Makes me glad this is useful for somebody.