From 5ab526814d6757638fbdaf0d98fa82e2539588d4 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 20 Dec 2001 03:27:54 +0000 Subject: [PATCH] Eliminate references to SYNTAX-TABLE/SYSTEM-INTERNAL. --- v7/src/6001/6001.sf | 6 +-- v7/src/6001/pic-ops.scm | 99 ++++++++++++++++++++-------------------- v7/src/6001/pic-read.scm | 11 +++-- v7/src/6001/pic-reco.scm | 22 ++++----- v7/src/6001/picture.scm | 49 +++++++++----------- v7/src/win32/win32.pkg | 4 +- 6 files changed, 94 insertions(+), 97 deletions(-) diff --git a/v7/src/6001/6001.sf b/v7/src/6001/6001.sf index d65cda898..f40cb95e1 100644 --- a/v7/src/6001/6001.sf +++ b/v7/src/6001/6001.sf @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: 6001.sf,v 1.12 2001/12/19 21:47:48 cph Exp $ +$Id: 6001.sf,v 1.13 2001/12/20 03:23:58 cph Exp $ Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology @@ -22,14 +22,14 @@ USA. (sf-conditionally "make") (sf-conditionally "nodefs") +(sf-conditionally "picture") (sf-conditionally "pic-reco") (sf-conditionally "pic-imag") (sf-conditionally "pic-read") (sf-conditionally "pic-ops") (fluid-let ((sf/default-syntax-table (->environment '(RUNTIME)))) - (sf-conditionally "arith") - (sf-conditionally "picture")) + (sf-conditionally "arith")) (fluid-let ((sf/default-syntax-table (->environment '(EDWIN)))) (sf-conditionally "edextra") diff --git a/v7/src/6001/pic-ops.scm b/v7/src/6001/pic-ops.scm index 0f0472a3a..20ebe7d2b 100644 --- a/v7/src/6001/pic-ops.scm +++ b/v7/src/6001/pic-ops.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: pic-ops.scm,v 1.5 1999/01/02 06:06:43 cph Exp $ +$Id: pic-ops.scm,v 1.6 2001/12/20 03:24:10 cph Exp $ -Copyright (c) 1993, 1999 Massachusetts Institute of Technology +Copyright (c) 1993, 1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,13 +16,14 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# - + ;;; Operations for manipulating pictures (declare (usual-integrations)) - + (define-integrable (in-rect? x y width height) (and (fix:< -1 x) (fix:< x width) (fix:< -1 y) (fix:< y height))) @@ -57,8 +58,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x wid2) (begin - (floating-vector-set! new-yth-row (fix:- x lf) - (floating-vector-ref p2-yth-row x)) + (flo:vector-set! new-yth-row (fix:- x lf) + (flo:vector-ref p2-yth-row x)) (x-loop (fix:+ x 1))) (y-loop (fix:+ y 1))))))) @@ -66,13 +67,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let y-loop ((y 0)) (if (fix:< y hgt1) (let* ((p1-yth-row (vector-ref p1-data y)) - (new-yth-row (vector-ref new-data - (fix:+ y p1y-offset)))) + (new-yth-row (vector-ref new-data (fix:+ y p1y-offset)))) (let x-loop ((x 0)) (if (fix:< x wid1) (begin - (floating-vector-set! new-yth-row (fix:+ x p1x-offset) - (floating-vector-ref p1-yth-row x)) + (flo:vector-set! new-yth-row (fix:+ x p1x-offset) + (flo:vector-ref p1-yth-row x)) (x-loop (fix:+ x 1))) (y-loop (fix:+ y 1))))))) (picture-set-data! new-pic new-data) @@ -96,8 +96,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x wid1) (begin - (floating-vector-set! p2-yth-row (fix:+ x u) - (floating-vector-ref p1-yth-row x)) + (flo:vector-set! p2-yth-row (fix:+ x u) + (flo:vector-ref p1-yth-row x)) (x-loop (fix:+ x 1))) (y-loop (fix:+ y 1)))))) (picture-set-data! pic2 p2-data)) @@ -127,8 +127,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x cut-wid) (begin - (floating-vector-set! new-yth-row x - (floating-vector-ref old-yth-row (fix:+ u x))) + (flo:vector-set! new-yth-row x + (flo:vector-ref old-yth-row (fix:+ u x))) (x-loop (fix:+ x 1))) (y-loop (fix:+ y 1)))))) (picture-set-data! new-pic new-data) @@ -150,17 +150,18 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (fix:< ny hgt) (let ((y-index (->discrete-y (/ ny ysf)))) (if (fix:= y-index old-y-index) ; don't recompute the row - (floating-vector-set! new-data ny - (floating-vector-copy - (vector-ref new-data (fix:- ny 1)))) + (flo:vector-set! new-data ny + (flo:vector-copy + (vector-ref new-data (fix:- ny 1)))) (let ((yth-row (vector-ref data y-index)) (new-yth-row (vector-ref new-data ny))) (let x-loop ((nx 0)) (if (fix:< nx wid) (begin - (floating-vector-set! new-yth-row nx - (floating-vector-ref yth-row - (->discrete-x (/ nx xsf)))) + (flo:vector-set! + new-yth-row nx + (flo:vector-ref yth-row + (->discrete-x (/ nx xsf)))) (x-loop (fix:+ nx 1))))))) (y-loop (fix:+ ny 1) y-index)))) (picture-set-data! new-pic new-data) @@ -210,7 +211,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (set! new-data (make-initialized-vector new-hgt (lambda (n) - (floating-vector-copy + (flo:vector-copy (vector-ref data n)))))) ((and (close-enough? (xcor ur) lx) ; check for @@ -221,11 +222,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((nx 0)) (if (fix:< nx new-wid) (begin - (floating-vector-set! yth-row nx - (floating-vector-ref - (vector-ref - data (fix:- nx-max nx)) - ny)) + (flo:vector-set! yth-row nx + (flo:vector-ref + (vector-ref + data (fix:- nx-max nx)) + ny)) (x-loop (fix:+ nx 1))) (y-loop (fix:+ ny 1)))))))) @@ -237,10 +238,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((nx 0)) (if (fix:< nx new-wid) (begin - (floating-vector-set! yth-row nx - (floating-vector-ref - (vector-ref data nx) - (fix:- ny-max ny))) + (flo:vector-set! yth-row nx + (flo:vector-ref + (vector-ref data nx) + (fix:- ny-max ny))) (x-loop (fix:+ nx 1))) (y-loop (fix:+ ny 1)))))))) @@ -249,12 +250,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let y-loop ((ny 0)) (if (fix:< ny new-hgt) (begin - (floating-vector-set! new-data ny - (list->vector - (reverse - (vector->list - (vector-ref data - (fix:- ny-max ny)))))) + (flo:vector-set! new-data ny + (list->vector + (reverse + (vector->list + (vector-ref data + (fix:- ny-max ny)))))) (y-loop (fix:+ ny 1)))))) (else @@ -272,11 +273,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (fix:< nx new-wid) (let ((x (round->exact inner-x)) (y (round->exact inner-y))) - (floating-vector-set! nyth-row nx - (if (in-rect? x y wid hgt) - (floating-vector-ref - (vector-ref data y) x) - pic-min)) + (flo:vector-set! nyth-row nx + (if (in-rect? x y wid hgt) + (flo:vector-ref + (vector-ref data y) x) + pic-min)) (x-loop (fix:+ nx 1) (flo:+ inner-x c) (flo:- inner-y s))) (y-loop (fix:+ ny 1) @@ -296,7 +297,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (fix:< y hgt) (begin (vector-set! new-data y - (floating-vector-copy + (flo:vector-copy (vector-ref data (fix:- y-max y)))) (y-loop (fix:+ y 1))))) (picture-set-data! new-pic new-data) @@ -312,19 +313,19 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (if (fix:< y hgt) (begin (vector-set! new-data y - (floating-vector-reverse (vector-ref data y))) + (flo:vector-reverse (vector-ref data y))) (y-loop (fix:+ y 1))))) (picture-set-data! new-pic new-data) new-pic)) -(define (floating-vector-reverse vector) - (let* ((length (floating-vector-length vector)) - (new-vector (floating-vector-cons length)) +(define (flo:vector-reverse vector) + (let* ((length (flo:vector-length vector)) + (new-vector (flo:vector-cons length)) (length-1 (- length 1))) (do ((i 0 (+ i 1))) ((= i length)) - (floating-vector-set! new-vector i - (floating-vector-ref vector (- length-1 i)))) + (flo:vector-set! new-vector i + (flo:vector-ref vector (- length-1 i)))) new-vector)) diff --git a/v7/src/6001/pic-read.scm b/v7/src/6001/pic-read.scm index ed723d966..1d1365df7 100644 --- a/v7/src/6001/pic-read.scm +++ b/v7/src/6001/pic-read.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: pic-read.scm,v 1.5 1999/01/02 06:06:43 cph Exp $ +$Id: pic-read.scm,v 1.6 2001/12/20 03:24:21 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# ;;;; Procedures to read a file in raw pgm format into a picture @@ -70,7 +71,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. width (lambda (index) index ; ignored - (make-floating-vector length 0.))))) ;initialize to blank + (flo:make-vector length 0.))))) ;initialize to blank (side-effecting-iter width (lambda (n) @@ -78,7 +79,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (side-effecting-iter length (lambda (m) - (floating-vector-set! + (flo:vector-set! nth-row m (exact->inexact (char->ascii (read-char port))))))))) diff --git a/v7/src/6001/pic-reco.scm b/v7/src/6001/pic-reco.scm index 0f5861471..6a07f70bd 100644 --- a/v7/src/6001/pic-reco.scm +++ b/v7/src/6001/pic-reco.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: pic-reco.scm,v 1.7 1999/01/02 06:06:43 cph Exp $ +$Id: pic-reco.scm,v 1.8 2001/12/20 03:24:33 cph Exp $ -Copyright (c) 1993, 1999 Massachusetts Institute of Technology +Copyright (c) 1993, 1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# ;;; Representation of pictures using records @@ -53,7 +54,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. height (lambda (n) n ; ignored - (make-floating-vector width initial-val)))) + (flo:make-vector width initial-val)))) (%picture-set-image! pic #f) pic)) @@ -104,7 +105,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (fix:< y (picture-height picture)))) (bad-range-signal y 'PICTURE-REF)) (else - (floating-vector-ref + (flo:vector-ref (vector-ref (picture-data picture) y) x))))) (define (make-picture-setter bad-type-predicate bad-range-signal) @@ -120,7 +121,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (fix:< y (picture-height picture)))) (bad-range-signal y 'PICTURE-SET!)) (else - (floating-vector-set! (vector-ref (picture-data picture) y) + (flo:vector-set! (vector-ref (picture-data picture) y) x (exact->inexact value)) (invalidate-cached-values picture))))) @@ -163,9 +164,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let ((yth-row (vector-ref picdata y))) (let x-loop ((x 0)) (if (< x width) - (begin (floating-vector-set! yth-row x - (exact->inexact - (fn x y))) + (begin (flo:vector-set! yth-row x + (exact->inexact (fn x y))) (x-loop (1+ x))) (y-loop (1+ y)))))) (invalidate-cached-values picture)))) @@ -191,14 +191,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let* ((picdata (picture-data picture)) (width (picture-width picture)) (height (picture-height picture)) - (current-min (floating-vector-ref (vector-ref picdata 0) 0)) + (current-min (flo:vector-ref (vector-ref picdata 0) 0)) (current-max current-min)) (let y-loop ((y 0)) (if (< y height) (let ((yth-row (vector-ref picdata y))) (let x-loop ((x 0)) (if (< x width) - (let ((v (floating-vector-ref yth-row x))) + (let ((v (flo:vector-ref yth-row x))) (set! current-min (min current-min v)) (set! current-max (max current-max v)) (x-loop (1+ x))) diff --git a/v7/src/6001/picture.scm b/v7/src/6001/picture.scm index 6f8f588b5..80109270b 100644 --- a/v7/src/6001/picture.scm +++ b/v7/src/6001/picture.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: picture.scm,v 1.29 1999/02/16 01:00:07 cph Exp $ +$Id: picture.scm,v 1.30 2001/12/20 03:24:45 cph Exp $ -Copyright (c) 1991-1999 Massachusetts Institute of Technology +Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,7 +16,8 @@ General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software -Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. +Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +02111-1307, USA. |# ;;;; 6.001 Images @@ -25,26 +26,20 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ;;;; Miscellaneous Utilities -(define-primitives - floating-vector-ref - floating-vector-set! - floating-vector-cons - floating-vector-length) - -(define (make-floating-vector length init) - (let ((result (floating-vector-cons length))) +(define (flo:make-vector length init) + (let ((result (flo:vector-cons length))) (if (not (= init 0.)) (do ((i 0 (fix:+ i 1))) ((fix:= i length)) - (floating-vector-set! result i init))) + (flo:vector-set! result i init))) result)) -(define (floating-vector-copy vector) - (let* ((length (floating-vector-length vector)) - (result (floating-vector-cons length))) +(define (flo:vector-copy vector) + (let* ((length (flo:vector-length vector)) + (result (flo:vector-cons length))) (do ((i 0 (fix:+ i 1))) ((fix:= i length)) - (floating-vector-set! result i (floating-vector-ref vector i))) + (flo:vector-set! result i (flo:vector-ref vector i))) result)) (define (side-effecting-iter n proc) @@ -62,10 +57,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (define (up-bound interval-length) (floor->exact (1+ (/ interval-length 2)))) -(define (floating-vector->list vector) - (generate-list (floating-vector-length vector) +(define (flo:vector->list vector) + (generate-list (flo:vector-length vector) (lambda (i) - (floating-vector-ref vector i)))) + (flo:vector-ref vector i)))) (define (generate-list n proc) ; ==> ( (proc 0) (proc 1) ... (proc n-1) ) (let loop ((i (- n 1)) (list '())) @@ -337,10 +332,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x width) (begin - (floating-vector-set! + (flo:vector-set! out-yth-row x (exact->inexact - (f (floating-vector-ref in-yth-row x)))) + (f (flo:vector-ref in-yth-row x)))) (x-loop (fix:+ 1 x))) (y-loop (fix:+ 1 y))))))))) ((null? (cddr pic-list)) @@ -354,11 +349,11 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x width) (begin - (floating-vector-set! + (flo:vector-set! out-yth-row x (exact->inexact - (f (floating-vector-ref in-yth-row1 x) - (floating-vector-ref in-yth-row2 x)))) + (f (flo:vector-ref in-yth-row1 x) + (flo:vector-ref in-yth-row2 x)))) (x-loop (fix:+ 1 x))) (y-loop (fix:+ 1 y))))))))) (else @@ -373,12 +368,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (let x-loop ((x 0)) (if (fix:< x width) (begin - (floating-vector-set! + (flo:vector-set! out-yth-row x (exact->inexact (apply f (map (lambda (row) - (floating-vector-ref row x)) + (flo:vector-ref row x)) in-yth-rows)))) (x-loop (fix:+ 1 x))) (y-loop (fix:+ 1 y)))))))))) @@ -485,7 +480,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. (lambda (x) (ascii->char (round->exact (* (- x pmin) scale))))))) - (floating-vector->list (vector-ref data row))))) + (flo:vector->list (vector-ref data row))))) (begin (write-string (list->string rowvals) port) (rowloop (- row 1)))))))))) \ No newline at end of file diff --git a/v7/src/win32/win32.pkg b/v7/src/win32/win32.pkg index a69b71a58..c98e97d2c 100644 --- a/v7/src/win32/win32.pkg +++ b/v7/src/win32/win32.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: win32.pkg,v 1.13 2001/08/18 04:52:11 cph Exp $ +$Id: win32.pkg,v 1.14 2001/12/20 03:27:54 cph Exp $ Copyright (c) 1993-2001 Massachusetts Institute of Technology @@ -25,7 +25,7 @@ USA. (global-definitions "../runtime/runtime") (define-package (win32) - (parent ()) + (parent (runtime)) (files "winuser" "wt_user" "wf_user" -- 2.25.1