1: 
(declare (fixnum))
2: 
3: 
(define header-size 39984)
4: 
(define trailer-size 1892352)
5: 
(define volumes 160)
6: 
(define slices 15)
7: 
(define copy-slice? #t)
8: 
(define rows 64)
9: 
(define columns 64)
10: 
(define overscan? #f)
11: 
(define back-and-forth? #t)
12: 
13: 
;;(define header (make-vector header-size))
14: 
;;(define trailer (make-vector trailer-size))
15: 
16: 
(define slice-size (* 2 columns rows))
17: 
(define volume-size (* (if copy-slice? (+ slices 1) slices) slice-size))
18: 
(define data-size (* volumes volume-size))
19: 
20: 
(define file-name "P50688.7")
21: 
(set! file-name file-name)
22: 
23: 
(define (read-data file-name)
24: 
  
25: 
  (let ((data (build-Fixed-array manipulators: generic-array-manipulators
26: 
				 domain: (build-Interval '#(0 0 0 0)
27: 
							 (vector 
28: 
							  160
29: 
							  (if copy-slice? (+ slices 1) slices)
30: 
							  64
31: 
							  64))))
32: 
	(port (open-input-file (list path: file-name input-char-encoding: 'latin1 eol-encoding: 'lf))))
33: 
    
34: 
    (define (read-header)
35: .01% 
      (do ((i 0 (+ i 1)))
36: 0% 
	  ((= i header-size))
37: 0% 
	(read-char port)))
38: 
39: 
    (define (read-trailer)
40: .39% 
      (do ((i 0 (+ i 1)))
41: .08% 
	  ((= i trailer-size))
42: .13% 
	(if (eof-object? (read-char port))
43: 
	    (error "crapola2"))))
44: 
    
45: 
    (define (read-volume v)   ; the slices are in order 0, 2, 4, ..., 1, 3, ...
46: 
      (let ((accessor (Array-accessor (curry v 1))))
47: 0% 
	(do ((j 0 (+ j 2)))
48: 0% 
	    ((<= slices j))
49: 
	  (read-slice (accessor j) #f))
50: 0% 
	(do ((j 1 (+ j 2)))
51: 0% 
	    ((<= slices j))
52: 
	  (read-slice (accessor j) #t))
53: 
	(if copy-slice? 
54: 
	    (let ((accessor (Mutable-array-accessor (accessor (- slices 1))))
55: 
		  (setter   (Mutable-array-setter   (accessor slices)))
56: 
		  (domain   (Mutable-array-domain   (accessor slices))))
57: 0% 
	      (Interval-for-each (lambda (k l)
58: .11% 
				   (setter (accessor k l) k l))
59: 
				 domain)))))
60: 
    
61: 
    (define (read-slice s change-sign?)
62: 0% 
      (let ((accessor (Array-accessor (curry s 1))))
63: .02% 
	(do ((k 0 (+ k 2)))
64: .01% 
	    ((= k rows))
65: .01% 
	  (read-row           (accessor k)            change-sign?)
66: .02% 
	  (read-row-backwards (accessor (+ k 1)) (not change-sign?)))))
67: 
    
68: 
    (define (read-row r change-sign?)
69: .01% 
      (let ((setter (Mutable-array-setter r)))
70: .97% 
	(do ((l 0 (+ l 1)))
71: .21% 
	    ((= l columns))
72: .11% 
	  (let ((result (read-complex)))
73: .41% 
	    (if change-sign?
74: 
		(begin
75: .29% 
		  (Complex-real-set! result (FLOAT (- (Complex-real result))))
76: .3% 
		  (Complex-imag-set! result (FLOAT (- (Complex-imag result))))))
77: .34% 
	    (setter result l)))))
78: 
    
79: 
    (define (read-row-backwards r change-sign?)
80: .01% 
      (let ((setter (Mutable-array-setter r)))
81: .96% 
	(do ((l (- columns 1) (- l 1)))
82: .24% 
	    ((< l 0))
83: .11% 
	  (let ((result (read-complex)))
84: .42% 
	    (if change-sign?
85: 
		(begin
86: .32% 
		  (Complex-real-set! result (FLOAT (- (Complex-real result))))
87: .34% 
		  (Complex-imag-set! result (FLOAT (- (Complex-imag result))))))
88: .37% 
	    (setter result l)))))
89: 
90: 
    (define (read-complex)
91: 4.23% 
      (let* ((byte-1 (char->integer (read-char port)))
92: .63% 
	     (byte-2 (char->integer (read-char port)))
93: .5% 
	     (byte-3 (char->integer (read-char port)))
94: .47% 
	     (byte-4 (char->integer (read-char port))))
95: 2.07% 
	(let ((value-1 (##flonum.<-fixnum (+ (##fixnum.arithmetic-shift-left (if (>= byte-1 128)
96: .33% 
										 (- byte-1 256)
97: .15% 
										 byte-1)
98: .2% 
									     8)
99: .45% 
					     byte-2)))
100: 2.% 
	      (value-2 (##flonum.<-fixnum (+ (##fixnum.arithmetic-shift-left (if (>= byte-3 128)
101: .33% 
										 (- byte-3 256)
102: .15% 
										 byte-3)
103: .18% 
									     8)
104: .51% 
					     byte-4))))
105: 1.67% 
	  (make-Complex value-1 value-2))))
106: 
    
107: 
    (read-header)
108: 
109: 
    (Array-for-each read-volume (curry data 1))
110: 
    
111: 
    (read-trailer)
112: 
    (if (not (eof-object? (read-char port)))
113: 
	(error "crapola"))
114: 
    (close-input-port port)
115: 
    data))
116: 
117: 
(declare (generic))