;;;  Demonstrate XLISP Arrays
;;;  File:  Arrays.lsp

(setq fn "C:/Temp/Arrays.lsp")
(defun L () (cls) (load fn)) (terpri)
(dribble "C:/Temp/Arrays.txt")

;;;  -------------------------------------------------------------

(princ "Demonstrate XLISP Arrays\n\n")
(setq AR1 (make-array 5))
(setq AR2 (make-array 4 :initial-element 'EMT))
(setq AR3 (make-array 3 :initial-contents '(1 22 333)))
(setq AR4 (make-array 2 :initial-element AR3))
(setq AR5 (make-array 2 :initial-contents (list (make-array 3) (make-array 4))))

;;; Show initial contents of the arrays
(format t "AR1 is ~S~%" AR1)
(format t "AR2 is ~S~%" AR2)
(format t "AR3 is ~S~%" AR3)
(format t "AR4 is ~S~%" AR4)
(format t "AR5 is ~S~%" AR5)
(terpri)

(dotimes (i 5)
    (setf (aref AR1 i) (* i i))
)
(format t "Now, AR1 is ~S~%~%" AR1)

(princ "Note that NEW-VAL now appears in BOTH sub-arrays\n\n")
(set2Delt AR4 1 2 'NEW-VAL)
(format t "AR4 is ~S~%~%" AR4)

;;;  -------------------------------------------------------------
;;;  (Re-)sets a 2D array value; array must exist; no bounds checking
;;;  -------------------------------------------------------------
(defun set2Delt (array i j value) (let ((oldValue (aref array i)))
    (setf (aref oldValue j) value)
    (setf (aref array i) oldValue) ))

(princ "Demonstrate 2D XLISP Arrays\n")
(princ "Note that NEW-VAL now appears ONLY where it is supposed to,\n")
(princ "and note that the AR5 array is NOT square\n\n")
(set2Delt AR5 1 2 'NEW-VAL)
(format t "AR5 is ~S~%" AR5)

(terpri)

;;;  -------------------------------------------------------------
;;;  Output from the above program...
;;;
;;;  Demonstrate XLISP Arrays
;;;
;;;  AR1 is #(NIL NIL NIL NIL NIL)
;;;  AR2 is #(EMT EMT EMT EMT)
;;;  AR3 is #(1 22 333)
;;;  AR4 is #(#(1 22 333) #(1 22 333))
;;;  AR5 is #(#(NIL NIL NIL) #(NIL NIL NIL NIL))
;;;
;;;  Now, AR1 is #(0 1 4 9 16)
;;;
;;;  Note that NEW-VAL now appears in BOTH sub-arrays
;;;
;;;  AR4 is #(#(1 22 NEW-VAL) #(1 22 NEW-VAL))
;;;
;;;  Demonstrate 2D XLISP Arrays
;;;  Note that NEW-VAL now appears ONLY where it is supposed to,
;;;  and note that the AR5 array is NOT square
;;;
;;;  AR5 is #(#(NIL NIL NIL) #(NIL NIL NEW-VAL NIL))
;;;
;;;  -------------------------------------------------------------