OSDev.org

Code: Select all

(define dump-file
;; read in a file and print a dump of it.
  (lambda (filename width height)
     
   ; display a number's ASCII value
    (define display-char-value
      (lambda (x)
        (display (char-value (modulo x 256)))))
    
    ; display a character's hex value
    (define display-hex-value
      (lambda (x)
        (let ((hexval (number->string (modulo x 256) 16))) 
          (begin
            (if (> 2 (string-length hexval))
                (display #\0))
            (display hexval)
            (display #\space)))))
    
    ;; display a line of character values
    (define display-line-values
      (lambda (dump)
        (for-each display-char-value dump)))
    
    ;; display a line of hex values
    (define display-line-dump 
      (lambda (dump)
        (for-each display-hex-value dump)))
    
    ;; display a line of hex values followed by 
    ;; a line of character values
    (define display-line
      (lambda (dump width)
        (let* ((size (length dump))
               (diff (- width size)))
          (begin
            (display-line-dump dump)
            (if (> diff 0)
                (do ((count diff (- count 1)))
                  ((<= count 0))
                  (begin
                    (display #\space)
                    (display #\space)
                    (display #\space)
                    )))
            (display #\space)
            (display #\:)
            (display #\space)
            (display-line-values dump)
            (newline)
            diff))))          
    
    ;; read in a line of data
    (define read-dump-line
      (lambda (src width)
        (let read-data ((count width))
          (if (or (>= 0 count)
                  (eof-object? (peek-char src))) 
              '()
              (append (list (char->integer (read-char src))) 
                      (read-data (- count 1)))))))

    ;; main function
    (if (and (string? filename)
             (> width 0)
             (> height 0))
        (let ((src (open-input-file filename)))
          (if (null? src)
              #f
              (let write-dump ((count height))
                (begin
                  (display-line (read-dump-line src width) width)
                  (if (or (<= count 0) 
                          (eof-object? (peek-char src)))
                      (begin
                        (close-input-port src)
                        #t)
                      (write-dump (- count 1)))))))
        #f)))

;; some support functions (usually in a spearate file)
(define hex->char
;; converts a character to a hex value
  (lambda (x y)
    (integer->char
     (string->number (string x y) 16))))

(define char-symbolic?
;; returns #t if the character is a symbol, #f otherwise 
  (lambda (c)
    (if (not (member c '(#\` #\~ #\! #\@ #\# #\$ #\% #\^ #\& #\* #\( #\)
                          #\- #\_ #\+ #\= #\\ #\| 
                          #\[ #\{ #\] #\} #\; #\: #\' #\" 
                          #\, #\< #\. #\> #\? #\/))) 
        #f
        #t)))

(define char-printable?
;; returns #t if a character is printable, #f otherwise
  (lambda (c)
    (or (char-alphabetic? c)
        (char-numeric? c)
        (char-symbolic? c))))

(define char-value
;; takes a character and returns its integer value
;; returns a period if given an invalid value
  (lambda (x)
    (let ((c (integer->char x)))
      (cond ((not (integer? x)) #\.)
            ((char-printable? c) c)
             (else #\.)))))