Change representation of floating-point arrays in picture data

structures.

diff --git a/v7/src/6001/pic-imag.scm b/v7/src/6001/pic-imag.scm
index 791b38aac24b77f574ec341a6f53850949bc9058..34b0baa86887513e34732750935b1719fe7eedb5 100644 (file)
--- a/v7/src/6001/pic-imag.scm
+++ b/v7/src/6001/pic-imag.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/6001/pic-imag.scm,v 1.3 1992/04/13 19:45:09 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/6001/pic-imag.scm,v 1.4 1992/06/08 16:49:57 aragorn Exp $
 
 Copyright (c) 1991-92 Massachusetts Institute of Technology
 
@@ -72,7 +72,7 @@ MIT in each case. |#
           (let y-loop ((py py-max) (iy-index 0))
             (if (fix:<= 0 py)
                 (begin
-                  (let ((pic-row (floating-vector-ref pic-data py)))
+                  (let ((pic-row (vector-ref pic-data py)))
                     (let x-loop ((px 0))
                       (if (fix:< px pic-width)
                           (begin
@@ -86,7 +86,7 @@ MIT in each case. |#
          ((and (fix:= 2 h-sf) (fix:= 2 v-sf))
           (let y-loop ((py py-max) (iy-index 0))
             (if (fix:<= 0 py)
-                (let ((pic-row (floating-vector-ref pic-data py)))
+                (let ((pic-row (vector-ref pic-data py)))
                   (let x-loop ((px 0) (ix 0))
                     (if (fix:< px pic-width)
                         (let* ((n-is-0 (fix:+ ix iy-index))
@@ -105,7 +105,7 @@ MIT in each case. |#
          ((and (fix:= 3 h-sf) (fix:= 3 v-sf))
           (let y-loop ((py py-max) (iy-index 0))
             (if (fix:<= 0 py)
-                (let ((pic-row (floating-vector-ref pic-data py)))
+                (let ((pic-row (vector-ref pic-data py)))
                   (let x-loop ((px 0) (ix 0))
                     (if (fix:< px pic-width)
                         (let* ((row0 (fix:+ ix iy-index))
@@ -130,7 +130,7 @@ MIT in each case. |#
          ((and (fix:= 4 h-sf) (fix:= 4 v-sf))
           (let y-loop ((py py-max) (iy-index 0))
             (if (fix:<= 0 py)
-                (let ((pic-row (floating-vector-ref pic-data py)))
+                (let ((pic-row (vector-ref pic-data py)))
                   (let x-loop ((px 0) (ix 0))
                     (if (fix:< px pic-width)
                         (let* ((row0 (fix:+ ix iy-index))
@@ -163,7 +163,7 @@ MIT in each case. |#
          (else 
           (let y-loop ((py py-max) (iy-index 0))
             (if (fix:<= 0 py)
-                (let ((pic-row (floating-vector-ref pic-data py)))
+                (let ((pic-row (vector-ref pic-data py)))
                   (let x-loop ((px 0) (ix 0))
                     (if (fix:< px pic-width)
                         (let* ((v

diff --git a/v7/src/6001/pic-read.scm b/v7/src/6001/pic-read.scm
index 4fc551183fd2987c77b3f0c7eb94f310fa88e192..ec5f5288a9902167ecad155209ca2643d496bc99 100644 (file)
--- a/v7/src/6001/pic-read.scm
+++ b/v7/src/6001/pic-read.scm
@@ -51,7 +51,7 @@
     (side-effecting-iter
      width
      (lambda (n)
-       (let ((nth-row (floating-vector-ref data (- width n 1))))
+       (let ((nth-row (vector-ref data (- width n 1))))
         (side-effecting-iter
          length
          (lambda (m)

diff --git a/v7/src/6001/pic-reco.scm b/v7/src/6001/pic-reco.scm
index 6f71451dcadcb233ce72b38bf732085afe86f918..503879ce3eafde7f5fb876cd1406ef8c804f753c 100644 (file)
--- a/v7/src/6001/pic-reco.scm
+++ b/v7/src/6001/pic-reco.scm
@@ -170,11 +170,11 @@
   (let* ((picdata (picture-data picture))
         (width (picture-width picture))
         (height (picture-height picture))
-        (current-min (floating-vector-ref (floating-vector-ref picdata 0) 0))
+        (current-min (floating-vector-ref (vector-ref picdata 0) 0))
         (current-max current-min))
     (let y-loop ((y 0))
       (if (< y height)
-         (let ((yth-row (floating-vector-ref picdata y)))
+         (let ((yth-row (vector-ref picdata y)))
            (let x-loop ((x 0))
              (if (< x width)
                  (let ((v (floating-vector-ref yth-row x)))

diff --git a/v7/src/6001/picture.scm b/v7/src/6001/picture.scm
index 37dc839dce17765c2ddddaeff28ab20382c392fe..bbb3b21c8d35ad11a1319700d8fb9bb9bdec9038 100644 (file)
--- a/v7/src/6001/picture.scm
+++ b/v7/src/6001/picture.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/6001/picture.scm,v 1.9 1992/06/03 18:25:12 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/6001/picture.scm,v 1.10 1992/06/08 16:50:21 aragorn Exp $
 
 Copyright (c) 1991-92 Massachusetts Institute of Technology
 
@@ -36,10 +36,28 @@ MIT in each case. |#
 
 (declare (usual-integrations))
 \f
-(define-integrable floating-vector-ref vector-ref)
-(define-integrable floating-vector-set! vector-set!)
-(define-integrable floating-vector-copy vector-copy)
-(define-integrable make-floating-vector make-vector)
+(define-primitives floating-vector-ref)
+(define-primitives floating-vector-set!)
+(define-primitives floating-vector-cons)
+(define-primitives floating-vector-length)
+
+(define (make-floating-vector length init)
+  (let ((result (floating-vector-cons length)))
+    (if (not (= init 0.))
+       (do 
+           ((i 0 (+ i 1)))
+           ((= i length))
+         (floating-vector-set! result i init)))
+    result))
+
+(define (floating-vector-copy vector)
+  (let* ((length (floating-vector-length vector))
+        (result (floating-vector-cons length)))
+    (do
+       ((i 0 (+ i 1)))
+       (( = i length))
+      (floating-vector-set! result i (floating-vector-ref vector i)))
+    result))
 
 (define (get-visual-info window)
   ((ucode-primitive x-get-visual-info) (x-graphics-device/xw window)