Liren Large Software Subsidy 13/13.iso/p/p024/11.img/BONUS2.LIB/PTEXT.LSP

Text File | 1993-02-09 | 58.2 KB | 1,861 lines

;;;   PText.lsp
;;;   ¬⌐┼v (C) 1988-1992  Autodesk ñ╜Ñq
;;;
;;;   Ñ╗╡{ªíñwÑ╤ Autodesk ñ╜Ñq╡∙ÑU¬⌐┼v, ╢╚⌐≤ñU¡z▒í¬pñUÑi▒┬╗P▒zíu│\ÑiívíC
;;;   ╗╒ñUñú▒oÑHÑ⌠ª≤º╬ªí╡oªµ⌐╬ÑX¬⌐ª╣╡{ªí¬║íu¡∞⌐l╜Xív; ª²ñ╣│\▒zªb»S⌐w¡lÑ═
;;;   ¬║ñuº@ñW╡▓ªXª╣╡{ªí¬║íuÑ╪¬║╜Xív¿╧Ñ╬íCª│├÷│o├■¡lÑ═ñuº@¬║▒°Ñ≤ªpñU:
;;;
;;;   ( i)  │]¡pñW╗Pñuº@ñW¼╥»┬║Θ░w╣∩ Autodesk ñ╜Ñq¬║▓ú½~íC
;;;   (ii)  ╕ⁿª│íu¬⌐┼v  (C) 1988-1992  Autodesk ñ╜Ñqív¬║¬⌐┼v│qºiíC
;;;
;;;
;;;
;;;   AUTODESKñ╜Ñq┤ú¿╤ª╣╡{ªí╢╚¿╤º@íu├■ªⁿív¬║░╤ª╥, ª╙ÑBñú▒╞░úª│Ñ⌠ª≤┐∙╗~¬║
;;;   Ñi»αíCAUTODESKñ╜Ñq»Sª╣º_╗{Ñ⌠ª≤»S⌐wÑ╬│~ñº╛A║┘⌐╩, ÑHñ╬░╙╖~╛P░Γ⌐╥┴⌠ºt
;;;   ÑX¿π¬║½O├╥íCAUTODESKñ╜ÑqªP«╔ÑτñúÑX¿πª╣╡{ªí░⌡ªµ«╔ñ@⌐wñú╖|íuññ┬_ív⌐╬
;;;   íuº╣Ñ■╡L╗~ív¬║½O├╥íC
;;;
;;;
;;;   by Jan S. Yoder
;;;   with thanks to Kieran McKeogh for suggesting how to handle control
;;;   characters.
;;;   15 February 1990
;;;
;;;   Version 1.11
;;;     29 January 1991 -- JSY  : More minor bug fixes.
;;;     11 January 1991 -- JSY  : Numerous minor bug fixes.
;;;
;;;----------------------------------------------------------------------------  ;;;
;;; DESCRIPTION
;;;   PTEXT -- Paragraph text processor.
;;;
;;;   Text can be entered directly on the AutoCAD text screen, in one of four
;;;   modes; Left justified, Center or Right justified, or Fit between two
;;;   line endpoints.  Word wrapping will occur based on some rudimentary
;;;   assumptions which are necessary until and if a function can be provided
;;;   for determining the actual size of a text item at any given font and
;;;   number and size of characters.
;;;
;;;   The actual number of characters of "slack", the number of allowable extra
;;;   characters beyond the predetermined maximum, can be set by the user.
;;;
;;;   This processor works by reading keyboard input via (grread) and based
;;;   on this input, causing the current text entity to be regenerated.  This
;;;   routine can probably be made to operate unacceptably slowly by doing
;;;   one or more of the following:
;;;
;;;     Operating the routine in multiple viewports where the text entities'
;;;     layer is ON in all of them.
;;;
;;;     Working on fairly long text strings;  say, greater than 30 characters.
;;;
;;;     Operating on a slow processor.
;;;
;;;   The best method is to work on a layer which is exclusively visible in
;;;   the current viewport, and on fairly short strings.
;;;
;;;   The options are:
;;;
;;;    Command: ptext
;;;    Center/Edit/Fit/Load-file/Right/Slack/<Start point>:
;;;
;;;  Left, Center, right, and Fit justified text entry types are supported
;;;  for text entry.  The editing portion of this routine should work on
;;;  all of the Release 11 justification options.  This has not been tested!
;;;
;;;  The following control characters allow a "cursor" composed of a set of
;;;  underline control codes to move around within a set of text entities.
;;;
;;;       ^A -- Append a space after the current cursor position and
;;;             move the cursor to that position.
;;;       ^B -- Go to the beginning of the line.
;;;       ^D -- Move the cursor down a line; maintains the current letter
;;;             position.  This position may appear to be different due to
;;;             character kerning within a font.
;;;       ^E -- Go to the end of the current line.
;;;       ^H -- Backspace key.
;;;       ^I -- Toggle insert/overwrite mode.
;;;       ^L -- Move the cursor to the left  -- non-destructive cursor.
;;;   RETURN -- Return; move any characters to the right of the cursor
;;;             down to the next line and push the remaining lines down
;;;             one "interline spacing" amount.
;;;       ^N -- Go to the end of the last text entity in the list.
;;;       ^R -- Move the cursor to the right -- non-destructive cursor.
;;;       ^T -- Go to the start of the first text entity in the list.
;;;       ^U -- Move the cursor up a line; maintains the current letter
;;;             position.  This position may appear to be different due to
;;;             character kerning within a font.
;;;       ^Z -- Exit text entry.
;;;       -  -- Hyphen character.
;;;          -- The delete key deletes the current character, and if there is
;;;             no character and the cursor is at the end of a line and there
;;;             are more lines, then the next line is pulled up onto the
;;;             current line and any remaining lines are moved up one
;;;             "interline spacing" amount.
;;;
;;;   ^U and ^X are interchanged between DOS and UNIX machines due to low
;;;   level character swapping by the operating system, so either of these
;;;   combinations will cause the cursor to move up a line on either
;;;   machine type.
;;;
;;;   Local variables representing key code values for translation
;;;   to other keyboard codes, if necessary, are listed at the top
;;;   of the (ptext) defun.
;;;
;;;----------------------------------------------------------------------------


(defun ptext (/ pt_ver pt_err        pt_oe  pt_oce pt_sty pt_twf
                char   insert grp_72 pt_spt pt_rpt str
                line_l pt_cl  pt_str cont   sset   j      TX:LST ent
                pt_ils cont1  ans    temp   sl     pt_rsp pt_msp pt_tsp
                return OK2BRK max_j  diff   nchars dir    dstrct pt_obm
                pt_te EDIT_T  pnding pt_dth
                P_SLCK P_BEGL P_HLPD P_HLPU P_DWNL P_ENDL P_BACK
                P_ISRT P_JUST P_LEFT P_RTRN P_ENDT P_RGHT P_BEGT
                P_UPLD P_UPLU P_QUIT P_SPCE P_HYPH P_DDEL P_UDEL
             )

  (setq pt_ver "1.11")                ; Reset this local if you make a change.

  ;;
  ;; Internal error handler defined locally
  ;;

  (defun pt_err (s)                   ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
    (if (/= s "Function cancelled")
      (if (= s "quit / exit abort")
        (princ)
        (princ (strcat "\n┐∙╗~: " s))
      )
    )
    (if (null pt_GEX)
      (progn
        (entdel (cdr(assoc -1 pt_te))) ; Delete the test text entity.
        (entmod (subst (cons 1 str) (assoc 1 ent) ent))
      )
    )
    (command "_.UNDO" "_END")
    (if ll_oe                         ; If an old error routine exists
      (setq *error* pt_oe)            ; then, reset it
    )
    (setvar "blipmode" pt_obm)        ; Restore blipmode
    (setvar "cmdecho" pt_oce)         ; Reset command echoing on error
    (princ)
  )
  (if *error*                         ; Set our new error handler
    (setq pt_oe *error* *error* pt_err)
    (setq *error* pt_err)
  )
  (setq pt_oce (getvar "cmdecho"))    ; Save current state of command echoing
  (setq pt_obm (getvar "blipmode"))   ; Save current state of blipmode
  (setvar "cmdecho" 0)                ; Turn off command echoing
  (setvar "blipmode" 0)               ; Turn off blipmode
  (command "_.UNDO" "_GROUP")

  (if (null pt_GEX)
    (progn
      (cond
        ((or (= (substr (getvar "PLATFORM") 1 4) "OS/2")
             (= (substr (getvar "PLATFORM") 1 3) "DOS"))
          (or
            (setq temp (findfile "ptext.exe"))
            (setq temp (findfile "ads/ptext.exe"))
          )
        )
        ((= (substr (getvar "PLATFORM") 1 7) "386 DOS")
          (or
            (setq temp (findfile "ptext.exp"))
            (setq temp (findfile "ads/ptext.exp"))
          )
        )
        (T
          (or
            (setq temp (findfile "ptext"))
            (setq temp (findfile "ads/ptext"))
          )
        )
      )
      (if temp
        (if (null (xload temp))
          (progn
            (princ "\n╡L¬k╕ⁿñJíuPtextív░⌡ªµ╡{ªííC ")
            (if (and pt_sup pt_uls get_ch pt_gll pt_cll pt_psl
                     is_num pt_csl pt_gpl pt_gpr pt_sjk pt_mc
                     pt_bul pt_sil pt_ael pt_ail pt_ats pt_pnl
                     pt_pl pt_gmp pt_waw pt_pww pt_pee pt_mne
                     pt_fww pt_dal dr_txt round)

              (princ (strcat "\n⌐╥░⌡ªµ¬║ AutoLISP ½Y╢╚¿╤"
                "íu«iÑ▄ívÑ╬¬║¬⌐Ñ╗íC"))
              (progn
                (princ "\nª╣¬⌐Ñ╗¬║íuPtext.lspív╗▌¡nѪíC")
                (exit)
              )
            )
          )
          (princ "\n\n\n░⌡ªµ ADS ¬⌐Ñ╗¬║ PTEXT íC")
        )
        (if (and pt_sup pt_uls get_ch pt_gll pt_cll pt_psl
                 is_num pt_csl pt_gpl pt_gpr pt_sjk pt_mc
                 pt_bul pt_sil pt_ael pt_ail pt_ats pt_pnl

                 pt_pl pt_gmp pt_waw pt_pww pt_pee pt_mne
                 pt_fww pt_dal dr_txt round)

          (progn
            (princ "\n╡L¬k╕ⁿñJíuPtextív░⌡ªµ╡{ªííC ")
            (princ (strcat "\n⌐╥░⌡ªµ¬║ AutoLISP ½Y╢╚¿╤"
              "íu«iÑ▄ívÑ╬¬║¬⌐Ñ╗íC"))
          )
          (progn
            (princ "\n╡L¬k╕ⁿñJíuPtextív░⌡ªµ╡{ªííC ")
            (princ "\nª╣¬⌐Ñ╗¬║íuPtext.lspív╗▌¡nѪíC")
            (exit)
          )
        )
      )
    )
    (princ "\n\n\n░⌡ªµ ADS ¬⌐Ñ╗¬║ PTEXT íC")
  )
  ;; These are the machine codes for the various cursor motion controls
  ;; for both UNIX and DOS which are reported by calls to (ads_grread).
  ;;
  ;; Note that UNIX machines can redefine the low level codes and the
  ;; actions of the keys marked "DELETE" and the backspace key, as well
  ;; others.  They may not operate as documented.  Check the codes returned
  ;; by (grread) "key press" against the table below to determine which
  ;; codes to change for your system.
  ;;
  ;; They may need translation for other country keyboard codes.
  ;;
  ;; The codes listed here are used only if the PTEXT executable is not
  ;; in use.  Change the source code for the executable if you wish to
  ;; change the response of any of the keys and recompile it as described
  ;; in the ADS User Guide.

  (if (null pt_GEX)
    (setq P_APPN   1                  ; ^A Append a space at current pt_rsp.
          P_BEGL   2                  ; ^B Beginning of line.
          P_DWNL   4                  ; ^D Down a line.
          P_ENDL   5                  ; ^E End of line.
          P_BACK   8                  ; ^H Backspace.
          P_ISRT   9                  ; ^I Toggle insert/overwrite mode.
          P_LEFT  12                  ; ^L Left  -- non-destructive cursor.
          P_RTRN  13                  ;    Return.
          P_ENDT  14                  ; ^N End of text.
          P_RGHT  18                  ; ^R Right -- non-destructive cursor.
          P_BEGT  20                  ; ^T Beginning of text.
          P_UPLD  21                  ; ^U Up a line (DOS).
          P_UPLU  24                  ; ^X Up a line (UNIX).
          P_QUIT  26                  ; ^Z Exit text entry.
          P_SPCE  32                  ;    Spacebar.
          P_HYPH  45                  ; -  Hyphen character.
          P_UDEL 127                  ;    Delete character (UNIX).
          P_DDEL 211                  ;    Delete character (DOS).
          P_HLPD 222                  ;^F1 Help screen on DOS
          P_HLPU  31                  ;^?  Help screen on UNIX
    )
  )
  (setq pt_sty (tblsearch "style" (getvar "textstyle"))
        pt_dth (cdr(assoc 40 pt_sty))
        pt_twf (cdr(assoc 41 pt_sty))
        pt_toa (cdr(assoc 50 pt_sty))
        pt_stn (cdr(assoc  2 pt_sty))
        P_SLCK 0                      ; No slack characters
        char   P_SPCE                 ; "space" character
        insert T                      ; Start in insert mode.
  )

  ;; Make a frozen layer for determining the length of a text string.
  (if (null (setq temp (tblsearch "layer" "frozen_text")))
    (command "_.LAYER" "_NEW" "FROZEN_TEXT" "_FREEZE" "FROZEN_TEXT" "")
    (if (= (logand (cdr(assoc 70 temp)) 1) 0)
      (command "_.LAYER" "_FREEZE" "FROZEN_TEXT" "")
      (princ)
    )
  )
  (if (= (getvar "handles") 0)        ; Handles are off
    (progn
      (initget "Yes No")
      (if (= (getkword "\n▒╥Ñ╬íu╣╧╜Xív? <Y>: ") "No")
        (progn
          (princ
            "\n▒²¿╧ª╣▒`ªí─~─≥╢iªµÑ▓╢╖┼²íu╣╧╜Xív▒╥Ñ╬íC")
          (exit)
        )
        (command "_.HANDLES" "_ON")
      )
    )
  )
  (if (null pt_GEX)
    (progn
      ;; Create a dummy text entity on this layer.
      (command "_.TEXT" "_R" "0,0" "" "" "Ptext")
      (setq pt_te (entget(entlast))
            pt_te (subst (cons 8 "frozen_text") (assoc 8 pt_te) pt_te)
      )
      (entmod pt_te)
    )
  )

  (princ (strcat "\níuThe Paragraph Text Editorív, ¬⌐Ñ╗ "
                 pt_ver
                 ", (c) 1990  Autodesk ñ╜ÑqíC "))
  (pt_opt)                            ; Get options from user
  (if (null EDIT_T)
    (progn
      (pt_sth)                        ; Set text height.
      (if (/= grp_72 5)
        (pt_sra)                      ; Set rotation angle.
        (setq pt_ra (angle pt_spt pt_rpt))
      )
      (setq pt_ils (pt_sis))          ; Set the spacing between lines.
      (if (/= grp_72 5)
        (pt_sml)                      ; Set the length of the lines.
        (setq pt_mll (distance pt_spt pt_rpt))
      )
    )
  )
  (if (null str)
    (setq str T)
  )
  (grtext -2 "Ptext: ┤íñJ╝╥ªí")
  (if (null pt_GEX)
    (progn
      (setq line_l 0
            pt_cl  0
            pt_str ""
      )
      (while (/= str "")
        (pt_sup)                      ; Set up
        (while (get_ch)               ; Get characters

          ;; Maximum line length plus "slack" amount not yet reached...

          (if (< line_l pt_mll)
            (pt_pl)                   ; Process the line
            (progn
              (setq temp (pt_waw))    ; Set up to wrap at word
              (pt_pww temp)           ; Wrap at word
            )
          )
          (setq char nil)
        )
      )
    )
    (progn
      (setq EDIT_T (if (null EDIT_T) 0 1))
      (if (null pt_rpt) (setq pt_rpt (list 0.0 0.0 0.0)))
      (setq pt_sty (cdr(assoc 2 pt_sty)))
      (setq err
        (pt_GEX pt_spt pt_rpt grp_72 pt_th  pt_ra
                pt_mll pt_ils (atof pt_ver) pt_sty EDIT_T)
      )
    )
  )
  (if (null pt_GEX)
    (entdel (cdr(assoc -1 pt_te)))    ; Delete the test text entity.
  )
  (command "_.UNDO" "_END")
  (setvar "blipmode" pt_obm)          ; Restore blipmode
  (setvar "cmdecho" pt_oce)           ; Restore command echoing
  (princ)
)
;;;
;;; Get options
;;;
;;; pt_opt == PText_OPTions
;;;
(defun pt_opt (/ cont)
  (setvar "cmdecho" 0)
  (while (null cont)

    (setq cont T)

    (initget "Center Edit Fit Load-file Right Slack ?")
    (setq pt_spt (getpoint
      "\nCññ╢í/E╜s┐Φ/F╢±╗⌠/RÑk/S├Pªó/?/<░_⌐l┬I>: "))

    (cond
      ((= pt_spt "Center")
        (setq grp_72 1)
        (initget 1)
        (setq pt_spt (getpoint "\nññ╢ííu░≥╜u┬Iív: "))
        (setq pt_spt (trans pt_spt 1 0))

      )
      ((= pt_spt "Edit")
        (princ (strcat
          "\n┐∩╛▄╣w│╞╜s┐Φ¬║ñσªr; Ñ╤¼q╕¿¬║▓─ñ@ªC╢}⌐l┐∩¿·, "
          "\n╡M½ß¿╠º╟┐∩¿·¿Σ╛lªUªC ... "))
        (setq sset (ssget))
        (if sset
          (progn
            (setq j 0)
            (setq temp   (entget (ssname sset j))
                  ename1 (cdr(assoc -1 temp))
                  k      (cdr(assoc 210 temp))
                  fd     (open "ptext.hdl" "w")
            )
            (if (null fd)
              (progn
                (princ
                  "\n╡L¬k╢}▒╥íu╣╧╜X└╔«╫ ptext.hdlívíC")
                (exit)
              )
            )
            (if (> (sslength sset) 1)
              (setq temp   (entget (ssname sset (1+ j)))
                    ename2 (cdr(assoc -1 temp))
              )
            )

            (repeat (sslength sset)
              (if (null pt_GEX)
                (progn
                  (if (= (cdr(assoc 0 (entget (ssname sset j)))) "TEXT")
                    (setq TX:LST (if TX:LST
                                   (append TX:LST (list (ssname sset j)))
                                   (list (ssname sset j))
                                 )
                          j      (1+ j)
                          gottxt T
                    )
                  )
                )
                (progn
                  (if (and
                        (= (cdr(assoc 0 (entget (ssname sset j)))) "TEXT")
                        (equal (cdr(assoc 210 (entget (ssname sset j)))) k)
                      )
                    (progn
                      (if (> j 0) (princ "\n" fd))
                      (princ (cdr(assoc 5 (entget (ssname sset j)))) fd)
                      (setq gottxt T)
                    )
                  )
                  (setq j      (1+ j))
                )
              )
            )
            (if gottxt
              (progn
                (if (null pt_GEX)
                  (setq ent    (entget(nth 0 TX:LST)))
                  (progn
                    (close fd)
                    (setq ent    (entget(ssname sset 0)))
                  )
                )
                (setq pt_spt (cdr(assoc 10 ent))
                      str    (cdr(assoc 1  ent))
                      pt_th  (cdr(assoc 40 ent))
                      pt_ra  (cdr(assoc 50 ent))
                      grp_72 (cdr(assoc 72 ent))
                )
                (if (= grp_72 5)          ; Fit text
                  (setq pt_rpt (cdr(assoc 11 ent))
                        pt_mll (distance pt_spt pt_rpt)
                  )
                  (setq pt_mll (pt_sml))  ; Set maximum line length
                )
                (setq pt_ils (pt_gis)     ; Get interline spacing.
                      EDIT_T T            ; Set a flag that we are editing.
                )
              )
              (progn
                (setq cont nil)
                (princ "\nÑ╝┐∩¿∞íuñσªr╣╧ñ╕ívíC")
              )
            )
          )
          (progn
            (setq cont nil)           ; Repeat the first prompt.
            (princ "\nÑ╝┐∩¿∞íuñσªr╣╧ñ╕ívíC")
          )
        )
      )
      ((= pt_spt "Fit")
        (setq grp_72 5)
        (initget 1)
        (setq pt_spt (getpoint "\nѬíu░≥╜u┬Iív: "))
        (initget 1)
        (setq pt_rpt (getpoint pt_spt "\nÑkíu░≥╜u┬Iív: "))
        (setq char nil)
        (setq pt_spt (trans pt_spt 1 0))
        (setq pt_rpt (trans pt_rpt 1 0))
      )
      ((= pt_spt "Right")
        (setq grp_72 2)
        (initget 1)
        (setq pt_spt (getpoint "\nÑkíu░≥╜u┬Iív: "))
        (setq pt_spt (trans pt_spt 1 0))

      )
      ((= pt_spt "Slack")
        (setq cont nil)
        (if (null P_SLCK) (setq P_SLCK 1))
        (initget 4)
        (setq pt_spt (getint (strcat
          "\níu├Pªóív¬║ªrñ╕╝╞Ñ╪ <" (itoa P_SLCK) ">: ")))
        (if pt_spt (setq P_SLCK pt_spt))
      )
      ((= (type pt_spt) 'LIST)        ; A point was entered
        (setq grp_72 0)
        (setq pt_spt (trans pt_spt 1 0))

      )
      ((= pt_spt "?")
        (pt_phs T)
        (setq cont nil)
      )
      (T
        (command "_.UNDO" "_END")
        (exit)                        ; Null entry -- get out.

      )
    )
  )
)
;;;
;;; The help screen.
;;;
;;; pt_phs == PText_Print_Help_Screens
;;;
(defun pt_phs (temp)
  (if textpage (textpage) (textscr))
  (if temp
    (progn
      (princ "\nñσªrÑi▒─ñU¡zÑ|║╪╝╥ªí¿╙┐ΘñJ: íuѬívíBíuññ╢íívíBíuÑkív⌐╬")
      (princ "\níu╢±╗⌠ívíC┐ΘñJñσªr┤┴╢íÑi▒N┤σ╝╨▓╛ª▄ñσªrñºÑ⌠╖Nª∞╕m, ⌐╬╕g")
      (princ "\nÑ╤íu E╜s┐Φív┐∩╢╡½ⁿ⌐wñσªrªC¿╙╢iªµ╜s┐ΦíC ")
      (princ "\n")
      (princ "\n")
      (princ "\nÑ▓╢╖Ñ┐╜Tªa½÷╖╙╣w⌐w¬║╜s┐Φª╕º╟¿╙¼D┐∩│o¿╟ñσªr╣╧ñ╕; ╖φ½ⁿ⌐w")
      (princ "\n¬║ñσªrªCññ┴ΣñJ├BÑ~¬║ñσªr«╔, ▒N╛╔¡P╕╙ªCíu▒▓ºΘ (wrap) ív")
      (princ "\nª▄ñUñ@ªCíC")
      (princ "\n  ")
      (princ "\n  ")
      (princ "\nñU¡z¬║íu▒▒¿εªrñ╕ívÑi┼²ºA╣BÑ╬íu┤σ╝╨ív (Ñ╤ñ@▓╒⌐│╜uíB│╗╜u")
      (princ "\n¬║▒▒¿ε╜X⌐╥▓╒ª¿) ªbñσªr╣╧ñ╕╢íªU│B▓╛¿½íC ")
      (princ "\n")
      (princ "\n")
      (princ "\n<▒╡ñU¡╢>")
      (grread)
      (princ "\r        ")
    )
  )
  (if temp
    (progn
      (princ "\n     ^F1 (DOS) ⌐╬ ")
      (princ "\n     ^?  (UNIX) -- ª╣¿DºU╡e¡▒íC")
    )
  )
  (princ "\n")
  (princ "\n     ^A  -- ªbÑ╪½e┤σ╝╨ª∞╕m¬■╝W (Append) ñ@¡╙¬┼«µ, ¿├▒N┤σ")
  (princ "\n            ╝╨▓╛ª▄╕╙ª∞╕míC")
  (princ "\n     ^B  -- ▒N┤σ╝╨▓╛ª▄Ñ╪½eªrªC¬║íuªC¡║ (Beginning)ívíC")
  (princ "\n     ^D  -- ┤σ╝╨▓╛ª▄ñU (Down) ñ@ªC, ¿├║√½∙ªbÑ╪½eªrñ╕¬║ª∞")
  (princ "\n            ╕mñWíCª╣ª∞╕mÑi»αÑ╤⌐≤íuªr┼ΘívññªUªrñ╕Ñ╗¿¡¬║«t")
  (princ "\n            ▓º, ª╙ñú║╔¼█ªPíC")
  (princ "\n     ^E  -- ▒N┤σ╝╨▓╛ª▄Ñ╪½eªrªC¬║íuªCº└ (End)ívíC")
  (princ "\n     ^H  -- ░hª∞┴ΣíC")
  (princ "\n     ^I  -- ñ┴┤½íu┤íñJí■┬╨╝gív╝╥ªííC")
  (princ "\n     ^L  -- ┤σ╝╨Ѭ (Left) ▓╛íC")
  (if temp
    (progn
      (princ "\n RETURN  -- <Return>; ▒N┤σ╝╨Ñk░╝¬║ªrñ╕íu▒▓ºΘívª▄ñUñ@ªC, ")
      (princ "\n            ¿├▒N¡∞ѲªUªC½÷╖╙íuªC╢Zív¿╠º╟⌐╣ñU▒└íC")
    )
  )
  (princ "\n     ^N  -- ▒N┤σ╝╨▓╛ª▄íuÑ╜ªCívñσªr╣╧ñ╕¬║íuªCº└ (eNd)ívíC")
  (princ "\n     ^R  -- ┤σ╝╨Ñk (Right) ▓╛íC")
  (princ "\n     ^T  -- ▒N┤σ╝╨▓╛ª▄íu│╗ªC (Top)ívñσªr╣╧ñ╕¬║íuªC¡║ívíC")
  (princ "\n     ^U  -- ▒N┤σ╝╨▓╛ª▄ñW (Up) ñ@ªCíC")
  (princ "\n     ^Z  -- ░hÑXñσªr┐ΘñJíC")
  (princ "\n")
  (if (null temp)
    (progn
      (princ "\n½÷Ñ⌠╖N┴ΣÑH¬≡ª^íu╣╧º╬╡e¡▒ívíC")
      (grread)
      (princ "\r                                          ")
      (princ "\n")
      (princ "\n")
      (princ "\nñσªr: ")
      (princ str)
    )
  )
  (if temp
    (progn
      (princ "\n<▒╡ñU¡╢>")
      (grread)
      (princ "\r        ")
      (princ "\n DELETE  -- ½÷ <Del>┴ΣÑiºR░úÑ╪½eªrñ╕; ¡Y┤σ╝╨ª∞⌐≤ªCº└ÑB╕╙")
      (princ "\n            ñσªr¼q⌐|ª│╝╞ªCñσªr, ½hñUñ@ªC▒N│Q▒└ñWª▄Ñ╪½eªC")
      (princ "\n            , ª╙¡∞ѲªUªC▒N½÷╖╙íuªC╢Zív¿╠º╟⌐╣ñW╖h▓╛íC")
      (princ "\n ")
      (princ
        "\nªbªr (word) ññ┤íñJíu-ívªrñ╕, ╕╙ªr▒NÑ╤íu-ív│Bíu▒▓ºΘ (wrap)ívª▄ñUªCíC")
      (princ "\n")
    )
  )
  (princ)
)
;;;
;;; Set the height of the text entities.
;;; Defaults to "0.2" if not preset in the style symbol table.
;;;
;;; pt_sth == PText_Set_Text_Height
;;;
(defun pt_sth ()
  (initget 6)
  (if (= pt_dth 0.0) (setq pt_dth 0.2))
  (setq ans (getdist (trans pt_spt 0 1) (strcat "\nªr░¬ <"
                                    (if pt_th (rtos pt_th) (rtos pt_dth))
                                    ">: ")))
  (if ans
    (setq pt_th ans)
    (if (null pt_th)
      (setq pt_th 0.2)
    )
  )
)
;;;
;;; Set the rotation angle for the text.
;;; Defaults to "0" if not preset in the style symbol table.
;;;
;;; pt_sra == PText_Set_Rotation_Angle
;;;
(defun pt_sra ()
  (if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
    (setq temp 270)
    (setq temp 0)
  )
  (setq ans (getorient (trans pt_spt 0 1) (strcat
    "\n▒█┬α¿ñ <" (if pt_ra (angtos pt_ra) (itoa temp)) ">: ")))
  (if ans
    (setq pt_ra ans)                  ; in radians
    (setq pt_ra (/ temp (/ 180 pi)))
  )
)
;;;
;;; Get the spacing between the "baseline" of lines of text.
;;; Defaults to 1.5 times the text height.
;;; "Temp" is the group code to use.
;;;
;;; pt_gis == PText_Get_Interline_Spacing
;;;
(defun pt_gis (/ temp)
  (if (> (sslength sset) 1)
    (progn
      (if (or (= grp_72 0) (= grp_72 5))
        (setq temp 10)
        (setq temp 11)
      )
      (distance (cdr(assoc temp (entget ename1)))
                (cdr(assoc temp (entget ename2)))
      )
    )
    (progn
      (setq pt_ils (pt_sis))
    )
  )
)
;;;
;;; Set the spacing between the "baseline" of lines of text.
;;; Defaults to 1.5 times the text height.
;;;
;;; pt_sis == PText_Set_Interline_Spacing
;;;
(defun pt_sis ()
  (setq pt_ils (* pt_th 1.5))
  (initget 6)
  (setq ans (getdist (trans pt_spt 0 1) (strcat
    "\nªrªC╢í╢Z <" (if pt_ils (rtos pt_ils) "0.3") ">: ")))
  (if ans
    (if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
      (- ans)
      ans
    )
    (if (= (logand (cdr(assoc 70 pt_sty)) 4) 4)
      (- (* 1.5 (if pt_th pt_th 0.2)))
      (* 1.5 (if pt_th pt_th 0.2))
    )
  )
)
;;;
;;; Set the maximum line length.
;;; Defaults to 2 units.
;;; Sets the global pt_mll.
;;;
;;; pt_sml == PText_Set_Maximum_line_Length
;;;
(defun pt_sml ()
  (if (null pt_mll)
    (setq pt_mll (* pt_th 10.0))
  )
  (initget 6)
  (setq ans (getdist (trans pt_spt 0 1) (strcat
    "\nªC¬°ñW¡¡" (if pt_mll
                              (strcat " <"  (rtos pt_mll) ">: ")
                              ": ")))
  )
  (if ans
    (setq pt_mll ans)
  )
  (+ pt_mll (* 0.9 P_SLCK pt_twf pt_th))
)
;;;
;;; All functions defined following this line up to the final c: function
;;; definitions at the end of the file are duplicated in ptext.c and are
;;; included here to allow you to execute the PTEXT command without using
;;; an ADS routine.  You may want to try this to see the difference in speed
;;; between the command running as a pure AutoLisp application versus one
;;; that has been ported to ADS.
;;;
;;; In order to run the AutoLisp version, rename the PTEXT executable, and
;;; then run PTEXT.  If this routine cannot find an executable with the
;;; name of PTEXT (the extension varies), then it runs only the AutoLisp
;;; version.  Otherwise, the ADS version is loaded and run.
;;;
;;; If you are never going to run the AutoLisp version, then the code
;;; following this up to the final c: definitions may be deleted.
;;;
;;; ------------------ Cut here ----------------------------------

;;;
;;; Set up before getting keyboard input.
;;;
;;; The counter "pt_cl" is the number of the current line
;;; starting at "1".  It is always one ahead of the number
;;; required by the lisp expression (nth <n> <list>) which
;;; starts its numbering at "0".  This counter is used througout
;;; for accessing text entities from the list TX:LST.
;;;
;;; pt_sup == PText_Set_UP
;;;
(defun pt_sup ()
  (setq pt_rsp 1
        char   P_SPCE
        pt_cl  (1+ pt_cl)
        pt_vsp 1
  )
  (setq str    (if (= (type str) 'STR) str (chr char))
        strlst (pt_psl str)           ; Parse string to list
        pt_msp (pt_cll (length strlst) T) ; Check line length
        pt_rsp (pt_cll pt_vsp nil)    ; Get character position/size
        pt_str (pt_uls str pt_rsp)    ; Underline character 1
  )
  (if ent
    (progn
      (setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent))
      (entmod ent)
    )
    (progn
      (dr_txt pt_str)                 ; Draw the text string - sets ent
      (setq TX:LST (if TX:LST
                     (pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
                     (list (cdr(assoc -1 ent)))
                   )
      )
    )
  )
  (princ "\nñσªr: ")
  (princ str)
)
;;;
;;; Turn on underlining for an apparent character location (j)
;;; in a string (s).  Return the string with underlining.
;;;
;;; pt_uls == PText_UnderLine_String
;;;
(defun pt_uls (s j / temp)
  (setq temp (strlen s))
  (if (> temp 0)
    (if (and (> j 0) (<= j temp))
      (strcat (substr s 1 (pt_csl 1 j))
              (strcat "%%u" (if insert "" "%%o")
                      (nth (1- j) strlst)
                      "%%u" (if insert "" "%%o")
              )
              (substr s (1+ (pt_csl 1 (1+ j))))
      )
      (strcat (substr s 1 (pt_csl 1 j)) "%%u %%u")
    )
    "%%u %%u"
  )
)
;;;
;;; Get a character from the keyboard
;;;
;;;
(defun get_ch (/ return)
  ;; Disallow all input except the keyboard.
  (while (/= (car (setq char (grread nil))) 2) (princ))
  (setq char (cadr char))
  (cond
    ((= char P_RTRN)
      (pt_pnl)                        ; Process newline
      (setq return nil)
    )
    ((= char P_ISRT)
      (if insert                      ; Toggle insert mode...
        (progn
          (setq insert nil)
          (grtext -2 "Ptext:íu┬╨╝gív╝╥ªí")
        )
        (progn
          (setq insert T)
          (grtext -2 "Ptext:íu┤íñJív╝╥ªí")
        )
      )
      (setq return T)
    )
    ;; Backspace key -- destructive cursor
    ((= char P_BACK)
      (pt_mc "LEFT" T)                ; Move cursor
      (setq return T)
    )
    ((or (= char P_DDEL)
         (= char P_UDEL))             ; Delete key
      (pt_mc "DEL" nil)
      (setq return T)
    )
    ;; ALT - A key  -- Append a space to the current cursor position.
    ((= char P_APPN)
      (setq char P_SPCE)
      (setq pt_rsp (pt_ats char T))   ; Add character to string
      (pt_mc "RIGHT" nil)             ; Move cursor
      (setq return T)
    )
    ((= char P_BEGL)                  ; ALT - B key : Beginning of line
      (pt_mc "HOME" nil)
      (setq return T)
    )
    ((= char P_DWNL)                  ; ALT - D key : Move down a line
      (pt_mc "DOWN" nil)
      (setq return T)
    )
    ((= char P_ENDL)                  ; ALT - E key : End of the line
      (pt_mc "END" nil)
      (setq return T)
    )
    ((= char P_LEFT)                  ; ALT - L key : Move left
      (pt_mc "LEFT" nil)
      (setq return T)
    )
    ((= char P_ENDT)                  ; ALT - N key : Move to bottom of text
      (pt_mc "BOTTOM" nil)
      (setq return T)
    )
    ((= char P_RGHT)                  ; ALT - R key : Move right
      (pt_mc "RIGHT" nil)
      (setq return T)
    )
    ((= char P_BEGT)                  ; ALT - T key : Move to top of text
      (pt_mc "TOP" nil)
      (setq return T)
    )
    ((or (= char P_UPLD)
         (= char P_UPLU))             ; ALT - U key (DOS or UNIX)
      (pt_mc "UP" nil)
      (setq return T)
    )
    ((= char P_QUIT)                  ; ALT - Z key -- exit.
      (initget "Yes No")
      (if (= (getkword "\n░hÑXíuñσªr┐ΘñJív? <Y>: ") "No")
        (progn
          (setq return T)
          (princ "\nñσªr: ")
          (princ str)
        )
        (progn
          (entmod (subst (cons 1 str) (assoc 1 ent) ent))
          (setq str    ""
                return nil
          )
        )
      )
    )
    ((= char P_DEL)                   ; Delete -- delete character at cursor
      (pt_mc "DEL" nil)
      (setq return T)
    )
    ((or (= char P_HLPD) (= char P_HLPU)) ; ^F1 or ^? -- Help screen.
      (pt_phs nil)
      (setq return T)
    )
    ((= (chr char) "%")
      (cond
        ((= pnding nil) (setq pnding 1))
        ((= pnding 1)   (setq pnding 2))
        ((= pnding 2)   (setq pnding nil))
        (T
          (exit)
        )
      )
      (setq pt_rsp (pt_ats char nil)
            pt_vsp (pt_cll pt_rsp T)
      )
      (setq return T)
    )
    ; Else return T
    (T
      (if (= char P_HYPH)
        (setq OK2BRK T)
        (setq OK2BRK nil)
      )
      (if (> pnding 1)
        (cond
          ((or (= (chr char) "o")     ; overline
              (= (chr char) "u")      ; underline
              (= (chr char) "d")      ; degrees
              (= (chr char) "p")      ; plus/minus
              (= (chr char) " ")      ; space
           )
            (setq pt_rsp (- (pt_ats char nil) 2)
                  strlst (pt_psl str) ; Parse string to list
                  pt_vsp (pt_cll pt_rsp T)
                  pnding nil
            )
          )
          ((is_num (chr char))
            (terpri)
            (if (< pnding 4)
              (setq pt_rsp (pt_ats char nil)
                    pnding (1+ pnding)
                    pt_vsp (pt_cll pt_rsp T)
              )
              (setq pt_rsp (- (pt_ats char nil) (- pnding 2))
                    strlst (pt_psl str) ; Parse string to list
                    pnding nil
                    pt_vsp (pt_cll pt_rsp T)
              )
            )
          )
          (T
            (setq pt_rsp (pt_ats char nil)
                  pt_vsp (pt_cll pt_rsp T)
                  pnding nil
            )
          )
        )
        (setq pt_rsp (pt_ats char nil)
              pt_vsp (pt_cll pt_rsp T)
        )
      )
      (setq return T) ; Return value
    )
  )
  (if (/= char P_RTRN)
    (progn
      ;; set the current string postion (pt_vsp) after allowing for
      ;; various control character codes such as %%d or %%p.
      (setq pt_rsp (pt_cll pt_vsp nil)
            ;; set the string that gets printed on-screen via (entmod).
            pt_str (pt_uls str pt_rsp)
            ;; set the maximum string postion (pt_msp) after allowing for
            ;; various control character codes such as %%d or %%p.
            pt_msp (pt_cll (length strlst) T)
            ;; set the line length up to the current adjusted string position.
            line_l (pt_gll (pt_csl 1 pt_rsp))
      )
    )
  )
  return
)
;;;
;;; Get the length of a text line by making a dummy text entity
;;; on the frozen text layer.  This entity will contain the current
;;; text string without the underline/overline cursor characters
;;; up to the current cursor position.
;;;
;;; Return the distance between the right and left points of the
;;; right justified text string.
;;;
;;; pt_gll == PText_Get_Line_Length
;;;
(defun pt_gll (pt_rsp)
  (setq pt_te (subst (cons 1 (pt_sjk 1 pt_rsp)) (assoc 1 pt_te) pt_te))
  (setq pt_te (subst (cons 40 pt_th) (assoc 40 pt_te) pt_te))
  (setq pt_te (subst (cons 41 pt_twf) (assoc 41 pt_te) pt_te))
  (setq pt_te (subst (cons 51 pt_toa) (assoc 51 pt_te) pt_te))
  (setq pt_te (subst (cons 7  pt_stn) (assoc  7 pt_te) pt_te))
  (entmod pt_te)
  (setq pt_te (entget(cdr(assoc -1 pt_te))))
  (distance (cdr(assoc 10 pt_te)) (cdr(assoc 11 pt_te)))
)
;;;
;;; Check the string list "strlst" for control characters.  If "diff" is T,
;;; then return the number of visible characters, else return the number of
;;; the item in the list which matches the current visual string position.
;;; N_chars is global to this routine, and specifies how many characters
;;; to delete if deleting a special symbol.
;;;
;;; pt_cll == PText_Check_Line_Length
;;;
(defun pt_cll (max diff / temp j)
  (setq temp   0
        j      0
        k      0
        nchars 0  ; global, local to (ptext).
  )
  (while (and (< k max) (< j (length strlst)))
    (cond
      ((or (= (nth j strlst) "%%o")   ; overline
           (= (nth j strlst) "%%u"))  ; underline
        (if diff
          (setq k (1+ k))
        )
        (setq j (1+ j))
      )
      (T
        (setq temp   (1+ temp)        ; diff count
              nchars (strlen (nth j strlst))
              j      (1+ j)
              k      (1+ k)
        )
      )
    )
  )
  (if diff (if (> temp 0) temp 1) j)
)
;;;
;;; Parse the string "str" into a list of strings, one string for each
;;; visual character or control character set.
;;; N_chars is global to this routine, and specifies how many characters
;;; to delete if deleting a special symbol.
;;;
;;; pt_psl == PText_Parse_String_to_List
;;;
(defun pt_psl (str / max temp j k tmplst)
  (setq max  (strlen str)
        j    1
        k    0
        x    1
        nchars 0  ; global, local to (ptext).
  )
  (while (<= j  (strlen str))
    (if (= (setq temp (substr str j 1)) "%")
      (progn
        (if (= (substr str (setq j (1+ j)) 1) "%")
          (progn
            (setq j (1+ j))
            (cond
              ((= (substr str j 1) " ") ; space
                (setq tmplst (if tmplst
                               (append tmplst (list "%" "%" " "))
                               (list "%" "%" " ")
                             )
                )
              )
              ((or (= (substr str j 1) "%")  ; percent
                   (= (substr str j 1) "d")  ; degrees
                   (= (substr str j 1) "p")  ; plus/minus
                   (= (substr str j 1) "o")  ; overline
                   (= (substr str j 1) "u")) ; underline
                (setq temp   (substr str (- j 2) 3)
                      j      (1+ j)
                )
              )
              ((is_num (substr str j 1))
                (while (and (< k 3) (is_num (substr str (+ j k) 1)))
                  (setq k      (1+ k))
                )
                (setq temp (substr str (- j 2) (+ 2 k))
                      j    (+ j k)
                )
              )
              (T
                (setq j (1+ j))
              )
            )
            (setq tmplst (if tmplst
                           (append tmplst (list temp))
                           (list temp)
                         )
            )
          )
          (progn
            (setq tmplst (if tmplst
                           (append tmplst (list temp))
                           (list temp)
                         )
                  tmplst (append tmplst (list (substr str j 1)))
                  j      (1+ j)
            )
          )
        )
      )
      (progn
        (setq tmplst (if tmplst
                       (append tmplst (list temp))
                       (list temp)
                     )
              j      (1+ j)
        )
      )
    )
  )
  tmplst
)
;;;
;;; Is the character (string) a number...
;;;
;;;
(defun is_num (char)
  (if
    (or
      (= char "0") (= char "1") (= char "2") (= char "3") (= char "4")
      (= char "5") (= char "6") (= char "7") (= char "8") (= char "9")
    )
    T
    nil
  )
)
;;;
;;; Count the number of characters in the list of strings up to the
;;; current string position from the starting point.
;;;
;;; pt_csl == PText_Count_String_Length
;;;
(defun pt_csl (j k / temp)
  (setq temp 0)
  (while (and (> j 0) (< j k) (<= j (length strlst)))
    (setq temp (+ temp (strlen (nth (1- j) strlst)))
          j    (1+ j)
    )
  )
  temp
)
;;;
;;; Get the real string position of the next visual character to the
;;; left of the current cursor posistion.
;;;
;;; pt_gpl == PText_Get_next_start_Position_Left
;;;
(defun pt_gpl (temp)
  (setq j (pt_cll temp T))
  (while (and (> temp 0) (= j (setq k (pt_cll temp T))))
    (setq temp (1- temp))
  )
  k
)
;;;
;;; Get the real string position of the next visual character to the
;;; right of the current cursor posistion.
;;;
;;; pt_gpr == PText_Get_next_start_Position_Right
;;;
(defun pt_gpr (temp)
  (pt_cll temp nil)
)
;;;
;;; Strcat from the list "strlst" from "j" position to "k" position.
;;; Return the string or "".
;;;
;;; pt_sjk == PText_Strcat_from_J_to_K
;;;
(defun pt_sjk (j k / temp)
  (setq temp 0
        l    0
  )
  (if (and (<= j (length strlst)) (<= j k))
    (progn
      (while (< temp (+ j l))
        (if (or (= (nth temp strlst) "%%o")  ; overline
                (= (nth temp strlst) "%%u")) ; underline
            (setq l (1+ l))
        )
        (setq temp (1+ temp))
      )
      (setq temp "")
      (while (and (<= (+ j l) (length strlst)) (<= j k))
        (setq temp (strcat temp (nth (1- (+ j l)) strlst)))
        (if (or (= (nth (1- (+ j l)) strlst) "%%o")  ; overline
                (= (nth (1- (+ j l)) strlst) "%%u")) ; underline
            (setq k (1+ k))
        )
        (setq j (1+ j))
      )
    )
    (setq temp "")
  )
  temp
)

;;;
;;; Move the cursor the direction "dir" and if the second argument is T,
;;; then erase the character under the new cursor location.
;;;
;;; pt_mc == PText_Move_Cursor
;;;
(defun pt_mc (dir dstrct)
  (cond
    ((= dir "LEFT")
      (if dstrct                      ; deleting text
        (if (> pt_vsp 1)              ; if not at the beginning of a line
          ;; subtract one visual character from the current position.
          (progn
            (setq pt_vsp (1- pt_vsp)
                  pt_rsp (pt_cll pt_vsp nil)
                  str    (strcat
                           (pt_sjk 1 (- pt_vsp 1))
                           (pt_sjk (1+ pt_vsp) pt_msp)
                         )
                  strlst (pt_psl str) ; Parse string to list
            )
            (repeat 5
              (princ (chr P_BACK))
              (princ (chr P_SPCE))
              (princ (chr P_BACK))
            )
          )
          (progn                      ; AT the beginning of the text line...
            (if (> pt_cl 1)           ; if not at the first line...
              (pt_dal T)              ; back up a line, destructive
            )
          )
        )
        (if (> pt_vsp 1)              ; NOT deleting text...
          (setq pt_vsp (1- pt_vsp)
                pt_rsp (pt_gpl pt_vsp)
          )
          (if (> pt_cl 1)             ; if not at the first line...
            (pt_dal nil)              ; back up a line, non-destructive
          )
        )
      )
    )
    ((= dir "RIGHT")
      (if dstrct                      ; overwriting text
        (if (< pt_vsp pt_msp)         ; if not at the end of a line
          (setq pt_vsp (1+ pt_vsp)
                pt_rsp (pt_gpr pt_vsp)
                str    (strcat
                         (pt_sjk 1 (- pt_rsp 2))
                         " "
                         (pt_sjk pt_rsp pt_msp)
                       )
                strlst (pt_psl str)   ; Parse string to list
          )
        )
      )
      (if (< pt_vsp pt_msp)           ; NOT deleting text and ...
                                      ; NOT at the end of a line...
        (setq pt_vsp (1+ pt_vsp)
              pt_rsp (pt_gpr pt_vsp)
        )
        ;; else
        (if (< pt_cl (length TX:LST)) ; AT the end of a line...
          ;; If not at the last line in the edit list...
          (progn
            ;; Modify the current entity to remove the cursor.
            (entmod (subst (cons 1 str) (assoc 1 ent) ent))
            (setq pt_cl  (1+ pt_cl)   ; add one to current line counter
                  ;; get the ename from TX:LST for the new current line.
                  ent    (entget(nth (1- pt_cl) TX:LST))
                  ;; get the string in ent
                  str    (cdr(assoc 1 ent))
                  strlst (pt_psl str) ; Parse string to list
                  ;; Actual under-line postion checked in (get_ch)
                  pt_vsp 1
            )
          )
          ;; Else do nothing.
        )
      )
    )
    ((= dir "HOME")
      ;; Actual under-line postion checked in (get_ch)
      (setq pt_vsp 1)
    )
    ((= dir "END")
      ;; Actual under-line postion checked in (get_ch)
      (setq pt_vsp pt_msp)
    )
    ((= dir "TOP")
      (entmod (subst (cons 1 str) (assoc 1 ent) ent))
      (setq pt_cl  1
            ent    (entget(nth 0 TX:LST))
            str    (cdr(assoc 1 ent))
            strlst (pt_psl str)       ; Parse string to list
            ;; Actual under-line postion checked in (get_ch)
            pt_vsp 1
      )
    )
    ((= dir "BOTTOM")
      (entmod (subst (cons 1 str) (assoc 1 ent) ent))
      (setq pt_cl  (length TX:LST)
            ent    (entget(last TX:LST))
            str    (cdr(assoc 1 ent))
            strlst (pt_psl str)       ; Parse string to list
            ;; Actual under-line postion checked in (get_ch)
            pt_vsp pt_msp
      )
      (terpri)
    )
    ((= dir "DEL")
      (if (< pt_vsp pt_msp)           ; if not at the end of the line...
        (progn
          (setq temp (strlen str)
                str    (strcat
                         (pt_sjk 1 (1- pt_rsp))
                         (pt_sjk (1+ pt_rsp) pt_msp)
                       )
                strlst (pt_psl str)                ; Parse string to list
          )
          (repeat (1+ (- temp (strlen str)))
            (princ (chr P_BACK))
            (princ (chr P_SPCE))
            (princ (chr P_BACK))
          )
        )
        ;; else, at the last character in the line...
        (if (= (substr str pt_rsp 1) " ") ; if it is a blank...
          (pt_bul (1+ pt_cl))         ; Bring up lines following this line.
          ;; else, replace the current character with a space.
          (setq str    (strcat (pt_sjk 1 (1- pt_rsp)) " ")
                strlst (pt_psl str)   ; Parse string to list
                pt_spt (polar pt_spt (+ pt_ra (/ pi 2)) pt_ils)
          )
        )
      )
    )
    ((= dir "UP")
      (if (and TX:LST (> pt_cl 1))    ; Never let pt_cl below 1.
        (progn
          (entmod (subst (cons 1 str) (assoc 1 ent) ent))
          (setq pt_cl  (1- pt_cl)
                ent    (entget(nth (1- pt_cl) TX:LST))
                str    (cdr(assoc 1 ent))
                strlst (pt_psl str)   ; Parse string to list
                tvsp   (length strlst)
          )
          (if (< tvsp pt_vsp) (setq pt_vsp tvsp))
          (terpri)
        )
      )
    )
    ((= dir "DOWN")
      (if (and TX:LST (< pt_cl (length TX:LST)))
        (progn
          (entmod (subst (cons 1 str) (assoc 1 ent) ent))
          (setq pt_cl  (1+ pt_cl)
                ent    (entget(nth (1- pt_cl) TX:LST))
                str    (cdr(assoc 1 ent))
                strlst (pt_psl str)   ; Parse string to list
                tvsp   (length strlst)
          )
          (if (< tvsp pt_vsp) (setq pt_vsp tvsp))
          (terpri)
        )
      )
    )
  )
  (princ "\rñσªr: ")
  (princ str)
  pt_rsp
)
;;;
;;; Bring up lines of text when deleting at the end of a line of text.
;;;
;;; pt_bul == PText_Bring_Up_Lines
;;;
(defun pt_bul (line)
  (if (< pt_cl (length TX:LST))
    (progn
      (setq str  (strcat
                   (substr str 1 (- pt_rsp 1))
                   (cdr(assoc 1 (entget (nth pt_cl TX:LST))))
                 )
            strlst (pt_psl str)       ; Parse string to list
            sset (ssadd)
            j    pt_cl
      )
      (entdel (nth pt_cl TX:LST))
      (setq TX:LST (pt_sil line TX:LST))
      (while (< j (length TX:LST))
        (ssadd (nth j TX:LST) sset)
        (setq j (1+ j))
      )
      (if (> (sslength sset) 0)
        (command "_.MOVE"
                 sset
                 ""
                 pt_spt
                 (polar pt_spt (+ pt_ra (/ pi 2)) pt_ils)
        )
      )
    )
  )
  ;; Else, do nothing.
)
;;;
;;; Strip the item from the list of enames in TX:LST.
;;;
;;; pt_sil == PText_Strip_Item_from_List
;;;
(defun pt_sil (temp lst / j k tmplst)
  (setq j   0
        k   (length lst)
  )
  (while (< j k)
    (if (= j (1- temp))
      (setq j (1+ j))                 ; Skip the entry...
      ;; else
      (setq tmplst (if tmplst
                     (append tmplst (list (nth j lst)))
                     (list (nth j lst))
                   )
            j      (1+ j)
      )
    )
  )
  tmplst
)
;;;
;;; Add the entity name to the list of enames in TX:LST.
;;; TX:LST must have at least one member.
;;;
;;; pt_ael == PText_Add_Ename_to_List
;;;
(defun pt_ael (ename temp lst / j k tmplst)
  (setq j   0
        k   (length lst)
  )
  (while (< j k)
    (setq tmplst (if tmplst
                   (append tmplst (list (nth j lst)))
                   (list (nth j lst))
                 )
          j      (1+ j)
    )
    (if (= j (1- temp))
      (setq tmplst (append tmplst (list ename)))
    )
  )
  tmplst
)
;;;
;;; Add the item (ename) to the list (lst).
;;;
;;; pt_ail == PText_Add_Item_to_List
;;;
(defun pt_ail (ename temp lst / j k tmplst)
  (setq j   0
        k   (length lst)
  )
  (while (< j k)
    (if (= j temp)
      (setq tmplst (if tmplst
                     (append tmplst (list ename))
                     (list ename)
                   )
            temp   nil
      )
    )
    (setq tmplst (if tmplst
                   (append tmplst (list (nth j lst)))
                   (list (nth j lst))
                 )
          j      (1+ j)
    )
  )
  (if temp (setq tmplst (if tmplst
                          (append tmplst (list ename))
                          (list ename)
                        )
           )
  )
  tmplst
)
;;;
;;; Add a character to a string
;;;
;;; pt_ats == PText_Add_char_To_String
;;;
(defun pt_ats (char appnd)
  ;; Add item (chr char) to list "strlst".
  (setq strlst (pt_ail (chr char) (if appnd pt_rsp (1- pt_rsp)) strlst))
  (if insert
    (progn
      (if (not appnd) (setq pt_vsp (1+ pt_vsp)))
      (setq pt_msp (1+ pt_msp))
    )
  )
  ;; If overwriting...
  (if (null insert)
    ;; Subtract item "pt_rsp" from list "strlst".
    (if (< pt_rsp pt_msp) (setq strlst (pt_sil pt_rsp strlst)))
  )
  (setq str    (pt_sjk 1 (length strlst)))
  (princ "\rñσªr: ")
  (princ str)
  (1+ pt_rsp)
)
;;;
;;; Process a newline character
;;;
;;; pt_pnl == PText_Process_NewLine
;;;
(defun pt_pnl (/ sset j)
  (if ent ; There should (!) always be an entity at this point...
    (progn
      ;; Get the correct "start point" for the current type of text entity...
      ;; This should correctly handle mixed text justification types.
      (setq pt_spt (cdr(assoc (if (or (= grp_72 2) ; Right justified
                                      (= grp_72 1) ; Left justified
                                  ) 11 10) ent))
            pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
      )
      (if (= grp_72 5)                ; if Fit text
        (setq pt_rpt (cdr(assoc 11 ent))
              pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils)
         )
      )
      (setq ent (subst (cons 1 (substr str 1 (1- pt_rsp))) (assoc 1 ent) ent))
      (if (= (cdr(assoc 1 ent)) "")
        (setq ent (subst (cons 1 " ") (assoc 1 ent) ent))
      )
      (entmod ent)
      ;; Null line at end of paragraph...
      (if (and (= pt_cl (length tx:lst)) (= str " "))
        (setq str "")                 ; Exit from routine.
        ;; else
        (progn
          (setq str (substr str pt_rsp)   ; The balance of the string.
                sl     (strlen str)
                pt_tsp (pt_cll sl nil)
                pt_str (pt_uls str pt_tsp)
                sset   (ssadd)
                j      pt_cl
          )
          (while (< j (length TX:LST))
            (ssadd (nth j TX:LST) sset)
            (setq j (1+ j))
          )
          (if (> (sslength sset) 0)
            (command "_.MOVE"
                     sset
                     ""
                     pt_spt
                     (polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
            )
          )
        )
      )
      (setq ent nil)
      (setq sl 0)
    )
    (progn
      (princ "\n│B▓z╖sªCñσªr┤┴╢í╣Jª│┐∙╗~íC")
      (exit)
    )
  )
)
;;;
;;; Process line
;;;
;;; pt_pl == PText_Process_Line
;;;
(defun pt_pl ()
  (if ent                             ; Modify the text string
    (entmod (setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent)))
    ;; else
    (progn
      (dr_txt pt_str)                 ; Draw the text string
      (setq TX:LST (if TX:LST
                     (pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
                     (list (cdr(assoc -1 ent)))
                   )
      )
    )
  )
)
;;;
;;; Get the maximum string position allowed on a line given the
;;; current contents of the variable "str".  Uses (pt_gll).
;;;
;;; pt_gmp == PText_Get_Maximum_string_Position
;;;
(defun pt_gmp (/ temp)
  ;; Get a temporary projected number of characters allowed on a line.
  ;; Check this against the actual line length of the real characters,
  ;; adding one character until either the end of the string is reached
  ;; or the maximum line length is reached.  Then start subtracting
  ;; characters until either a space or hypen is found, or the start of
  ;; the string is reached.  If the start of the string is reached, then
  ;; search forward on the string looking for the end of the word.  If
  ;; the end of the word is not found then return 1, else return the
  ;; wrap position on the line.

  (setq temp (round (/ pt_mll (* 0.8 pt_twf pt_th))))
  (while (and (< temp pt_rsp) (< (pt_gll temp) pt_mll))
    (setq temp (1+ temp))
  )
  (while (> (pt_gll temp) pt_mll)
    (setq temp (1- temp))
  )
  (while (and (> temp 1)
              (/= (nth (1- temp) strlst) " ") ; Back up until a space
              (/= (nth (1- temp) strlst) "-") ; or hyphen is found...
         )
    (setq temp (1- temp))
  )
  (if (= temp 1)
    (progn
      (setq temp (round (/ pt_mll (* 0.8 pt_twf pt_th))))
      (while (and (< temp pt_rsp)
                  (/= (nth (1- temp) strlst) " ") ; Back up until a space
                  (/= (nth (1- temp) strlst) "-") ; or hyphen is found...
             )
        (setq temp (1+ temp))
      )
    )
  )
  (if (= temp pt_rsp)
    1
    temp
  )
)
;;;
;;; Wrap the line at the end of the previous word, if there is one.
;;; Otherwise, if the line is short and/or the word is long enough
;;; to occupy the entire line length, then extend the word.
;;;
;;; pt_waw == PText_Wrap_At_Word
;;;
(defun pt_waw (/ temp)
  (setq temp (pt_gmp))                ; Get the maximum string position.

  (if (= grp_72 5)                    ; Fit text...
    ;; Set up to test if we are within the last 1/4 of the word,
    ;; and if so, we will cram the whole word on the line.
    (progn
      (setq line_l (* 0.9
                      pt_twf
                      pt_th
                      (- pt_rsp (* (- pt_rsp temp) 0.25)))
      )
    )
    ;; Else, set a dummy value large enough to trip the next test.
    (setq line_l (* 2 line_l))
  )
  (pt_cll temp T) ; Return the visual string position.
)
;;;
;;; Process word wrap.
;;;
;;; pt_pww == PText_Process_Word_Wrap
;;;
(defun pt_pww (loc / sset j)
  ;; Not at the start of a line and line is longer than  maximum specified...
  (if (and (> loc 1) (> line_l pt_mll))
    ;; Wrapping a text line...
    (progn
      (pt_pee) ; Process existing entity

      (pt_mne) ; Make the new text line here...
    )
    ;; Extending a text line...
    (progn

      ;; set the string that gets printed on-screen via (entmod).
      (setq pt_str (pt_uls str pt_rsp))
      (setq ent (subst (cons 1 pt_str) (assoc 1 ent) ent))
      (entmod ent)
    )
  )
)
;;;
;;; Process the existing string, entmoding it to its final form.
;;;
;;; pt_pee == PText_Process_Existing_Entity
;;;
(defun pt_pee ()
  (repeat (- (pt_cll pt_msp nil) loc) (princ (chr P_BACK))
                                      (princ (chr P_SPCE))
                                      (princ (chr P_BACK))
  )
  (princ "\rñσªr: ")
  ;; Strip trailing space.
  (while (= (nth (1- loc) strlst) " ") (setq loc (1- loc)))
  (setq ent    (subst
                 (cons 1 (princ (pt_sjk 1 loc))) ; print the string
                 (assoc 1 ent)
                 ent
               )
        pt_cl  (1+ pt_cl)
        pt_spt (cdr(assoc (if (or (= grp_72 2)
                                  (= grp_72 1)) 11 10) ent))
        str    (pt_sjk (+ loc 2)  (length strlst))
        strlst (pt_psl str)           ; Parse string to list
        pt_msp (pt_cll (length strlst) T) ; Check line length
        pt_vsp (pt_cll (- pt_rsp loc 1) T)
        pt_rsp (pt_cll pt_vsp nil)    ; Get character position/size
  )
  (if (< pt_vsp 1) (setq pt_vsp 1))
  (entmod ent)
)
;;;
;;; Make a new entity after a word wrap.
;;;
;;; pt_mne == PText_Make_New_Entity
;;;
(defun pt_mne ()
  (princ "\nñσªr: ")
  (princ str)
  ;; set the string that gets printed on-screen via (entmod).
  (setq pt_str (pt_uls str pt_rsp))

  (if (<= pt_cl (length TX:LST))
    (progn
      (setq pt_spt (cdr(assoc (if (or (= grp_72 2)
                                      (= grp_72 1)) 11 10) ent))
      )
      (if (= grp_72 5)                ; if Fit text
        (setq pt_rpt (cdr(assoc 11 ent))
              pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils)
        )
      )
    )
    ;; else
    (princ)
  )

  (pt_fww)

  (setq pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils))
  (dr_txt pt_str)                     ; Draw the text string
  (setq TX:LST (if TX:LST
                 (pt_ael (cdr(assoc -1 ent)) pt_cl TX:LST)
                 (list (cdr(assoc -1 ent)))
               )
  )
)
;;;
;;; Finish up a word wrap; get ready for the next character.
;;; Move any entities that may follow down by one space.
;;;
;;; pt_fww == PText_Finish_Word_wrap
;;;
(defun pt_fww ()
  (setq sset   (ssadd)
        j      (1- pt_cl)
  )
  (while (< j (length TX:LST))
    (ssadd (nth j TX:LST) sset)
    (setq j (1+ j))
  )
  (if (> (sslength sset) 0)
    (command "_.MOVE"
             sset
             ""
             pt_spt
             (polar pt_spt (- pt_ra (/ pi 2)) pt_ils)
    )
  )
)
;;;
;;; Delete a line and back up to the previous one
;;;
;;; pt_dal == PText_Delete_A_Line
;;;
(defun pt_dal (temp / )
  ;; Remove last ename if at the maximum string position discounting
  ;; control characters.  Both should be 1.
  (if (= pt_vsp pt_msp)
    (if temp
      (progn
        (repeat (1+ (strlen str))
          (princ (chr P_BACK))
          (princ (chr P_SPCE))
          (princ (chr P_BACK))
        )
        (princ "* ºR░ú *")
      )
      (progn
        (entmod (subst (cons 1 str) (assoc 1 ent) ent))
        (setq str "")
      )
    )
    (entmod (subst (cons 1 str) (assoc 1 ent) ent))
  )
  (terpri)
  (setq pt_cl (1- pt_cl)
        ent   (if (and (> pt_cl 0) (> (length TX:LST) 0))
                (entget (nth (1- pt_cl) TX:LST))
                nil
              )
  )
  (if ent
    (progn
      (if temp
        (progn
          (pt_bul (1+ pt_cl))        ; Bring up lines following this line.
          (setq st     (pt_psl (cdr(assoc 1 ent)))
                str    (strcat (cdr(assoc 1 ent)) str)
          )
        )
        (setq str    (cdr(assoc 1 ent)))
      )
      (setq strlst (pt_psl str)
            pt_vsp (1+ (pt_cll (length st) nil))
            pt_msp (pt_cll (length strlst) T)
            pt_spt (polar pt_spt (+ pt_ra (/ pi 2)) pt_ils)
      )
      (princ str)
      (if (= grp_72 5)
        (setq pt_rpt (polar pt_rpt (+ pt_ra (/ pi 2)) pt_ils))
      )
    )
    (progn
      (setq TX:LST nil
            ent    nil
      )
    )
  )
)
;;;
;;; Draw each text item
;;;
;;;
(defun dr_txt (str / j)
  (setq j (* pt_ra (/ 180 pi)))       ; rotation angle in decimal degrees.
  (cond
    ((= grp_72 0) (command "_.TEXT" pt_spt pt_th j str))
    ((= grp_72 1) (command "_.TEXT" "_C" pt_spt pt_th j str))
    ((= grp_72 2) (command "_.TEXT" "_R" pt_spt pt_th j str))
    ((= grp_72 5) (command "_.TEXT" "_F" pt_spt pt_rpt pt_th str))
  )
  (setq ent (entget(entlast)))
  (setq pt_spt (cdr(assoc (if (or (= grp_72 2) (= grp_72 1)) 11 10) ent)))
  (setq pt_spt (polar pt_spt (- pt_ra (/ pi 2)) pt_ils))
  (if (= grp_72 5)
    (setq pt_rpt (polar pt_rpt (- pt_ra (/ pi 2)) pt_ils))
  )
  ent
)

;;;
;;; Round a number off to the nearest integer correctly
;;;
;;;
(defun round (num)
  (if (>= (- num (fix num)) 0.5)
    (fix (1+ num))
    (fix num)
  )
)
;;; ------------------ Cut here ----------------------------------
;;;
;;; C: function definition.
;;;
(defun c:pt () (ptext))
(defun c:ptext () (ptext))
(princ "\n\tíuC:PTextívñw╕ⁿñJ; ╜╨ÑH PT ⌐╬ PTEXT ▒╥░╩½ⁿÑOíC")
(princ)