cgit.sxemacs.org Git - packages/blob - xemacs-packages/tm/tl-num.el

   1 ;;;
   2 ;;; $Id: tl-num.el,v 1.1.1.1 1998-01-14 06:27:57 steve Exp $
   3 ;;;
   4 ;;; by MORIOKA Tomohiko <morioka@jaist.ac.jp>, 1993/10/4
   5 ;;;
   6
   7 (require 'emu)
   8 (require 'tl-seq)
   9
  10
  11 ;;; @ n base
  12 ;;;
  13
  14 (defun n-char-to-int (chr)
  15   "Convert n base character CHR to integer (n <= 36). [tl-num]"
  16   (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
  17         ((and (<= ?A chr)(<= chr ?Z)) (+ (- chr ?A) 10))
  18         ((and (<= ?a chr)(<= chr ?z)) (+ (- chr ?a) 10))
  19         ))
  20
  21 (defun int-to-n-char (n)
  22   "Convert integer N to n base character (n <= 36). [tl-num]"
  23   (if (< n 10)
  24       (+ ?0 n)
  25     (+ ?A (- n 10))
  26     ))
  27
  28 (defun base-seq-to-int (base seq)
  29   "Convert n base number sequence SEQ to number. [tl-num]"
  30   (foldl (function
  31           (lambda (n m)
  32             (+ (* n base) m)
  33             ))
  34          0 seq))
  35
  36 (defun base-char-seq-to-int (base seq)
  37   "Convert n base char sequence SEQ to number. [tl-num]"
  38   (foldl (function
  39           (lambda (n chr)
  40             (+ (* n base)(n-char-to-int chr))
  41             ))
  42          0 seq))
  43
  44
  45 ;;; @ Hex
  46 ;;;
  47
  48 (defun hex-char-to-number (chr)
  49   "Convert hex character CHR to number. [tl-num]"
  50   (cond ((and (<= ?0 chr)(<= chr ?9)) (- chr ?0))
  51         ((and (<= ?A chr)(<= chr ?F)) (+ (- chr ?A) 10))
  52         ((and (<= ?a chr)(<= chr ?f)) (+ (- chr ?a) 10))
  53         ))
  54
  55 (defalias 'number-to-hex-char 'int-to-n-char)
  56
  57 (defun hex-seq-to-int (seq)
  58   "Convert hex number sequence SEQ to integer. [tl-num]"
  59   (base-seq-to-int 16 seq)
  60   )
  61
  62 (defun hex-char-seq-to-int (seq)
  63   "Convert hex char sequence SEQ to integer. [tl-num]"
  64   (base-char-seq-to-int 16 seq)
  65   )
  66
  67
  68 ;;; @ end
  69 ;;;
  70
  71 (provide 'tl-num)