port example 'palindrome' (see eql5)

examples/palindrome/lisp/definitions.lisp

@@ -0,0 +1,77 @@
+(in-package :pal)
+
+(defparameter *items*
+  '(("P" "gs")
+    ("A" "djpv")
+    ("T" "ckow")
+    ("E" "hlnr")
+    ("R" "aiqy")
+    ("N" "m")
+    ("O" "bftx")
+    ("S" "eu")))
+
+(defparameter *state-1*
+  '("..............."
+    "..............."
+    "..............."
+    "..............."
+    "..............."
+    ".....abcde....."
+    ".....fghij....."
+    ".....klmno....."
+    ".....pqrst....."
+    ".....uvwxy....."
+    "..............."
+    "..............."
+    "..............."
+    "..............."
+    "..............."))
+
+(defparameter *state-2*
+  '(".......d......."
+    "..............."
+    ".......g......."
+    ".......j......."
+    ".......c......."
+    ".......h......."
+    ".......a......."
+    "p.svklqmbeoni.t"
+    ".......f......."
+    ".......u......."
+    ".......w......."
+    ".......r......."
+    ".......y......."
+    "..............."
+    ".......x......."))
+
+(let (ex)
+  (defun rotated (&optional (state ex))
+    (let* ((width  (length (first state)))
+           (height (length state))
+           (array  (make-array (list width height))))
+      (loop :for string :in state
+            :for y :upfrom 0
+            :do (loop :for ch :across string
+                      :for x :upfrom 0
+                      :do (setf (aref array x (- (1- width) y)) ; rotate
+                                ch)))
+      (setf ex (loop :for y :below height
+                     :collect (coerce (loop :for x :below width
+                                            :collect (aref array y x))
+                                      'string)))))
+  (defun ex-rotated ()
+    ex))
+
+(defparameter *states*
+  (list *state-1*           ; 1
+        *state-2*
+        *state-1*
+        (rotated *state-1*) ; 2
+        *state-2*
+        (ex-rotated)
+        (rotated)           ; 3
+        *state-2*
+        (ex-rotated)
+        (rotated)           ; 4
+        *state-2*
+        (ex-rotated)))

examples/palindrome/lisp/helper/generate-qml.lisp

@@ -0,0 +1,35 @@
+;;; generates QML file for animation
+
+(load "../package")
+(load "../definitions")
+(load "../utils")
+(load "with-qml-file")
+
+(in-package :pal)
+
+(with-qml-file ("../../qml/main.qml")
+  "import QtQuick 2.15"
+  "import 'ext/' as Ext"
+  (qml "Rectangle"
+       "width: 527; height: 527"
+       "color: 'black'"
+       (qml "Rectangle"
+            "x: scale * (width - 527) / 2"
+            "y: scale * (height - 527) / 2"
+            "width: parent.width"
+            "height: parent.height"
+            "color: 'black'"
+            "scale: Math.min(width, height) / 527"
+            ""
+            (let ((num 0))
+              (mapc (lambda (char xy)
+                      (incf num)
+                      (qml "Ext.PalindromeImage { objectName: 'img~D'; source: 'img/~A.png'; x: ~D; y: ~D }"
+                           num
+                           (image-of-char char)
+                           (* 31 (first xy))
+                           (* 31 (second xy))))
+                    *chars* (first *move-to-positions*))))))
+
+(qquit)
+

examples/palindrome/lisp/helper/readme.md

@@ -0,0 +1,8 @@
+HowTo
+-----
+
+```
+lqml generate-qml.lisp
+```
+
+This will create [main.qml](../../qml/main.qml).

examples/palindrome/lisp/helper/with-qml-file.lisp

@@ -0,0 +1,55 @@
+;;; generate indented QML file
+;;;
+;;; note: giving an 'id' will automatically add an 'objectName' of the same name
+
+(in-package :pal)
+
+(defmacro with-qml-file ((file) &body body)
+  (let ((text (gensym)))
+    `(let ((,text (with-output-to-string (s)
+                    ,@(mapcar (lambda (x) (if (stringp x) `(write-line ,x s) x))
+                              body))))
+       ;; stream S is intentionally not a gensym
+       (with-open-file (s ,file :direction :output :if-exists :supersede)
+         (format s "// THIS FILE IS GENERATED~%~%")
+         (write-string (%indent-qml ,text) s)
+         (qlater (lambda () (format t "~%QML file generated, see ~S~%~%" ,file)))))))
+
+(defmacro qml (first &body body)
+  (if (find #\~ first)
+      `(progn
+         (format s ,first ,@body)
+         (terpri s))
+      (let ((open-close (and (upper-case-p (char first 0))
+                             (not (find #\{ first)))))
+        (if body
+            `(progn
+               ,(if open-close
+                    `(write-line ,(format nil "~%~A {" first) s)
+                    (if (find #\{ first)
+                        `(write-line ,(format nil "~%~A" first))
+                        `(write-line ,first s)))
+               ,@(mapcar (lambda (x)
+                           (if (stringp x)
+                               (if (x:starts-with "id:" x)
+                                   `(progn
+                                      (write-line ,x s)
+                                      (write-line ,(format nil "objectName: ~S" (string-trim " " (subseq x 3))) s))
+                                   `(write-line ,x s))
+                               x))
+                         body)
+               ,(when open-close `(write-line "}" s)))
+            (if (find #\{ first)
+                `(write-line ,(format nil "~%~A" first) s)
+                `(write-line ,first s))))))
+
+(defun %indent-qml (text)
+  (with-output-to-string (out)
+    (let ((in (make-string-input-stream text))
+          (depth 0))
+      (x:while-it (read-line in nil nil)
+        (let ((open (count #\{ x:it))
+              (close (count #\} x:it)))
+          (write-string (make-string (* 2 (- depth (if (= (- open close) -1) 1 0)))) out)
+          (write-line (string-left-trim " " x:it) out)
+          (setf depth (+ depth open (- close))))))))

examples/palindrome/lisp/main.lisp

@@ -0,0 +1,16 @@
+(in-package :pal)
+
+(defun run-animation (&optional first)
+  (dolist (move-to (nthcdr (if first 1 0) *move-to-positions*))
+    (let ((target 0))
+      (dolist (xy move-to)
+        (incf target)
+        (let ((img (find-quick-item (format nil "img~D" target))))
+          (q> |x| img (* 31 (first xy)))
+          (q> |y| img (* 31 (second xy)))
+          (qsleep 0.05))))            ; delay between item start      (sec)
+    (qsleep 4))                       ; duration of animation + pause (sec)
+  (qsingle-shot 1500 'run-animation)) ; pause                         (msec)
+
+(qlater (lambda () (run-animation t)))
+

examples/palindrome/lisp/package.lisp

@@ -0,0 +1,6 @@
+(defpackage :palindrome
+  (:nicknames :pal)
+  (:use :cl :qml)
+  (:export
+   #:run-animation))
+

examples/palindrome/lisp/utils.lisp

@@ -0,0 +1,30 @@
+(in-package :pal)
+
+(defun item-count ()
+  (loop :for item :in *items*
+        :sum (length (second item))))
+
+(defvar *chars* (loop :for i :below (item-count) :collect (code-char (+ i #.(char-code #\a)))))
+
+(defun image-of-char (char)
+  (dolist (item *items*)
+    (x:when-it (find char (second item))
+      (return-from image-of-char (first item)))))
+
+(defun compute-move-to-positions ()
+  (flet ((item-pos (char list)
+           (let ((y 0))
+             (dolist (state list)
+               (incf y)
+               (x:when-it (position char state)
+                 (return-from item-pos (list (1+ x:it) y)))))))
+    (let (states)
+      (dolist (state *states*)
+        (let (positions)
+          (dolist (char *chars*)
+            (push (item-pos char state)
+                  positions))
+          (push (nreverse positions) states)))
+      (nreverse states))))
+
+(defvar *move-to-positions* (compute-move-to-positions))

examples/palindrome/qml/ext/PalindromeImage.qml

@@ -0,0 +1,7 @@
+import QtQuick 2.15
+
+Image {
+  Behavior on x { NumberAnimation { duration: 3000; easing.type: Easing.InOutSine } }
+  Behavior on y { NumberAnimation { duration: 3000; easing.type: Easing.InOutSine } }
+}
+

examples/palindrome/qml/main.qml

@@ -0,0 +1,44 @@
+// THIS FILE IS GENERATED
+
+import QtQuick 2.15
+import 'ext/' as Ext
+
+Rectangle {
+  width: 527; height: 527
+  color: 'black'
+  
+  Rectangle {
+    x: scale * (width - 527) / 2
+    y: scale * (height - 527) / 2
+    width: parent.width
+    height: parent.height
+    color: 'black'
+    scale: Math.min(width, height) / 527
+    
+    Ext.PalindromeImage { objectName: 'img1'; source: 'img/R.png'; x: 186; y: 186 }
+    Ext.PalindromeImage { objectName: 'img2'; source: 'img/O.png'; x: 217; y: 186 }
+    Ext.PalindromeImage { objectName: 'img3'; source: 'img/T.png'; x: 248; y: 186 }
+    Ext.PalindromeImage { objectName: 'img4'; source: 'img/A.png'; x: 279; y: 186 }
+    Ext.PalindromeImage { objectName: 'img5'; source: 'img/S.png'; x: 310; y: 186 }
+    Ext.PalindromeImage { objectName: 'img6'; source: 'img/O.png'; x: 186; y: 217 }
+    Ext.PalindromeImage { objectName: 'img7'; source: 'img/P.png'; x: 217; y: 217 }
+    Ext.PalindromeImage { objectName: 'img8'; source: 'img/E.png'; x: 248; y: 217 }
+    Ext.PalindromeImage { objectName: 'img9'; source: 'img/R.png'; x: 279; y: 217 }
+    Ext.PalindromeImage { objectName: 'img10'; source: 'img/A.png'; x: 310; y: 217 }
+    Ext.PalindromeImage { objectName: 'img11'; source: 'img/T.png'; x: 186; y: 248 }
+    Ext.PalindromeImage { objectName: 'img12'; source: 'img/E.png'; x: 217; y: 248 }
+    Ext.PalindromeImage { objectName: 'img13'; source: 'img/N.png'; x: 248; y: 248 }
+    Ext.PalindromeImage { objectName: 'img14'; source: 'img/E.png'; x: 279; y: 248 }
+    Ext.PalindromeImage { objectName: 'img15'; source: 'img/T.png'; x: 310; y: 248 }
+    Ext.PalindromeImage { objectName: 'img16'; source: 'img/A.png'; x: 186; y: 279 }
+    Ext.PalindromeImage { objectName: 'img17'; source: 'img/R.png'; x: 217; y: 279 }
+    Ext.PalindromeImage { objectName: 'img18'; source: 'img/E.png'; x: 248; y: 279 }
+    Ext.PalindromeImage { objectName: 'img19'; source: 'img/P.png'; x: 279; y: 279 }
+    Ext.PalindromeImage { objectName: 'img20'; source: 'img/O.png'; x: 310; y: 279 }
+    Ext.PalindromeImage { objectName: 'img21'; source: 'img/S.png'; x: 186; y: 310 }
+    Ext.PalindromeImage { objectName: 'img22'; source: 'img/A.png'; x: 217; y: 310 }
+    Ext.PalindromeImage { objectName: 'img23'; source: 'img/T.png'; x: 248; y: 310 }
+    Ext.PalindromeImage { objectName: 'img24'; source: 'img/O.png'; x: 279; y: 310 }
+    Ext.PalindromeImage { objectName: 'img25'; source: 'img/R.png'; x: 310; y: 310 }
+  }
+}