add example 'clog-demo' (currently only runs '01-demo.lisp'); tested on android

examples/clog-demo/.gitignore

@@ -0,0 +1,2 @@
+*
+!.gitignore

examples/clog-demo/app.asd

@@ -0,0 +1,10 @@
+(defsystem :app
+  :serial t
+  :depends-on (:clog) ; requires this fork: https://github.com/pls153/clog
+  :components ((:file "lisp/package")
+               (:file "lisp/ui-vars")
+               (:file "lisp/swank-quicklisp")
+               (:file "lisp/eval")
+               (:file "lisp/clog-bridge")
+               (:file "clog-assets/demos/01-demo")
+               (:file "lisp/main")))

examples/clog-demo/app.pro

@@ -0,0 +1,76 @@
+LISP_FILES = $$files(lisp/*) app.asd make.lisp
+
+android {
+  lisp.commands = $$(ECL_ANDROID)/../ecl-android-host/bin/ecl \
+                  -norc -shell $$PWD/make.lisp
+} else:ios {
+  lisp.commands = $$(ECL_IOS)/../ecl-ios-host/bin/ecl \
+                  -norc -shell $$PWD/make.lisp
+} else:unix {
+  lisp.commands = /usr/local/bin/ecl -shell $$PWD/make.lisp
+}
+
+lisp.input  = LISP_FILES
+lisp.output = tmp/libapp.a
+
+QMAKE_EXTRA_COMPILERS += lisp
+PRE_TARGETDEPS        += tmp/libapp.a
+
+QT          += quick qml websockets webview
+TEMPLATE    = app
+CONFIG      += no_keywords release
+DEFINES     += DESKTOP_APP INI_LISP INI_ECL_CONTRIB INI_ASDF INI_WEBVIEW
+INCLUDEPATH = /usr/local/include
+ECL_VERSION = $$lower($$system(ecl -v))
+ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+LIBS        = -L/usr/local/lib -lecl
+LIBS        += -L/usr/local/lib/$$ECL_VERSION
+LIBS        += -lasdf -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+DESTDIR     = .
+TARGET      = app
+OBJECTS_DIR = tmp
+MOC_DIR     = tmp
+
+linux: LIBS += -L../../../platforms/linux/lib
+macx:  LIBS += -L../../../platforms/macos/lib
+
+android {
+  QT          += androidextras
+  DEFINES     -= DESKTOP_APP
+  INCLUDEPATH = $$(ECL_ANDROID)/include
+  ECL_VERSION = $$lower($$system($ECL_ANDROID/../ecl-android-host/bin/ecl -v))
+  ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+  LIBS        = -L$$(ECL_ANDROID)/lib -lecl
+  LIBS        += -L$$(ECL_ANDROID)/lib/$$ECL_VERSION
+  LIBS        += -lasdf -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+  LIBS        += -L../../../platforms/android/lib
+
+  ANDROID_ABIS               = "arm64-v8a"
+  ANDROID_EXTRA_LIBS         += $$(ECL_ANDROID)/lib/libecl.so
+  ANDROID_PACKAGE_SOURCE_DIR = ../platforms/android
+}
+
+ios {
+  DEFINES     -= DESKTOP_APP
+  INCLUDEPATH = $$(ECL_IOS)/include
+  ECL_VERSION = $$lower($$system($ECL_IOS/../ecl-ios-host/bin/ecl -v))
+  ECL_VERSION = $$replace(ECL_VERSION, " ", "-")
+  LIBS        = -L$$(ECL_IOS)/lib -lecl
+  LIBS        += -leclatomic -leclffi -leclgc -leclgmp
+  LIBS        += -L$$(ECL_IOS)/lib/$$ECL_VERSION
+  LIBS        += -lasdf -lecl-help -ldeflate -lecl-cdb -lecl-curl -lql-minitar -lsockets
+  LIBS        += -lcrypto -lssl
+  LIBS        += -L../../../platforms/ios/lib
+
+  assets.files      = $$files($$PWD/platforms/ios/assets)
+  QMAKE_BUNDLE_DATA += assets
+}
+
+LIBS    += -llqml -llisp -Ltmp -lapp
+HEADERS += ../../src/cpp/main.h
+SOURCES += ../../src/cpp/main.cpp
+
+RESOURCES += $$files(qml/*)
+
+QMAKE_CXXFLAGS += -std=c++17
+

examples/clog-demo/clog-assets/clog.asd

@@ -0,0 +1 @@
+(defsystem :clog)

examples/clog-demo/clog-assets/demos/01-demo.lisp

@@ -0,0 +1,189 @@
+(defpackage #:clog-demo-1
+  (:use #:cl #:clog)
+  (:export start-demo))
+
+(in-package :clog-demo-1)
+
+;; Game Display
+(defconstant display-width  300)
+(defconstant display-height 450)
+
+;; Snake Parameters
+(defconstant initial-length 5)
+(defconstant segment-size 10)
+
+(deftype snake-direction-type () '(member :left :right :up :down))
+
+(defun new-food ()
+  (list (random (floor (- (/ display-width segment-size) 1))) 
+	(random (floor (- (/ display-height segment-size) 1)))))
+
+(defclass app-data ()
+  ((snake-direction
+    :initform :right
+    :accessor snake-direction)
+   (score
+    :initform 0
+    :accessor score)
+   (food
+    :initform (new-food)
+    :accessor food)
+   (snake
+    :initform nil
+    :accessor snake)))
+
+(defun display-splash (body)
+  (let* ((splash
+	   (create-div body :content
+"<H1>(Sparky The Snake)</H1>
+ <br />
+ <p>Use your keyboard to move Sparky to pick up batteries.</p>
+ <i>Be careful...</i><br />
+ If sparky hits his tail he electrocute himself to <b>death!!</b>
+ <br /><br />
+  Use the arrow keys or a,w,s,d for direction keys.<br/><br/>"))
+	 (ticker (create-span splash)))
+    (setf (width splash) "100%")
+    (setf (text-alignment splash) :center)
+    (dotimes (n 10)
+      (setf (text ticker) (format nil "~A *" (text ticker)))
+      (sleep .1))
+    (setf (hiddenp splash) t)))
+
+(defun local-file (file)
+  (format nil "file://~A" (merge-pathnames file)))
+
+(defun paint (body cx app)
+  (let ((game-over nil)
+	(head-cell (car (snake app))))
+    (flet ((draw-segment (cell)
+	     (fill-rect cx
+			(* (car cell) segment-size)
+			(* (cadr cell) segment-size)
+			segment-size
+			segment-size))
+	   (self-collision ()
+	     (dolist (cell (snake app))
+	       (when (equal cell head-cell)
+		 (return t)))))
+      (cond ((eq :right (snake-direction app))
+	      (setf head-cell (list (1+ (car head-cell))
+				    (cadr head-cell))))
+	    ((eq :left (snake-direction app))
+	      (setf head-cell (list (1- (car head-cell))
+				    (cadr head-cell))))
+	    ((eq :up (snake-direction app))
+	      (setf head-cell (list (car head-cell)
+				    (1- (cadr head-cell)))))
+	    ((eq :down (snake-direction app))
+	      (setf head-cell (list (car head-cell)
+				    (1+ (cadr head-cell))))))
+      (cond ((or (< (car head-cell) 0)
+	      (< (cadr head-cell) 0)
+	      (>= (* (car head-cell) segment-size) display-width)
+	      (>= (* (cadr head-cell) segment-size) display-height)
+	      (self-collision))
+	     (fill-style cx :red)
+	     (font-style cx "bold 20px sans-serif")
+	     (fill-text cx "GAME OVER" 30 30)
+	     (play-media (create-audio body
+                                       :source (local-file "htm/demo/game-over.wav")
+                                       :controls nil))
+	     (setf game-over t))
+	    (t
+	     (fill-style cx :purple)
+	     (push head-cell (snake app))
+	     (dolist (cell (snake app))
+	       (draw-segment cell))
+	     (fill-style cx :white)
+	     (cond ((equal head-cell (food app))
+		    (fill-text cx (format nil "Score: ~A" (score app))
+			       5 (- display-height 15))
+		    (setf (score app) (+ (score app) 10))
+		    (fill-style cx :green)
+		    (fill-text cx (format nil "Score: ~A" (score app))
+			       5 (- display-height 15))
+		    (play-media (create-audio body
+                                              :source (local-file "htm/demo/eat.wav")
+                                              :controls nil))
+		    (setf (food app) (new-food)))
+		   (t
+		    (draw-segment (car (last (snake app))))
+		    (setf (snake app) (butlast (snake app)))))	  
+	     (fill-style cx :brown)
+	     (draw-segment (food app))))      
+	game-over)))
+
+(defun on-key-down (obj event)
+  (let ((app      (connection-data-item obj "app-data"))
+	(key      (getf event :key)))
+    (cond ((or (equalp key "ArrowLeft") (equalp key "a"))
+	   (setf (snake-direction app) :left))
+	  ((or (equalp key "ArrowUp") (equalp key "w"))
+	   (setf (snake-direction app) :up))
+	  ((or (equalp key "ArrowDown") (equalp key "s"))
+	   (setf (snake-direction app) :down))
+	  ((or (equalp key "ArrowRight") (equalp key "d"))
+	   (setf (snake-direction app) :right)))))
+	  
+(defun on-click (obj)
+  (let ((app     (connection-data-item obj "app-data"))
+	(btn-txt (text obj)))
+  (cond ((equal btn-txt " <-- ") (setf (snake-direction app) :left))
+	((equal btn-txt " --> ") (setf (snake-direction app) :right))
+	((equal btn-txt " -^- ") (setf (snake-direction app) :up))
+	((equal btn-txt " -v- ") (setf (snake-direction app) :down)))))
+
+(defun start-game (body)
+  (let* ((app       (connection-data-item body "app-data"))
+	 (disp      (create-canvas body
+				   :width display-width
+				   :height display-height))
+	 (br        (create-br body))
+	 (controls  (create-div body))
+	 (left-btn  (create-button controls :content "<h3><pre> <-- </pre></h3>"))
+	 (right-btn (create-button controls :content "<h3><pre> --> </pre></h3>"))
+	 (up-btn    (create-button controls :content "<h3><pre> -^- </pre></h3>"))
+	 (down-btn  (create-button controls :content "<h3><pre> -v- </pre></h3>"))
+	 context)
+    (declare (ignore br))
+    ;; Initialize display
+    (setf (background-color body) :orange)    
+    (setf (display disp) :block)
+    (setf (background-color disp) :white)
+    (set-margin disp :auto :auto :auto :auto)
+    (set-border disp :thin :solid :white)
+    (setf (border-radius disp) "10px")
+    (setf (box-shadow disp) "3px 3px 5px")
+    ;; Initialize snake
+    (dotimes (n initial-length)
+      (push (list n 0) (snake app)))
+    (setf context (create-context2d disp))
+    (font-style context "normal 20px sans-serif")
+    (fill-style context :green)
+    (fill-text context (format nil "Score: ~A" (score app))
+	       5 (- display-height 15))
+    (set-on-key-down body      #'on-key-down :disable-default t)
+    (set-on-click    left-btn  #'on-click)
+    (set-on-click    right-btn #'on-click)
+    (set-on-click    up-btn    #'on-click)
+    (set-on-click    down-btn  #'on-click)
+    (play-media (create-audio body
+                              :source (local-file "htm/demo/start.wav")
+                              :controls nil))
+    ;; Game loop
+    (loop
+      (unless (validp body) (return))
+      (when (paint body context app) (return))
+      (sleep .1))))
+
+(defun on-new-window (body)
+  (set-html-on-close body "Connection Lost")
+  (let ((app (make-instance 'app-data)))
+    (setf (connection-data-item body "app-data") app))
+  (display-splash body)
+  (start-game body))
+
+(defun start-demo ()
+  "Start demo."
+  (initialize #'on-new-window))

examples/clog-demo/clog-assets/htm/boot.html

@@ -0,0 +1,15 @@
+<!doctype HTML>
+<HTML>
+   <HEAD>
+      <meta http-equiv="Cache-Control" content="no-cache, no-store, must-revalidate" />
+      <meta http-equiv="Pragma" content="no-cache" />
+      <meta http-equiv="Expires" content="0" />
+      <meta charset="utf-8">
+      <meta name="viewport" content="width=device-width, initial-scale=1">
+      <script src="js/jquery.min.js" type="text/javascript"></script>
+      <script src="js/boot.js" type="text/javascript"></script>
+   </HEAD>
+<BODY>
+</BODY>
+<noscript>Your browser must support JavaScript and be HTML 5 compilant to see this site.</noscript>
+</HTML>

examples/clog-demo/clog-assets/htm/js/boot.js

@@ -0,0 +1,111 @@
+/*static version*/
+var ws;
+var adr;
+var clog={};
+var pingerid;
+
+if (typeof clog_debug == 'undefined') {
+    clog_debug = false;
+}
+
+function Ping_ws() {
+    if (ws.readyState == 1) {
+        ws.send ('0');
+    }
+}
+
+function Shutdown_ws(event) {
+    if (ws != null) {
+	ws.onerror = null;
+	ws.onclose = null;
+	ws.close ();
+	ws = null;
+    }
+    clearInterval (pingerid);
+    if (clog['html_on_close'] != '') {
+        $(document.body).html(clog['html_on_close']);
+    }
+}
+
+function Setup_ws() {
+    ws.onmessage = function (event) {
+        try {
+            if (clog_debug == true) {
+		console.log ('eval data = ' + event.data);
+            }
+            eval (event.data);
+        } catch (e) {
+            console.error (e.message);
+        }
+    }
+    
+    ws.onerror = function (event) {
+        console.log ('onerror: reconnect');
+        ws = null;
+        ws = new WebSocket (adr  + '?r=' + clog['connection_id']);
+        ws.onopen = function (event) {
+            console.log ('onerror: reconnect successful');
+            Setup_ws();
+        }
+        ws.onclose = function (event) {
+            console.log ('onerror: reconnect failure');
+            Shutdown_ws(event);
+        }
+    }
+    
+    ws.onclose = function (event) {
+        console.log ('onclose: reconnect');
+        ws = null;
+        ws = new WebSocket (adr  + '?r=' + clog['connection_id']);
+        ws.onopen = function (event) {
+            console.log ('onclose: reconnect successful');
+            Setup_ws();
+        }
+        ws.onclose = function (event) {
+            console.log ('onclose: reconnect failure');
+            Shutdown_ws(event);
+        }
+    }
+}
+
+$( document ).ready(function() {
+    var s = document.location.search;
+    var tokens;
+    var r = /[?&]?([^=]+)=([^&]*)/g;
+
+    clog['body']=document.body;
+    clog['head']=document.head;
+    clog['documentElement']=document.documentElement;
+    clog['window']=window;
+    clog['navigator']=navigator;
+    clog['document']=window.document;
+    clog['location']=window.location;
+    
+    if (location.protocol == 'https:') {
+        adr = 'wss://' + location.hostname;
+    } else {
+        adr = 'ws://' + location.hostname;
+    }
+    
+    if (location.port != '') { adr = adr + ':' + location.port; }
+    //adr = adr + '/clog';
+    adr = adr + '127.0.0.1:8080/'; // for LQML
+    
+    try {
+        console.log ('connecting to ' + adr);
+        ws = new WebSocket (adr);
+    } catch (e) {
+        console.log ('trying again, connecting to ' + adr);
+        ws = new WebSocket (adr);
+    }
+    
+    if (ws != null) {
+        ws.onopen = function (event) {
+            console.log ('connection successful');
+            Setup_ws();
+        }
+        pingerid = setInterval (function () {Ping_ws ();}, 10000);
+    } else {
+        document.writeln ('If you are seeing this your browser or your connection to the internet is blocking websockets.');
+    }
+});

examples/clog-demo/clog-assets/mgl-pax.asd

@@ -0,0 +1 @@
+(defsystem :mgl-pax)

examples/clog-demo/lisp/clog-bridge.lisp

@@ -0,0 +1,18 @@
+;;; this requires a CLOG fork prepared for mobile
+
+(in-package :clog-connection)
+
+(setf *websocket-server-send*
+      (lambda (text) (qml:qjs |send| ui:*server* text)))
+
+(defun server/on-new-connection ()
+  (handle-new-connection 'qml-websocket-server nil))
+
+(defun server/on-message (message)
+  (handle-message 'qml-websocket-server message))
+
+(defun server/on-close ()
+  (handle-close-connection 'qml-websocket-server))
+
+(qml:q> |url| ui:*browser* (format nil "file://~A"
+                                   (merge-pathnames "htm/boot.html")))

examples/clog-demo/lisp/eval.lisp

@@ -0,0 +1,179 @@
+(defpackage :eval
+  (:use :cl :qml)
+  (:export
+   #:*eval-thread*
+   #:append-output
+   #:eval-in-thread))
+
+(in-package :eval)
+
+(defvar *output-buffer* (make-string-output-stream))
+(defvar *prompt*        t)
+(defvar *eval-thread*   nil)
+(defvar *               nil)
+(defvar **              nil)
+(defvar ***             nil)
+
+(defun ini-streams ()
+  (setf *standard-output* (make-broadcast-stream *standard-output*
+                                                 *output-buffer*))
+  (setf *trace-output* *standard-output*
+        *error-output* *standard-output*))
+
+(defun current-package-name ()
+  (if (eql (find-package :cl-user) *package*)
+      "CL-USER"
+      (car (sort (list* (package-name *package*) (package-nicknames *package*))
+                 (lambda (x y) (< (length x) (length y)))))))
+
+(let ((n -1))
+  (defun eval-in-thread (text &optional (progress t)) ; called from QML
+    (let ((str (string-trim " " text)))
+      (unless (x:empty-string str)
+        (if *prompt*
+            (let ((pkg (if (zerop n) "QML-USER" (current-package-name)))
+                  (counter (princ-to-string (incf n))))
+              (format t "~A [~A]~%~A"
+                      pkg
+                      counter
+                      str))
+            (format t "~%~%~A" str))
+        ;; run eval in its own thread, so UI will remain responsive
+        (update-output t)
+        (when progress
+          (show-progress-bar))
+        (qsingle-shot 50 (lambda ()
+                           (setf *eval-thread*
+                                 (mp:process-run-function "LQML REPL top-level"
+                                                          (lambda () (do-eval str))))))))))
+
+(defvar *color-text*       "#c0c0c0")
+(defvar *color-values*     "#80b0ff")
+(defvar *color-read-error* "orange")
+(defvar *color-error*      "#ff8080")
+
+#+ios
+(defun escape-smart-quotation (string)
+  (dotimes (i (length string))
+    (case (char-code (char string i))
+      ((8216 8217 8218)
+       (setf (char string i) #\'))
+      ((171 187 8220 8221 8222)
+       (setf (char string i) #\"))))
+  string)
+
+(defun do-eval (string)
+  (let ((str #+ios (escape-smart-quotation string)
+             #-ios string)
+        (color *color-read-error*))
+    (handler-case
+        (let ((exp (read-from-string str)))
+          (setf color *color-error*)
+          (let ((vals (multiple-value-list (eval exp))))
+            (setf *** ** ** * * (first vals))
+            (update-output)
+            (append-output (format nil "~{~S~^~%~}" vals) *color-values* t))
+          (q! |clear| ui:*repl-input*)
+          (history-add str))
+      (condition (c)
+        (show-error c color))))
+  (qsingle-shot 50 'eval-exited))
+
+(defun eval-exited ()
+  (update-output)
+  (show-progress-bar nil))
+
+(defun show-error (error color)
+  (let ((e1 (prin1-to-string error))
+        (e2 (princ-to-string error)))
+    (append-output e1 color)
+    (unless (string= e1 e2)
+      (append-output e2 color))))
+
+(defun show-progress-bar (&optional (show t))
+  (q> |visible| ui:*progress* show))
+
+;;; output
+
+(defun update-output (&optional line)
+  (let ((text (get-output-stream-string *output-buffer*)))
+    (unless (x:empty-string text)
+      (let ((err (search "[LQML:err]" text)))
+        (qjs |appendText| ui:*repl-model*
+             (list :m-text  (if err (subseq text err) text)
+                   :m-color (if err *color-error* *color-text*)
+                   :m-bold  nil
+                   :m-line  line))))))
+
+(defun append-output (text &optional (color *color-text*) bold)
+  (qjs |appendText| ui:*repl-model*
+       (list :m-text  text
+             :m-color color
+             :m-bold  bold
+             :m-line  nil)))
+
+;;; command history
+
+(defvar *history*       (make-array 0 :adjustable t :fill-pointer t))
+(defvar *history-index* nil)
+(defvar *history-file*  ".lqml-repl-history")
+(defvar *max-history*   100)
+
+(defun read-saved-history ()
+  (when (probe-file *history-file*)
+    (let ((i -1))
+      (labels ((index ()
+                 (mod i *max-history*))
+               (next-index ()
+                 (incf i)
+                 (index)))
+        (let ((tmp (make-array *max-history*))) ; ring buffer
+          (with-open-file (s *history-file*)
+            (x:while-it (read-line s nil nil)
+              (setf (svref tmp (next-index)) x:it)))
+          (let ((max (min (1+ i) *max-history*)))
+            (when (< max *max-history*)
+              (setf i -1))
+            (dotimes (n max)
+              (vector-push-extend (svref tmp (next-index))
+                                  *history*))
+            (setf *history-index* (length *history*)))))))) ; 1 after last
+
+(let (out)
+  (defun history-ini ()
+    (read-saved-history)
+    (setf out (open *history-file* :direction :output
+                    :if-exists :append :if-does-not-exist :create)))
+  (defun history-add (line)
+    (unless out
+      (history-ini))
+    (let ((len (length *history*)))
+      (when (or (zerop len)
+                (string/= line (aref *history* (1- len))))
+        (vector-push-extend line *history*)
+        (write-line line out)
+        (finish-output out)))
+    (setf *history-index* (length *history*))) ; 1 after last
+  (defun history-move (direction)
+    (unless out
+      (history-ini))
+    (when (and *history-index*
+               (plusp (length *history*)))
+      (setf *history-index* (if (string= "back" direction)
+                                (max (1- *history-index*) 0)
+                                (min (1+ *history-index*) (1- (length *history*)))))
+      (let ((text (aref *history* *history-index*)))
+        (q> |text| ui:*repl-input* text)
+        (q> |cursorPosition| ui:*repl-input*
+            (- (length text) (if (x:ends-with ")" text) 1 0)))))))
+
+(defun qml::help ()
+  (format t "~%~
+             ~% :s  (start-swank)~
+             ~% :q  (quicklisp)")
+  (values))
+
+(progn
+  (ini-streams)
+  (in-package :qml-user)
+  (eval-in-thread "(qml::help)" nil))

examples/clog-demo/lisp/main.lisp

@@ -0,0 +1,7 @@
+(in-package :app)
+
+(defun run-demo ()
+  (clog-demo-1:start-demo)
+  (q> |visible| ui:*busy* nil))
+
+(qlater 'run-demo)

examples/clog-demo/lisp/package.lisp

@@ -0,0 +1,10 @@
+(defpackage :app
+  (:use :cl :qml)
+  (:export))
+
+;;; hack, loads empty systems to suppress ASDF runtime error "system not found"
+
+(progn
+  (push "./" asdf:*central-registry*)
+  (asdf:load-system :mgl-pax)
+  (asdf:load-system :clog))

examples/clog-demo/lisp/swank-quicklisp.lisp

@@ -0,0 +1,191 @@
+;;; enable Swank and Quicklisp on mobile
+
+(in-package :qml)
+
+;; for mobile app updates:
+;; to be incremented on every ECL upgrade in order to replace all asset files
+#+(or android ios)
+(defconstant +app-version+ 1)
+
+#+(and ios (not interpreter))
+(ffi:clines "extern void init_lib_ASDF(cl_object);")
+
+#+(or android ios)
+(defvar *assets* #+android "assets:/lib/"
+                 #+ios     "assets/")
+
+#+ios
+(defvar *bundle-root* (namestring *default-pathname-defaults*))
+
+#+(or android ios)
+(defun copy-asset-files (&optional (dir-name *assets*) origin)
+  "Copy asset files to home directory."
+  (flet ((directory-p (path)
+           (x:ends-with "/" path))
+         (translate (name)
+           #+android
+           (if (x:starts-with *assets* name)
+               (subseq name (length *assets*))
+               name)
+           #+ios
+           (namestring
+	    (merge-pathnames (x:cc "../" (subseq name (length origin)))))))
+    (ensure-directories-exist (translate dir-name))
+    ;; note: both QDIRECTORY and QCOPY-FILE are prepared for accessing
+    ;; APK asset files, which can't be accessed directly from Lisp
+    (dolist (from (qdirectory dir-name))
+      (if (directory-p from)
+          (copy-asset-files from origin)
+          (let ((to (translate from)))
+            (when (probe-file to)
+              (delete-file to))
+            (unless (qcopy-file from to)
+              (qlog "Error copying asset file: ~S" from)
+              (return-from copy-asset-files))))))
+  t)
+
+#+(or android ios)
+(let ((file ".app-version"))
+  (defun app-version ()
+    (if (probe-file file)
+        (with-open-file (s file)
+          (let ((str (make-string (file-length s))))
+            (read-sequence str s)
+            (values (parse-integer str))))
+        0))
+  (defun save-app-version ()
+    (with-open-file (s file :direction :output :if-exists :supersede)
+      (princ +app-version+ s))
+    (values)))
+
+(defun %sym (symbol package)
+  (intern (symbol-name symbol) package))
+
+;;; Quicklisp setup
+
+#+ios
+(defun load-asdf ()
+  (unless (find-package :asdf)
+    ;; needed for ASDF and Quicklisp
+    (setf (logical-pathname-translations "SYS")
+          (list (list "sys:**;*.*"
+                      (merge-pathnames "**/*.*" (user-homedir-pathname)))))
+    (setf (logical-pathname-translations "HOME")
+          (list (list "home:**;*.*"
+                      (merge-pathnames "**/*.*" (user-homedir-pathname)))))
+    (ffi:c-inline nil nil :void "ecl_init_module(NULL, init_lib_ASDF)" :one-liner t)
+    (in-package :qml-user))
+  :asdf)
+
+#+(or android ios)
+(defun ensure-asdf ()
+  (unless (find-package :asdf)
+    #+android
+    (require :asdf)
+    #+ios
+    (load-asdf)))
+
+#+(or android ios)
+(defun quicklisp ()
+  (ensure-asdf)
+  (unless (find-package :quicklisp)
+    #+android
+    (progn
+      (require :ecl-quicklisp)
+      (require :deflate)
+      (require :ql-minitar))
+    #+ios
+    (load "quicklisp/setup")
+    ;; replace interpreted function with precompiled one from DEFLATE
+    (setf (symbol-function (%sym 'gunzip :ql-gunzipper))
+          (symbol-function (%sym 'gunzip :deflate)))
+    (in-package :qml-user))
+  :quicklisp)
+
+;;; Swank setup
+
+#+(or android ios)
+(defun swank/create-server (interface port dont-close style)
+  (funcall (%sym 'create-server :swank)
+           :interface interface
+           :port port
+           :dont-close dont-close
+           :style style))
+
+#+(or android ios)
+(defun start-swank (&key (port 4005) (interface "0.0.0.0") (style :spawn)
+                         (load-contribs t) (setup t) (delete t) (quiet t)
+                         (dont-close t) log-events)
+  (unless (find-package :swank)
+    (ensure-asdf)
+    (funcall (%sym 'load-system :asdf) :swank))
+  (funcall (%sym 'init :swank-loader)
+           :load-contribs load-contribs
+           :setup         setup
+           :delete        delete
+           :quiet         quiet)
+  (setf (symbol-value (%sym '*log-events* :swank)) log-events)
+  (eval (read-from-string "(swank/backend:defimplementation swank/backend:lisp-implementation-program () \"org.lisp.ecl\")"))
+  (if (eql :spawn style)
+      (swank/create-server interface port dont-close style)
+      (mp:process-run-function
+       "SLIME-listener"
+       (lambda () (swank/create-server interface port dont-close style)))))
+
+#+(or android ios)
+(defun stop-swank (&optional (port 4005))
+  (when (find-package :swank)
+    (funcall (%sym 'stop-server :swank) port)
+    :stopped))
+
+#+(or android ios)
+(progn
+  ;; be careful not to use :s, :q in your mobile app code
+  ;; ios simulator note: wrap :s and :q in qrun* (would crash otherwise)
+  (define-symbol-macro :s (start-swank))
+  (define-symbol-macro :q (quicklisp)))
+
+#+(or android ios)
+(export (list #+ios
+              'load-asdf
+              'start-swank
+              'stop-swank
+              'quicklisp))
+
+#+ios
+(progn
+  ;; adapt paths to iOS specific values
+  (defvar *user-homedir-pathname-orig* (symbol-function 'user-homedir-pathname))
+
+  (ext:package-lock :common-lisp nil)
+
+  (defun cl:user-homedir-pathname (&optional host)
+    (merge-pathnames "Library/" (funcall *user-homedir-pathname-orig* host)))
+
+  (ext:package-lock :common-lisp t)
+
+  (dolist (el '(("XDG_DATA_HOME"   . "")
+                ("XDG_CONFIG_HOME" . "")
+                ("XDG_DATA_DIRS"   . "")
+                ("XDG_CONFIG_DIRS" . "")
+                ("XDG_CACHE_HOME"  . ".cache")))
+    (ext:setenv (car el) (namestring (merge-pathnames (cdr el)
+                                                      (user-homedir-pathname))))))
+
+;;; ini
+
+#+(or android ios)
+(defun startup-ini ()
+  #+ios
+  (setf *default-pathname-defaults* (user-homedir-pathname))
+  (ext:install-bytecodes-compiler)
+  (and (/= +app-version+ (app-version))
+       #+ios
+       (let ((dir (namestring (merge-pathnames *assets* *bundle-root*))))
+         (copy-asset-files dir dir))
+       #+android
+       (copy-asset-files)
+       (save-app-version)))
+
+#+(or android ios)
+(qlater 'startup-ini)

examples/clog-demo/lisp/ui-vars.lisp

@@ -0,0 +1,28 @@
+(defpackage ui
+  (:use :cl :qml)
+  (:export
+   #:*browser*
+   #:*busy*
+   #:*flick-output*
+   #:*history-back*
+   #:*history-forward*
+   #:*main*
+   #:*progress*
+   #:*repl-input*
+   #:*repl-output*
+   #:*repl-model*
+   #:*server*))
+
+(in-package :ui)
+
+(defparameter *browser*         "browser")
+(defparameter *busy*            "busy")
+(defparameter *flick-output*    "flick_output")
+(defparameter *history-back*    "history_back")
+(defparameter *history-forward* "history_forward")
+(defparameter *main*            "main")
+(defparameter *progress*        "progress")
+(defparameter *repl-input*      "repl_input")
+(defparameter *repl-output*     "repl_output")
+(defparameter *repl-model*      "repl_model")
+(defparameter *server*          "server")

examples/clog-demo/ql-libs.lisp

@@ -0,0 +1,3 @@
+;;; define here how to load eventual, not yet installed dependencies
+;;; (for cross-compiling only)
+(ql:quickload :clog) ; requires this fork: https://github.com/pls153/clog

examples/clog-demo/qml/ext/Browser.qml

@@ -0,0 +1,32 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+import QtWebView 1.15
+
+Item {
+  WebView {
+    id: browser
+    objectName: "browser"
+    width: parent. width
+    height: parent.height - reload.height
+    visible: !busy.visible
+  }
+
+  Button {
+    id: reload
+    anchors.bottom: parent.bottom
+    text: "Reload"
+    onClicked: browser.reload()
+  }
+
+  Rectangle {
+    id: busy
+    objectName: "busy"
+    color: "white"
+    anchors.fill: parent
+
+    Image {
+      anchors.centerIn: parent
+      source: "../img/busy.png"
+    }
+  }
+}

examples/clog-demo/qml/ext/Repl.qml

@@ -0,0 +1,160 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+
+Item {
+  id: repl
+  z: 1
+  anchors.fill: parent
+
+  Row {
+    anchors.right: parent.right
+    z: 1
+
+    Text {
+      text: "REPL"
+      anchors.verticalCenter: show.verticalCenter
+      visible: !show.checked
+    }
+
+    Switch {
+      id: show
+
+      onCheckedChanged: container.enabled = checked
+    }
+  }
+
+  Column {
+    id: container
+    opacity: 0
+
+    Rectangle {
+      width: repl.parent.width
+      height: repl.parent.height / 4
+      color: "#101010"
+
+      ListView {
+        id: replOutput
+        objectName: "repl_output"
+        anchors.fill: parent
+        contentWidth: parent.width * 4
+        clip: true
+        model: replModel
+        flickableDirection: Flickable.HorizontalAndVerticalFlick
+
+        delegate: Column {
+          Rectangle {
+            width: replOutput.contentWidth
+            height: 1
+            color: "#707070"
+            visible: mLine
+          }
+
+          Text {
+            x: 2
+            padding: 2
+            textFormat: Text.PlainText
+            font.family: fontHack.name
+            font.bold: mBold
+            text: mText
+            color: mColor
+          }
+        }
+      }
+
+      ListModel {
+        id: replModel
+        objectName: "repl_model"
+
+        function appendText(data) {
+          append(data)
+          replOutput.contentX = 0
+          replOutput.positionViewAtEnd()
+        }
+      }
+    }
+
+    Row {
+      width: repl.parent.width
+
+      TextField {
+        id: input
+        objectName: "repl_input"
+        width: repl.parent.width - 2 * back.width
+        font.family: fontHack.name
+        font.bold: true
+        color: "#c0c0c0"
+        inputMethodHints: Qt.ImhNoAutoUppercase | Qt.ImhNoPredictiveText
+        focus: show.checked
+        palette {
+          highlight: "#e0e0e0"
+          highlightedText: "#101010"
+        }
+
+        background: Rectangle {
+          color: "#101010"
+          border.width: 2
+          border.color: "gray"
+        }
+
+        onAccepted: Lisp.call("eval:eval-in-thread", text)
+      }
+
+      Button {
+        id: back
+        objectName: "history_back"
+        width: 40
+        height: input.height
+        focusPolicy: Qt.NoFocus
+        font.family: fontIcons.name
+        font.pixelSize: 26
+        text: "\uf100"
+
+        onClicked: Lisp.call("eval:history-move", "back")
+      }
+
+      Rectangle {
+        width: 1
+        height: input.height
+        color: "#101010"
+      }
+
+      Button {
+        id: forward
+        objectName: "history_forward"
+        width: back.width
+        height: input.height
+        focusPolicy: Qt.NoFocus
+        font.family: fontIcons.name
+        font.pixelSize: 26
+        text: "\uf101"
+
+        onClicked: Lisp.call("eval:history-move", "forward")
+      }
+    }
+
+    Rectangle {
+      width: repl.parent.width
+      height: 1
+      color: "#101010"
+    }
+  }
+
+  ProgressBar {
+    objectName: "progress"
+    anchors.top: container.bottom
+    width: repl.width
+    z: 1
+    indeterminate: true
+    enabled: visible
+    visible: false
+  }
+
+  states: [
+    State { when: show.checked;  PropertyChanges { target: container; opacity: 0.9; y: 0 }},
+    State { when: !show.checked; PropertyChanges { target: container; opacity: 0.0; y: -height }}
+  ]
+
+  transitions: [
+    Transition { NumberAnimation { properties: "opacity,y"; duration: 250; easing.type: Easing.InCubic }}
+  ]
+}

examples/clog-demo/qml/ext/Server.qml

@@ -0,0 +1,69 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+import QtWebSockets 1.15
+import "." as Ext
+
+Rectangle {
+  color: "lavender"
+
+  Ext.Repl {}
+  
+  WebSocketServer {
+    id: server
+    objectName: "server"
+    port: 8080
+    listen: true
+
+    property int counter: 0
+    property var connection
+
+    function send(message) {                                                    // called from CLOG
+      connection.sendTextMessage(message)
+    }
+
+    function log(dictionary) {
+      logModel.append(dictionary)
+      view.positionViewAtEnd()
+    }
+
+    onClientConnected: {
+      connection = webSocket
+      webSocket.objectName = ++counter
+      log({ message: "[new] " + counter, error: false })
+      Lisp.call(webSocket, "clog-connection:server/on-new-connection")          // call CLOG
+
+      webSocket.onTextMessageReceived.connect(function(message) {
+        log({ message: message, error: false })
+        Lisp.call(webSocket, "clog-connection:server/on-message", message)      // call CLOG
+      })
+
+      webSocket.onStatusChanged.connect(function(status) {
+        var state
+        switch (status) {
+          case WebSocket.Closed: state = "close"; break
+          case WebSocket.Error:  state = "error"; break
+          default: return
+        }
+        log({ message: "[status] " + state, error: status === WebSocket.Error})
+        if (status === WebSocket.Closed) {
+          Lisp.call(webSocket, "clog-connection:server/on-close")               // call CLOG
+        }
+      })
+    }
+
+    onErrorStringChanged: {
+      log({ message: "[server error] " + errorString, error: true });
+    }
+  }
+
+  ListView {
+    id: view
+    anchors.fill: parent
+    model: ListModel { id: logModel }
+    delegate: Text {
+      font.pixelSize: 14
+      color: error ? "red" : "#111"
+      text: message
+    }
+  }
+}

examples/clog-demo/qml/main.qml

@@ -0,0 +1,34 @@
+import QtQuick 2.15
+import QtQuick.Controls 2.15
+import "ext/" as Ext
+
+Rectangle {
+  width: 400
+  height: 650
+  objectName: "main"
+  color: "#333"
+
+  SwipeView {
+    id: view
+    objectName: "view"
+    anchors.fill: parent
+
+    // page 1: webview (native on mobile)
+    Ext.Browser {}
+
+    // page 2: websocket server, log, repl
+    Ext.Server {}
+  }
+
+  PageIndicator {
+    anchors.bottom: view.bottom
+    anchors.bottomMargin: 10
+    anchors.horizontalCenter: parent.horizontalCenter
+    count: view.count
+    currentIndex: view.currentIndex
+  }
+
+  FontLoader { id: fontIcons;    source: "fonts/fontawesome-webfont.ttf" }
+  FontLoader { id: fontHack;     source: "fonts/Hack-Regular.ttf" }
+  FontLoader { id: fontHackBold; source: "fonts/Hack-Bold.ttf" }
+}

examples/clog-demo/readme.md

@@ -0,0 +1,33 @@
+
+Prepare
+-------
+
+Please copy the app template files first:
+```
+$ cd ..
+$ ./copy.sh clog-demo
+```
+
+See also [../../slime/src/readme-sources](../../slime/src/readme-sources.md)
+for installing the Slime sources where this example can find them.
+
+**Important**: you need to put this fork of CLOG in your
+`~/quicklisp/local-projects/` directory:
+[CLOG for mobile](https://github.com/pls153/clog).
+
+If you want to run this example on the desktop, you need to uncomment the Qt
+WebEngine dependency in [../../src/lqml.pro](../../src/lqmp.pro) and rebuild
+the `lqml` executable.
+
+
+
+Info
+----
+
+This shows how to run CLOG on mobile. It uses the native web-view on mobile,
+which has some restrictions: to see page 2 of the QML UI, you need to swipe
+at the bottom (where the 'Reload' button is), because swiping the native
+web-view won't work.
+
+On the second page you can see a log of CLOG messages, and start Swank from the
+REPL.

src/lisp/ini.lisp

@@ -48,6 +48,29 @@
 (defun %reference-name ()
   (format nil "%~A%" (gensym)))
 
+(defun qrun-on-ui-thread (function &optional (blocking t))
+  ;; for internal use
+  (%qrun-on-ui-thread function blocking))
+
+(defvar *gui-thread* mp:*current-process*)
+
+(defmacro qrun-on-ui-thread* (&body body)
+  ;; for internal use
+  (let ((values (gensym)))
+    `(if (eql *gui-thread* mp:*current-process*)
+         ,(if (second body)
+              (cons 'progn body)
+              (first body))
+         (let (,values)
+           (qrun (lambda ()
+                   (setf ,values (multiple-value-list ,(if (second body)
+                                                           (cons 'progn body)
+                                                           (first body))))))
+           (values-list ,values)))))
+
+(defmacro qrun* (&body body) ; alias
+  `(qrun-on-ui-thread* ,@body))
+
 (defun qexec (&optional ms)
   (qrun* (%qexec ms)))
 
@@ -119,29 +142,6 @@
       (unless (member x '(t nil))
         (symbol-name x)))))
 
-(defun qrun-on-ui-thread (function &optional (blocking t))
-  ;; for internal use
-  (%qrun-on-ui-thread function blocking))
-
-(defvar *gui-thread* mp:*current-process*)
-
-(defmacro qrun-on-ui-thread* (&body body)
-  ;; for internal use
-  (let ((values (gensym)))
-    `(if (eql *gui-thread* mp:*current-process*)
-         ,(if (second body)
-              (cons 'progn body)
-              (first body))
-         (let (,values)
-           (qrun (lambda ()
-                   (setf ,values (multiple-value-list ,(if (second body)
-                                                           (cons 'progn body)
-                                                           (first body))))))
-           (values-list ,values)))))
-
-(defmacro qrun* (&body body) ; alias
-  `(qrun-on-ui-thread* ,@body))
-
 (defun qfind-children (object &optional object-name class-name)
   ;; for internal use
   (%qfind-children object object-name class-name))

src/lqml.pro

@@ -8,7 +8,9 @@ DESTDIR     = .
 OBJECTS_DIR = ./tmp
 MOC_DIR     = ./tmp
 
-# optional (requires Qt WebEngine to be installed)
+# optional (uncomment if wanted)
+# for running example 'clog-demo' on the desktop
+# requires Qt WebEngine to be installed
 #QT          += webview
 #DEFINES     += INI_WEBVIEW