;;;; Copyright 2002-2003 Kevin M. Rosenberg
;;;; Permission to use with BSD-style license included in the COPYING file
;;;;
-;;;; $Id: src.lisp,v 1.3 2003/01/04 06:13:53 kevin Exp $
+;;;; $Id: src.lisp,v 1.6 2003/01/04 13:43:27 kevin Exp $
(defpackage #:base64
(:use #:cl)
(let* ((string-length (length string))
(complete-group-count (truncate string-length 3))
(remainder (nth-value 1 (truncate string-length 3)))
- (padded-length (+ remainder
- (* 4 complete-group-count)))
+ (padded-length (* 4 (truncate (+ string-length 2) 3)))
(num-lines (if (plusp columns)
(truncate (+ padded-length (1- columns)) columns)
0))
(num-breaks (if (plusp num-lines)
(1- num-lines)
0))
- (strlen (+ padded-length num-breaks))
- (result (unless stream
- (make-string strlen)))
+ (strlen (if stream
+ 0
+ (+ padded-length num-breaks)))
+ (result (make-string strlen))
(col (if (plusp columns)
0
(1+ padded-length)))
(labels ((output-char (ch)
(when (= col columns)
(if stream
- (write #\Newline stream)
+ (write-char #\Newline stream)
(progn
(setf (schar result ioutput) #\Newline)
(incf ioutput)))
(setq col 0))
(incf col)
(if stream
- (write ch stream)
+ (write-char ch stream)
(progn
(setf (schar result ioutput) ch)
(incf ioutput))))
(output-group (svalue chars)
+ (declare (fixnum svalue chars))
(output-char
(schar encode-table
(the fixnum
(the fixnum
(logand #x3f
(the fixnum (ash svalue -6))))))
- (output-char pad))
+ (output-char pad))
(if (> chars 3)
(output-char
(schar encode-table
(the fixnum
(logand #x3f svalue))))
- (output-char pad))))
+ (output-char pad))))
(do ((igroup 0 (1+ igroup))
- (isource 0 (+ isource 3))
- svalue)
+ (isource 0 (+ isource 3)))
((= igroup complete-group-count)
- (case remainder
- (2
- (setq svalue
- (the fixnum
- (+
- (the fixnum
- (ash (char-code (the character
- (char string isource))) 16))
- (the fixnum
- (ash (char-code (the character
- (char string (1+ isource)))) 8)))))
- (output-group svalue 3))
- (1
- (setq svalue
- (the fixnum
- (char-code (the character
- (char string isource)))))
- (output-group svalue 2)))
+ (cond
+ ((= remainder 2)
+ (output-group
+ (the fixnum
+ (+
+ (the fixnum
+ (ash (char-code (the character
+ (char string isource))) 16))
+ (the fixnum
+ (ash (char-code (the character
+ (char string (1+ isource)))) 8))))
+ 3))
+ ((= remainder 1)
+ (output-group
+ (the fixnum
+ (ash (char-code (the character (char string isource))) 16))
+ 2)))
result)
- (declare (fixnum igroup isource svalue))
- (setq svalue
- (the fixnum
- (+
- (the fixnum
- (ash (char-code (the character
- (char string isource))) 16))
- (the fixnum
- (ash (char-code (the character
- (char string (1+ isource)))) 8))
- (the fixnum
- (char-code (the character
- (char string (+ 2 isource))))))))
- (output-group svalue 4))))))
-
+ (declare (fixnum igroup isource))
+ (output-group
+ (the fixnum
+ (+
+ (the fixnum
+ (ash (char-code (the character
+ (char string isource))) 16))
+ (the fixnum
+ (ash (char-code (the character (char string (1+ isource)))) 8))
+ (the fixnum
+ (char-code (the character (char string (+ 2 isource)))))))
+ 4))))))
(defun integer-to-base64 (input &key (uri nil) (columns 0) (stream nil))
(if stream