;;; ---------------------------------------------------------------------------
;;; GraphGrid.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; GRAPH PAPER WITH LABELLED AXES
;;;
;;; PURPOSE
;;;   Draws a ruled grid with both axes numbered - the background for a section
;;;   through a road or drain, a settlement plot, a load curve, a pressure test,
;;;   anything read off rather than dimensioned.
;;;
;;;   Each axis takes a starting value, how much each square is worth, and how
;;;   often to write a number. So a chainage axis can run 0, 25, 50 in squares
;;;   of 5, and the level axis alongside it can run in metres.
;;;
;;; WHAT WAS FIXED
;;;   - It used T as a variable to hold each label:
;;;
;;;         (setq t (itoa (fix vbl)))
;;;
;;;     T is the symbol for true. Overwriting it breaks every test in the
;;;     session - including inside AutoCAD's own routines - until the drawing is
;;;     closed. This is the single most damaging thing a LISP routine can do,
;;;     and this one did it twice, once per axis.
;;;   - Labels were written with (itoa (fix ...)), so every one was rounded down
;;;     to a whole number. An axis in increments of 0.5 was labelled 0, 0, 1, 1,
;;;     2, 2 - and an axis running in tenths was labelled all zeros.
;;;   - The grid was built by drawing one line and ARRAYing it, which meant two
;;;     command invocations per axis and left the result as separate objects
;;;     with no way to tell the grid from the plot.
;;;   - CMDECHO and BLIPMODE were set to 1 at the end rather than to what they
;;;     had been.
;;;   - All eighteen variables were global.
;;;
;;;   GRAPHGRID  - ruled and numbered graph grid
;;; ---------------------------------------------------------------------------

(defun Graph: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 Graph:Line ( p1 p2 layer )
    (entmake (list '(0 . "LINE") (cons 8 layer) (cons 10 p1) (cons 11 p2)))
)

;;; JUST is 0 left, 1 centred, 2 right. Group 11 has to carry the point too
;;; whenever the justification is not the default.
(defun Graph:Text ( pt hgt txt layer just )
    (entmake (list '(0 . "TEXT") (cons 8 layer) (cons 10 pt) (cons 11 pt)
                   (cons 40 hgt) (cons 1 txt) (cons 72 just) '(73 . 2)))
)

;;; A number written without a trailing ".00" when it is a whole one, and to
;;; enough places to tell one gridline from the next when it is not.
(defun Graph:Num ( v step )
    (cond ((equal v (float (fix v)) 1e-9) (itoa (fix v)))
          ((>= (abs step) 1.0) (rtos v 2 1))
          ((>= (abs step) 0.1) (rtos v 2 2))
          (t (rtos v 2 3)))
)

(defun c:GRAPHGRID ( / *error* vars vals org rows cols sx sy lay layt
                       hgt xBase xStep xEvery yBase yStep yEvery
                       i x y w h v n )

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

    (defun Graph: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 )
        (Graph:Restore)
        (if (and msg (not (wcmatch (strcase msg t) "*break*,*cancel*,*exit*")))
            (princ (strcat "\n** GRAPHGRID 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")

    (initget 7)
    (setq cols (getint "\nNumber of squares across: "))
    (initget 7)
    (setq rows (getint "\nNumber of squares up: "))
    (initget 7)
    (setq sx (getdist "\nWidth of one square: "))
    (initget 7)
    (setq sy (getdist (strcat "\nHeight of one square <" (rtos sx 2 3) ">: ")))
    (if (null sy) (setq sy sx))

    (setq org (getpoint "\nBottom left corner: "))

    (if (or (null cols) (null rows) (null sx) (null org))
        (princ "\nCancelled.")
        (progn
            (setvar "OSMODE" 0)
            (setq org (list (car org) (cadr org) 0.0)
                  w   (* cols sx)
                  h   (* rows sy))

            ;; --- what the axes mean ------------------------------------------
            (initget 1)
            (setq xBase (getreal "\nValue at the left-hand edge: "))
            (initget 3)
            (setq xStep (getreal "\nValue per square across: "))
            (initget 6)
            (setq xEvery (getint "\nNumber every how many squares across <1>: "))
            (if (null xEvery) (setq xEvery 1))

            (initget 1)
            (setq yBase (getreal "\nValue at the bottom edge: "))
            (initget 3)
            (setq yStep (getreal "\nValue per square up: "))
            (initget 6)
            (setq yEvery (getint "\nNumber every how many squares up <1>: "))
            (if (null yEvery) (setq yEvery 1))

            (setq hgt (getvar "TEXTSIZE"))
            (if (or (null hgt) (<= hgt 0.0)) (setq hgt (/ (min sx sy) 2.0)))
            (initget 6)
            (setq v (getdist (strcat "\nText height <" (rtos hgt 2 3) ">: ")))
            (if v (setq hgt v))

            (setq lay  (Graph:Layer "Graph-Grid" 8)
                  layt (Graph:Layer "Graph-Text" 7)
                  n    0)

            ;; --- the ruling ---------------------------------------------------
            (setq i 0)
            (while (<= i cols)
                (setq x (+ (car org) (* i sx)))
                (Graph:Line (list x (cadr org) 0.0)
                            (list x (+ (cadr org) h) 0.0) lay)
                ;; Numbers below the axis, centred on their line.
                (if (zerop (rem i xEvery))
                    (progn
                        (Graph:Text (list x (- (cadr org) (* hgt 1.4)) 0.0)
                                    hgt
                                    (Graph:Num (+ xBase (* i xStep)) xStep)
                                    layt 1)
                        (setq n (1+ n))))
                (setq i (1+ i)))

            (setq i 0)
            (while (<= i rows)
                (setq y (+ (cadr org) (* i sy)))
                (Graph:Line (list (car org) y 0.0)
                            (list (+ (car org) w) y 0.0) lay)
                ;; Numbers to the left, right-justified so they line up.
                (if (zerop (rem i yEvery))
                    (progn
                        (Graph:Text (list (- (car org) (* hgt 0.6)) y 0.0)
                                    hgt
                                    (Graph:Num (+ yBase (* i yStep)) yStep)
                                    layt 2)
                        (setq n (1+ n))))
                (setq i (1+ i)))

            (princ (strcat "\n" (itoa cols) " by " (itoa rows)
                           " grid, " (itoa n) " labels."
                           "\n  Across " (Graph:Num xBase xStep) " to "
                           (Graph:Num (+ xBase (* cols xStep)) xStep)
                           ",  up " (Graph:Num yBase yStep) " to "
                           (Graph:Num (+ yBase (* rows yStep)) yStep) "."))
        )
    )

    (Graph:Restore)
    (princ)
)

(princ)