Category : Printer + Display Graphics
Archive   : TED.ZIP
Filename : TED.LSP

; TED 2.1a
; Full screen line editor for AutoCAD text entities.
; Please read TED.DOC for installation and operation instructions.
; This is a shareware product. If you use TED, you must register.
; Copyright 1988 Alacrity

(defun c:TED (/ ss process escape modify key ent num entlst deltxt len nkey
i chglin txtlst tab display txtlin cursor ins mode comlin err
entdata txt modtxt clear x insert p lst delete chglst okey)
;---------------
; Error Handler
;---------------
(setq err *error*)
(defun *error* (msg)
(okey)
(clear)
(setq *error* err)
(princ msg)
(princ)
)
;--------------------------
; Process alphanumeric key
;--------------------------
(defun process ()
; Insert or Replace
(if ins
(progn
; Print change, make change to txt
(setq txt (strcat (substr txt 1 (1- p))
(princ (chr key))
(princ (substr txt p))))
(princ "\004")
; Add to pointer, length
(setq p (1+ p) len (1+ len))
; Position cursor
(cursor)
)
(progn
; Print change, make change to txt
(setq txt (strcat (substr txt 1 (1- p))
(princ (chr key))
(substr txt (1+ p))))
; Add to length if end of line
(if (> p len)
(progn
(setq len (1+ len))
(princ "\004")
)
)
; Add to pointer
(setq p (1+ p))
; Position cursor
(cursor)
)
)
)
;-----------------
; Position Cursor
;-----------------
(defun cursor ()
; Write current cursor position
(princ (strcat "\e[2;26H" (itoa p) " "
; Position cursor
"\e[" (itoa (+ 5 txtlin)) ";" (itoa p) "H"))
)
;---------------------
; Delete atom in list
;---------------------
(defun delete (lst p)
(cond
((zerop p) (cdr lst))
(T (cons (car lst) (delete (cdr lst) (1- p))))
)
)
;---------------------
; Insert atom in list
;---------------------
(defun insert (lst x p)
(cond
((zerop p) (cons x lst))
(T (cons (car lst) (insert (cdr lst) x (1- p))))
)
)
;---------------------
; Change current line
;---------------------
(defun chglin (i)
; Has text changed?
(if txt (chglst))
; Set variables
(setq txtlin (+ i txtlin) ; current text line
p 1 ; string position
txt (nth txtlin txtlst) ; current text string
len (strlen txt) ; length of text string
)
; Write current line number to status line
(princ (strcat "\e[2;15H" (itoa (1+ txtlin)) " "))
(cursor)
)
;--------------------
; Modify text entity
;--------------------
(defun modtxt ()
(setq entdata (entget (nth txtlin entlst)))
(entmod (subst (cons 1 txt) (assoc 1 entdata) entdata))
)
;--------------------
; Clear command line
;--------------------
(defun comlin () (princ "\e[3;1H\e[K"))
;-------------------
; Update text list
;-------------------
(defun chglst ()
; Has text changed
(if (/= txt (nth txtlin txtlst))
; Yes, update txtlst
(setq txtlst (insert (delete txtlst txtlin) txt txtlin))
)
)
;----------------------
; Toggle Insert ON/OFF
;----------------------
(defun mode ()
; Toggle
(setq ins (not ins))
; Save cursor position, locate cursor on status line
; Print insert mode
; restore cursor position
(princ (strcat "\e[s\e[2;1H" (if ins "Insert " "Replace") "\e[u"))
)
;-------------------------
; Clear screen of garbage
;-------------------------
(defun clear ()
(okey)
(princ "\e[2J")
(repeat 24 (terpri))
(graphscr)
(princ "\n \n \n \n")
)
;---------------------
; Generate TED display
;---------------------
(defun display ()
; Clear screen
(textscr)
; Redefine keys
(nkey)
; Title line
(princ
(strcat
"\e[2J\e[0mTED 2.1a (c) 1988 Alacrity \e[7mF2\e[0mModify\e[7mNA\e[0mJoin"
"\e[7mNA\e[0mBreak\e[7mNA\e[0mCopy\e[7mNA\e[0mPaste\e[7mNA\e[0mUpper\e[7mNA"
"\e[0mLower\n"
(if ins "Insert " "Replace")
" Line "
(itoa (1+ txtlin))
"\e[2;19HColumn "
(itoa p)
"\e[2;31H\020 \021 \036 \037 Home End Ins Del BackSpace TAB ShftTAB ESC\n"
)
)
; Tab stops line
(repeat 16 (princ tab))
; Write text strings
(mapcar
'(lambda (x)
(princ (strcat x "\004\n"))
)
txtlst
)
)
;--------------------
; Delete Text Entity
;--------------------
(defun deltxt ()
; Clear screen
(clear)
; Delete entity
(entdel (nth txtlin entlst))
; Update variables
(setq txtlst (delete txtlst txtlin)
entlst (delete entlst txtlin)
txt nil
num (1- num)
)
; Still have text?
(if (zerop num)
; No, quit
nil
; Yes,
(progn
; Regen display
(display)
; Reposition cursor
(if (zerop txtlin)
(chglin 0)
(chglin -1)
)
)
)
)
;---------------------------
; Modify text, Regen screen
;---------------------------
(defun modify ()
(clear)
(modtxt)
; Update txtlst
(chglst)
; Continue or Quit
(princ "Any key to continue, [ESC] to end.")
(if (= (cadr (grread)) 27)
; ESCAPE (Quit)
(escape)
; Continue
(progn
(display)
(cursor)
)
)
)
;------------------
; Ecape (Quit TED)
;------------------
(defun escape ()
; Has text changed?
(chglst)
; Clear command line
(comlin)
; Update text?
(initget "Yes No")
(setq key (getkword "Make changes? No/: "))
; Clear screen
(clear)
(if (/= key "No")
(mapcar
'(lambda (ent txt)
; Get entity list
(setq entdata (entget ent))
; Has text been changed?
(if (/= (cdr (assoc 1 entdata)) txt)
; Yes, make changes
(entmod (subst (cons 1 txt) (assoc 1 entdata) entdata))
)
)
entlst txtlst
)
)
; Quit TED
nil
)
;---------------------
; New Key Definitions
;---------------------
(defun nkey ()
(princ "\e[0;75;0;115p\e[0;77;0;116p\e[0;71;0;119p\e[0;79;0;117p\e[0;73;0;132p")
(princ "\e[0;81;0;118p\e[0;82;0;23p\e[0;83;0;32p\e[0;72;0;132p\e[0;80;0;118p")
)
;---------------------
; Old Key Definitions
;---------------------
(defun okey ()
(princ "\e[0;75;0;75p\e[0;77;0;77p\e[0;71;0;71p\e[0;74;0;74p\e[0;73;0;73p")
(princ "\e[0;81;0;81p\e[0;82;0;82p\e[0;83;0;83p\e[0;72;0;72p\e[0;80;0;80p")
)
;----------------------------
; Initialize some parameters
;----------------------------
(gc)
(setvar "CmdEcho" 0)
(setq num 0
p 1
txtlin 0
tab (strcat "+" (chr 205) (chr 205) (chr 205) (chr 205))
)
;-----------------------------------------------------------
; Create entlst of text entities and txtlst of text strings
;-----------------------------------------------------------
(if (setq ss (ssget))
(progn
(while (and (setq ent (ssname ss 0)) (< num 15))
(if (equal (cdr (assoc 0 (entget ent))) "TEXT")
(setq entlst (append entlst (list ent))
txtlst (append txtlst
(list (substr (cdr (assoc 1 (entget ent))) 1 79)))
num (1+ num)
)
)
(ssdel ent ss)
)
(setq txt (nth 0 txtlst)
ent (nth 0 entlst)
)
)
)
;--------------
; Main routine
;--------------
; Are there any text entities selected?
(if entlst
; Yes, edit them
(progn
; Draw display
(display)

; Initialize cursor position
(chglin 0)
(while
(and
; Are there text lines to edit?
(if (zerop num) nil T)
; Get input from user
(if (= (car (setq key (grread))) 2)
(progn
(setq key (cadr key))
(cond
; Alphanumeric key
((not (or (< key 32) (> key 126) (> p 80))) (process))
; Ctrl Left arrow
((not (or (/= key 243) (< p 2)))
(progn (setq p (1- p)) (cursor))
)
; Ctrl Right arrow
((not (or (/= key 244) (> p len)))
(progn (setq p (1+ p)) (cursor))
)
; Backspace
((not (or (/= key 8) (< p 2)))
(progn
(setq p (1- p))
(cursor)
(setq txt (strcat (substr txt 1 (1- p))
(princ (substr txt (1+ p))))
)
(princ "\004 ")
(setq len (1- len))
(cursor)
)
)
; TAB
((= key 9)
(progn
(setq p (if (= (/ (1- p) 5) (/ (1- p) 5.0))
(+ p 5)
(+ 6 (* (/ (1- p) 5) 5))))
(if (>= p len) (setq p (1+ len)))
(cursor)
)
)
; Shift TAB
((= key 143)
(progn
(setq p (if (= (/ (1- p) 5) (/ (1- p) 5.0))
(- p 5)
(1+ (* (/ (1- p) 5) 5))))
(if (< p 1) (setq p 1))
(cursor)
)
)
; Home
((= key 247) (progn (setq p 1) (cursor)))
; End
((= key 245) (progn (setq p (1+ len)) (cursor)))
; Down arrow or ENTER
((or (= key 246) (= key 13))
(cond
; Less then number of text lines
((< txtlin (1- num)) (chglin 1))
; Can do no more lines
(T (chglin 0))
)
)
; Up arrow
((not (or (/= key 132) (<= txtlin 0))) (chglin -1))
; Modify F2
((= key 188) (modify))
; Delete
((not (or (/= key 160) (> p len)))
(progn
(setq txt (strcat (substr txt 1 (1- p))
(princ (substr txt (1+ p)))))
(princ "\004 ")
(setq len (1- len))
(cursor)
)
)
; Insert
((= key 151) (mode))
; ESCAPE
((= key 27) (escape))
; Fall through
(T T)
)
)
T
)
; Is text string empty?
(if (< len 1) (deltxt) T)
)
)
)
)
(setq *error* err)
(princ)
)
; End of File