;;; ---------------------------------------------------------------------------
;;; TerminalStrip.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; NUMBERED TERMINAL STRIP
;;;
;;; PURPOSE
;;;   Draws a terminal block - a ladder of numbered terminals at an even pitch,
;;;   at any angle, with a prefix and suffix on the numbers.
;;;
;;;   For control panel drawings, junction boxes, marshalling cabinets: anywhere
;;;   a row of numbered connections has to be drawn and labelled.
;;;
;;;   Numbers can count up or down, in any step, so a strip wired from the far
;;;   end reads correctly.
;;;
;;; WHAT WAS FIXED
;;;   - Four variables were global despite a careful list of locals - the strip
;;;     length, the text style name, the style height and the assembled label.
;;;   - When the text style had a fixed height the routine printed
;;;     "Fixed height text?  You use fixed height text?" at the user and carried
;;;     on. It is a perfectly ordinary way to set a drawing up.
;;;   - The terminal numbers were built with ITOA, so a strip could only be
;;;     numbered in whole numbers - no 1A, 1B, no 101.1.
;;;   - There was no error handler and no undo group, so a cancelled strip left
;;;     however many terminals it had drawn, each needing its own U.
;;;
;;;   TERMSTRIP  - draw a numbered terminal strip
;;; ---------------------------------------------------------------------------

(setq *Term:Pitch* nil *Term:Width* nil)

(defun Term:Layer ( name colour )
    (if (not (tblsearch "LAYER" name))
        (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord")
                       '(100 . "AcDbLayerTableRecord") (cons 2 name)
                       '(70 . 0) (cons 62 colour) '(6 . "Continuous"))))
    name
)

(defun Term:Line ( p1 p2 layer )
    (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))
)

;;; Middle-centred text, so a number sits squarely in its terminal whatever its
;;; length. Group 11 carries the point as well when justification is set.
(defun Term:Text ( pt hgt rot txt layer )
    (entmake (list '(0 . "TEXT") (cons 8 layer) (cons 10 pt) (cons 11 pt)
                   (cons 40 hgt) (cons 1 txt) (cons 50 rot)
                   '(72 . 1) '(73 . 2)))
)

;;; A terminal number. Whole numbers come out clean; a fractional step keeps
;;; enough places to tell one terminal from the next.
(defun Term:Num ( v step )
    (if (and (equal v (float (fix v)) 1e-9) (equal step (float (fix step)) 1e-9))
        (itoa (fix v))
        (rtos v 2 (if (>= (abs step) 0.1) 1 2)))
)

(defun c:TERMSTRIP ( / *error* vars vals org ang width pitch count start step
                       pref suff lay hgt v i num p1 p2 txtang style )

    (setq vars '("CMDECHO" "BLIPMODE" "OSMODE" "CLAYER")
          vals (mapcar 'getvar vars))

    (defun Term:Restore ( )
        (mapcar 'setvar vars vals)
        (while (= 8 (logand 8 (getvar 'undoctl))) (command "_.UNDO" "_End"))
        (vl-catch-all-apply '(lambda ( ) (*pop-error-mode*)) '())
        (princ)
    )

    (defun *error* ( msg )
        (Term:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** TERMSTRIP error: " msg " **")))
        (princ)
    )

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 0)
    ;; AutoCAD 2015 and later refuse (command) inside an *error* handler unless
    ;; the routine says up front that it will use one.
    (vl-catch-all-apply '(lambda ( ) (*push-error-using-command*)) '())
    (command "_.UNDO" "_Begin")

    (setq org (getpoint "\nTop left corner of the strip: "))

    (if (null org)
        (princ "\nCancelled.")
        (progn
            (setvar "OSMODE" 0)
            (setq org (list (car org) (cadr org) 0.0))

            (setq ang (getangle org "\nDirection the strip runs <down>: "))
            (if (null ang) (setq ang (* 1.5 pi)))

            (initget 6)
            (setq width (getdist (strcat "\nWidth of the strip"
                                         (if *Term:Width*
                                             (strcat " <" (rtos *Term:Width* 2 3) ">") "")
                                         ": ")))
            (if (null width) (setq width *Term:Width*))
            (initget 6)
            (setq pitch (getdist (strcat "\nPitch between terminals"
                                         (if *Term:Pitch*
                                             (strcat " <" (rtos *Term:Pitch* 2 3) ">") "")
                                         ": ")))
            (if (null pitch) (setq pitch *Term:Pitch*))

            (if (not (and width pitch))
                (princ "\nNot enough given to draw a strip.")
                (progn
                    (setq *Term:Width* width *Term:Pitch* pitch)

                    (initget 7)
                    (setq count (getint "\nHow many terminals: "))

                    (initget 1)
                    (setq start (getreal "\nNumber of the first terminal <1>: "))
                    (if (null start) (setq start 1.0))
                    (initget 2)
                    (setq step (getreal "\nStep, negative to count down <1>: "))
                    (if (null step) (setq step 1.0))

                    (setq pref (getstring t "\nPrefix, or Enter for none: ")
                          suff (getstring t "\nSuffix, or Enter for none: "))

                    ;; Text height from the style if it has one.
                    (setq style (tblsearch "STYLE" (getvar "TEXTSTYLE"))
                          hgt   (cdr (assoc 40 style)))
                    (if (or (null hgt) (<= hgt 0.0)) (setq hgt (* pitch 0.5)))
                    (initget 6)
                    (setq v (getdist (strcat "\nText height <" (rtos hgt 2 3) ">: ")))
                    (if v (setq hgt v))

                    ;; Numbers read along the strip unless they would come out
                    ;; upside down.
                    (setq txtang (+ ang (/ pi 2.0)))
                    (if (and (> txtang (/ pi 2.0)) (< txtang (* 1.5 pi)))
                        (setq txtang (+ txtang pi)))

                    (setq lay (Term:Layer "Terminals" 7) i 0)

                    ;; The two long edges.
                    (Term:Line org (polar org ang (* count pitch)) lay)
                    (Term:Line (polar org (+ ang (/ pi 2.0)) (- width))
                               (polar (polar org ang (* count pitch))
                                      (+ ang (/ pi 2.0)) (- width))
                               lay)

                    ;; A divider above each terminal, the number inside it.
                    (while (<= i count)
                        (setq p1 (polar org ang (* i pitch))
                              p2 (polar p1 (+ ang (/ pi 2.0)) (- width)))
                        (Term:Line p1 p2 lay)
                        (if (< i count)
                            (progn
                                (setq num (Term:Num (+ start (* i step)) step))
                                (Term:Text
                                    (polar (polar p1 ang (/ pitch 2.0))
                                           (+ ang (/ pi 2.0)) (/ (- width) 2.0))
                                    hgt txtang
                                    (strcat pref num suff) lay)))
                        (setq i (1+ i)))

                    (princ (strcat "\n" (itoa count) " terminals, "
                                   pref (Term:Num start step) suff " to "
                                   pref (Term:Num (+ start (* (1- count) step)) step)
                                   suff ", at " (rtos pitch 2 3) " pitch.")))))
    )

    (Term:Restore)
    (princ)
)

(princ)