pestctrl/emacs-config
1
0
Fork 0
mirror of https://github.com/pestctrl/emacs-config.git synced 2026-02-16 08:14:15 +00:00
Code Issues Projects Releases Packages Wiki Activity

Ehhh, I wanna go a different direction

Browse source
This commit is contained in:
Benson Chu 2024-04-26 08:11:12 -05:00
parent 4c026227c8
commit 1015f5c9a5
2 changed files with 140 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
lisp/cf-map-test.el Normal file
View file

@ -0,0 +1,66 @@
;;; cf-map-test.el --- -*- lexical-binding: t -*-
;; Copyright (C) 2024 Benson Chu
;; Author: Benson Chu <bensonchu457@gmail.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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

83
lisp/cf-map.el
View file

@ -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)))))