From 5e17b5d8f73d917368e9ccd730bdc030b5f343f1 Mon Sep 17 00:00:00 2001 From: c Date: Thu, 26 Dec 2024 11:56:13 +0100 Subject: [PATCH] =?UTF-8?q?better=20handle=20directionality=20of=20?= =?UTF-8?q?=E2=86=95=E2=86=94=20arrows?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- tests/bench15.el | 2 +- tests/bench16.el | 28 ++++++++++++++++++++++++ tests/uniline-bench.el | 40 ++++++++++++++++++++-------------- uniline.el | 49 +++++++++++++++++++++++++++++++++++++----- 4 files changed, 97 insertions(+), 22 deletions(-) create mode 100644 tests/bench16.el diff --git a/tests/bench15.el b/tests/bench15.el index 3981e1e..4b37fc5 100644 --- a/tests/bench15.el +++ b/tests/bench15.el @@ -20,7 +20,7 @@ ;; along with this program. If not, see . (uniline-bench -" a a a a a a a a a a a a a a a a a a a a a A A A a A A A A a S- A A S- a A A A A a a a S- a S- a a a a a a a a a a a a a a S- a S- S-" +" a a a a a a a a a a a a a a a a a a a a a A A A a A A A A a S- A A S- a A A A A a a a S- a S- a a a a a a a a a a a a a a S- a S- S- " "\ ╭──▷▶→▿▸↔──╮ diff --git a/tests/bench16.el b/tests/bench16.el new file mode 100644 index 0000000..2b9ce26 --- /dev/null +++ b/tests/bench16.el @@ -0,0 +1,28 @@ +;;; uniline.el --- Draw lines, boxes, & arrows with the keyboard -*- coding:utf-8; lexical-binding: t; -*- + +;; Copyright (C) 2024 Thierry Banel + +;; Author: Thierry Banel tbanelwebmin at free dot fr +;; Version: 1.0 +;; URL: https://github.com/tbanel/uniline + +;; Uniline is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; Uniline is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(uniline-bench +" a A a S- A S- C-a C-k C-y C-y a a a a C-a C-k C-y C-a C-y C-a A A A A A A" +"\ + + ▷ ↔ △ ↕ + ▶ ◁ ▲ ◁ + ↔ ↔ ↕ ↔ ") diff --git a/tests/uniline-bench.el b/tests/uniline-bench.el index 8cb7323..a7ef742 100644 --- a/tests/uniline-bench.el +++ b/tests/uniline-bench.el @@ -104,29 +104,34 @@ Do not call it directly." (insert "\")\n") (lisp-mode)) -(defun uniline-bench-run () - "Run all benches. -The benches are all files with *.el suffix. +(defun uniline-bench-run (&rest files) + "Run all benches, or a specified list. +When FILES is nil, th benches are all files with *.el suffix. Stops on the first error, presenting two buffers, - one with the actual drawing, - the other with the expected drawing, with points on the first difference. If there are no errors, a summary buffer is presented." (interactive) - (let ((buf (current-buffer)) - (nbpassed 0) - (nbfailed 0)) - (cl-loop - for file in (directory-files "." nil "\\.el$") - unless (equal "uniline-bench.el" file) - do - (load (format "%s%s" default-directory file) nil nil t) - (if uniline-bench-result - (cl-incf nbpassed) - (cl-incf nbfailed) - (message "%s FAILED" file))) + (unless files + (setq files + (delete "uniline-bench.el" (directory-files "." nil "\\.el$")))) + (let* ((buf (current-buffer)) + (nbpassed 0) + (nbfailed 0) + (failed + (cl-loop + for file in files + do + (load (format "%s%s" default-directory file) nil nil t) + (if uniline-bench-result + (cl-incf nbpassed) + (cl-incf nbfailed) + (message "%s FAILED" file)) + unless uniline-bench-result + collect file))) (switch-to-buffer buf) - (message "%s PASSED / %s FAILED" nbpassed nbfailed))) + (message "%s PASSED / %s FAILED %s" nbpassed nbfailed failed))) (if t (uniline-bench-run) @@ -135,5 +140,8 @@ If there are no errors, a summary buffer is presented." (profiler-stop) (profiler-report)) +(if nil + (uniline-bench-run "bench15.el" "bench16.el")) + (provide 'uniline-bench) ;;; uniline-bench.el ends here diff --git a/uniline.el b/uniline.el index 76ff441..3976954 100644 --- a/uniline.el +++ b/uniline.el @@ -756,7 +756,7 @@ without the fall-back characters.") (a ?▵ ?▹ ?▿ ?◃) ;; white *-pointing small triangle" (a ?▴ ?▸ ?▾ ?◂) ;; black *-pointing small triangle (a ?↕ ?↔ ?↕ ?↔) ;; up down arrow, left right arrow - + ;; Those commented-out arrows are monospaces and supported ;; by the 6 fonts. But they do not have 4 directions. ;;(a ?‹ ?› ?› ?‹) ;; single *-pointing angle quotation mark @@ -945,6 +945,17 @@ Here we selected only the fixed-size ones. This list is ciurcular in forward order.")) (eval-when-compile ; not needed at runtime + + (defun uniline--duplicate (list) + "Return not-nil if LIST is duplicate-free. +Using `eq'." + (while + (and + (cdr list) + (not (memq (car list) (cdr list)))) + (pop list)) + (cdr list)) + (defun uniline--make-hash (list) "Helper function to build `uniline--glyphs-reverse-hash-*'. Used only at package initialization. @@ -958,7 +969,14 @@ LIST is `uniline--glyphs-fbw'." (cl-loop for cc in (cdar ll) for i from 0 - do (puthash cc (cons i ll) hh)) + do (puthash + cc + (cons + (if (uniline--duplicate (car ll)) + t ; special case ↕↔↕↔ is NOT fully directional + i) ; fully directional, i gives the direction + ll) + hh)) ;; glyph is not directional, like ■ ● ◆ (puthash (cadar ll) (cons nil ll) hh)) ;; explicitly break out of circular list @@ -1997,12 +2015,31 @@ of the same command." (if (and repeat (< repeat 0)) (setq repeat (- repeat) back (not back))) - (let ((line ; something like (3 x ((a ?▲ ?▶ ?▼ ?◀) (a ?↑ ?→ ?↓ ?←) …)) + (let ((line + ;; line is something like: + ;; (3 ((a ?↑ ?→ ?↓ ?←) (a ?▲ ?▶ ?▼ ?◀) …)) + ;; △ △ △ △ △ current character is + ;; │ ╰──┴──┴──┴─╴one of those arrows + ;; ╰─────────────────╴oriented in this direction + ;; + ;; line can also be like: + ;; (t ((a ?↕ ?↔ ?↕ ?↔) (a ?↑ ?→ ?↓ ?←) …)) + ;; △ △ △ △ △ current character is + ;; │ ╰──┴──┴──┴─╴one of those arrows + ;; ╰─────────────────╴with no definite orientation + ;; + ;; or line may be like: + ;; (nil ((s ?■) (s ?▫) …)) + ;; △ △ current character is + ;; │ ╰────────╴this one + ;; ╰────────────────╴and it has NO orientation (gethash (uniline--char-after) (if back uniline--glyphs-reverse-hash-bw uniline--glyphs-reverse-hash-fw)))) - (if (and line (car line)) + (if (and + line ; current character is one the known glyphs + (fixnump (car line))) ; it has a north-south-east-west orientation (setq uniline--arrow-direction (car line))) (setq line (if line @@ -2111,7 +2148,9 @@ See `uniline--insert-glyph'." uniline--glyphs-reverse-hash-fw))) (when (car ligne) ;; if (point) is on a directional arrow (uniline--insert-char ;; then change its direction - (nth (1+ dir) (cadr ligne)))))) + (nth (1+ dir) (cadr ligne))) + (setq uniline--arrow-direction dir) + ))) ;; Run the following cl-loop to automatically write a bunch ;; of 4 interactive functions