annotate src/clojure/contrib/test_contrib/pprint/examples/hexdump.clj @ 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ;;; hexdump.clj -- part of the pretty printer for Clojure
rlm@10 2
rlm@10 3 ;; by Tom Faulhaber
rlm@10 4 ;; April 3, 2009
rlm@10 5
rlm@10 6 ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
rlm@10 7 ; The use and distribution terms for this software are covered by the
rlm@10 8 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10 9 ; which can be found in the file epl-v10.html at the root of this distribution.
rlm@10 10 ; By using this software in any fashion, you are agreeing to be bound by
rlm@10 11 ; the terms of this license.
rlm@10 12 ; You must not remove this notice, or any other, from this software.
rlm@10 13
rlm@10 14 ;; This example is a classic hexdump program written using cl-format.
rlm@10 15
rlm@10 16 ;; For some local color, it was written in Dulles Airport while waiting for a flight
rlm@10 17 ;; home to San Francisco.
rlm@10 18
rlm@10 19 (ns clojure.contrib.pprint.examples.hexdump
rlm@10 20 (:use clojure.contrib.pprint
rlm@10 21 clojure.contrib.pprint.utilities)
rlm@10 22 (:gen-class (:main true)))
rlm@10 23
rlm@10 24 (def *buffer-length* 1024)
rlm@10 25
rlm@10 26 (defn zip-array [base-offset arr]
rlm@10 27 (let [grouped (partition 16 arr)]
rlm@10 28 (first (map-passing-context
rlm@10 29 (fn [line offset]
rlm@10 30 [[offset
rlm@10 31 (map #(if (neg? %) (+ % 256) %) line)
rlm@10 32 (- 16 (count line))
rlm@10 33 (map #(if (<= 32 % 126) (char %) \.) line)]
rlm@10 34 (+ 16 offset)])
rlm@10 35 base-offset grouped))))
rlm@10 36
rlm@10 37
rlm@10 38 (defn hexdump
rlm@10 39 ([in-stream] (hexdump in-stream true 0))
rlm@10 40 ([in-stream out-stream] (hexdump [in-stream out-stream 0]))
rlm@10 41 ([in-stream out-stream offset]
rlm@10 42 (let [buf (make-array Byte/TYPE *buffer-length*)]
rlm@10 43 (loop [offset offset
rlm@10 44 count (.read in-stream buf)]
rlm@10 45 (if (neg? count)
rlm@10 46 nil
rlm@10 47 (let [bytes (take count buf)
rlm@10 48 zipped (zip-array offset bytes)]
rlm@10 49 (cl-format out-stream
rlm@10 50 "~:{~8,'0X: ~2{~8@{~#[ ~:;~2,'0X ~]~} ~}~v@{ ~}~2{~8@{~A~} ~}~%~}"
rlm@10 51 zipped)
rlm@10 52 (recur (+ offset *buffer-length*) (.read in-stream buf))))))))
rlm@10 53
rlm@10 54 (defn hexdump-file
rlm@10 55 ([file-name] (hexdump-file file-name true))
rlm@10 56 ([file-name stream]
rlm@10 57 (with-open [s (java.io.FileInputStream. file-name)]
rlm@10 58 (hexdump s))))
rlm@10 59
rlm@10 60 ;; I don't quite understand how to invoke main funcs w/o AOT yet
rlm@10 61 (defn -main [& args]
rlm@10 62 (hexdump-file (first args)))
rlm@10 63