example 'clog-demo': update to CLOG version 2.2; update CLOG apk demo

examples/clog-demo/app.asd

@@ -1,7 +1,9 @@
 (defsystem :app
   :serial t
-  :depends-on (#-clog-loaded :clog) ; requires this fork: https://github.com/pls153/clog
+  ;; requires this CLOG fork: https://gitlab.com/eql/clog-for-mobile/-/blob/main/clog-2.2.tgz
+  :depends-on (#-clog-loaded :clog)
   :components ((:file "lisp/package")
+               (:file "lisp/ini")
                (:file "lisp/ui-vars")
                (:file "lisp/swank-quicklisp")
                (:file "lisp/eval")

examples/clog-demo/app.pro

@@ -69,6 +69,8 @@ android {
     QT += androidextras
   }
 
+  ANDROID_MIN_SDK_VERSION    = 21
+  ANDROID_TARGET_SDK_VERSION = 34
   ANDROID_EXTRA_LIBS         += $$ECL/lib/libecl.so
   ANDROID_PACKAGE_SOURCE_DIR = ../platforms/android
 

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

@@ -4,9 +4,12 @@
 
 (in-package :clog-demo-1)
 
+(defparameter *app-mode* nil
+  "Run application once and shutdown")
+
 ;; Game Display
-(defconstant display-width  300)
+(defconstant display-width 375)
-(defconstant display-height 450)
+(defconstant display-height 375)
 
 ;; Snake Parameters
 (defconstant initial-length 5)
@@ -15,8 +18,8 @@
 (deftype snake-direction-type () '(member :left :right :up :down))
 
 (defun new-food ()
-  (list (random (floor (- (/ display-width segment-size) 1))) 
+  (list (random (floor (- (/ display-width segment-size) 1)))
-	(random (floor (- (/ display-height segment-size) 1)))))
+        (random (floor (- (/ display-height segment-size) 1)))))
 
 (defclass app-data ()
   ((snake-direction
@@ -34,7 +37,7 @@
 
 (defun display-splash (body)
   (let* ((splash
-	   (create-div body :content
+           (create-div body :content
 "<H1>(Sparky The Snake)</H1>
  <br />
  <p>Use your keyboard to move Sparky to pick up batteries.</p>
@@ -42,7 +45,7 @@
  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)))
+         (ticker (create-span splash)))
     (setf (width splash) "100%")
     (setf (text-alignment splash) :center)
     (dotimes (n 10)
@@ -51,81 +54,82 @@
     (setf (hiddenp splash) t)))
 
 (defun local-file (file)
-  (format nil "file://~A" (merge-pathnames file)))
+  #+android file
+  #-android (format nil "file://~A" (merge-pathnames (x:cc "static-files/" file))))
 
 (defun paint (body cx app)
   (let ((game-over nil)
-	(head-cell (car (snake app))))
+        (head-cell (car (snake app))))
     (flet ((draw-segment (cell)
-	     (fill-rect cx
+             (fill-rect cx
-			(* (car cell) segment-size)
+                        (* (car cell) segment-size)
-			(* (cadr cell) segment-size)
+                        (* (cadr cell) segment-size)
-			segment-size
+                        segment-size
-			segment-size))
+                        segment-size))
-	   (self-collision ()
+           (self-collision ()
-	     (dolist (cell (snake app))
+             (dolist (cell (snake app))
-	       (when (equal cell head-cell)
+               (when (equal cell head-cell)
-		 (return t)))))
+                 (return t)))))
       (cond ((eq :right (snake-direction app))
-	      (setf head-cell (list (1+ (car head-cell))
+              (setf head-cell (list (1+ (car head-cell))
-				    (cadr head-cell))))
+                                    (cadr head-cell))))
-	    ((eq :left (snake-direction app))
+            ((eq :left (snake-direction app))
-	      (setf head-cell (list (1- (car head-cell))
+              (setf head-cell (list (1- (car head-cell))
-				    (cadr head-cell))))
+                                    (cadr head-cell))))
-	    ((eq :up (snake-direction app))
+            ((eq :up (snake-direction app))
-	      (setf head-cell (list (car head-cell)
+              (setf head-cell (list (car head-cell)
-				    (1- (cadr head-cell)))))
+                                    (1- (cadr head-cell)))))
-	    ((eq :down (snake-direction app))
+            ((eq :down (snake-direction app))
-	      (setf head-cell (list (car head-cell)
+              (setf head-cell (list (car head-cell)
-				    (1+ (cadr head-cell))))))
+                                    (1+ (cadr head-cell))))))
       (cond ((or (< (car head-cell) 0)
-	      (< (cadr head-cell) 0)
+              (< (cadr head-cell) 0)
-	      (>= (* (car head-cell) segment-size) display-width)
+              (>= (* (car head-cell) segment-size) display-width)
-	      (>= (* (cadr head-cell) segment-size) display-height)
+              (>= (* (cadr head-cell) segment-size) display-height)
-	      (self-collision))
+              (self-collision))
-	     (fill-style cx :red)
+             (setf (fill-style cx) :red
-	     (font-style cx "bold 20px sans-serif")
+                   (font-style cx) "bold 20px sans-serif")
-	     (fill-text cx "GAME OVER" 30 30)
+             (fill-text cx "GAME OVER" 30 30)
-	     (play-media (create-audio body
+             (play-media (create-audio body
-                                       :source (local-file "htm/demo/game-over.wav")
+                                       :source (local-file "demo/game-over.wav")
                                        :controls nil))
-	     (setf game-over t))
+             (setf game-over t))
-	    (t
+            (t
-	     (fill-style cx :purple)
+             (setf (fill-style cx) :purple)
-	     (push head-cell (snake app))
+             (push head-cell (snake app))
-	     (dolist (cell (snake app))
+             (dolist (cell (snake app))
-	       (draw-segment cell))
+               (draw-segment cell))
-	     (fill-style cx :white)
+             (setf (fill-style cx) :white)
-	     (cond ((equal head-cell (food app))
+             (cond ((equal head-cell (food app))
-		    (fill-text cx (format nil "Score: ~A" (score app))
+                    (fill-text cx (format nil "Score: ~A" (score app))
-			       5 (- display-height 15))
+                               5 (- display-height 15))
-		    (setf (score app) (+ (score app) 10))
+                    (setf (score app) (+ (score app) 10))
-		    (fill-style cx :green)
+                    (setf (fill-style cx) :green)
-		    (fill-text cx (format nil "Score: ~A" (score app))
+                    (fill-text cx (format nil "Score: ~A" (score app))
-			       5 (- display-height 15))
+                               5 (- display-height 15))
-		    (play-media (create-audio body
+                    (play-media (create-audio body
-                                              :source (local-file "htm/demo/eat.wav")
+                                              :source (local-file "demo/eat.wav")
                                               :controls nil))
-		    (setf (food app) (new-food)))
+                    (setf (food app) (new-food)))
-		   (t
+                   (t
-		    (draw-segment (car (last (snake app))))
+                    (draw-segment (car (last (snake app))))
-		    (setf (snake app) (butlast (snake app)))))	  
+                    (setf (snake app) (butlast (snake app)))))
-	     (fill-style cx :brown)
+             (setf (fill-style cx) :brown)
-	     (draw-segment (food app))))      
+             (draw-segment (food app))))
-	game-over)))
+        game-over)))
 
 (defun on-key-down (obj event)
   (let ((app      (connection-data-item obj "app-data"))
-	(key      (getf event :key)))
+        (key      (getf event :key)))
     (cond ((or (equalp key "ArrowLeft") (equalp key "a"))
-	   (setf (snake-direction app) :left))
+           (setf (snake-direction app) :left))
-	  ((or (equalp key "ArrowUp") (equalp key "w"))
+          ((or (equalp key "ArrowUp") (equalp key "w"))
-	   (setf (snake-direction app) :up))
+           (setf (snake-direction app) :up))
-	  ((or (equalp key "ArrowDown") (equalp key "s"))
+          ((or (equalp key "ArrowDown") (equalp key "s"))
-	   (setf (snake-direction app) :down))
+           (setf (snake-direction app) :down))
-	  ((or (equalp key "ArrowRight") (equalp key "d"))
+          ((or (equalp key "ArrowRight") (equalp key "d"))
-	   (setf (snake-direction app) :right)))))
+           (setf (snake-direction app) :right)))))
-	  
+
 (defun on-click (obj)
   (let ((app     (connection-data-item obj "app-data"))
         (btn-txt (text obj)))
@@ -137,19 +141,19 @@
 
 (defun start-game (body)
   (let* ((app       (connection-data-item body "app-data"))
-	 (disp      (create-canvas body
+         (disp      (create-canvas body
-				   :width display-width
+                                   :width display-width
-				   :height display-height))
+                                   :height display-height))
-	 (br        (create-br body))
+         (br        (create-br body))
-	 (controls  (create-div body))
+         (controls  (create-div body))
-	 (left-btn  (create-button controls :content "<h3><pre> <-- </pre></h3>"))
+         (left-btn  (create-button controls :content "<h3><pre> <-- </pre></h3>"))
-	 (right-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>"))
+         (up-btn    (create-button controls :content "<h3><pre> -^- </pre></h3>"))
-	 (down-btn  (create-button controls :content "<h3><pre> -v- </pre></h3>"))
+         (down-btn  (create-button controls :content "<h3><pre> -v- </pre></h3>"))
-	 context)
+         context)
     (declare (ignore br))
     ;; Initialize display
-    (setf (background-color body) :orange)    
+    (setf (background-color body) :orange)
     (setf (display disp) :block)
     (setf (background-color disp) :white)
     (set-margin disp :auto :auto :auto :auto)
@@ -160,17 +164,17 @@
     (dotimes (n initial-length)
       (push (list n 0) (snake app)))
     (setf context (create-context2d disp))
-    (font-style context "normal 20px sans-serif")
+    (setf (font-style context) "normal 20px sans-serif"
-    (fill-style context :green)
+          (fill-style context) :green)
     (fill-text context (format nil "Score: ~A" (score app))
-	       5 (- display-height 15))
+               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")
+                              :source (local-file "demo/start.wav")
                               :controls nil))
     ;; Game loop
     (loop

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

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

examples/clog-demo/clog-assets/static-files/boot.html

@@ -8,8 +8,10 @@
       <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>
+      <noscript><%= (@ meta) %></noscript>
    </HEAD>
 <BODY>
+  <noscript><%= (@ body) %></noscript>
 </BODY>
 <noscript>Your browser must support JavaScript and be HTML 5 compilant to see this site.</noscript>
 </HTML>

examples/clog-demo/clog-assets/static-files/js/boot.js

@@ -1,9 +1,21 @@
-var _ws;
+var _ws=null;
-var adr;
+var adr; var adrc;
-var clog = {};
+var clog={};
 var pingerid;
+var retryid;
+var s = document.location.search;
+var tokens;
+var r = /[?&]?([^=]+)=([^&]*)/g;
 var ios = false;
 
+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 (typeof clog_debug == 'undefined') {
     clog_debug = false;
 }
@@ -52,53 +64,43 @@ function Setup_ws() {
         }
     }
 
-    _ws.onerror = function (event) {
+    var rc = function (event) {
-        console.log ('onerror: reconnect');
+	console.log (event);
-        _ws = null;
+	clearInterval (retryid);
-        _ws = new WebSocket (adr  + '?r=' + clog['connection_id']);
+	_ws = null;
+	_ws = new WebSocket (adr  + '?r=' + clog['connection_id']);
         _ws.onopen = function (event) {
-            console.log ('onerror: reconnect successful');
+            console.log ('reconnect successful');
             Setup_ws();
         }
         _ws.onclose = function (event) {
-            console.log ('onerror: reconnect failure');
+            console.log ('reconnect failure');
-            Shutdown_ws(event);
+	    console.log (Date.now());
+	    retryid = setInterval(function () {rc("Failed reconnect - trying again")}, 500);
         }
     }
 
+    _ws.onerror = function (event) {
+        console.log ('onerror: reconnect');
+	rc("onerror - trying reconnect")
+    }
+
     _ws.onclose = function (event) {
-        console.log ('onclose: reconnect');
+        if (event.code && event.code === 1000) {
-        _ws = null;
+            console.log("WebSocket connection got normal close from server. Don't reconnect.");
-        _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);
+        } else {
+	    rc("onclose - trying reconnnect");
         }
     }
 }
 
-$( document ).ready(function() {
+function Open_ws() {
-    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;
+	adr = 'wss://' + location.hostname;
     } else {
-        adr = 'ws://' + location.hostname;
+	adr = 'ws://' + location.hostname;
     }
 
     if (location.port != '') { adr = adr + ':' + location.port; }
@@ -108,12 +110,16 @@ $( document ).ready(function() {
     if (ios) {
         adr = 'ws://127.0.0.1:8080';
 
+        if (clog['connection_id']) {
+          adrc = adr  + '?r=' + clog['connection_id'];
+        } else { adrc = adr }
+
         try {
-            console.log ('connecting to ' + adr);
+            console.log ('connecting to ' + adrc);
-            _ws = new WebSocket (adr);
+            _ws = new WebSocket (adrc);
         } catch (e) {
-            console.log ('trying again, connecting to ' + adr);
+            console.log ('trying again, connecting to ' + adrc);
-            _ws = new WebSocket (adr);
+            _ws = new WebSocket (adrc);
         }
 
         if (_ws != null) {
@@ -123,8 +129,11 @@ $( document ).ready(function() {
             }
             pingerid = setInterval (function () {Ping_ws ();}, 10000);
         } else {
-            document.writeln ('If you are seeing this your browser or your connection to the internet is blocking web_wss.');
+            document.writeln ('If you are seeing this your browser or your connection to the internet is blocking websockets.');
         }
     }
-});
+}
 
+$( document ).ready(function() {
+    if (_ws == null) { Open_ws(); }
+});

examples/clog-demo/htm

@@ -1 +0,0 @@
-clog-assets/htm

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

@@ -4,7 +4,7 @@
 
 (setf clog-connection::*send-to-webview*
       #+ios (lambda (js) (qml:qjs |send| ui:*server* js))
-      #-ios (lambda (js) (qml:q! |runJavaScript| ui:*browser* js)))
+      #-ios (lambda (js) (qml:q! |runJavaScript| ui:*browser* js nil)))
 
 (defun webview/on-new-connection ()
   (clog-connection::handle-new-connection 'qml-webview nil))
@@ -12,11 +12,9 @@
 (defun webview/on-message (message)
   (clog-connection::handle-message 'qml-webview message))
 
-(defun webview/on-close ()
-  (clog-connection::handle-close-connection 'qml-webview))
-
 (defun boot ()
-  (qml:q> |url| ui:*browser* (format nil "file://~A"
+  (qml:q> |url| ui:*browser*
-                                     (merge-pathnames "htm/boot.html"))))
+          #+android "file:///android_asset/lib/static-files/boot.html"
+          #-android (format nil "file://~A" (merge-pathnames "static-files/boot.html"))))
 
 (export 'boot)

examples/clog-demo/lisp/ini.lisp

@@ -0,0 +1,22 @@
+(in-package :qml)
+
+(export
+ (list #+android '*shell-output*
+       #+android 'shell))
+
+;;; add function 'shell' (android only)
+
+#+android
+(defvar *shell-output* nil)
+
+#+android
+(defun shell (command)
+  "Run shell commands; example:
+  (shell \"df -h\")"
+  (let ((s (ext:run-program "sh" (list "-c" command))))
+    (setf *shell-output*
+          (loop :for line = (read-line s nil nil)
+                :while line :collect line)))
+  (princ (x:join *shell-output* #\Newline))
+  (values))
+

examples/clog-demo/lisp/package.lisp

@@ -2,9 +2,7 @@
   (:use :cl :qml)
   (:export))
 
-;;; hack, loads empty systems to suppress ASDF runtime error "system not found"
+;; hack, loads empty system to suppress ASDF runtime error "system not found"
-
 (progn
   (push *default-pathname-defaults* asdf:*central-registry*)
-  (asdf:load-system :mgl-pax)
   (asdf:load-system :clog))

examples/clog-demo/make.lisp

@@ -41,12 +41,12 @@
                    "/lib/ecl-*/")))
       (shell (cc "cp " lib "*.doc " *assets*))
       (shell (cc "cp -r " lib "encodings " *assets*))))
-  (shell (cc "rm -r " *assets* "htm/*")) ; may have changed
+  (shell (cc "rm -r " *assets* "static-files/*")) ; may have changed
-  (shell (cc "cp -r ../clog-assets/htm " *assets*))
+  (shell (cc "cp -r ../clog-assets/static-files " *assets*))
   (shell (cc "cp -r ../clog-assets/*.asd " *assets*)))
 
 #+ios
-(with-open-file (s (merge-pathnames "htm/js/boot.js" *assets*)
+(with-open-file (s (merge-pathnames "static-files/js/boot.js" *assets*)
                    :direction :output :if-exists :append)
   (write-line "ios = true;" s))
 

examples/clog-demo/platforms/android/AndroidManifest.xml

@@ -10,10 +10,22 @@
     <!-- The following comment will be replaced upon deployment with default features based on the dependencies of the application.
          Remove the comment if you do not require these default features. -->
 
-    <uses-sdk android:minSdkVersion="21" android:targetSdkVersion="31"/>
     <supports-screens android:largeScreens="true" android:normalScreens="true" android:anyDensity="true" android:smallScreens="true"/>
-    <application android:hardwareAccelerated="true" android:name="org.qtproject.qt5.android.bindings.QtApplication" android:label="CLOG demo" android:extractNativeLibs="true" android:icon="@drawable/icon">
+    <application
-        <activity android:configChanges="orientation|uiMode|screenLayout|screenSize|smallestScreenSize|layoutDirection|locale|fontScale|keyboard|keyboardHidden|navigation|mcc|mnc|density" android:name="org.qtproject.qt5.android.bindings.QtActivity" android:label="CLOG demo" android:screenOrientation="unspecified" android:launchMode="singleTop" android:exported="true">
+        android:hardwareAccelerated="true"
+        android:name="org.qtproject.qt5.android.bindings.QtApplication"
+        android:label="CLOG demo"
+        android:extractNativeLibs="true"
+        android:icon="@drawable/icon"
+        android:usesCleartextTraffic="true"
+        android:networkSecurityConfig="@xml/network_security_config">
+        <activity
+            android:configChanges="orientation|uiMode|screenLayout|screenSize|smallestScreenSize|layoutDirection|locale|fontScale|keyboard|keyboardHidden|navigation|mcc|mnc|density"
+            android:name="org.qtproject.qt5.android.bindings.QtActivity"
+            android:label="CLOG demo"
+            android:screenOrientation="unspecified"
+            android:launchMode="singleTop"
+            android:exported="true">
             <intent-filter>
                 <action android:name="android.intent.action.MAIN"/>
                 <category android:name="android.intent.category.LAUNCHER"/>

examples/clog-demo/platforms/android/res/xml/network_security_config.xml

@@ -0,0 +1,7 @@
+<?xml version="1.0" encoding="utf-8"?>
+<network-security-config>
+    <base-config cleartextTrafficPermitted="true" />
+    <domain-config cleartextTrafficPermitted="true">
+        <domain includeSubdomains="true">org.lqml.example.clog</domain>
+    </domain-config>
+</network-security-config>

examples/clog-demo/ql-libs.lisp

@@ -1,3 +1,4 @@
 ;;; 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
+
+(ql:quickload :clog) ; requires this fork: https://gitlab.com/eql/clog-for-mobile/-/blob/main/clog-2.2.tgz

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

@@ -35,11 +35,9 @@ Item {
   Button {
     id: reload
     anchors.bottom: parent.bottom
+    font.pixelSize: 18
     text: "Reload"
     onClicked: {
-      if (Qt.platform.os !== "ios") {
-        Lisp.call("clog:webview/on-close")
-      }
       browser.reload()
     }
   }
@@ -47,6 +45,7 @@ Item {
   Button {
     anchors.bottom: parent.bottom
     anchors.right: parent.right
+    font.pixelSize: 18
     text: "log/REPL"
     onClicked: view.currentIndex = 1
   }

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

@@ -11,6 +11,7 @@ Item {
     z: 1
 
     Text {
+      font.pixelSize: 18
       text: "REPL"
       anchors.verticalCenter: show.verticalCenter
       visible: !show.checked

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

@@ -37,9 +37,6 @@ Item {
           default: return
         }
         main.log("[status] " + state)
-        if (status === WebSocket.Closed) {
-          Lisp.call("clog:webview/on-close")
-        }
       })
     }
 

examples/clog-demo/readme.md

@@ -1,4 +1,4 @@
-*This example is outdated and not really useful anymore, sorry.*
+*This example has been updated in 2025 to CLOG version 2.2.*
 
 
 Try it
@@ -23,7 +23,7 @@ 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).
+[CLOG for mobile](https://gitlab.com/eql/clog-for-mobile/-/blob/main/clog-2.2.tgz).
 
 If you want to run this example on the desktop, you need to uncomment the Qt
 WebEngine dependency in [../../src/lqml.pro](../../src/lqml.pro) and rebuild

examples/clog-demo/static-files

@@ -0,0 +1 @@
+clog-assets/static-files