Artifact 01886823db8f2ea7cb1584a9ba3a8bf043052aad73c3436605e210b67a0c8c85:

• File psl-1983/3-1/util/util.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4243) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/util.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 4243) [annotate] [blame] [check-ins using]

%
% 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))
    ))