File psl-1983/util/util.sl artifact 01886823db part of check-in e1a8550313


%
% UTIL.SL - General Utility/Support functions
% 
% Author:      Nancy Kendzierski
%              Hewlett-Packard/CRC
% Date:        23 September 1982
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load common strings objects))

(fluid '(nmode-terminal))

(defun integer$parse (str)
  % Return an integer corresponding to the string -- not the characters
  %  in the string, but the number in the string.
  (prog (i negative error ch num)
    (setf i 0)
    (setf num 0)
    (if (<= (string-length str) 0) (return NIL))
    (setf ch (indx str 0))
    (cond ((= ch (char -)) (let () (setf negative t)
				   (setf i (add1 i))))
	  ((= ch (char +)) (setf i (add1 i))))
    (if (>= i (string-length str)) (return NIL))
    (for (from i i (size str)) (do 
      (setq ch (indx str i))
      (cond ((or (< ch (char 0)) (> ch (char 9)))
	     (exit (setq error t)))
	    (t (setq num (+ (* num 10) (- ch (char 0))))))))
    (cond (error (return NIL))
	  (negative (return (setq num (minus num))))
	  (t (return num)))))

(defun integer$unparse (num)
  % Return an ASCII string version of the integer.
  (let ((str "") (negative nil) temp)
    (cond ((< num 0) (setf negative t) (setf num (minus num))))
    (while (> num 0)
      (setq temp (divide num 10))
      (setq num (car temp))
      (setq str (string-concat (string (+ (cdr temp) (char 0))) str)))
    (cond ((equal str "") "0")
	  (negative (string-concat "-" str))
	  (t str))
    ))

(defun integer-base$parse (base str)
  % Return an integer corresponding to the string -- not the characters
  %  in the string, but the number in the string.
  (prog (i negative error ch num max-digit)
    (setf max-digit (+ #\0 (- base 1)))
    (setf i 0)
    (setf num 0)
    (if (<= (string-length str) 0) (return NIL))
    (setf ch (indx str 0))
    (cond ((= ch (char -)) (let () (setf negative t)
				(setf i (add1 i))))
	  ((= ch (char +)) (setf i (add1 i))))
    (if (>= i (string-length str)) (return NIL))
    (for (from i i (size str)) (do 
      (setq ch (indx str i))
      (cond ((or (< ch (char 0)) (> ch max-digit))
	     (exit (setq error t)))
	    (t (setq num (+ (* num base) (- ch (char 0))))))))
    (cond (error (return NIL))
	  (negative (return (setq num (minus num))))
	  (t (return num)))))

(defun integer-base$unparse (base num)
  % Return an ASCII string version of the integer.
  (let ((str "") (negative nil) temp)
    (cond ((< num 0) (setf negative t) (setf num (minus num))))
    (while (> num 0)
      (setq temp (divide num base))
      (setq num (car temp))
      (setq str (string-concat (string (+ (cdr temp) (char 0))) str)))
    (cond ((equal str "") "0")
	  (negative (string-concat "-" str))
	  (t str))
    ))

(defun LoadSoftKey (key mode command label)
  % Load a soft key on an HP264X terminal
  %   key:      0 <= key <= 8
  %   mode:     'N 'L or 'T
  %   command:  string (maximum 80 characters)
  %   label:    string (maximum 80 characters)
  (prog (cmd command-size label-size restore-echo?)
    (setq cmd (string 27 38))  % Escape-& is soft-key command prefix start.
    %  Set up proper mode.
    (cond ((= mode 'N) (setq cmd (concat cmd "f0a")))
	  ((= mode 'L) (setq cmd (concat cmd "f1a")))
	  ((= mode 'T) (setq cmd (concat cmd "f2a")))
	  (t (return "Illegal mode") ))
    %  Set up soft-key number.
    (if (or (< key 0) (> key 8)) (return "Illegal soft-key number"))
    (setq cmd (string-concat cmd (integer$unparse key) "k"))
    %  Set up label length, command length, and command.
    (setq label-size (+ 1 (size label)))
    (if (> label-size 80) (return "Label too long"))
    (setq command-size (+ 1 (size command)))
    (if (> command-size 80) (return "Command too long"))

    (setq cmd (string-concat cmd
			     (integer$unparse label-size)
			     "d"
			     (integer$unparse command-size)
                             "L"
			     label
			     command))
    %  Turn echoing off, if necessary.
    (cond ((not (=> nmode-terminal raw-mode))
	   (=> nmode-terminal enter-raw-mode)
	   (setq restore-echo? t)))
    %  Output the string of command characters.
    (for (from i 0 (size cmd)) (do (pbout (indx cmd i))))
    (if restore-echo? (=> nmode-terminal leave-raw-mode))
    ))


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]