70 lines
2.2 KiB
Scheme
70 lines
2.2 KiB
Scheme
; -*- Mode: Scheme; Syntax: Scheme; Package: Scheme; -*-
|
||
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
|
||
|
||
|
||
;;;; Portable definitions of char->ascii and ascii->char
|
||
|
||
; Don't detabify this file!
|
||
|
||
; This module defines char->ascii and ascii->char in terms of
|
||
; char->integer and integer->char, with no assumptions about the encoding.
|
||
; Portable except maybe for the strings that contain tab, page, and
|
||
; carriage return characters. Those can be flushed if necessary.
|
||
|
||
(define ascii-limit 128)
|
||
|
||
(define ascii-chars
|
||
(let* ((ascii-chars (make-vector ascii-limit #f))
|
||
(unusual (lambda (s)
|
||
(if (or (not (= (string-length s) 1))
|
||
(let ((c (string-ref s 0)))
|
||
(or (char=? c #\space)
|
||
(char=? c #\newline))))
|
||
(error "unusual whitespace character lost" s)
|
||
s)))
|
||
(init (lambda (i s)
|
||
(do ((i i (+ i 1))
|
||
(j 0 (+ j 1)))
|
||
((= j (string-length s)))
|
||
(vector-set! ascii-chars i (string-ref s j))))))
|
||
(init 9 (unusual " ")) ;tab
|
||
(init 12 (unusual " ")) ;page
|
||
(init 13 (unusual "
|
||
")) ;carriage return
|
||
(init 10 (string #\newline))
|
||
(init 32 " !\"#$%&'()*+,-./0123456789:;<=>?")
|
||
(init 64 "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_")
|
||
(init 96 "`abcdefghijklmnopqrstuvwxyz{|}~")
|
||
ascii-chars))
|
||
|
||
(define (ascii->char n)
|
||
(or (vector-ref ascii-chars n)
|
||
(error "not a standard character's ASCII code" n)))
|
||
|
||
(define native-chars
|
||
(let ((end (vector-length ascii-chars)))
|
||
(let loop ((i 0)
|
||
(least #f)
|
||
(greatest #f))
|
||
(cond ((= i end)
|
||
(let ((v (make-vector (+ (- greatest least) 1) #f)))
|
||
(do ((i 0 (+ i 1)))
|
||
((= i end) (cons least v))
|
||
(let ((c (vector-ref ascii-chars i)))
|
||
(if c
|
||
(vector-set! v (- (char->integer c) least) i))))))
|
||
(else
|
||
(let ((c (vector-ref ascii-chars i)))
|
||
(if c
|
||
(let ((n (char->integer c)))
|
||
(loop (+ i 1)
|
||
(if least (min least n) n)
|
||
(if greatest (max greatest n) n)))
|
||
(loop (+ i 1) least greatest))))))))
|
||
|
||
(define (char->ascii char)
|
||
(or (vector-ref (cdr native-chars)
|
||
(- (char->integer char) (car native-chars)))
|
||
(error "not a standard character" char)))
|
||
|
||
(define ascii-whitespaces '(32 10 9 12 13)) ;space linefeed tab page return
|