;;;; test-primitive.ss
;;
;; Purpose: Test primitive.c
;;
;; First-edit:         2002-04-04  SSeidel
;; Major-revision:    2002-07-24  SSeidel
;; Latest-revision:    2002-11-08  SSeidel


;;;; LOAD EXTENSION
(current-namespace (make-namespace)) ;; clear namespace
(require (lib "primitive.ss" "matlab-interface")) ;; <-- load definitions of low-level-interface

;;;; MAKE ARRAY
(define cell (make-cell-array #(3 1)))
(define char (make-char-array #(1 1)))
(define real-double (make-array #(1 1)))
(define complex-double (make-array #(1 1) 'double 'complex))

;;;; ARRAY-SET!
(array-set! cell #(0 0) char)
(array-set! cell #(1 0) real-double)
(array-set! cell #(2 0) complex-double)

;;;; ARRAY-REF
(array-ref cell #(0 0)) ;; => #<array> 
(array-ref char #(0 0)) ;; => #\nul
(array-ref real-double #(0 0)) ;; => 0.0
(array-ref complex-double #(0 0)) ;; => 0.0+0.0i

(array-ref (array-ref cell #(0 0)) #(0 0)) ;; => #\nul
(array-ref (array-ref cell #(1 0)) #(0 0)) ;; => 0.0
(array-ref (array-ref cell #(2 0)) #(0 0)) ;; => 0.0+0.0i

(array-set! real-double #(0 0) (+ (array-ref real-double #(0 0)) 111))
(array-ref (array-ref cell #(1 0)) #(0 0)) ;; => 0.0

(array-set! cell #(1 0) (make-array #(1 1) 'double 'real 111))
(array-ref (array-ref cell #(1 0)) #(0 0)) ;; => 111.0

;;;; ARRAY-SHAPE AND ARRAY-RANK
(array-shape cell) ;; => #2(3 1)
(array-rank cell) ;; => 2

;;;; TYPE AND COMPLEXITY
(array-type real-double) ;; => double
(eq? (array-type real-double) 'double) ;; => #t
(array-complexity real-double) ;; => real
(array-complexity complex-double) ;; => complex

;;;; PREDICATES
(array? real-double) ;; => #t
(double-array? real-double) ;; => #t
(complex-array? real-double) ;; => #f
(numeric-array? real-double) ;; => #t

;;;; ARRAY NAME
(array-name cell) ;; => ""
(array-name cell "my_precious_cell") ;; name must be matlab-compliant
(array-name cell) ;; => "my_precious_cell"

;;;; ENGINE INTERACTION
(engine-open) ;; ==> Matlab-Command-Windows pops up.
(display (engine-eval "2 + 2")) ;; ==> ans = 4 
(engine-eval "2 + 2;") ;; No output.
(engine-close)

;;;; ARRAY EXPORT AND IMPORT
(engine-open)
(engine-put cell)

;; go inside matlab-command-window and type:
my_precious_cell (2, 1)  % ==> ans = [111]
my_precious_cell {2, 1}  % ==> ans = 111
import = 6 * my_precious_cell {2, 1};

;; go back inside scheme-command-window and say:
(define import (engine-get "import"))
(array-ref import #(0 0)) ;; => 666.0

(engine-close)

;;;; LUSCIOUS LITTLE LUXURY
(define vec #(1 2 3 4 5 6))
(define arr (vector->array vec))
(array-name arr "my_precious_array")
(engine-open)
(engine-put arr)
(engine-eval "x = flipud (my_precious_array);")
(define x (engine-get "x"))
(engine-close)
(array->vector x) ;; => #6(6 5 4 3 2 1)
(array-name x) ;; => "x"


;;;; CORRECTED ERROR - SITUATIONS =========================================

;; ;;;; LOAD EXTENSION
;; (current-namespace (make-namespace)) ;; clear namespace
;; (require (lib "primitive.dll" "matlab-interface"))  ;; <-- load definitions of low-level-interface
;; (engine-open)
;; (engine-close)

;; ;;;; 2002-05-05
;; (define cell (make-cell-array #(3 1)))
;; (array-ref cell #(0 0))
;; ;; ==> MzScheme - crash


;; ERROR MESSAGE:
;; > "\nans =\n\n     1\n     2\n     3\n     4\n     5\n     6\n\n"
;; > terminate_ss_array: Free ss_array.
;; terminate_ss_array: Free ss_array.
;; terminate_ss_array: Free ss_array.
;; terminate_ss_array: Free ss_array.
;; Warning: Handle array initialization failed.
;; ./mwmem.c:870: Assert : (hdr->in_use != 0), "Attempt to free previously freed memory"
;; forrtl: error (200): program aborting due to control-C event

;; Process scheme finished



;; ;;;; IMPORT-ARRAY-TYPE-CHECK
;; (engine-open)
;; ;; In Matlab >> a = struct ('x',1.0)
;; (engine-get "a")
;; (engine-close)

;; ;;;; ARRAY-BOUNDARY-VIOLATION
;; (define a (make-array #(2 2)))
;; (array-set! a #(-1 0) 1) ;; outside array-boundaries
;; (array-set! a #(0 0) 1)
;; (array-set! a #(0 1) 1)
;; (array-set! a #(0 2) 1) ;; => ERROR: outside array-boundaries
;; (array-set! a #(1 0) 1)
;; (array-set! a #(1 1) 1)
;; (array-set! a #(1 2) 1) ;; => ERROR: "outside array-boundaries", otherwise if DEBUG ERROR: "outside array-storage"
;; (array-set! a #(2 0) 1) ;; => ERROR:

;; ;;;; ARRAY-OFFSET-VIOLATION -- array-element-set! is defined in debug-mode only
;; (define a (make-array #(2 2)))
;; (array-element-set! a 0 1) ;; => expects type <Fixnum-Integer>
;; (array-element-set! a 0.5 1) ;; => expects type <Fixnum-Integer>
;; (array-element-set! a -1 1) ;; => Value outside of array-storage.
;; (array-element-set! a 5 1) ;; => Value outside of array-storage.

;; ;;;; ARRAY-HOMOGENITY
;; (define b (make-char-array #(2 2)))
;; (array-set! b #(0 0) #\a)
;; (array-ref b #(0 0)) ;; ==>  #\a
;; (array-set! b #(0 0) 0.0) ;; => ERROR: expects argument of type <char>; given 0.0
;; (define a (make-array #(2 2)))
;; (array-set! a #(0 0) #\a) ;; => ERROR: expects argument of type <real>; given #\a

;; ;;;; ARRAY-DIMENSIONS
;; (define a (make-char-array #(2 2 3)))
;; (array-rank a) ;; ==> 3
;; (array-shape a) ;; ==> #(2 2 3)
;; (array-num-of-els a) ;; ==> 12 DEBUG-MODE ONLY

;; ;;;; PREDICATES
;; (define a (make-char-array #(2 2 3)))
;; (array-type a) ;; => char

;; ;;;; COMPLEX-ARRAY? REAL-ARRAY? NUMERIC-ARRAY?
;; (define a (make-array #(2 2) 'double 'real))
;; (define b (make-array #(2 2) 'double 'complex))
;; (define c (make-cell-array #(2 2)))
;; (complex-array? a) ;; => #f
;; (complex-array? b) ;; => #t
;; (complex-array? c) ;; => #f
;; (real-array? a) ;; => #t
;; (real-array? b) ;; => #f
;; (real-array? c) ;; => #t
;; (numeric-array? a) ;; => #t
;; (numeric-array? b) ;; => #t
;; (numeric-array? c) ;; => #f

;; ;;;; DEBUG-MODE-ONLY: ARRAY-INDEX->OFFSET ARRAY-INDEX->ELNUM ARRAY-BYTES-PER-ELEMENT
;; (define a (make-array #(2 3 2)))
;; (array-bytes-per-element a)
;; (array-index->elnum a #(0 0 0))         (array-index->offset a #(0 0 0))
;; (array-index->elnum a #(1 0 0))         (array-index->offset a #(1 0 0))
;; (array-index->elnum a #(0 1 0))         (array-index->offset a #(0 1 0))
;; (array-index->elnum a #(1 1 0))         (array-index->offset a #(1 1 0))
;; (array-index->elnum a #(0 2 0))         (array-index->offset a #(0 2 0))
;; (array-index->elnum a #(1 2 0))         (array-index->offset a #(1 2 0))
;; (array-index->elnum a #(0 0 1))         (array-index->offset a #(0 0 1))
;; (array-index->elnum a #(1 0 1))         (array-index->offset a #(1 0 1))
;; (array-index->elnum a #(0 1 1))         (array-index->offset a #(0 1 1))
;; (array-index->elnum a #(1 1 1))         (array-index->offset a #(1 1 1))
;; (array-index->elnum a #(0 2 1))         (array-index->offset a #(0 2 1))
;; (array-index->elnum a #(1 2 1))         (array-index->offset a #(1 2 1))

;; ;;;; DEBUG-MODE-ONLY: ARRAY-ELEMENT-REF ARRAY-ELEMENT-SET! 
;; (define a (make-array/id #(2 2) 6 0))
;; (array-element-set! a -1 1) ;; => Value outside of array-storage.
;; (array-element-set! a 1.5 1) ;; => expects type <Fixnum-Integer>
;; (array-element-set! a 4 1) ;; => Value outside of array-storage.
;; (array-element-set! a 0 1)
;; (array-element-set! a 1 2)
;; (array-element-set! a 2 3)
;; (array-element-set! a 3 4)
;; (array-element-ref a -1) ;; => Value outside of array-storage.
;; (array-element-ref a 1.5) ;; => expects type <Fixnum-Integer>
;; (array-element-ref a 4) ;; => Value outside of array-storage.
;; (array-element-ref a 0) ;; => 1.0
;; (array-element-ref a 1) ;; => 2.0
;; (array-element-ref a 2) ;; => 3.0
;; (array-element-ref a 3) ;; => 4.0



;; ;; revision:2002-07-24: WHAT'S THAT SUPPOSED TO MEAN AND DO???
;; (define arr #(#(#(01 02 03 04) #(05 06 07 08) #(09 10 11 12))
;;            #(#(13 14 15 16) #(17 18 19 20) #(21 22 23 24))))
;; arr
;; (define walker
;;   (lambda (mx n)
;;     (if (< n (vector-length mx))
;;      (if (vector? (vector-ref mx n))
;;          (begin
;;            (walker (vector-ref mx n) 0)
;;            (walker mx (+ n 1)))
;;          (begin
;;            (display (format "~s " (vector-ref mx n)))
;;            (walker mx (+ n 1))))
;;      (display (format "~s " 'End)))))
;; (newline)
;; (walker arr 0)