;; This file:
;;   http://anggtwu.net/MAXIMA/2025-testdispla.lisp.html
;;   http://anggtwu.net/MAXIMA/2025-testdispla.lisp
;;          (find-angg "MAXIMA/2025-testdispla.lisp")
;; Author: Eduardo Ochs <eduardoochs@gmail.com>
;;
;; Supersedes: (find-angg "MAXIMA/2025-dim-save.lisp")
;; (defun td () (interactive) (find-angg "MAXIMA/2025-testdispla.lisp"))
;;
;; See:
;; (find-maximamsg "59249497 202510 21" "Edrx: Displaying... using very low-level tools")
;; (find-maximamsg "59249515 202510 21" "Edrx: Displaying... Update!!!")
;; (find-maximamsg "59249628 202510 21" "Edrx: verbatimbox.lisp")


;; (defun e () (interactive) (find-angg "MAXIMA/2025-testdispla.lisp"))
;;
;; «.str»			(to "str")
;; «.str-tests»			(to "str-tests")
;; «.td-save»			(to "td-save")
;; «.td-save-tests»		(to "td-save-tests")
;; «.td-contract»		(to "td-contract")
;; «.td-contract-tests»		(to "td-contract-tests")
;; «.testdispla»		(to "testdispla")
;; «.testdispla-tests-1»	(to "testdispla-tests-1")
;; «.testdispla-tests-2»	(to "testdispla-tests-2")
;; «.lowdraw»			(to "lowdraw")
;; «.lowdraw-tests-1»		(to "lowdraw-tests-1")
;; «.lowdraw-tests-2»		(to "lowdraw-tests-2")
;; «.linearray»			(to "linearray")
;; «.linearray-tests»		(to "linearray-tests")
;; «.defun-inner»		(to "defun-inner")




;; «str»  (to ".str")
;; Some functions to display multi-line strings in a nicer way.
;; See: (find-try-sly-intro "4. Download quicklisp.lisp")
;;      https://quickdocs.org/cl-str
;;      (find-es "lisp" "cl-str")
(load #P"~/quicklisp/setup.lisp")
(ql:quickload "str")
(defvar newline)
(setq newline (format nil "~%"))
(defun td-replace-all (a b str) (values (str:replace-all a b str)))
(defun td-bton   (str) (td-replace-all "|" newline str)) ; bar -> newline
(defun td-ntob   (str) (td-replace-all newline "|" str)) ; newline -> bar
(defun td-indent (str) (td-replace-all newline (format nil "~%|") str))

#|
** «str-tests»  (to ".str-tests")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
to_lisp();
  (load "2025-testdispla.lisp")
             (td-bton "ab|cd|ef")
  (td-indent (td-bton "ab|cd|ef"))
  (to-maxima)

|#




;; «td-save»  (to ".td-save")
;; Some functions to save the current values of certain variables
;; and display them in a nice way.
(defvar td-saved)

(setq td-saved nil)

(defun td-save (&rest plist)
  (setq td-saved `(,@td-saved ,(copy-tree plist)))
  plist)

(defun td-show (&optional (fmt "~S~%"))
  (let ((*print-pretty* nil))
    (loop for plist in td-saved
	  do (format t fmt plist))))

#|
** «td-save-tests»  (to ".td-save-tests")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-testdispla.lisp");
to_lisp();
  (td-save :pos 1 :a 'a :b '("b" 42 #\c))
  (td-save :pos 2 :a 'a :b '("b" 42 #\c) :foo "foo")
  (td-show)
  (td-show "~a~%")
  (to-maxima)

|#



;; «td-contract»  (to ".td-contract")
(defun td-contract (o)
  (cond ((null o) nil)
	((atom o) o)
	((characterp (car o))
	 (let ((chars ()))
	   (loop while (characterp (car o))
		 do (push (car o) chars)
		 do (setq o (cdr o)))
	   (cons (coerce chars 'string)
		 (td-contract o))))
	(t (cons (td-contract (car o))
		 (td-contract (cdr o))))))

(defun td-expand (o)
  (if (consp o)
      (if (stringp (car o))
	  `(,@(nreverse (exploden (car o))) ,@(td-expand (cdr o)))
	  `(,(td-expand (car o)) ,@(td-expand (cdr o))))
      o))

#|
** «td-contract-tests»  (to ".td-contract-tests")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-testdispla.lisp");
to_lisp();
  (defvar o)
  (setq o '(1 2 #\a #\b #\c 3 4 #\d #\e 5))
  (td-contract o)
  (td-expand '(1 2 "ab" "cd" (3 "ef" "gh" "i") "jk"))
  (to-maxima)

|#






;; «testdispla»  (to ".testdispla")
;; (find-maximagitfile "src/displm.lisp" "width height depth maxht maxdp")

(defvar td-innersave)
(setq   td-innersave '(:height height :depth depth :width width
		       :maxht  maxht  :maxdp maxdp))

(defclass testdispla ()
  ((form      :initarg :form      :initform #$a+b$)
   (dim       :initarg :dim       :initform nil)
   (altinner  :initarg :altinner  :initform nil)
   (save      :initarg :save      :initform t)
   (innersave :initarg :innersave :initform td-innersave)
   (contract  :initarg :contract  :initform t)
   ($testdispla    :initarg :$testdispla    :initform '$testdispla)
   (dim-testdispla :initarg :dim-testdispla :initform 'dim-testdispla)
   ))

(defun make-testdispla (&rest args)
  (apply 'make-instance 'testdispla args))

(defmethod td-innerbody ((td testdispla))
  (with-slots (form dim altinner) td
    (or altinner
	(let ((dim-this (or dim (get (caar form) 'dimension))))
	  `(,dim-this ',form result)))))

(defmethod td-out ((td testdispla))
  (with-slots (contract) td
    (if contract
	'(:out-c (td-contract out))
	'(:out out))))

(defmethod td-outerbody ((td testdispla))
  (with-slots (save innersave) td
    (if (not save)
	(td-innerbody td)
	`(progn
	   (td-save :pos 1 ,@innersave)
	   (let ((out ,(td-innerbody td)))
	     (td-save :pos 2 ,@innersave ,@(td-out td))
	     out)))))

(defmethod td-redef-progn ((td testdispla))
  (with-slots ($testdispla dim-testdispla) td
    `(progn
       ;;
       (setf (get ',$testdispla 'dimension) ',dim-testdispla)
       (defun ,dim-testdispla (form result)
	 (declare (ignorable form result))
	 ,(td-outerbody td))
       ;;
       )))

(defmethod td-redef ((td testdispla))
  (eval (td-redef-progn td)))

(defun td-output-as-string ()
  (with-output-to-string (*standard-output*)
    (maxima-display #$testdispla()$)))

(defmethod td-run ((td testdispla))
  (setq td-saved nil)
  (td-redef td)
  (let ((output (td-output-as-string)))
    (td-show)
    (td-indent output)))


#|
** «testdispla-tests-1»  (to ".testdispla-tests-1")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-testdispla.lisp");
to_lisp();
  (load "2025-testdispla.lisp")
  (td-innerbody (make-testdispla))
  (td-innerbody (make-testdispla :form #$c^d$))
  (td-innerbody (make-testdispla :form #$c^d$ :dim 'dim-pow))
  (td-innerbody (make-testdispla :altinner '(dim-foo bla)))
  (td-outerbody (make-testdispla :save nil))
  (td-outerbody (make-testdispla))
  (td-outerbody (make-testdispla :innersave '(:height height)))
  (td-outerbody (make-testdispla :innersave '(:height height) :contract nil))
  (td-redef-progn (make-testdispla :save nil))
  (td-redef-progn (make-testdispla))
  (td-redef       (make-testdispla))
  (td-output-as-string)
  (to-maxima)

|#

#|
** «testdispla-tests-2»  (to ".testdispla-tests-2")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
to_lisp();
  (load "2025-testdispla.lisp")
  (td-run (make-testdispla))
  (td-run (make-testdispla :form #$a^b$))
  (td-run (make-testdispla :form #$ab^c$))
  (td-run (make-testdispla :form #$ab^cd$))
  (td-run (make-testdispla :form #$'mlabel("%o42", ab^cd)$))
  (td-run (make-testdispla :form #$'diff(f(x),x)$))
  (td-run (make-testdispla :form #$'diff(f(x),x)$ :innersave nil))
  (setq td-innersave nil)
  (td-run (make-testdispla :form #$'diff(f(x),x)$))
  (td-run (make-testdispla :form #$'integrate(f(x),x)$))
  (td-run (make-testdispla :form #$'integrate(f(x),x,a,b)$))

|#



;; «lowdraw»  (to ".lowdraw")
(defvar ld-setqs)
(setq   ld-setqs
	'(setq height 3 maxht 3 depth 2 maxdp 2 width 5))

(defclass lowdraw ()
  ((expand :initarg :expand :initform t)
   (setqs  :initarg :setqs  :initform '(setq height 3 maxht 3 depth 2 maxdp 2 width 5))
   (o      :initarg :o      :initform '((-3 -2 "ef") (-1 -1 "bcd") "a"))
   (form   :initarg :form   :initform #$lowdraw()$)
   ))

(defun make-lowdraw (&rest args)
  (apply 'make-instance 'lowdraw args))

(defmethod ld-ld-altinner ((ld lowdraw))
  (with-slots (sets o expand) ld
    (let ((real-o o))
      (if expand (setq real-o (td-expand real-o)))
      `(progn ,ld-setqs
	      ',real-o))))

(defmethod ld-ld-testdispla ((ld lowdraw))
  (make-testdispla
   :$testdispla    '$lowdraw
   :dim-testdispla 'dim-lowdraw
   :altinner       (ld-ld-altinner ld)
   :save          nil))

(defmethod ld-ld-redef-progn ((ld lowdraw))
  (td-redef-progn (ld-ld-testdispla ld)))

#|
** «lowdraw-tests-1»  (to ".lowdraw-tests-1")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
to_lisp();
  (load "2025-testdispla.lisp")
  (ld-ld-altinner (make-lowdraw))
  (ld-ld-altinner (make-lowdraw :expand nil))
  (ld-ld-redef-progn (make-lowdraw))

|#

(defmethod ld-td-testdispla ((ld lowdraw))
  (with-slots (form) ld
    (make-testdispla
     :form form
     :dim  'dim-lowdraw)))

(defmethod ld-td-redef-progn ((ld lowdraw))
  (td-redef-progn (ld-td-testdispla ld)))

(defmethod ld-redef-progn ((ld lowdraw))
  `(progn
     ,(ld-td-redef-progn ld)
     ,(ld-ld-redef-progn ld)))

(defmethod ld-redef ((ld lowdraw))
  (eval (ld-redef-progn ld)))

(defmethod ld-run ((ld lowdraw))
  (setq td-saved nil)
  (ld-redef ld)
  (let ((output (td-output-as-string)))
    (td-show)
    (td-indent output)))

#|
** «lowdraw-tests-2»  (to ".lowdraw-tests-2")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
to_lisp();
  (load "2025-testdispla.lisp")
  (td-innerbody (ld-td-testdispla (make-lowdraw)))
  (td-outerbody (ld-td-testdispla (make-lowdraw)))
  (ld-td-redef-progn (make-lowdraw))
  (ld-redef-progn (make-lowdraw))
  (ld-run (make-lowdraw))
  (ld-run (make-lowdraw :o '((-3 -2 "ef") (-1 -1 "bcd") "A")))

|#


#|
* (eepitch-sbcl)
* (eepitch-kill)
* (eepitch-sbcl)
(load "2025-testdispla.lisp")

|#



;; «linearray»  (to ".linearray")
(defun linearray-to-strings (linearray)
  (loop for line in (reverse (coerce linearray 'list))
	if line
	  collect (cadr (td-contract line))))

(defun linearray-to-bigstring (linearray)
  (str:join (format nil "|~%|") (linearray-to-strings linearray)))

#|
;; «linearray-tests»  (to ".linearray-tests")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
load("2025-testdispla.lisp");
to_lisp();
  (load "2025-testdispla.lisp")
  (to-maxima)

|#



;; «defun-inner»  (to ".defun-inner")
;; (find-es "lisp" "symbol-function")
(defun defun-inner (newf f)
  (if (not (fboundp newf))
      (setf (symbol-function newf)
            (symbol-function f))
      `(not redefining ,newf)))

;; (find-maximagitfile "src/displa.lisp" "(defun draw-linear ")
(defun-inner 'draw-linear-inner 'draw-linear)

(defvar linearrays)
(setq linearrays nil)

(defun draw-linear-print (dmstr oldrow oldcol)
  (declare (ignorable dmstr oldrow oldcol)))

(defun draw-linear (dmstr oldrow oldcol)
  (draw-linear-print dmstr oldrow oldcol)
  (draw-linear-inner dmstr oldrow oldcol))

#|
** «defun-inner»  (to ".defun-inner")
* (eepitch-maxima)
* (eepitch-kill)
* (eepitch-maxima)
display2d_unicode : false;
M1 : matrix([a,b], [c,d]);
M2 : matrix([M1,e], [f,g]);
to_lisp();
  (load "2025-testdispla.lisp")
  (defun draw-linear-print (dmstr oldrow oldcol)
    (declare (ignorable dmstr oldrow oldcol))
    (format t "~S~%~S ~S ~S~%~%"
       (linearray-to-bigstring linearray)
       (td-contract dmstr) oldrow oldcol
       ))
  (displa #$M1$)


|#








;; Local Variables:
;; coding:  utf-8-unix
;; End: