From: miya@kansai.oki.co.jp (Toshihiko Miyazaki)
Newsgroups: fj.editor.emacs
Subject: utility for draw lines
Date: 28 Jul 92 09:45:38 GMT
Reply-To: miya@kansai.oki.co.jp
Distribution: fj
Organization: Oki Electric Industry Co.,Ltd. Kansai Lab. Osaka, Japan.

$@5\:j!w2-EE5$$G$9!#(J

  $@@hF|!"$3$N%K%e!<%9%0%k!<%W$G(J jserver + EGG $@$N%Q%C%A$K4X(J$@$9$k<ALd(J
$@$r$5$;$FD:$-$^$7$?!#K\F|$O$3$N$*Ni$b7s$M$F!"2f!9$,:n$C$?@~0z$-%W(J
$@%m%0%i%`$r$*FO$1$7$^$9!#(J

  (La)Tex $@$d(J X-window $@$N$*3(=q$-%=%U%H$J$I$NIa5Z$K$h$j$"$^$j<{MW(J
$@$O$J$$$+$bCN$l$^$;$s$,!"(Jplain2 $@$N%f!<(J$@%6$J$I$K$OM-MQ$+$bCN$l$^$;$s!#(J

$@!t(J   $@@5D>8@$C$F!":n<T$G$"$k;d<+?H$O$[$H$s$I;H$C$?$3$H$,$J$$$N$G!"%P(J
$@!t(J $@%0$bM-$k$+$H;W$$$^$9!#$^$?!"(JEmacs Lisp $@$N;H$$J}$b$=$l$[$I$&$^$/$O(J
$@!t(J $@$J$$$H;W$$$^$9$,!"3'MM$N$*Lr$KN)(J$@$F$P9,$$$G$9!#(J

  $@;HMQK!$O!"(Jregion $@$r;XDj$7$FE,Ev$J4X?t!JNc$($P(J pic:write-lines$@!K(J
$@$r8F$V$@$1$G$9!#(J $@@~(J$@$N8rE@$b$=$l$J$j$K=hM}$7$F$/$l$^$9!#BP1~$7$F$$(J
$@$k@~<o$O!":Y$$7S@~$HB@$$7S@~$=$l$K(J "+" $@$H(J "-" $@$r;H$C$?(J$@@~$G$9!#(J

  $@FbItE*$K$O(J picture-mode $@$r;H$C$F$$$^$9$N$G!"@~>e$K$"$kJ8;z$OA4(J
$@$F>e=q$-$5$l$F$7$^$$$^$9!#(J$@Nc$($P!"0J2<$N%F%-%9%H$G!"(Ja $@$H(J b $@$N%]%$(J
$@%s%H$r(J region $@$H$7$F(J pic:write-lines $@$r8F$V$H!"(J

		      a $@$3(J$@$l$O(J
			$@%F%9%H(J
			$@$G$9!#(J b

$@0J2<$N$h$&$J7k2L$H$J$j$^$9!#(J

		      $@(#(!(!(!($(J
		      $@("%F%9%H("(J
		      $@(&(!(!(!(%(J

$@$5$i$K>e5-$N%F%-%9%H$G(J "$@%9(J" $@$N>e$H2<$r(J region $@$H$7$F(J pic:write-lines
$@$r<B9T$9$k$H(J
		      $@(#(!(((!($(J
		      $@("%F("%H("(J
		      $@(&(!(*(!(%(J
$@$H$J$j$^$9!#(J

  $@H>3Q$HA43Q$N07$$$G@~$,Mp$l$k$3$H(J$@$,$"$j$^$9$,!"8f0&7I$H$$$&$3$H(J
$@$G(J :-)
					$@!]!]!]!]!]!]!]!]!]!]!]!]!]!]!]!](J
					$@5\:jIRI'(J(miya@kansai.oki.co.jp)


----------------- cut here ------ cut here --------------
;; rectangle.el  ---   Writing a rectangular and a line.

;;   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 1, 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.

;;      (1) Some suggestions for your .emacs file
;;
;;                 (autoload 'pic:write-lines "rectangle" "rectangle" t)
;;                 (autoload 'pic:write-char-lines "rectangle" "rectangle" t)
;;                 (global-set-key "\C-c\C-l" 'pic:write-lines)
;;                 (global-set-key "\C-c\C-t" 'pic:write-char-lines)
;; 		Usage:
;;                     C-c C-l  --> thin line  such that "$@(!(!(J".
;;                 C-u C-c C-l  --> thick line such that "$@(,(,(J".
;;                     C-c C-t  --> char line  such that "+----+".
;;                     C-x u    --> undo.
;;
;;      (2) Please copy this file to 'rectangle.el' in the directory in
;;          your 'load-path'.
;;
;;   Author:  Toshihiko Miyazaki (miya@kansai.oki.co.jp)
;;            Hideki Yamamoto    (hyama@kansai.oki.co.jp)
;;
;;   History:
;;	    Jul.28,1992.  Ver.2.1	pic:move-down-char bug fixied
;;	    Fri.17,1992.  Ver.2		char line
;;          Mar.25,1992.  Ver.1		thick line
;;	    ???.??,1989.  Ver.0		thin line
;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;    $@#2%P%$%H%3!<%IJ8;z$r;H$C$?@~?^7A$NIA2h(J
;;
(defvar pic:line-chars-thin
  (let ((v (make-vector 11 0)))
    (aset v 0  "$@(#(J")
    (aset v 1  "$@(((J")
    (aset v 2  "$@($(J")
    (aset v 3  "$@('(J")
    (aset v 4  "$@(+(J")
    (aset v 5  "$@()(J")
    (aset v 6  "$@(&(J")
    (aset v 7  "$@(*(J")
    (aset v 8  "$@(%(J")
    (aset v 9  "$@("(J")
    (aset v 10 "$@(!(J")
    v))
(defvar pic:line-chars-thick
  (let ((v (make-vector 11 0)))
    (aset v 0  "$@(.(J")
    (aset v 1  "$@(3(J")
    (aset v 2  "$@(/(J")
    (aset v 3  "$@(2(J")
    (aset v 4  "$@(6(J")
    (aset v 5  "$@(4(J")
    (aset v 6  "$@(1(J")
    (aset v 7  "$@(5(J")
    (aset v 8  "$@(0(J")
    (aset v 9  "$@(-(J")
    (aset v 10 "$@(,(J")
    v))
(defvar pic:line-chars-mix-n
  (let ((v (make-vector 5 0)))
    (aset v 0  "$@(8(J")
    (aset v 1  "$@(<(J")
    (aset v 2  "$@(;(J")
    (aset v 3  "$@(>(J")
    (aset v 4  "$@(:(J")
    v))

(defvar pic:line-chars-mix-k
  (let ((v (make-vector 5 0)))
    (aset v 0  "$@(=(J")
    (aset v 1  "$@(7(J")
    (aset v 2  "$@(@(J")
    (aset v 3  "$@(9(J")
    (aset v 4  "$@(?(J")
    v))

(defvar pic:line-chars-v      pic:line-chars-thin)
(defvar pic:line-chars-o      pic:line-chars-thick)
(defvar pic:line-chars-mix-v  pic:line-chars-mix-n)
(defvar pic:line-chars-mix-o  pic:line-chars-mix-k)

(defvar pic:line-type-flag 'thin)

(defun pic:write-lines (beg end sw)
  (interactive "r\np")
  (if (eq sw 4)
      (progn
       (setq pic:line-chars-v      pic:line-chars-thick)
       (setq pic:line-chars-o      pic:line-chars-thin)
       (setq pic:line-chars-mix-v  pic:line-chars-mix-k)
       (setq pic:line-chars-mix-o  pic:line-chars-mix-n)
       (setq pic:line-type-flag 'thick)))

  (unwind-protect
      (save-excursion
	(let (tmp)
	  (if (> beg end)
	      (progn (setq tmp beg) (setq beg end) (setq end tmp))))
	(picture-mode)
	(let (clm0 clm1 line0 line1)
	  (goto-char end)
	  (setq clm1 (current-column))
	  (setq line1 (count-lines 1 (point)))
	  (if (zerop clm1)
	      (setq line1 (1+ line1)))
	  (goto-char beg)
	  (setq clm0 (current-column))
	  (setq line0 (count-lines 1 (point)))
	  (if (zerop clm0)
	      (setq line0 (1+ line0)))
	  (cond ((> clm0 clm1)
		 (picture-backward-column ( - clm0 clm1 ))
		 (pic:write-box clm1 line0 clm0 line1))
		((< clm0 clm1)
		 (pic:write-box clm0 line0 clm1 line1))
		((eq clm0 clm1)
		 (pic:write-v-line (1+ (- line1 line0))
				   (aref pic:line-chars-v 1)
				   (aref pic:line-chars-v 4)
				   (aref pic:line-chars-v 7)
				   (aref pic:line-chars-mix-v 0)
				   (aref pic:line-chars-mix-v 2)
				   (aref pic:line-chars-mix-v 4))))))
    (picture-mode-exit)
    (setq pic:line-chars-v pic:line-chars-thin)
    (setq pic:line-chars-o pic:line-chars-thick)
    (setq pic:line-chars-mix-v  pic:line-chars-mix-n)
    (setq pic:line-chars-mix-o  pic:line-chars-mix-k)
    (setq pic:line-type-flag 'thin)))

(defun pic:write-box (clm0 line0 clm1 line1)
  (let ((clms (1+ (- clm1 clm0)))
	(lines (1+ (- line1 line0 1))))
    (if (not (zerop (mod clms 2)))
	(setq clms (1+ clms)))
    (if (eq line0 line1)
	(pic:write-h-line clms
			  (aref pic:line-chars-v 3)
			  (aref pic:line-chars-v 4)
			  (aref pic:line-chars-v 5)
			  (aref pic:line-chars-mix-o 1)
			  (aref pic:line-chars-mix-o 2)
			  (aref pic:line-chars-mix-o 3)
			  )
      (set-mark (point))
      (pic:write-h-line-b clms
			(aref pic:line-chars-v 0)
			(aref pic:line-chars-v 1)
			(aref pic:line-chars-v 2)
			(aref pic:line-chars-mix-o 2))
      (pic:move-down)
      (while (> lines 1)
	(set-mark (point))
	(pic:write-wall clms
			(aref pic:line-chars-v 3)
			(aref pic:line-chars-v 9)
			(aref pic:line-chars-v 5))
	(setq lines (1- lines))
	(pic:move-down))
      (pic:write-h-line-b clms
			(aref pic:line-chars-v 6)
			(aref pic:line-chars-v 7)
			(aref pic:line-chars-v 8)
			(aref pic:line-chars-mix-v 2)))))

(defun pic:move-down ()
  (let (chr)
    (goto-char (mark))
    (setq chr (pic:get-char))
    (picture-set-motion 1 0)
    (picture-insert-string chr)))

(defun pic:write-wall (num bchr mchr echr)
  (picture-set-motion 0 1)
  (save-excursion
    (let (chr p len)
      (setq chr (pic:get-char))
      (cond ((equal chr (aref pic:line-chars-v 10)) ; "$@(!(J"
	     (picture-insert-string bchr))
	    (t (picture-insert-string mchr)))

      (setq p (point))
      (end-of-line)
      (setq len (- (point) p)) ;1
      (goto-char p)
      (if (> len (- num 4))  ;***
	  (goto-char (+ (point) (- num 4)))
	(end-of-line)
	(if (not (zerop (mod (- num len) 2)))
	    (picture-insert-string " "))

	(setq num (/ (- num 2 len) 2))
	(while (> num 1)
	  (picture-insert-string "$@!!(J")
	  (setq num (- num 1))))
      (setq chr (pic:get-char))
      (cond ((equal chr (aref pic:line-chars-v 10)) ; "$@(!(J"
	     (picture-insert-string echr))
	    (t (picture-insert-string mchr))))))

(defun pic:write-h-line-b (num bchr mchr echr mchr-mix)
  (picture-set-motion 0 1)
  (let ((flg 'start)
	chr)
    (picture-insert-string bchr)
    (setq num (- num 2))
    (while (> num 3)
      (setq chr (pic:get-char))
      (cond ((equal chr (aref pic:line-chars-v 9)) ; "$@("(J"
	     (picture-insert-string mchr))
	    ((equal chr (aref pic:line-chars-o 9)) ; "$@(-(J"
	     (picture-insert-string mchr-mix))
	    (t (picture-insert-string (aref pic:line-chars-v 10))))
      (setq num (- num 2)))
    (picture-insert-string echr)))

(defun pic:write-h-line (num bchr mchr echr bchr-mix mchr-mix echr-mix)
  (picture-set-motion 0 1)
  (let ((flg 'start)
	chr)
    (while (> num 1)
      (setq chr (pic:get-char))
      (cond ((equal chr (aref pic:line-chars-v 9)) ; "$@("(J"
	     (cond ((eq flg 'start)
		    (picture-insert-string bchr)
		    (setq flg 'middle))
		   ((< num 4)
		    (picture-insert-string echr))
		   ((eq flg 'middle)
		    (picture-insert-string mchr))))
	    ((equal chr (aref pic:line-chars-o 9)) ; "$@(-(J"
	     (cond ((eq flg 'start)
		    (picture-insert-string bchr-mix)
		    (setq flg 'middle))
		   ((< num 4)
		    (picture-insert-string echr-mix))
		   ((eq flg 'middle)
		    (picture-insert-string mchr-mix))))
	    (t (setq flg 'middle)
	       (picture-insert-string (aref pic:line-chars-v 10))))
      (setq num (- num 2)))))

(defun pic:write-v-line (num bchr mchr echr bchr-mix mchr-mix echr-mix)
  (picture-set-motion 1 0)
  (save-excursion
    (let ((flg 'start)
	  p len chr)
      (while (> num 0)
	(setq chr (pic:get-char))
	(cond ((equal chr (aref pic:line-chars-v 10)) ; "$@(!(J"
	       (cond ((eq flg 'start)
		      (picture-insert-string bchr)
		      (setq flg 'middle))
		     ((eq num 1)
		      (picture-insert-string echr))
		     ((eq flg 'middle)
		      (picture-insert-string mchr))))
	      ((equal chr (aref pic:line-chars-o 10)) ; "$@(,(J"
	       (cond ((eq flg 'start)
		      (picture-insert-string bchr-mix)
		      (setq flg 'middle))
		     ((eq num 1)
		      (picture-insert-string echr-mix))
		     ((eq flg 'middle)
		      (picture-insert-string mchr-mix))))
	      (t (setq flg 'middle)
		 (picture-insert-string (aref pic:line-chars-v 9))))
	(setq num (- num 1))))))

(defun pic:get-char ()
  (if (> (+ 2 (point)) (point-max))
      ""
    (buffer-substring (point) (+ 2 (point)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;    "+" "-" "|" $@$r;H$C$?@~?^7A$NIA2h(J
;;
(defun pic:write-char-lines (st ed)
  (interactive "r")
  (unwind-protect
      (save-excursion
	(let (clm0 clm1 ln0 ln1)
	  (picture-mode)
	  (goto-char ed)
	  (setq clm1 (current-column))
	  (setq ln1 (count-lines 1 (point)))
	  (if (zerop clm1)
	      (setq ln1 (1+ ln1)))
	  (goto-char st)
	  (setq clm0 (current-column))
	  (setq ln0 (count-lines 1 (point)))
	  (if (zerop clm0)
	      (setq ln0 (1+ ln0)))
	  (cond ((> clm0 clm1)
		 (pic:write-char-box clm1 ln0 clm0 ln1))
		((< clm0 clm1)
		 (pic:write-char-box clm0 ln0 clm1 ln1))
		((eq clm0 clm1)
		 (pic:write-v-char-line (1+ (- ln1 ln0)))))))
    (picture-mode-exit)))

(defun pic:get-column-line (p clm ln)
  (goto-char p)
  (setq clm (current-column))
  (setq ln (count-lines 1 (point)))
  (if (zerop clm)
      (setq ln (1+ ln))))

(defun pic:write-char-box (clm0 line0 clm1 line1)
  (let ((clms (1+ (- clm1 clm0)))
	(lines (1+ (- line1 line0 1))))
    (if (eq line0 line1)
	(pic:write-h-char-line clms)
      (pic:write-h-char-line-2 clms)
      (pic:move-down-char clm0)
      (while (> lines 1)
	(pic:write-char-wall clms)
	(setq lines (1- lines))
	(pic:move-down-char clm0))
      (pic:write-h-char-line-2 clms))))

(defun pic:write-h-char-line (clms)
  (picture-set-motion 0 1)
  (let (chr)
    (while (> clms 0)
      (setq chr (char-after (point)))
      (cond ((equal ?| chr)
	     (picture-insert-string "+"))
	    ((equal ?+ chr)
	     nil)
	    (t
	     (picture-insert-string "-")))
      (setq clms (1- clms)))))

(defun pic:write-h-char-line-2 (clms)
  (picture-set-motion 0 1)
  (picture-insert-string "+")
  (let (chr)
    (while (> clms 2)
      (setq chr (char-after (point)))
      (cond ((equal ?| chr)
	     (picture-insert-string "+"))
	    ((equal ?+ chr)
	     nil)
	    (t
	     (picture-insert-string "-")))
      (setq clms (1- clms))))
  (picture-insert-string "+"))

(defun pic:write-v-char-line (num)
  (picture-set-motion 1 0)
  (let (chr)
    (while (> num 0)
      (setq chr (char-after (point)))
      (cond ((equal ?- chr)
	     (picture-insert-string "+"))
	    ((equal ?+ chr)
	     nil)
	    (t
	     (picture-insert-string "|")))
      (setq num (1- num)))))

(defun pic:write-char-wall (clms)
  (picture-set-motion 0 1)
  (let (chr len
	(p (point)))
    (setq chr (char-after (point)))
    (cond ((equal ?- chr)
	   (picture-insert-string "+"))
	  ((equal ?+ chr)
	   t)
	  (t
	   (picture-insert-string "|")))
    (end-of-line)
    (setq len (- (point) p))
    (cond ((> len clms)
	   (goto-char p)
	   (goto-char (+ p (1- clms))))
	  ((< len clms)
	   (setq len (- clms len))
	   (while (> len 1)
	     (picture-insert-string " ")
	     (setq len (1- len)))))
    (setq chr (char-after (point)))
    (cond ((equal ?- chr)
	   (picture-insert-string "+"))
	  ((equal ?+ chr)
	   t)
	  (t
	   (picture-insert-string "|")))))

(defun pic:move-down-char (clm)
  (beginning-of-line)
  (next-line 1)
  (end-of-line)
  (cond ((< clm (current-column))
	 (backward-char (- (current-column) clm)))
	((> clm (current-column))
	 (let ((len (- clm (current-column))))
	   (while (> len 0)
	     (picture-insert-string " ")
	     (setq len (1- len)))))))

;;;; end of 'rectangle.el'
Newsgroups: fj.forsale