; -*- Scheme -*-
;
; $Id: string-unpack.scm,v 1.1 1998/03/16 08:00:25 foner Exp $
;
;------------

;+doc
;                           STRING-UNPACK
;                           =============
;
; Routines to unpack various sized integers (8,16,24,32 bit) from a string.
; The routines are a cross between string->integer with a radix of 255
; and part of Perl's unpack facility.  Only the unsigned routines are
; really necessary, the others can be synthesised from them.  They are
; only included here for historical reasons.  Note that the numbers
; are extracted in network (big endian) order.
;
; Stephen J. Bevan <bevan@cs.man.ac.uk> 19920922
;-doc


;+doc
; procedure: string:unpack:unsigned-int:32
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 4))
; post:      (<= 0 value (expt 2 32))
;
; Extract an unsigned 32 bit (4 byte) integer from STRING starting at
; POSITION.
;
;  (string:unpack:unsigned-int:32 
;    (string (integer->char 0) (integer->char 0)
;            (integer->char 0) (integer->char 2))
;    0)
;  2
;-doc

(define string:unpack:unsigned-int:32
  (lambda (s p)
    (+ (* (char->integer (string-ref s p)) 16777216)
       (* (char->integer (string-ref s (+ p 1))) 65536)
       (* (char->integer (string-ref s (+ p 2))) 256)
       (char->integer (string-ref s (+ p 3))))))

;------------

;+doc
; procedure: string:unpack:1s-complement-int:32
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 4))
; post:      (<= (- (- (expt 2 31) 1)) value (- (expt 2 31) 1))
;
; Extract a 1s complement 32 bit (4 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:1s-complement-int:32
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:32 s p)))
      (if (> i 2147483648) (- i 4294967295) i))))

;------------

;+doc
; procedure: string:unpack:2s-complement-int:32
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 4))
; post:      (<= (- (expt 2 31)) value (- (expt 2 31) 1))
;
; Extract a 2s complement 32 bit (4 byte) integer from STRING starting at
; POSITION.
;
; (string:unpack:2s-complement-int:32 
;    (string (integer->char 0) (integer->char 0)
;            (integer->char 0) (integer->char 2))
;    0)
; 2
;
; (string:unpack:2s-complement-int:32
;   (string (integer->char 0) (integer->char 0)
;           (integer->char 255) (integer->char 2))
;   0)
; 65282
;-doc

(define string:unpack:2s-complement-int:32
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:32 s p)))
      (if (> i 2147483647) (- i 4294967296) i))))

;------------

;+doc
; procedure: string:unpack:unsigned-int:24
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 3))
; post:      (<= 0 value (expt 2 24))
;
; Extract an unsigned 24 bit (3 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:unsigned-int:24
  (lambda (s p)
    (+ (* (char->integer (string-ref s (+ p 0))) 65536)
       (* (char->integer (string-ref s (+ p 1))) 256)
       (char->integer (string-ref s (+ p 2))))))

;------------

;+doc
; procedure: string:unpack:1s-complement-int:24
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 3))
; post:      (<= (- (- (expt 2 23) 1)) value (- (expt 2 23) 1))
;
; Extract a 1s complement 24 bit (3 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:1s-complement-int:24
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:24 s p)))
      (if (> i 8388607) (- i 16777215) i))))

;-------------

;+doc
; procedure: string:unpack:2s-complement-int:24
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 3))
; post:      (<= (- (expt 2 23)) value (- (expt 2 23) 1))
;
; Extract a 2s complement 24 bit (3 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:2s-complement-int:24
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:24 s p)))
      (if (> i 8388607) (- i 16777216) i))))

;------------

;+doc
; procedure: string:unpack:unsigned-int:16
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 2))
; post:      (<= 0 value (expt 2 16))
;
; Extract an unsigned 16 bit (2 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:unsigned-int:16
  (lambda (s p)
    (+ (* (char->integer (string-ref s p)) 256)
       (char->integer (string-ref s (+ p 1))))))

;------------

;+doc
; procedure: string:unpack:1s-complement-int:16
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 2))
; post:      (<= (- (- (expt 2 15) 1)) value (- (expt 2 15) 1))
;
; Extract a 1s complement 16 bit (2 byte) integer from STRING starting at
; POSITION.
; (string:unpack:1s-complement-int:16
;   (string (integer->char 255) (integer->char 254))
;   0)
; -1
;-doc

(define string:unpack:1s-complement-int:16
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:16 s p)))
      (if (> i 32767) (- i 65535) i))))

;------------

;+doc
; procedure: string:unpack:2s-complement-int:16
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 2))
; post:      (<= (- (expt 2 15)) value (- (expt 2 15) 1))
;
; Extract a 2s complement 16 bit (2 byte) integer from STRING starting at
; POSITION.
;
; (string:unpack:2s-complement-int:16
;   (string (integer->char 255) (integer->char 254))
;   0)
; -2
;
; (string:unpack:2s-complement-int:16
;   (string (integer->char 0) (integer->char 0)
;           (integer->char 255) (integer->char 2))
;   2)
; -254
;-doc

(define string:unpack:2s-complement-int:16
  (lambda (s p)
    (let ((i (string:unpack:unsigned-int:16 s p)))
      (if (> i 32767) (- i 65536) i))))

;-------------

;+doc
; procedure: string:unpack:unsigned-int:8
; arguments: string position
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start)
;                 (< start (string-length string))
;                 (>= (string-length string) 1))
; post:      (<= 0 value (expt 2 8))
;
; Extract an unsigned 8 bit (1 byte) integer from STRING starting at
; POSITION.
;-doc

(define string:unpack:unsigned-int:8
  (lambda (s p)
    (char->integer (string-ref s p))))

;-------------

;+doc
; procedure: string:unpack:1s-complement-int:8
; arguments: string start
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start) 
;                 (< start (string-length string))
;                 (>= (string-length string) 1))
; post:      (<= (- (expt 2 7)) value (- (expt 2 7) 1))
; 
; Extract a 1s complement 8 bit (1 byte) integer from STRING starting
; at POSITION.
;-doc

(define string:unpack:1s-complement-int:8
  (lambda (s p)
    (let ((i (char->integer (string-ref s p))))
      (if (> i 127) (- i 255) i))))

;------------

;+doc
; procedure: string:unpack:2s-complement-int:8
; arguments: string start
; result:    value
; signature: string x int -> integer
; pre:       (and (<= 0 start) 
;                 (< start (string-length string))
;                 (>= (string-length string) 1))
; post:      (<= (- (expt 2 7)) value (- (expt 2 7) 1))
; 
; Extract a 2s complement 8 bit (1 byte) integer from STRING starting
; at POSITION.
;-doc

(define string:unpack:2s-complement-int:8
  (lambda (s p)
    (let ((i (char->integer (string-ref s p))))
      (if (> i 127) (- i 256) i))))

;-------------

; eof
