;;; ---------------------------------------------------------------------------
;;; Cannon.lsp
;;; code compiled by YZ August 2026
;;; ---------------------------------------------------------------------------
;;; ARTILLERY - A BALLISTICS GAME
;;;
;;; PURPOSE
;;;   A cannon at one end, an ammunition dump somewhere down range, and a
;;;   parabola between them. Set the elevation and the muzzle velocity and try to
;;;   land a shot on the target.
;;;
;;;   It is a game, but the trajectory is honest: the shot follows
;;;
;;;       x = x0 + v cos(a) t
;;;       y = y0 + v sin(a) t - g t^2
;;;
;;;   which is projectile motion with no drag. Doubling the velocity quadruples
;;;   the range, forty-five degrees carries furthest, and every elevation below
;;;   that has a matching one above it that lands in the same place. All of that
;;;   falls out of the maths rather than being faked.
;;;
;;; WHAT WAS FIXED
;;;   The original left the drawing wrecked. It set LIMITS to a hard-coded
;;;   -600,-300 to 1800,1080, turned LIMCHECK off, zoomed to those limits, and
;;;   set CMDECHO, BLIPMODE and HIGHLIGHT without ever putting any of them back.
;;;   Its own last instruction was to print "Please QUIT this Drawing" - which is
;;;   an honest admission, but not a fix.
;;;
;;;   Here the whole game is drawn as TEMPORARY VECTORS. Nothing is added to the
;;;   drawing at all, the view is restored, and every system variable goes back.
;;;   You can play it in the middle of real work and lose nothing.
;;;
;;; THE RANDOM TARGET
;;;   1980s AutoLISP had no random number function, so the original carried a
;;;   table of a hundred hand-written decimals. The table is kept - it is
;;;   perfectly good - but the starting point is taken from the clock, so the
;;;   targets differ from game to game instead of repeating the same hundred.
;;;
;;;   CANNON  - play artillery
;;; ---------------------------------------------------------------------------

;;; ---------------------------------------------------------------------------
;;; THE FIELD
;;;
;;; All distances are in drawing units. The cannon stands at the origin of the
;;; play area, the ground is the line y = 0, and the target lands somewhere
;;; between the two ranges below.
;;; ---------------------------------------------------------------------------

(setq Cannon:MINRANGE  300.0
      Cannon:MAXRANGE 1500.0
      Cannon:GRAVITY     2.735   ; per time step squared, as the original had it
      Cannon:HITRADIUS  60.0     ; how close counts as a hit
      Cannon:MUZZLEANG   0.197395 ; muzzle offset from the pivot, radians
      Cannon:MUZZLEDIST 122.3765)

;;; The original's random table. A hundred values, and good enough for a game.
(setq Cannon:Seed
    '(0.92412 0.75081 0.49014 0.09867 0.43629 0.06930 0.85240 0.55830 0.31190
      0.95364 0.50503 0.43701 0.24999 0.76237 0.27236 0.20589 0.79133 0.50998
      0.35895 0.13145 0.76697 0.15255 0.36356 0.02105 0.01037 0.05387 0.35834
      0.56651 0.32854 0.77913 0.85262 0.49690 0.25513 0.17181 0.34821 0.51985
      0.55691 0.59619 0.40174 0.31858 0.63265 0.07755 0.43698 0.47971 0.63173
      0.63858 0.79850 0.95529 0.12762 0.21966 0.50574 0.30996 0.30940 0.97785
      0.65484 0.37272 0.70261 0.28809 0.22328 0.80026 0.19859 0.21764 0.96066
      0.26729 0.45940 0.41294 0.89672 0.32688 0.37378 0.02626 0.56586 0.23204
      0.96704 0.31713 0.13530 0.97792 0.81630 0.69192 0.03222 0.31153 0.39023
      0.99266 0.19282 0.26443 0.62042 0.61436 0.50483 0.69151 0.21966 0.31796
      0.18239 0.14698 0.59028 0.21429 0.50064 0.99692 0.41380 0.12192 0.32520
      0.75543))

;;; Next value from the table, wrapping round. The index is a global so the
;;; sequence carries on across shots rather than restarting each time.
(if (null *Cannon:Index*)
    ;; Seeded from the fraction of the day, so a new session starts elsewhere in
    ;; the table and the targets are not the same hundred every time.
    (setq *Cannon:Index*
          (fix (* 100.0 (- (getvar "DATE") (fix (getvar "DATE"))) 10.0))))

(defun Cannon:Random ( / v )
    (setq *Cannon:Index* (rem (1+ *Cannon:Index*) 100)
          v (nth *Cannon:Index* Cannon:Seed))
    (if v v 0.5)
)

;;; ---------------------------------------------------------------------------
;;; DRAWING, ALL TEMPORARY
;;;
;;; GRDRAW puts vectors straight on the screen without creating objects. They
;;; clear on the next redraw, which is exactly what a game wants and why nothing
;;; here needs cleaning up afterwards.
;;; ---------------------------------------------------------------------------

;;; A point relative to the field origin.
(defun Cannon:P ( org x y ) (list (+ (car org) x) (+ (cadr org) y) 0.0))

;;; The same, rotated about the origin first - used for the barrel, which
;;; elevates.
(defun Cannon:R ( org x y ang )
    (list (+ (car org) (- (* x (cos ang)) (* y (sin ang))))
          (+ (cadr org) (+ (* x (sin ang)) (* y (cos ang))))
          0.0)
)

(defun Cannon:Chain ( pts colour / prev )
    (setq prev (car pts))
    (foreach p (cdr pts) (grdraw prev p colour) (setq prev p))
    (princ)
)

;;; A circle, drawn as a temporary polygon. GRDRAW has no circle of its own.
(defun Cannon:Circle ( cen rad colour / i n pts )
    (setq n 24 i 0 pts nil)
    (while (<= i n)
        (setq pts (cons (polar cen (/ (* 2.0 pi i) n) rad) pts) i (1+ i)))
    (Cannon:Chain (reverse pts) colour)
)

;;; The gun: barrel, breech and two wheels, elevated to the firing angle.
;;; Coordinates are the original block's, taken relative to its base point.
(defun Cannon:Gun ( org ang colour )
    (Cannon:Chain
        (list (Cannon:R org -48.0 48.0 ang)
              (Cannon:R org 120.0 36.0 ang)
              (Cannon:R org 120.0 12.0 ang)
              (Cannon:R org  35.5025 5.9645 ang))
        colour)
    (Cannon:Chain
        (list (Cannon:R org -48.0 0.0 ang)
              (Cannon:R org -35.9898 0.8579 ang))
        colour)
    ;; Breech, the semicircular end behind the trunnions.
    (Cannon:Chain
        (list (Cannon:R org -48.0 48.0 ang)
              (Cannon:R org -72.0 24.0 ang)
              (Cannon:R org -48.0  0.0 ang))
        colour)
    ;; Wheels sit on the pivot and do not turn with the barrel.
    (Cannon:Circle (Cannon:P org 0.0 0.0) 24.0 colour)
    (Cannon:Circle (Cannon:P org 0.0 0.0) 36.0 colour)
)

;;; The ammunition dump, down range.
(defun Cannon:Dump ( org x colour )
    (Cannon:Chain
        (list (Cannon:P org (+ x -12.0)   0.0) (Cannon:P org (+ x -12.0) -36.0)
              (Cannon:P org (+ x -48.0) -36.0) (Cannon:P org (+ x -48.0)   0.0)
              (Cannon:P org (+ x  48.0)   0.0) (Cannon:P org (+ x  48.0) -36.0)
              (Cannon:P org (+ x  12.0) -36.0) (Cannon:P org (+ x  12.0)   0.0))
        colour)
    (Cannon:Chain
        (list (Cannon:P org (+ x  18.0)  0.0) (Cannon:P org (+ x  18.0) 36.0)
              (Cannon:P org (+ x -18.0) 36.0) (Cannon:P org (+ x -18.0)  0.0))
        colour)
)

;;; ---------------------------------------------------------------------------
;;; MAIN COMMAND
;;; ---------------------------------------------------------------------------

(defun c:CANNON ( / *error* vars vals org targetX vel elev rads
                    muzzle t0 bx by prev dist hit shots playing v ground )

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

    ;; Nothing is created, so there is no undo group to close and no (command)
    ;; call in the error path - which is why this one needs no error-mode
    ;; declaration.
    (defun Cannon:Restore ( )
        (redraw)
        (mapcar 'setvar vars vals)
        (princ)
    )

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

    (setvar "CMDECHO" 0)
    (setvar "BLIPMODE" 0)
    (setvar "OSMODE" 0)

    (princ "\nArtillery. Nothing is added to the drawing - it is all temporary.")
    (setq org (getpoint "\nWhere should the cannon stand: "))

    (if (null org)
        (princ "\nCancelled.")
        (progn
            (setq org     (list (car org) (cadr org) 0.0)
                  targetX (+ Cannon:MINRANGE
                             (* (Cannon:Random)
                                (- Cannon:MAXRANGE Cannon:MINRANGE)))
                  ground  (Cannon:P org 0.0 0.0)
                  shots   0
                  playing t
                  elev    45.0
                  vel     100.0)

            (princ (strcat "\nTarget is " (rtos targetX 2 0) " units down range."))

            (while playing

                ;; --- redraw the scene --------------------------------------
                (redraw)
                (grdraw (Cannon:P org -100.0 0.0)
                        (Cannon:P org (+ targetX 200.0) 0.0) 8)   ; the ground
                (Cannon:Dump org targetX 2)

                (initget 6)
                (setq v (getreal (strcat "\nElevation in degrees <"
                                         (rtos elev 2 1) ">: ")))
                (if v (setq elev v))

                (initget 6)
                (setq v (getreal (strcat "\nMuzzle velocity <"
                                         (rtos vel 2 1) ">: ")))
                (if v (setq vel v))

                (setq rads   (/ (* pi elev) 180.0)
                      muzzle (polar org (+ Cannon:MUZZLEANG rads) Cannon:MUZZLEDIST))

                (Cannon:Gun org rads 7)

                ;; --- fly the shot -------------------------------------------
                ;; One time step per iteration, plotting where the shot is.
                (setq t0 0 prev muzzle hit nil dist 1e9)
                (while (and (not hit) (< t0 400))
                    (setq t0 (1+ t0)
                          bx (+ (car muzzle) (* vel (cos rads) t0))
                          by (+ (cadr muzzle)
                                (- (* vel (sin rads) t0)
                                   (* Cannon:GRAVITY t0 t0))))

                    (grdraw prev (list bx by 0.0) 1)
                    (setq prev (list bx by 0.0))

                    (setq dist (distance (list bx by)
                                         (list (+ (car org) targetX) (cadr org))))
                    (cond
                        ((< dist Cannon:HITRADIUS) (setq hit t))
                        ;; Below the ground, or off the end of the field.
                        ((< by (- (cadr org) 72.0)) (setq hit 'miss))
                        ((> (- bx (car org)) (+ Cannon:MAXRANGE 400.0)) (setq hit 'miss))))

                (setq shots (1+ shots))

                (if (eq hit t)
                    (progn
                        (Cannon:Circle (list (+ (car org) targetX) (cadr org) 0.0)
                                       Cannon:HITRADIUS 1)
                        (princ (strcat "\n\nDIRECT HIT, in " (itoa shots)
                                       " shot" (if (= shots 1) "" "s") "."))
                        (setq playing nil))
                    (progn
                        (princ (strcat "\nMissed by " (rtos dist 2 0)
                                       ". Shots fired: " (itoa shots)))
                        (initget "Yes No")
                        (if (= "No" (getkword "\nAnother [Yes/No] <Yes>: "))
                            (setq playing nil))))
            )

            (princ "\nGame over.")
        )
    )

    (Cannon:Restore)
    (princ)
)

(princ)
