Category Archives: Uncategorized

The HP-67 emulator, hardening the input

While we’ve got a program that can accept commands and behave like a calculator, it is, at this point, somewhat brittle.  Unexpected input can cause it to enter the Lisp debugger, which isn’t how we’d like to have things behave.  So, it’s time to start making sure that bad input is handled gracefully.

We’ll define an error status region of the screen that will fill in with text when the calculator determines that an error has occurred.  In that case, we’ll mark the stack with an error text and force the user to type the “clx” command before continuing.  This means we have to add a new field to our keypress structure, “can clear errors”, so that we can make sure only that key can be used until the error has been cleared.

Now, in engine.lisp, we cheated a bit on the code that allows an entire number to be input at once.  We used read-from-string on unsanitized input to see if the string contained a number.  This can break in a variety of ways if the string contains, say, unbalanced double-quotes, to name only one of many bad cases.  So, to clean it up, we do a pre-test to verify that the string contains only characters that are legal in a numeric context.  That is, the digits, the dot, the minus sign, and ‘d’ or ‘e’ in either lower- or upper-case, for the exponential notation.

Here, then, is an example of what happens when the user tries to divide 1 by 0:cli-error-state

This code is checked into the git repository under the tag v2014-11-26.

The HP-67 emulator, a working calculator emerges

We are now ready to put together an actual useful calculator.  With an event loop and input handler, we can now perform interactive operations commanded by the user.  By displaying the stack, we can show the user the results of those operations.

One problem we will have is keyboards.  They keyboard has the ability to send control keys, most of which are handled in an implementation-dependent manner by Lisp.  We would like to filter out control characters unless they have some particular meaning to the program.  This is done with two new functions, quit-character and allowed-character, both defined under the reader macro #+sbcl, so only compiled when running on SBCL.  In SBCL, the character codes for the common keyboard characters are just their ASCII values, so we can filter keypresses by their ASCII code.

We also want the arithmetic operation keys to be hot keys.  That means that if they are the first character on a line, they will immediately take effect, as if the enter key had been pressed.

Main now looks like this:
curses-cli.lisp

(defun main()
  (charms:with-curses ()
    (let ((w charms:*standard-window*)
          n-rows n-cols)

      (multiple-value-setq
          (n-cols n-rows)
        (charms:window-dimensions w))

      (macrolet
          ((wsc (ostring)
             `(charms:write-string-at-cursor w ,ostring)))
        
        (charms:enable-echoing)
        (charms:disable-extra-keys w)
        (charms:disable-non-blocking-mode w)
        (charms:enable-raw-input :interpret-control-characters t)

        (let* ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (all-keys (get-key-abbrevs mode
                                          :sort-fcn #'comp<
                                          :veto-list *excluded-keys*))
               (maxlen (apply 'max
                              (mapcar 'length all-keys)))
               (keys-per-row (floor (/ n-cols (1+ maxlen)))))

          (do (exit-requested)
              (exit-requested)

            (charms:clear-window w)

            (let ((active-keys (get-key-abbrevs mode
                                                :sort-fcn #'comp<
                                                :veto-list *excluded-keys*
                                                :limit-to-mode t))
                  (i 0)
                  (accumulator (make-string-output-stream)))

              (dolist (candidate all-keys)
                (when (member candidate active-keys
                              :test 'string=)
                  (multiple-value-bind (r c)
                      (floor i keys-per-row)
                    (charms:move-cursor w (* c (1+ maxlen)) r))
                  (wsc candidate))
                (incf i))

              (dotimes (j 4)
                (let ((entry (nth j (stack-registers stack))))
                  (when entry
                    (charms:move-cursor w 0 (- n-rows j 4))
                    (wsc (format-for-printing mode entry)))))

              (charms:move-cursor w 0 (- n-rows 2))

              (charms:refresh-window w)

              (do ((pos 0)
                   (c (charms:get-char w) (charms:get-char w)))
                  ((char= c #\Newline))

                (cond
                  ((quit-character c)
                   (return-from main))
                  ((allowed-character c)
                   (format accumulator "~C" c)
                   (incf pos)))

                (when (and (= pos 1)
                           (member c *hot-keys* :test 'char=))
                  (return)))

              (let ((result (get-output-stream-string accumulator)))
                (handle-one-keypress result nil nil stack mode
                                     :arg-is-num t))))

              )))))

It can be loaded into SBCL (but not SLIME) with the command:
(asdf:oos 'asdf:load-op 'curses-cli)

Here’s what this first version of the calculator looks like:

Initial version of the CLI
Initial version of the CLI

This code is in the git repository under the tag v2014-11-24.

The HP-67 emulator, a command-line interface begins

Now that the internals for interactive mode are mainly done, it’s time to put a front-end on it, so that we can have something to test on.

I’m not an interface person, I write computational engines, and have little experience interacting with the user of the program.  If a reader could recommend a good GUI from among those on cliki.net that I should use for the graphical interface, that would be helpful.

In the mean time, I’m starting a text-based interface, using NCurses.  The library I’ll be using is cl-charms, as it’s based on the more modern CFFI system for calling external libraries.

The CLI behaves differently from a GUI that replicates the behaviour of the calculator.  For instance, you’re not likely to input numbers one digit at a time, you can simply type the entire number into the prompt.  Also, some keys are unnecessary in this context.  For instance, the specific gosub keys for labels A, B, C, D, E, and their lower-case equivalents.  From the CLI you would just enter the label on the line, so having those keys there only clutters the display.

In the CLI, we will want all of the keys to have natural positions in the table, but only display those keys which have meaning in the current mode.  This means that keys that only have effect in programming mode shouldn’t be displayed in interactive mode.  We’ll leave those spaces blank, to avoid confusion with key names moving around based on the mode.

One minor annoyance, cl-charms doesn’t run within a SLIME context, so we’ll have to test outside of SLIME.

Here is the beginning of the CLI function.  This just displays the keys, waits 4 seconds, then exits:
curses-cli.lisp

(defun main()
  (charms:with-curses ()
    (charms:disable-echoing)
    (charms:disable-extra-keys charms:*standard-window*)
    (charms:enable-non-blocking-mode charms:*standard-window*)
    (charms:enable-raw-input :interpret-control-characters t)

    (multiple-value-bind (n-cols n-rows)
        (charms:window-dimensions charms:*standard-window*)

      (let* ((stack (get-new-stack-object 4))
             (mode (get-new-mode-object))
             (all-keys (get-key-abbrevs mode
                                        :sort-fcn #'comp<
                                        :veto-list *excluded-keys*))
             (maxlen (apply 'max
                            (mapcar 'length all-keys)))
             (keys-per-row (floor (/ n-cols (1+ maxlen)))))

        (do (exit-requested)
            (exit-requested)

          (charms:clear-window charms:*standard-window*)

          (let ((active-keys (get-key-abbrevs mode
                                              :sort-fcn #'comp<
                                              :veto-list *excluded-keys*
                                              :limit-to-mode t))
                (i 0))

            (dolist (candidate all-keys)
              (when (member candidate active-keys
                            :test 'string=)
                (multiple-value-bind (r c)
                    (floor i keys-per-row)
                  (charms:move-cursor charms:*standard-window*
                                      (* c (1+ maxlen))
                                      r))
                (charms:write-string-at-cursor charms:*standard-window*
                                               candidate))
              (incf i))

            (charms:refresh-window charms:*standard-window*)

            (sleep 4)

            (setf exit-requested t)

            ))))))

This code is checked into the git repository under the tag v2014-11-22.

The HP-67 emulator, compound keys, and moving to a package

We’re almost done with the back-end that talks to the UI, at least for interactive use.  There is one category of keypresses that we haven’t handled yet, the compound keys.  These are key sequences such as “STO” “+” “2”.  This example takes the value in the X register and adds it to the value in memory register 2, holding the result in register 2.  There are similar compound keys for subtraction, multiplication, and division.

Compound keys are defined in calc1.lisp, with a special location record that includes the abbreviation strings of the two keys that must be pressed, in sequence, to invoke the compound key.  We want to notice when a compound key sequence has been pressed, and substitute the compound key’s abbreviation in the flow.  This is how that is done:
engine.lisp

      ;; Look for compound keys
      (dolist (k (get-compound-keys))
        (let* ((location (key-struct-key-location k))
               (ck (location-compound-key location)))
          (when (and (string= abbrev (first ck))
                     (string= arg (second ck)))
            (setf key k)
            (setf arg (funcall fetch-argument-closure
                               (key-struct-abbrev key)))
            (unless arg
              (return-from handle-one-keypress :MISSING-ARGUMENT))
            (return))))

One final step before switching to UI coding is the packaging of symbols.  We create a package called hp-internals that will hold everything we’ve written so far.  Because the functions for this package are defined in multiple .lisp files, I prefer not to use the :export keyword in the defpackage form, but instead have each module that produces exported symbols do the export explicitly with the export function.

Here is the defpackage, in constants.lisp:
constants.lisp

(defpackage :HP67-INTERNALS
  (:use :COMMON-LISP)
  )

(in-package :HP67-INTERNALS)

Here is a sample export form, in stack.lisp:
stack.lisp

(in-package :HP67-INTERNALS)

(export '(STACK-REGISTERS STACK-MEMORY STACK-PROGRAM-MEMORY
          STACK-ERROR-STATE))

Now, to invoke and test the compound keypresses, we would do something like this:
*slime-repl sbcl*

CL-USER> (import '(hp67-internals:handle-one-keypress 
                   hp67-internals:get-new-stack-object 
                   hp67-internals:get-new-mode-object))
T
CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "8" arg-fcn nil stack mode)
           (handle-one-keypress "sto -" arg-fcn nil stack mode)
           stack)
Argument for sto-:  2

#S(HP67-INTERNALS::STACK
   :REGISTERS (8 0 0 0)
   :REGISTERS-COPY (8 0 0 0)
   :NUM-REGISTERS 4
   :LAST-X 0
   :ASSEMBLER #S(HP67-INTERNALS::TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {10044FDA53}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :EXPONENT-DIGITS 0
                 :TRANSLATION ((:|0| . "0") (:|1| . "1") (:|2| . "2")
                               (:|3| . "3") (:|4| . "4") (:|5| . "5")
                               (:|6| . "6") (:|7| . "7") (:|8| . "8")
                               (:|9| . "9") (:DOT . ".") (:EEX . "d")
                               (:ENTER . :ENTER) (:CLX . :CLX) (:CHS . :CHS))
                 :SEEN-DOT NIL
                 :SEEN-EXPT NIL
                 :FINALIZED NIL)
   :MEMORY (("2" . -8))
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

This code is available in the git repository under the tag v2014-11-20.

The HP-67 emulator, handling the number-pad keys

In previous HP-67 emulators that I wrote in other languages, the UI was always keyboard-based, and numbers did not have to be assembled from individual number tokens, the user simply typed the number out on the line and that was passed to the program for parsing.

I want to allow for the possibility that this new emulator will have a GUI front end with key-presses that behave like the calculator does, so keys that are used to assemble numbers must be treated in a special manner.

When the engine receives a keypress, it checks to see if the key is a token key before attempting to run the form attached to the key.  If it is a token key, that token is retrieved and handed to the stack object, which now has a token assembler structure that acts on these contents.  It then switches the mode of the program to :NUMERIC-INPUT.  This mode switch has only one noticeable effect: it changes what the CLX key does.  When CLX is pressed in any other context, it clears the X register.  In numeric-input mode, after at least one input token has been seen, it clears the input line but does not touch the X register.

If the ENTER key is pressed and there is no token being assembled, it pushes a copy of X onto the stack.  That code is in stack.lisp.

If a non-token key arrives when tokens have been seen and are being assembled, the in-progress number is immediately completed and pushed onto the stack before the non-token key’s operation is invoked.

Here we see two examples of execution in the current setup. Note that the registers-copy field of the stack holds the contents of the stack before the last operation occurred, so you can see there what the inputs were to the most recent operation.

Assembling a number, pushing it onto the stack.  Starting a second number, but pressing the wrong key, so sending CLX to clear the error and enter the correct key:
*slime-repl sbcl*

CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "1" arg-fcn nil stack mode)
           (handle-one-keypress "2" arg-fcn nil stack mode)
           (handle-one-keypress "." arg-fcn nil stack mode)
           (handle-one-keypress "enter" arg-fcn nil stack mode)
           (handle-one-keypress "3" arg-fcn nil stack mode)
           (handle-one-keypress "clx" arg-fcn nil stack mode)
           (handle-one-keypress "4" arg-fcn nil stack mode)
           (handle-one-keypress "+" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (16 0 0 0)
   :REGISTERS-COPY (4 12 0 0)
   :NUM-REGISTERS 4
   :LAST-X 4
   :ASSEMBLER #S(TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {1006E13563}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :EXPONENT-DIGITS 0
                 :TRANSLATION ((:|0| . "0") (:|1| . "1") (:|2| . "2")
                               (:|3| . "3") (:|4| . "4") (:|5| . "5")
                               (:|6| . "6") (:|7| . "7") (:|8| . "8")
                               (:|9| . "9") (:DOT . ".") (:EEX . "d")
                               (:ENTER . :ENTER) (:CLX . :CLX) (:CHS . :CHS))
                 :SEEN-DOT NIL
                 :SEEN-EXPT NIL
                 :FINALIZED NIL)
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

Starting to assemble a number, then pushing the SIN key.  The number that was being assembled is finalized and pushed onto the stack so that SIN operates on it:
*slime-repl sbcl*

CL-USER> (let ((stack (get-new-stack-object 4))
               (mode (get-new-mode-object))
               (arg-fcn #'(lambda (x)
                            (format t "Argument for ~A:  " x)
                            (read))))
           (handle-one-keypress "3" arg-fcn nil stack mode)
           (handle-one-keypress "0" arg-fcn nil stack mode)
           (handle-one-keypress "." arg-fcn nil stack mode)
           (handle-one-keypress "sin" arg-fcn nil stack mode)
           stack)
#S(STACK
   :REGISTERS (1/2 0 0 0)
   :REGISTERS-COPY (30 0 0 0)
   :NUM-REGISTERS 4
   :LAST-X 30
   :ASSEMBLER #S(TOKEN-ASSEMBLER
                 :MANTISSA-SIGN 1
                 :MANTISSA #<SB-IMPL::STRING-OUTPUT-STREAM {1006CA3C23}>
                 :MANTISSA-DIGITS 0
                 :EXPONENT-SIGN 1
                 :EXPONENT #(0 0)
                 :EXPONENT-DIGITS 0
                 :TRANSLATION ((:|0| . "0") (:|1| . "1") (:|2| . "2")
                               (:|3| . "3") (:|4| . "4") (:|5| . "5")
                               (:|6| . "6") (:|7| . "7") (:|8| . "8")
                               (:|9| . "9") (:DOT . ".") (:EEX . "d")
                               (:ENTER . :ENTER) (:CLX . :CLX) (:CHS . :CHS))
                 :SEEN-DOT NIL
                 :SEEN-EXPT NIL
                 :FINALIZED NIL)
   :MEMORY NIL
   :FLAGS (("0") ("1") ("2") ("3"))
   :PROGRAM-MEMORY NIL
   :COMPLEX-ALLOWED-P NIL
   :ERROR-STATE NIL)

This code is in the git repository under the tag v2014-11-18.