;; geometry.sx — Multiple dispatch with CLOS
;;
;; Demonstrates generic functions dispatching on combinations of
;; geometric types: point, line, plane.
;;
;; Depends on: lib/common-lisp/runtime.sx, lib/common-lisp/clos.sx

;; ── geometric classes ──────────────────────────────────────────────────────

(clos-defclass "geo-point" (list "t") (list {:initform 0 :initarg ":px" :reader nil :writer nil :accessor nil :name "px"} {:initform 0 :initarg ":py" :reader nil :writer nil :accessor nil :name "py"}))

(clos-defclass "geo-line" (list "t") (list {:initform nil :initarg ":p1" :reader nil :writer nil :accessor nil :name "p1"} {:initform nil :initarg ":p2" :reader nil :writer nil :accessor nil :name "p2"}))

(clos-defclass "geo-plane" (list "t") (list {:initform nil :initarg ":normal" :reader nil :writer nil :accessor nil :name "normal"} {:initform 0 :initarg ":d" :reader nil :writer nil :accessor nil :name "d"}))

;; ── helpers ────────────────────────────────────────────────────────────────

(define geo-point-x (fn (p) (clos-slot-value p "px")))
(define geo-point-y (fn (p) (clos-slot-value p "py")))

(define
  geo-make-point
  (fn (x y) (clos-make-instance "geo-point" ":px" x ":py" y)))

(define
  geo-make-line
  (fn (p1 p2) (clos-make-instance "geo-line" ":p1" p1 ":p2" p2)))

(define
  geo-make-plane
  (fn
    (nx ny d)
    (clos-make-instance "geo-plane" ":normal" (list nx ny) ":d" d)))

;; ── describe generic ───────────────────────────────────────────────────────

(clos-defgeneric "geo-describe" {})

(clos-defmethod
  "geo-describe"
  (list)
  (list "geo-point")
  (fn
    (args next-fn)
    (let
      ((p (first args)))
      (str "P(" (geo-point-x p) "," (geo-point-y p) ")"))))

(clos-defmethod
  "geo-describe"
  (list)
  (list "geo-line")
  (fn
    (args next-fn)
    (let
      ((l (first args)))
      (str
        "L["
        (clos-call-generic "geo-describe" (list (clos-slot-value l "p1")))
        "-"
        (clos-call-generic "geo-describe" (list (clos-slot-value l "p2")))
        "]"))))

(clos-defmethod
  "geo-describe"
  (list)
  (list "geo-plane")
  (fn
    (args next-fn)
    (let
      ((pl (first args)))
      (str "Plane(d=" (clos-slot-value pl "d") ")"))))

;; ── intersect: multi-dispatch generic ─────────────────────────────────────
;;
;; Returns a string description of the intersection result.

(clos-defgeneric "intersect" {})

;; point ∩ point: same if coordinates match
(clos-defmethod
  "intersect"
  (list)
  (list "geo-point" "geo-point")
  (fn
    (args next-fn)
    (let
      ((p1 (first args)) (p2 (first (rest args))))
      (if
        (and
          (= (geo-point-x p1) (geo-point-x p2))
          (= (geo-point-y p1) (geo-point-y p2)))
        "point"
        "empty"))))

;; point ∩ line: check if point lies on line (cross product = 0)
(clos-defmethod
  "intersect"
  (list)
  (list "geo-point" "geo-line")
  (fn
    (args next-fn)
    (let
      ((pt (first args)) (ln (first (rest args))))
      (let
        ((lp1 (clos-slot-value ln "p1")) (lp2 (clos-slot-value ln "p2")))
        (let
          ((dx (- (geo-point-x lp2) (geo-point-x lp1)))
            (dy (- (geo-point-y lp2) (geo-point-y lp1)))
            (ex (- (geo-point-x pt) (geo-point-x lp1)))
            (ey (- (geo-point-y pt) (geo-point-y lp1))))
          (if (= (- (* dx ey) (* dy ex)) 0) "point" "empty"))))))

;; line ∩ line: parallel (same slope = empty) or point
(clos-defmethod
  "intersect"
  (list)
  (list "geo-line" "geo-line")
  (fn
    (args next-fn)
    (let
      ((l1 (first args)) (l2 (first (rest args))))
      (let
        ((p1 (clos-slot-value l1 "p1"))
          (p2 (clos-slot-value l1 "p2"))
          (p3 (clos-slot-value l2 "p1"))
          (p4 (clos-slot-value l2 "p2")))
        (let
          ((dx1 (- (geo-point-x p2) (geo-point-x p1)))
            (dy1 (- (geo-point-y p2) (geo-point-y p1)))
            (dx2 (- (geo-point-x p4) (geo-point-x p3)))
            (dy2 (- (geo-point-y p4) (geo-point-y p3))))
          (let
            ((cross (- (* dx1 dy2) (* dy1 dx2))))
            (if (= cross 0) "parallel" "point")))))))

;; line ∩ plane: general case = point (or parallel if line ⊥ normal)
(clos-defmethod
  "intersect"
  (list)
  (list "geo-line" "geo-plane")
  (fn
    (args next-fn)
    (let
      ((ln (first args)) (pl (first (rest args))))
      (let
        ((p1 (clos-slot-value ln "p1"))
          (p2 (clos-slot-value ln "p2"))
          (n (clos-slot-value pl "normal")))
        (let
          ((dx (- (geo-point-x p2) (geo-point-x p1)))
            (dy (- (geo-point-y p2) (geo-point-y p1)))
            (nx (first n))
            (ny (first (rest n))))
          (let
            ((dot (+ (* dx nx) (* dy ny))))
            (if (= dot 0) "parallel" "point")))))))

;; ── tests ─────────────────────────────────────────────────────────────────

(define passed 0)
(define failed 0)
(define failures (list))

(define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))

;; describe
(check
  "describe point"
  (clos-call-generic
    "geo-describe"
    (list (geo-make-point 3 4)))
  "P(3,4)")
(check
  "describe line"
  (clos-call-generic
    "geo-describe"
    (list
      (geo-make-line
        (geo-make-point 0 0)
        (geo-make-point 1 1))))
  "L[P(0,0)-P(1,1)]")
(check
  "describe plane"
  (clos-call-generic
    "geo-describe"
    (list (geo-make-plane 0 1 5)))
  "Plane(d=5)")

;; intersect point×point
(check
  "P∩P same"
  (clos-call-generic
    "intersect"
    (list
      (geo-make-point 2 3)
      (geo-make-point 2 3)))
  "point")
(check
  "P∩P diff"
  (clos-call-generic
    "intersect"
    (list
      (geo-make-point 1 2)
      (geo-make-point 3 4)))
  "empty")

;; intersect point×line
(let
  ((origin (geo-make-point 0 0))
    (p10 (geo-make-point 10 0))
    (p55 (geo-make-point 5 5))
    (l-x
      (geo-make-line
        (geo-make-point 0 0)
        (geo-make-point 10 0))))
  (begin
    (check
      "P∩L on line"
      (clos-call-generic "intersect" (list p10 l-x))
      "point")
    (check
      "P∩L on x-axis"
      (clos-call-generic "intersect" (list origin l-x))
      "point")
    (check
      "P∩L off line"
      (clos-call-generic "intersect" (list p55 l-x))
      "empty")))

;; intersect line×line
(let
  ((horiz (geo-make-line (geo-make-point 0 0) (geo-make-point 10 0)))
    (vert
      (geo-make-line
        (geo-make-point 5 -5)
        (geo-make-point 5 5)))
    (horiz2
      (geo-make-line
        (geo-make-point 0 3)
        (geo-make-point 10 3))))
  (begin
    (check
      "L∩L crossing"
      (clos-call-generic "intersect" (list horiz vert))
      "point")
    (check
      "L∩L parallel"
      (clos-call-generic "intersect" (list horiz horiz2))
      "parallel")))

;; intersect line×plane
(let
  ((diag (geo-make-line (geo-make-point 0 0) (geo-make-point 1 1)))
    (vert-plane (geo-make-plane 1 0 5))
    (diag-plane (geo-make-plane -1 1 0)))
  (begin
    (check
      "L∩Plane cross"
      (clos-call-generic "intersect" (list diag vert-plane))
      "point")
    (check
      "L∩Plane parallel"
      (clos-call-generic "intersect" (list diag diag-plane))
      "parallel")))

;; ── summary ────────────────────────────────────────────────────────────────

(define geo-passed passed)
(define geo-failed failed)
(define geo-failures failures)