diff --git a/lisp/cf-map-test.el b/lisp/cf-map-test.el new file mode 100644 index 0000000..c3fc590 --- /dev/null +++ b/lisp/cf-map-test.el @@ -0,0 +1,66 @@ +;;; cf-map-test.el --- -*- lexical-binding: t -*- + +;; Copyright (C) 2024 Benson Chu + +;; Author: Benson Chu +;; Created: [2024-04-26 07:05] + +;; This file is not part of GNU Emacs + +;; This program 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. + +;; This program 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 . + +;;; Commentary: + +;;; Code: +(require 'cf-map) + +(ert-deftest inside-test () + (should-not (cfmap--inside '(1 . 10) '(2 . 5))) + (should-not (cfmap--inside '(1 . 10) '(8 . 12))) + (should-not (cfmap--inside '(5 . 10) '(2 . 7))) + (should (cfmap--inside '(2 . 5) '(1 . 10)))) + +(ert-deftest overlapping-test () + (should (cfmap-overlapping '(1 . 10) '(2 . 5))) + (should (cfmap-overlapping '(1 . 10) '(8 . 12))) + (should (cfmap-overlapping '(5 . 10) '(2 . 7))) + (should (cfmap-overlapping '(2 . 5) '(1 . 10))) + + (should-not (cfmap-overlapping '(1 . 2) '(3 . 4))) + (should-not (cfmap-overlapping '(5 . 6) '(3 . 4)))) + +(ert-deftest regionify-one-region () + (should (= 1 (length (cfmap-regionify '((1 . 10) (2 . 5)))))) + (should (= 1 (length (cfmap-regionify '((1 . 10) (8 . 12)))))) + (should (= 1 (length (cfmap-regionify '((5 . 10) (2 . 7)))))) + (should (= 1 (length (cfmap-regionify '((2 . 5) (1 . 10)))))) + + (should (= 2 (length (cfmap-regionify '((1 . 2) (3 . 4))))))) + +(ert-deftest test-subregions () + ;; This is one region with 2 sub-regions + (should (= 2 + (length + (plist-get (car (cfmap-regionify '((1 . 10) (2 . 3) (4 . 5)))) + :subregions)))) + ;; One subregion, since things overlap + (should (= 1 + (length + (plist-get (car (cfmap-regionify '((1 . 10) (2 . 4) (3 . 5)))) + :subregions))))) + +;; (ert-run-tests-interactively t) + +(provide 'cf-map-test) +;;; cf-map-test.el ends here diff --git a/lisp/cf-map.el b/lisp/cf-map.el index 37170d3..2a6e10b 100644 --- a/lisp/cf-map.el +++ b/lisp/cf-map.el @@ -498,7 +498,7 @@ If REMOVE is non-nil, remove cfmap from other modes." (if (eq (point) (line-end-position)) (insert "|" (make-string arrow-length ? )) (delete-char 1) - (if (eq (point) (line-end-position)) + (if (not (looking-at-p "|")) (insert "|") (insert "+")))) ((eq type 'ingress) @@ -512,13 +512,13 @@ If REMOVE is non-nil, remove cfmap from other modes." (make-string arrow-length ?-)))))) (my-next-line () (forward-line 1))) - (goto-line (1+ start)) + (goto-line start) (insert-arrow-part (if (eq dir 'up) 'ingress 'egress)) (let ((i 0) - (end (abs (- start end)))) + (end (1- (abs (- start end))))) (while (< i end) (my-next-line) (insert-arrow-part 'line) @@ -531,20 +531,85 @@ If REMOVE is non-nil, remove cfmap from other modes." (defvar cfmap-test '(-1 - (5 . 20) - (10 . 2) - (1 . 22) + (5 . 11) + (7 . 3) + (15 . 18) + (2 . 22) + (24 . 30) ;; (22 . 25) )) +(defun cfmap--point-inside (p r) + (and + (< (car r) p) + (< p (cdr r)))) + +(defun cfmap--inside (r1 r2) + (and + (cfmap--point-inside (car r1) r2) + (cfmap--point-inside (cdr r1) r2))) + +(defun cfmap-overlapping (r1 r2) + (or + (cfmap--point-inside (car r2) r1) + (cfmap--point-inside (cdr r2) r1) + (cfmap--inside r1 r2))) + +(defun cfmap-regionify (list) + (let ((points (sort (cdr cfmap-test) + (lambda (x y) + (< (car x) (car y))))) + (remaining list) + regions + cur-region) + (labels ((make-one-region + () + (let ((region-over nil) + (depth 0) + the-region super-region + sub-regions) + (while (and (not region-over) + (not (zerop (length remaining)))) + (let* ((curr-region (car remaining)) + (curr-start (car curr-region)) + (curr-end (cdr curr-region))) + (cond + ((not super-region) + (push curr-region the-region) + (setq super-region (copy-tree curr-region) + remaining (cdr remaining))) + ((not (cfmap-overlapping super-region curr-region)) + ;; Region is officially over + (setq region-over t)) + ((not (cfmap--inside curr-region super-region)) + ;; Extend current region + (push curr-region the-region) + (setcdr super-region curr-end) + (setq remaining (cdr remaining))) + (t + (push (make-one-region) sub-regions))))) + (list :region (reverse the-region) + :subregions (reverse sub-regions))))) + (while (not (zerop (length remaining))) + (push (make-one-region) regions)) + ) + regions)) + +(defun cfmap-max-live (region) + ) + +;; (cfmap-regionify cfmap-test) + (defvar cfmap-arrow-depth 0) (progn (with-current-buffer (get-buffer "*scratch0*") (setq cfmap-arrow-depth 3) (erase-buffer) + ;; (dotimes (i 637) + ;; (insert (format "%3d" i) "\n")) (dotimes (i 637) - (insert (format "%3d" i) "\n")) + (insert "\n")) (let* ((lines (reverse (cdr cfmap-test))) (len (length lines)) (counter 0)) @@ -553,8 +618,8 @@ If REMOVE is non-nil, remove cfmap from other modes." (b (cdr l)) start end direction) (if (< a b) - (cfmap-draw-arrow 'down a b 3 (1+ (* counter 3)) (* 3 (- len counter))) - (cfmap-draw-arrow 'up b a 3 (1+ (* counter 3)) (* 3 (- len counter)))) + (cfmap-draw-arrow 'down a b 0 (* counter 3) (* 3 (- len counter))) + (cfmap-draw-arrow 'up b a 0 (* counter 3) (* 3 (- len counter)))) ) (cl-incf counter)))))