;;; linedraw.el --- draw pictures with line characters

;; Copyright (C) 1994 Eberhard Mattes

;; Author: Eberhard Mattes <mattes@azu.informatik.uni-stuttgart.de>
;; Keywords: emx

;; This file is part of GNU Emacs.

;; GNU Emacs 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 2, or (at your option)
;; any later version.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:
;;
;; Use M-S-left, M-S-up, M-S-down, and M-S-right to draw pictures.
;;

;;; Bugs:
;;
;; To be able to put the cursor at positions beyond the end of the line,
;; this code has sometimes to add whitespace to the end of lines.  After
;; drawing a picture, you might want to remove all whitespace at the end
;; of all lines with (replace-regexp "[ \t]+$" "").
;;

;;; Code:

(require 'picture)

;; User interface

(defun linedraw-style (style)
  "Set the style for drawing lines.
STYLE is a number indicating the style.  Available styles are:
0  use characters - | and +
1  use single line graphic characters
2  use double line graphic characters
3  use mixed line graphic characters: single lines horizontally,
     double lines vertically (code page 437 only)
4  use mixed line graphic characters: double lines horizontally,
     single lines vertically (code page 437 only)."
  (interactive "NStyle (0 through 4): ")
  (cond ((memq style '(0 1 2))
         (setq linedraw-style (vector style style style style)))
        ((= style 3)
         (setq linedraw-style '[1 2 2 1]))
        ((= style 4)
         (setq linedraw-style '[2 1 1 2]))
        (t (error "Invalid style")))
  ;; As finding the closest matching character depends on the current
  ;; style, flush the cache now
  (setq linedraw-cache nil))

(defun linedraw-left ()
  "Draw line graphic, move point to the left."
  (interactive)
  (linedraw-move 0 -1 0))

(defun linedraw-right ()
  "Draw line graphic, move point to the right."
  (interactive)
  (linedraw-move 3 1 0))

(defun linedraw-up ()
  "Draw line graphic, move point up."
  (interactive)
  (linedraw-move 1 0 -1))

(defun linedraw-down ()
  "Draw line graphic, move point down."
  (interactive)
  (linedraw-move 2 0 1))

(global-set-key [M-S-left] 'linedraw-left)
(global-set-key [M-S-up] 'linedraw-up)
(global-set-key [M-S-down] 'linedraw-down)
(global-set-key [M-S-right] 'linedraw-right)

;; Internal code

(defvar linedraw-style '[1 1 1 1]
  "The style used for drawing lines.
The value is a vector [LEFT UP DOWN RIGHT] of style codes.
Use the command `linedraw-style' to set this variable.")

(defconst linedraw-characters
  '((205 [2 nil nil 2])
    (186 [nil 2 2 nil])
    (196 [1 nil nil 1])
    (179 [nil 1 1 nil])
    (218 [nil nil 1 1])
    (194 [1 nil 1 1])
    (191 [1 nil 1 nil])
    (195 [nil 1 1 1])
    (197 [1 1 1 1])
    (180 [1 1 1 nil])
    (192 [nil 1 nil 1])
    (193 [1 1 nil 1])
    (217 [1 1 nil nil])
    (201 [nil nil 2 2])
    (203 [2 nil 2 2])
    (187 [2 nil 2 nil])
    (204 [nil 2 2 2])
    (206 [2 2 2 2])
    (185 [2 2 2 nil])
    (200 [nil 2 nil 2])
    (202 [2 2 nil 2])
    (188 [2 2 nil nil])
    (213 [nil nil 1 2])
    (209 [2 nil 1 2])
    (184 [2 nil 1 nil])
    (198 [nil 1 1 2])
    (216 [2 1 1 2])
    (181 [2 1 1 nil])
    (212 [nil 1 nil 2])
    (207 [2 1 nil 2])
    (190 [2 1 nil nil])
    (214 [nil nil 2 1])
    (210 [1 nil 2 1])
    (183 [1 nil 2 nil])
    (199 [nil 2 2 1])
    (215 [1 2 2 1])
    (182 [1 2 2 nil])
    (211 [nil 2 nil 1])
    (208 [1 2 nil 1])
    (189 [1 2 nil nil])
    (43 [0 0 0 0 ])
    (45 [0 nil nil 0])
    (124 [nil 0 0 nil]))
  "Alist of elements (CHAR VECTOR) for defining linedraw characters.
CHAR is a character code, VECTOR is a vector [LEFT UP DOWN RIGHT]
of style codes.")

(defvar linedraw-cache nil
  "Alist of elements (VECTOR CHAR).
This is a reverse of linedraw-characters, built as needed.")

(defun linedraw-move (dir dx dy)
  "Draw line graphic and move.
DIR is the direction slot of a vector (0 through 3), DX and DY
are the distances to move right and down, respectively."
  (let ((char-left (preceding-char))
        (char-right (char-after (1+ (point))))
        (char-up (above-char))
        (char-down (below-char))
        (char-point (following-char))
        attr char)
    (setq attr (copy-sequence (linedraw-decode char-point)))
    (aset attr 0 (aref (linedraw-decode char-left) 3))
    (aset attr 1 (aref (linedraw-decode char-up) 2))
    (aset attr 2 (aref (linedraw-decode char-down) 1))
    (aset attr 3 (aref (linedraw-decode char-right) 0))
    (aset attr dir (aref linedraw-style dir))
    (setq char (linedraw-make attr))
    (if char
        (progn
          (insert char)
          (or (eolp)
              (delete-char 1))))
    (or (= dx 1)
        (forward-char (1- dx)))
    (or (= dy 0)
        (picture-move-down dy))))

(defun above-char ()
  "Return the character above point, or 0 if not possible."
  (let ((col (current-column)))
    (save-excursion
      (if (/= (forward-line -1) 0)
          0
        (move-to-column col)
        (string-to-char (buffer-substring (point) (1+ (point))))))))

(defun below-char ()
  "Return the character below point, or 0 if not possible."
  (let ((col (current-column)))
    (save-excursion
      (if (/= (forward-line 1) 0)
          0
        (move-to-column col)
        (if (eobp)
            0
          (string-to-char (buffer-substring (point) (1+ (point)))))))))

(defun linedraw-decode (char)
  (or (car (cdr (assoc char linedraw-characters)))
      [nil nil nil nil]))

(defun linedraw-make (attr)
  "Return a character matching ATTR in the current linedraw style.
ATTR is a vector [LEFT UP DOWN RIGHT] of style codes.  The character
shall have a line in direction i if the ith element of the vector
is non-nil.  The element specifies the style of the line.
If no matching character is found, return nil."
  (let ((elt (assoc attr linedraw-cache))
        (tail linedraw-characters)
        (best-score -1)
        vec result score idx)
    (if elt
        (car (cdr elt))
      (while (consp tail)
        (setq elt (car tail))
        (setq tail (cdr tail))
        (setq vec (car (cdr elt)))
        (setq score 0 idx 0)
        (while (< idx 4)
          (cond ((eq (aref attr idx) (aref vec idx))
                 (setq score (+ 25 score)))
                ((eq (aref vec idx) (aref linedraw-style idx))
                 (setq score (+ 5 score)))
                ((aref vec idx)
                 (setq score (1+ score))))
          (setq idx (1+ idx)))
        (if (> score best-score)
            (setq result (car elt)
                  best-score score)))
      (setq linedraw-cache (append (list (list attr result)) linedraw-cache))
      result)))

;;; linedraw.el ends here
