From fdd0d498f985c2268d66c7bd8f74fe1a4a7834be Mon Sep 17 00:00:00 2001 From: aragorn Date: Mon, 8 Jun 1992 16:50:28 +0000 Subject: [PATCH] Change representation of floating-point arrays in picture data structures. --- v7/src/6001/pic-imag.scm | 12 ++++++------ v7/src/6001/pic-read.scm | 2 +- v7/src/6001/pic-reco.scm | 4 ++-- v7/src/6001/picture.scm | 28 +++++++++++++++++++++++----- 4 files changed, 32 insertions(+), 14 deletions(-) diff --git a/v7/src/6001/pic-imag.scm b/v7/src/6001/pic-imag.scm index 791b38aac..34b0baa86 100644 --- 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 4fc551183..ec5f5288a 100644 --- 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 6f71451dc..503879ce3 100644 --- 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 37dc839dc..bbb3b21c8 100644 --- 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)) -(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) -- 2.25.1