Updated 2012-09-03 10:51:48 by Torsten

HP-15C Torsten Manz
 [http://www.hpmuseum.org/simulate/15_1_205.zip]

Larry Smith I see no HP-15C_Simulator_Font.ttf file in the above link.

Torsten Manz has written a GPL'd HP-15C simulation entirely in Tcl/Tk. This version requires one install the included HP-15C simulation font.

Larry Smith took Torsten's work and added a version of LCD hexa panel and removed the need to install a font. I also changed the name to IQ-15C, since Torsten's version was so faithful to the actual calculator I got nervous about trademark issues.

My website is just too unstable right now.
 #!/bin/sh
 #-*-tcl-*-
 # the next line restarts using wish \
 exec wish "$0" -- ${1+"[email protected]"}
 
 # -----------------------------------------------------------------------------
 #
 #                    H E W L E T T · P A C K A R D  15C
 #
 #                      A simulator written in Tcl/TK
 #
 #                        © 1997-2006 Torsten Manz
 #                        © 2008 LCD code Larry Smith
 #
 # -----------------------------------------------------------------------------
 #
 # This program is free software; you can redistribute it and/or modify it under
 # the terms of the GNU General Public License as published by the Free Software
 # Foundation; either version 2 of the License, or any later version.
 #
 # This program is distributed in the hope that it will be useful, but WITHOUT
 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 #
 # -----------------------------------------------------------------------------
 
 package require Tk
 # proc announce args { tk_messageBox -message "$args" -icon info -type ok }
 
 # -----------------------------------------------------------------------------
 # Hide window until everything is ready
 wm withdraw .
 
 ### LCD NUMBER DISPLAY ENGINE ###
   package require Tk
   # hex segment
 
   set dx 2
   set 2dx 4
   set dy 2
   set 2dy 4
   set seglen 8
   set dheight [expr 2*$seglen+4*$dy]
   set dwidth 25
   set digits 10
 
   set coord1 "0 0"
   set coord2 "$dx -$dy"
   set coord3 "[expr $dx+$seglen] -$dy"
   set coord4 "[expr $2dx+$seglen] 0"
   set coord5 "[expr $dx+$seglen] $dy"
   set coord6 "$dx $dy"
   set horseg "$coord1 $coord2 $coord3 $coord4 $coord5 $coord6"
 
   set coord1 "0 0"
   set coord2 "$dx -$dy"
   set coord3 "$2dx 0"
   set coord4 "$2dx $seglen"
   set coord5 "$dx [expr $seglen+$dy]"
   set coord6 "0 $seglen"
   set verseg "$coord1 $coord2 $coord3 $coord4 $coord5 $coord6"
 
   proc getseg { xoffset yoffset isHorizontal } {
     global horseg verseg dx dx 2dx 2dy seglen
 
     set xoffset [ expr $xoffset ]
     set yoffset [ expr $yoffset ]
     if $isHorizontal { set result $horseg } else { set result $verseg }
     for {set j 0 } { $j < 12 } { incr j } {
       set result [ lreplace $result $j $j [ expr [lindex $result $j] + $xoffset] ]
       incr j
       set result [ lreplace $result $j $j [ expr [lindex $result $j] + $yoffset] ]
     }
     return $result
   }
 
   # The shapes of individual elements of a digit
   set lcdshape(a) [ getseg 0 0 0 ]
   set lcdshape(b) [ getseg $dx -$dy 1 ]
   set lcdshape(c) [ getseg $2dx+$seglen 0 0 ]
   set lcdshape(d) [ getseg $2dx+$seglen $2dy+$seglen 0 ]
   set lcdshape(e) [ getseg $dx 3*$dy+2*$seglen 1 ]
   set lcdshape(f) [ getseg 0 $2dy+$seglen 0 ]
   set lcdshape(g) [ getseg $dx $dy+$seglen 1 ]
   set lcdshape(h) {18 22 18 28 23 28 23 22 }
   set lcdshape(i) {18 28 23 28 16 34}
 
   # Which elements are turned on for a given digit?
   array set llcd {
      0   {a b c d e f}
      1   {c d}
      2   {b c e f g}
      3   {b c d e g}
      4   {a c d g}
      5   {a b d e g}
      6   {a b d e f g}
      7   {b c d}
      8   {a b c d e f g}
      9   {a b c d e g}
      A   {a b c d f g}
      B   {a d e f g}
      C   {a b e f}
      D   {c d e f g}
      E   {a b e f g}
      F   {a b f g}
      -   {g}
      .   {h}
      ,   {h i}
      r   {a b}
      u   {a g c}
      n   {a b c}
      i   { c }
      g   {a b c d e g}
      e   {a b e f g}
      o   {a b c g}
      { } {}
   }
 
   # Displays a decimal str using LCD digits in the top-left of the canvas
   set eurostyle 0
   proc disp_update { args } {
      global curdisp llcd lcdshape eurostyle dwidth
 
      # uncomment this line and comment next to switch from LCD to LED
      # set colors {#000000 #ff0000 #000000 #333333 }
      set colors {#929292 #000000 #929292 #A2A2A2}
      set lcdoffset 0
      .display delete lcd
      foreach {onRim onFill offRim offFill} $colors {break}
      set len [ string length $curdisp ]
      for { set j 0 } { $j < $len } { incr j } {
        set glyph [ string index $curdisp $j ]
        set next [ string index $curdisp [ expr $j+1 ] ]
        foreach symbol {a b c d e f g} {
           if {[lsearch $llcd($glyph) $symbol] != -1} {
             .display move [.display create polygon $lcdshape($symbol) -tags lcd \
               -outline $onRim -fill $onFill] $lcdoffset 8
           } else {
             .display move [.display create polygon $lcdshape($symbol) -tags lcd \
               -outline $offRim -fill $offFill] $lcdoffset 8
           }
        }
        if { $next eq "." } {
           .display move [.display create polygon $lcdshape(h) -tags lcd \
             -outline $onRim -fill $onFill] $lcdoffset 0
           if $eurostyle {
              .display move [.display create polygon $lcdshape(i) -tags lcd \
                -outline $onRim -fill $onFill] $lcdoffset 0
           }
           incr j
        } elseif { $next eq "," } {
          .display move [.display create polygon $lcdshape(h) -tags lcd \
            -outline $onRim -fill $onFill] $lcdoffset 0
          if !$eurostyle {
             .display move [.display create polygon $lcdshape(i) -tags lcd \
               -outline $onRim -fill $onFill] $lcdoffset 0
          }
          incr j
        }
        incr lcdoffset $dwidth
     }
     update
   }
 
 # ------------------------------------------------------------------------------
 # Application data: All non persistent parameters
 
 set useiq 0
 array set APPDATA {
   title "HEWLETT·PACKARD 15C"
   titlewide "H E W L E T T · P A C K A R D 15C"
   titleverywide "  H   E   W   L   E   T   T   ·   P   A   C   K   A   R   D  "
   titleshort " HP-15c "
   Char1 h
   Char1x 15
   Char1y 12
   Char2 p
   Char2x 22
   Char2y 14
   version 1.2.05
   copyright "COPYRIGHT \u00A9 1997-2006, Torsten Manz"
   copyright2 "LCD Addition \u00A92008 by Larry Smith"
   filetypes {{"HP-15C Programs" {.15c}} {"Text files" {.txt}}}
 }
 if $useiq {
   array set APPDATA {
     title "INTELLIGENCE QUOTIENT 15C"
     titlewide "I N T E L L I G E N C E   Q U O T I E N T   1 5 C"
     titleverywide "  I  N  T  E  L  L  I  G  E  N  C  E  ·  Q  U  O  T  I  E  N  T  "
     titleshort " IQ-15c "
     Char1 h
     Char1 I
     Char1x 14
     Char1y 12
     Char2 Q
     Char2x 21
     Char2y 15
     version 1.2.05
     copyright "COPYRIGHT \u00A9 1997-2006, Torsten Manz"
     copyright2 "LCD Addition \u00A92008 by Larry Smith"
     filetypes {{"IQ-15C Programs" {.15c}} {"Text files" {.txt}}}
   }
 }
 set APPDATA(SerialNo) "9931G0[string map {. {}} $APPDATA(version)]"
 
 # ------------------------------------------------------------------------------
 # Check on required minimum Tcl/TK version and font
 
 option add *Dialog.msg.font "Helvetica 10" userDefault
 option add *Dialog.msg.wrapLength 600 userDefault
 
 if {$tk_version < "8.0"} {
   puts $APPDATA(titlewide)
   puts "ERROR: This program requires Tcl/Tk 8.4 or higher."
   exit
 } elseif {$tk_version < "8.4"} {
   tk_messageBox -type ok -icon error -default ok -title $APPDATA(titlewide) \
     -message "This program requires Tcl/Tk 8.4 or higher."
   exit
 }
 
 # ------------------------------------------------------------------------------
 # Default program settings
 
 array set HP15 {
   breakstomenu 1
   browser ""
   clpbrdc 0
   dataregs 19
   delay 100
   flash 200
   freebytes 0
   gsbmax 7
   maxval 9.999999999e99
   mnemonics 1
   pause 1000
   prgmcoloured 1
   prgmmenubreak 30
   prgmname ""
   prgmregsfree 46
   prgmregsused 0
   prgmstounicode 1
   saveonexit 1
   strictHP15 1
   totregs 65
 }
 
 # Used by preferences dialogue box to hold changed values until Ok or Apply.
 array set hp15tmp {}
 
 # ------------------------------------------------------------------------------
 # Platform independent interface settings
 
 array set LAYOUT {
   display #9E9E87
   display_outer_frame #F2F5F5
   display_inner_frame #D9DEDD
   keypad_bg #484848
   button_bg #434343
   keypad_frame #E0E0E0
   fbutton_bg #E1A83E
   gbutton_bg #6CB7BD
   BtnWidth 4
   BtnPadX 1
   BtnPadY 5
 }
 if $useiq {
   array set LAYOUT {
     display #A2A699
     display_outer_frame #C0C0C0
     display_inner_frame #D9DEDD
     keypad_bg #484848
     button_bg #434343
     keypad_frame #E0E0E0
     fbutton_bg #FFFF00
     gbutton_bg #BBBBFF
     BtnWidth 5
     BtnPadX 1
     BtnPadY 5
   }
 }
 # Predefined, well adjusted font sets
 set FONTSET {
   { {"unix" "UNIX Standard fonts, small" 70 80} {
     FnDisplay "{Sans} 25"
     FnStatus "Helvetica 8"
     FnButton "Helvetica 11 bold"
     FnEnter "Helvetica 11 bold"
     FnFGBtn "Helvetica 9"
     FnBrand "{Bitstream Vera Sans} 8"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier} 12 bold"
     FnScale 1.35
   }}
   { {"unix" "UNIX Standard fonts" 70 80} {
     FnDisplay "{Sans} 29"
     FnStatus "Helvetica 9"
     FnButton "Helvetica 12 bold"
     FnEnter "Helvetica 12 bold"
     FnFGBtn "Helvetica 10"
     FnBrand "Helvetica 11 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier} 12 bold"
     FnScale 1.35
   }}
   { {"unix" "Microsoft fonts" 70 80} {
     FnDisplay "{Sans} 28"
     FnStatus "Arial 9"
     FnButton "Arial 12 bold"
     FnEnter "Arial 11 bold"
     FnFGBtn "{Microsoft Sans Serif} 9"
     FnBrand "Tahoma 9"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 12 bold"
     FnScale 1.35
   }}
   { {"unix" "UNIX standard fonts, small" 81 135} {
     FnDisplay "{Sans} 24"
     FnStatus "Helvetica 8"
     FnButton "Helvetica 10 bold"
     FnEnter "Helvetica 10 bold"
     FnFGBtn "Helvetica 8"
     FnBrand "Helvetica 9 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier} 10 bold"
     FnScale 1.35
   }}
   { {"unix" "UNIX standard fonts" 81 135} {
     FnDisplay "{Sans} 26"
     FnStatus "Helvetica 9"
     FnButton "Helvetica 12 bold"
     FnEnter "Helvetica 11 bold"
     FnFGBtn "Helvetica 9"
     FnBrand "Helvetica 9"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier} 12 bold"
     FnScale 1.35
   }}
   { {"unix" "Microsoft fonts, small" 81 135} {
     FnDisplay "{Sans} 22"
     FnStatus "{Microsoft Sans Serif} 7"
     FnButton "Arial 9 bold"
     FnEnter "Arial 9 bold"
     FnFGBtn "Arial 8"
     FnBrand "Arial 8 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 12 bold"
     FnScale 1.35
   }}
   { {"unix" "Microsoft fonts" 81 135} {
     FnDisplay "{Sans} 26"
     FnStatus "{Microsoft Sans Serif} 8"
     FnButton "Arial 12 bold"
     FnEnter "Arial 10 bold"
     FnFGBtn "Arial 9"
     FnBrand "Arial 9 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 12 bold"
     FnScale 1.35
   }}
   { {"windows" "Microsoft fonts, small" 91 119} {
     FnDisplay "{Sans} 22"
     FnStatus "{Microsoft Small Fonts} 6"
     FnButton "Arial 9 bold"
     FnEnter "Arial 8 bold"
     FnFGBtn "{Microsoft Sans Serif} 6"
     FnBrand "Arial 7 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 10 bold"
     FnScale 1.35
   }}
   { {"windows" "Microsoft fonts" 91 119} {
     FnDisplay "{Sans} 23"
     FnStatus "{Microsoft Sans Serif} 7"
     FnButton "Arial 10 bold"
     FnEnter "Arial 9 bold"
     FnFGBtn "{Microsoft Sans Serif} 7"
     FnBrand "Arial 8 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 10 bold"
     FnScale 1.35
   }}
   { {"windows" "URW fonts, small" 91 119} {
     FnDisplay "{Sans} 22"
     FnStatus "{Nimbus Sans L} 7"
     FnButton "{Nimbus Sans L} 9 bold"
     FnEnter "{Nimbus Sans L} 8 bold"
     FnFGBtn "{Bitstream Vera Sans} 7"
     FnBrand "{Nimbus Sans L} 7 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 10 bold"
     FnScale 1.35
   }}
   { {"windows" "Microsoft fonts, small" 120 140} {
     FnDisplay "{Sans} 21"
     FnStatus "{Microsoft Small Fonts} 6"
     FnButton "Arial 9 bold"
     FnEnter "Arial 8 bold"
     FnFGBtn "{Microsoft Sans Serif} 6"
     FnBrand "Arial 7 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 10 bold"
     FnScale 1.69
   }}
   { {"windows" "Microsoft fonts" 120 140} {
     FnDisplay "{Sans} 22"
     FnStatus "{Microsoft Sans Serif} 7"
     FnButton "Arial 10 bold"
     FnEnter "Arial 9 bold"
     FnFGBtn "{Microsoft Sans Serif} 7"
     FnBrand "Arial 8 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 10 bold"
     FnScale 1.69
   }}
   { {"windows" "URW fonts, small" 120 140} {
     FnDisplay "{Sans} 19"
     FnStatus "{Nimbus Sans L} 6"
     FnButton "{Nimbus Sans L} 8 bold"
     FnEnter "{Nimbus Sans L} 7 bold"
     FnFGBtn "{Bitstream Vera Sans} 6"
     FnBrand "{Nimbus Sans L} 6 bold"
     FnLogo1 "{Chancery} 10 bold italic"
     FnLogo2 "{Sans} 10"
     FnMenu "{Courier New} 9 bold"
     FnScale 1.69
   }}
 }
 
 # Labels for preferences. Used both in dialogue and message boxes.
 array set PREFTEXT {
   breakstomenu "Two column storage menu"
   browser "Help file browser"
   clpbrdc "Use C locale for clipboard"
   delay {Delay value [ms]}
   fonthint \
     "Changes to font settings take effect when you\nrestart the simulator."
   frm_browser "Help file browser"
   frm_fontset "Font settings"
   frm_os "System settings"
   frm_simulator "Simulator settings"
   mnemonics "Program mnemonics"
   pause {Pause length [ms]}
   prgmcoloured "Coloured program menu"
   prgmmenubreak "Lines per column in program menu"
   prgmstounicode "Encode programs in UNICODE"
   saveonexit "Save memory on exit"
   strictHP15 "Strict HP-15C behaviour"
 }
 
 # ------------------------------------------------------------------------------
 # Platform specific settings
 
 switch $::tcl_platform(platform) {
   windows {
     set APPDATA(memfile) "HP-15C.mem"
     set APPDATA(exetypes) {{"Executable files" {.exe}}}
     set APPDATA(browserlist) {mozilla firefox netscape opera start iexplore hh}
 
     switch -glob "$::tcl_platform(os) $::tcl_platform(osVersion)" {
       "Windows 95 *"   {set APPDATA(HOME) $env(windir)}
       "Windows NT 4.0" {set APPDATA(HOME) $env(homedrive)$env(homepath)}
       "Windows NT 5.*" {set APPDATA(HOME) $env(APPDATA)}
       -- { tk_messageBox -type ok -icon error -default ok \
              -title $APPDATA(titlewide) -message \
              "$::tcl_platform(os) $::tcl_platform(osVersion) is not supported."
          }
     }
 
     set HP15(prgmdir) $APPDATA(HOME)
     set HP15(fontset) [expr round([tk scaling]*72) < 120 ? 8 : 11]
 
     if {[file exists hp-15c.ico]} {
       set iconFile hp-15c.ico
       wm iconbitmap . $iconFile
     }
   }
   unix {
     set APPDATA(memfile) ".hp-15c.mem"
     set APPDATA(exetypes) {{"All files" {*}}}
     set APPDATA(browserlist) {firefox mozilla netscape opera konqueror}
     set APPDATA(HOME) $env(HOME)
 
     set HP15(fontset) [expr round([tk scaling]*72) < 81 ? 1 : 4]
     set HP15(prgmdir) $APPDATA(HOME)
   }
   -- {
     tk_messageBox -type ok -icon error -default ok \
       -title $APPDATA(titlewide) \
       -message "Platform '$::tcl_platform(platform)' not supported."
   }
 }
 
 # ------------------------------------------------------------------------------
 # Initialize processor, stack and storage registers
 
 set PI [expr acos(0)*2.0]
 
 array set status {
   f 0
   g 0
   user 0
   BEGIN 0
   RAD {}
   DMY 0
   PRGM 0
   integrate 0
   solve 0
   num 1
   liftlock 1
   dispmode FIX
   dispprec 4
   comma ,
   dot .
   error 0
   seed 0
 }
 
 # Must do this outside of "array set" to become evaluated
 set status(RADfactor) [expr $PI/180.0]
 
 # During execution two additional registers are added to the stack:
 #   s: general scratchpad register that stores the last operand
 #   u: used by helper functions in complex mode
 
 array set stack {
   x 0.0
   y 0.0
   z 0.0
   t 0.0
   LSTx 0.0
 }
 
 array set istack {
   x 0.0
   y 0.0
   z 0.0
   t 0.0
   LSTx 0.0
 }
 
 array set prgstat {
   curline 0
   running 0
   interrupt 0
   rtnadr {0}
   maxiter {10000}
 }
 
 set PRGM {""}
 
 # Flags
 array set FLAG { 0 0 1 0 2 0 3 0 4 0 5 0 6 0 7 0 8 0 9 0 }
 
 # Test menu labels. Also used for mnemonics.
 set TEST { "x \u2260 0" "x > 0" "x < 0" "x \u2265 0" "x \u2264 0" "x = y" \
   "x \u2260 y" "x > y" "x < y" "x \u2265 y" "x \u2264 y" "x = 0" }
 
 # ------------------------------------------------------------------------------
 # Global program control variables
 
 set curdisp 0
 set keyseq ""
 set isseq 0
 
 # ------------------------------------------------------------------------------
 # List of HP-15C keys
 
 # Key definitions
 # Each key definition consists of 10 elements:
 #   row column : Row [1-4] and column [1-10] on the key pad
 #   rowspan    : Numbers of rows a key spans (normally 1 but 2 for ENTER)
 #   key-code   : Normally row+column, but numeric keys return number
 #   f-label label g-label : The keys labels. Encoded in UNICODE.
 #   f-binding binding g-binding : List of X11-keysyms bound to a key
 #
 set HP15_KEYS {
   { 1  1 1 11 A \u221ax x\u00B2 {Alt-a} {q} {Alt-x} }
   { 1  2 1 12 B e\u2191x LN {Alt-b} {e} {Alt-n} }
   { 1  3 1 13 C 10\u2191x LOG {Alt-c} {x} {Alt-g} }
   { 1  4 1 14 D y\u2191x % {Alt-d} {y} {percent} }
   { 1  5 1 15 E 1/x \u0394% {Alt-e} {Alt-slash backslash ssharp} {d} }
   { 1  6 1 16 MATRIX CHS ABS {} {Alt-plus Alt-minus} {bar brokenbar} }
   { 1  7 1  7 FIX 7 DEG {} {7 KP_7} {} }
   { 1  8 1  8 SCI 8 RAD {} {8 KP_8} {} }
   { 1  9 1  9 ENG 9 GRD {} {9 KP_9} {} }
   { 1 10 1 10 SOLVE \u00F7 x\u2264y {} {slash KP_Divide} {} }
   { 2  1 1 21 LBL SST BST {F8} {} {} }
   { 2  2 1 22 HYP GTO HYP\u002D\u00B9 {h} {F2} {Alt-h} }
   { 2  3 1 23 DIM SIN SIN\u002D\u00B9 {} {s} {} }
   { 2  4 1 24 (i) COS COS\u002D\u00B9 {} {c} {} }
   { 2  5 1 25 I TAN TAN\u002D\u00B9 {I j} {t} {} }
   { 2  6 1 26 RESULT EEX \u03C0 {} {E} {p} }
   { 2  7 1  4 x\u2194? 4 SF {Alt-less Alt-greater} {4 KP_4} {} }
   { 2  8 1  5 DSE 5 CF {} {5 KP_5} {} }
   { 2  9 1  6 ISG 6 F? {} {6 KP_6} {} }
   { 2 10 1 20 \u222Bxy \u00D7 x=0 {} {asterisk KP_Multiply} {} }
   { 3  1 1 31 PSE R/S P/R {F6} {F5} {F9} }
   { 3  2 1 32 \u2211 GSB RTN {} {F3} {F4} }
   { 3  3 1 33 PRGM R\u2193 R\u2191 {} {Down} {Up} }
   { 3  4 1 34 REG x\u2194y RND {} {less greater} {} }
   { 3  5 1 35 PREFIX \u2190 CLx {} {BackSpace} {Escape} }
   { 3  6 2 36 "RAN #" ENTER LSTx {numbersign} {Return KP_Enter} {l} }
   { 3  7 1  1 \u2192R 1 \u2192P {} {1 KP_1} {} }
   { 3  8 1  2 \u2192H.MS 2 \u2192H {} {2 KP_2} {} }
   { 3  9 1  3 \u2192RAD 3 \u2192DEG {} {3 KP_3} {} }
   { 3 10 1 30 Re\u2194Im - TEST {Tab} {minus KP_Subtract} {} }
   { 4  1 1 41 "" ON "" {} {} {} }
   { 4  2 1 42 "" f "" {} {} {} }
   { 4  3 1 43 "" g "" {} {} {} }
   { 4  4 1 44 FRAC STO INT {} {m} {} }
   { 4  5 1 45 USER RCL MEM {u} {r} {} }
   { 4  7 1  0 x! 0 x {exclam} {0 KP_0} {} }
   { 4  8 1 48 \u0177,r . s {} {comma period KP_Decimal} {} }
   { 4  9 1 49 L.R. \u2211+ \u2211- {} {Insert} {Delete} }
   { 4 10 1 40 Py,x + Cy,x {} {plus KP_Add} {} }
 }
 
 # HP-15C Key sequence, corresponding functions and function attributes
 #   Key sequence: A regular expression describing a set of key sequences
 #   Function name: The Tcl function.
 #   Attributes (0|1):
 #     LSTx: Operand is saved in the LSTx register.
 #     End input: Function terminates input. Thus we have a number.
 #     Programmable: Function is programmable.
 set HP15_KEY_FUNCS {
   {
     { 0 "func_digit 0" 0 0 1}
     { 1 "func_digit 1" 0 0 1}
     { 2 "func_digit 2" 0 0 1}
     { 3 "func_digit 3" 0 0 1}
     { 4 "func_digit 4" 0 0 1}
     { 5 "func_digit 5" 0 0 1}
     { 6 "func_digit 6" 0 0 1}
     { 7 "func_digit 7" 0 0 1}
     { 8 "func_digit 8" 0 0 1}
     { 9 "func_digit 9" 0 0 1}
     {10 "func_div" 1 1 1}
     {11 "func_sqrt" 1 1 1}
     {12 "func_exp" 1 1 1}
     {13 "func_10powx" 1 1 1}
     {14 "func_ypowx" 1 1 1}
     {15 "func_inv" 1 1 1}
     {16 "func_chs" 0 0 1}
     {20 "func_mult" 1 1 1}
     {21 "func_sst" 0 0 0}
     {22_([0-9]) "func_gto " 0 1 1}
     {22_1([1-5]) "func_gto -" 0 1 1}
     {22_25 "func_gto I" 0 1 1}
     {22_48_([0-9]) "func_gto 1" 0 1 1}
     {22_16_([0-9]) "func_gto_chs " 0 0 0}
     {23 "func_trign sin" 1 1 1}
     {24 "func_trign cos" 1 1 1}
     {25 "func_trign tan" 1 1 1}
     {26 "func_digit e+0" 0 0 1}
     {30 "func_minus" 1 1 1}
     {31 "func_rs" 0 1 1}
     {32_([0-9]) "func_gsb " 0 1 1}
     {32_1([1-5]) "func_gsb -" 0 1 1}
     {32_25 "func_gsb I" 0 1 1}
     {32_48_([0-9]) "func_gsb 1" 0 1 1}
     {33 "func_roll 1" 0 1 1}
     {34 "func_xy" 0 1 1}
     {35 "func_bs" 0 0 0}
     {36 "func_enter" 0 1 1}
     {40 "func_plus" 1 1 1}
     {41 "func_on" 0 0 0}
     {48 "func_digit ." 0 0 1}
     {49 "func_sum_plus" 1 1 1}
   } {
     {42_0 "func_faculty" 1 1 1}
     {42_1 "func_rectangular" 1 1 1}
     {42_1([1-5]) "dispatch_key 32_1" 0 0 0}
     {42_10_([0-9]) "func_solve "  0 1 1}
     {42_10_1([1-5]) "func_solve -" 0 1 1}
     {42_10_48_([0-9]) "func_solve 1" 0 1 1}
     {42_16 "# not implemented" 0 0 0}
     {42_2 "func_hms" 1 1 1}
     {42_20_([0-9]) "func_integrate " 0 0 1}
     {42_20_1([1-5]) "func_integrate -" 0 0 1}
     {42_20_48_([0-9]) "func_integrate 1" 0 0 1}
     {42_21_([0-9]) "func_label " 0 1 1}
     {42_21_1([1-5]) "func_label " 0 1 1}
     {42_21_48_([0-9]) "func_label 1" 0 1 1}
     {42_22_23 "func_hyp sin" 1 1 1}
     {42_22_24 "func_hyp cos" 1 1 1}
     {42_22_25 "func_hyp tan" 1 1 1}
     {42_23_1([1-5]) "# not implemented" 0 0 0}
     {42_23_24 "func_dim_mem" 0 1 1}
     {42_24 "func_i" 0 1 0}
     {42_25 "func_I" 0 1 1}
     {42_26 "# not implemented" 0 0 0}
     {42_3 "func_rad" 1 1 1}
     {42_30 "func_re_im" 0 1 1}
     {42_31 "func_pse" 0 1 1}
     {42_32 "func_clearsumregs" 0 1 1}
     {42_33 "func_clearprgm" 0 1 0}
     {42_34 "func_clearreg" 0 1 1}
     {42_35 "func_prefix" 0 1 0}
     {42_36 "func_random" 0 1 1}
     {42_4_([0-9]) "func_xexchg " 0 1 1}
     {42_4_24 "func_xexchg (i)" 0 1 1}
     {42_4_25 "func_xexchg I" 0 1 1}
     {42_4_48_([0-9]) "func_xexchg 1" 0 1 1}
     {42_40 "func_Pyx" 1 1 1}
     {42_44 "func_frac" 1 1 1}
     {42_45 "set_status user" 0 1 0}
     {42_48 "func_linexpolation" 0 1 1}
     {42_49 "func_linreg" 0 1 1}
     {42_5_([0-9]) "func_dse " 0 1 1}
     {42_5_24 "func_dse (i)" 0 1 1}
     {42_5_25 "func_dse I" 0 1 1}
     {42_5_48_([0-9]) "func_dse 1" 0 1 1}
     {42_6_([0-9]) "func_isg " 0 1 1}
     {42_6_24 "func_isg (i)" 0 1 1}
     {42_6_25 "func_isg I" 0 1 1}
     {42_6_48_([0-9]) "func_isg 1" 0 1 1}
     {42_7_([0-9]) "func_dsp_mode FIX " 0 1 1}
     {42_7_25 "func_dsp_mode FIX I" 0 1 1}
     {42_8_([0-9]) "func_dsp_mode SCI " 0 1 1}
     {42_8_25 "func_dsp_mode SCI I" 0 1 1}
     {42_9_([0-9]) "func_dsp_mode ENG " 0 1 1}
     {42_9_25 "func_dsp_mode ENG I" 0 1 1}
   } {
     {43_0 "func_avg" 0 1 1}
     {43_1 "func_polar" 1 1 1}
     {43_10 "func_test 10" 0 1 1}
     {43_11 "func_xpow2" 1 1 1}
     {43_12 "func_ln" 1 1 1}
     {43_13 "func_log10" 1 1 1}
     {43_14 "func_percent" 1 1 1}
     {43_15 "func_dpercent" 1 1 1}
     {43_16 "func_abs" 1 1 1}
     {43_2 "func_h" 1 1 1}
     {43_20 "func_test 11" 0 1 1}
     {43_21 "func_bst" 0 0 0}
     {43_22_23 "func_ahyp sin" 1 1 1}
     {43_22_24 "func_ahyp cos" 1 1 1}
     {43_22_25 "func_ahyp tan" 1 1 1}
     {43_23 "func_atrign sin" 1 1 1}
     {43_24 "func_atrign cos" 1 1 1}
     {43_25 "func_atrign tan" 1 1 1}
     {43_26 "func_pi" 0 1 1}
     {43_3 "func_deg" 1 1 1}
     {43_30_([0-9]) "func_test " 0 1 1}
     {43_31 "func_pr" 0 0 0}
     {43_32 "func_rtn" 0 1 1}
     {43_33 "func_roll 3" 0 1 1}
     {43_34 "func_rnd" 1 1 1}
     {43_35 "func_clx" 0 1 1}
     {43_36 "func_lastx" 0 1 1}
     {43_4_([0-9]) "func_sf " 0 1 1}
     {43_4_25 "func_sf I" 0 1 1}
     {43_40 "func_Cyx" 1 1 1}
     {43_44 "func_int" 1 1 1}
     {43_45 "func_mem" 0 1 0}
     {43_48 "func_stddev" 0 1 1}
     {43_49 "func_sum_minus" 1 1 1}
     {43_5_([0-9]) "func_cf " 0 1 1}
     {43_5_25 "func_cf I" 0 1 1}
     {43_6_([0-9]) "func_Finq " 0 1 1}
     {43_6_25 "func_Finq I" 0 1 1}
     {43_7 "set_status DEG" 0 1 1}
     {43_8 "set_status RAD" 0 1 1}
     {43_9 "set_status GRAD" 0 1 1}
   } {
     {44_([0-9]) "func_sto " 0 1 1}
     {44_25 "func_sto I" 0 1 1}
     {44_24 "func_sto (i)" 0 1 1}
     {44_48_([0-9]) "func_sto 1" 0 1 1}
     {44_10_([0-9]) "func_sto_oper / " 0 1 1}
     {44_10_24 "func_sto_oper / (i)" 0 1 1}
     {44_10_25 "func_sto_oper / I" 0 1 1}
     {44_10_48_([0-9]) "func_sto_oper / 1" 0 1 1}
     {44_20_([0-9]) "func_sto_oper * " 0 1 1}
     {44_20_24 "func_sto_oper * (i)" 0 1 1}
     {44_20_25 "func_sto_oper * I" 0 1 1}
     {44_20_48_([0-9]) "func_sto_oper * 1" 0 1 1}
     {44_30_([0-9]) "func_sto_oper - " 0 1 1}
     {44_30_24 "func_sto_oper - (i)" 0 1 1}
     {44_30_25 "func_sto_oper - I" 0 1 1}
     {44_30_48_([0-9]) "func_sto_oper - 1" 0 1 1}
     {44_*36 "func_storandom" 0 1 1}
     {44_40_([0-9]) "func_sto_oper + " 0 1 1}
     {44_40_24 "func_sto_oper + (i)" 0 1 1}
     {44_40_25 "func_sto_oper + I" 0 1 1}
     {44_40_48_([0-9]) "func_sto_oper + 1" 0 1 1}
   } {
     {45_([0-9]) "func_rcl " 0 1 1}
     {45_25 "func_rcl I" 0 1 1}
     {45_24 "func_rcl (i)" 0 1 1}
     {45_48_([0-9]) "func_rcl 1" 0 1 1}
     {45_10_([0-9]) "func_rcl_oper / " 0 1 1}
     {45_10_24 "func_rcl_oper / (i)" 0 1 1}
     {45_10_25 "func_rcl_oper / I" 0 1 1}
     {45_10_48_([0-9]) "func_rcl_oper / 1" 0 1 1}
     {45_20_([0-9]) "func_rcl_oper * " 0 1 1}
     {45_20_24 "func_rcl_oper * (i)" 0 1 1}
     {45_20_25 "func_rcl_oper * I" 0 1 1}
     {45_20_48_([0-9]) "func_rcl_oper * 1" 0 1 1}
     {45_30_([0-9]) "func_rcl_oper - " 0 1 1}
     {45_30_24 "func_rcl_oper - (i)" 0 1 1}
     {45_30_25 "func_rcl_oper - I" 0 1 1}
     {45_30_48_([0-9]) "func_rcl_oper - 1" 0 1 1}
     {45_36 "func_rclrandom" 0 1 1}
     {45_40_([0-9]) "func_rcl_oper + " 0 1 1}
     {45_40_24 "func_rcl_oper + (i)" 0 1 1}
     {45_40_25 "func_rcl_oper + I" 0 1 1}
     {45_40_48_([0-9]) "func_rcl_oper + 1" 0 1 1}
     {45_49 "func_rclsum" 0 1 1}
   }
 }
 
 # ------------------------ End of variable definitions -------------------------
 
 # ------------------------------------------------------------------------------
 proc commify { num {sign ,} } {
 
   if {$sign == "."} {regsub {[.]} $num "," num}
   set trg "\\1$sign\\2\\3"
   while {[regsub {^([-+ ]?[0-9]+)([0-9][0-9][0-9])([- ][0-9][0-9])?} \
     $num $trg num]} {}
 
   return $num
 
 }
 
 # ------------------------------------------------------------------------------
 proc format_exponent { expo } {
 
   if {$expo != ""} {
     regsub {^([-+ ]?)0([1-9][0-9]?)} $expo {\1\2} expo
     set expo [expr $expo >= 0 ? \" \" : \"-\"][format "%02d" [expr abs($expo)]]
   }
   return $expo
 
 }
 
 # ------------------------------------------------------------------------------
 proc format_number { var } {
 
   global HP15 status
 
   set prec $status(dispprec)
   set eexprecmax 6
   set eex 1
 
 # calculate mantissa and exponent parameters
   set log [expr $var != 0 ? int(floor(log10(abs($var)))) : 0]
   switch $status(dispmode) {
     FIX {
       if {$log >= -$prec && $log <= 9} {
         set eex 0
         if {$log+$prec > 9} {set prec [expr 9-$log]}
       }
     }
     SCI {
 # Nothing to do here
     }
     ENG {
       append ff "%1." $prec "e"
       set var [format $ff $var]
       set log [expr int($log/3)*3]
     }
   }
 
 # format mantissa
   append fmt "% ." $prec "f"
   if {[expr $var >= $HP15(maxval)]} {
     set mantissa " [string range $HP15(maxval) 0 7]"
   } elseif {[expr $var <= -$HP15(maxval)]} {
     set mantissa "-[string range $HP15(maxval) 0 7]"
   } elseif {$eex == 1} {
     set mantissa [format $fmt [expr $var/pow(10, $log)]]
     if {$status(dispmode) != "ENG" && $mantissa >= 10.0 && $log < 99} {
       incr log
       set mantissa [format $fmt [expr $var/pow(10, $log)]]
     }
     set len [expr ($prec > $eexprecmax ? $eexprecmax : $prec)+2]
     if {$status(dispmode) == "ENG" && $prec == 0} {incr len}
     set mantissa [string range $mantissa 0 $len]
   } else {
     set mantissa [format $fmt $var]
   }
   if {[string first "." $mantissa] <= 0} {set mantissa "$mantissa."}
 
 # format exponent
   if {$eex == 0} {
     set expo ""
   } else {
     set expo [format_exponent $log]
   }
   set filler [string repeat " " [expr 12-[string length "$mantissa$expo"]]]
 
 # return concatenated number
   return [commify "$mantissa$filler$expo" $status(dot)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc format_input { var } {
 
   global status
 
   regsub {(e[+-]$)} $var {\10} var
   regexp {^([-+ ]?[.0-9]+)e?([+-][0-9]+)?} $var all mantissa expo
 
   if {[string index $mantissa 0] != "-"} {set mantissa " $mantissa"}
   set expo [format_exponent $expo]
   set filler [string repeat " " \
     [expr 11-[string length [string map {. ""} "$mantissa$expo"]]]]
 
   return [commify [format "%s%s%s" $mantissa $filler $expo] $status(dot)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc format_prgm { lnum wid } {
 
   global status PRGM
 
   set kl [split [lindex $PRGM $lnum] "_"]
   switch [llength $kl] {
     1 -
     2 {
       set st [join $kl]
     }
     3 {
       if {[lindex $kl 1] == 48} {
         set st [format "  %2d $status(comma)%1d" [lindex $kl 0] [lindex $kl 2]]
       } else {
         set st [format "%2d$status(dot)%2d$status(dot)%2d" \
           [lindex $kl 0] [lindex $kl 1] [lindex $kl 2]]
       }
     }
     4 {
       set st [format "%2d$status(dot)%2d$status(dot) %2s" \
         [lindex $kl 0] [lindex $kl 1] "$status(comma)[lindex $kl 3]"]
     }
     default {
       set st ""
     }
   }
   return "[format "%03d-%$wid\s" $lnum $st]"
 
 }
 
 # ------------------------------------------------------------------------------
 proc error_handler { errinfo } {
 
   global APPDATA HP15 FLAG stack istack status prgstat curdisp errorInfo errorCode
 
   set errnum -1
   set status(num) 1
 
   if {[lindex $errinfo 0] == "ARITH"} {
     switch [lindex $errinfo 1] {
       IOVERFLOW -
       OVERFLOW {
         set stack(x) $HP15(maxval)
         set istack(x) $HP15(maxval)
         set FLAG(9) 1
         show_x
       }
       NOVERFLOW {
         set stack(x) -$HP15(maxval)
         set istack(x) -$HP15(maxval)
         set FLAG(9) 1
         show_x
       }
       UNDERFLOW {
         set stack(x) 0.0
         show_x
       }
       INVALID -
       default {
         set errnum 0
       }
     }
   } else {
     switch [lindex $errinfo 0] {
       SUM {
         set errnum 2
       }
       INDEX {
         set errnum 3
       }
       ADDRESS {
         set errnum 4
       }
       RTN {
         set errnum 5
       }
       FLAG {
         set errnum 6
       }
       RECURSION {
         set status(solve) 0
         set status(integrate) 0
         set errnum 7
       }
       SOLVE {
         set errnum 8
       }
       DIM {
         set errnum 10
       }
       INTERRUPT {
         set prgstat(running) 0
         set prgstat(interrupt) 0
         show_x
       }
       FILEIO {
         switch [lindex $errinfo 1] {
           ECREATE {
             set errmsg "Could not write file"
           }
           ENOENT {
             set errmsg "No such file"
           }
           EOPEN {
             set errmsg "Could not open file"
           }
           NONE -
           EFMT {
             set errmsg "Error parsing line [lindex $errinfo 3]"
           }
           INVCMD {
             set errmsg "Invalid command in line [lindex $errinfo 3]"
           }
           default {
             set errmsg "$errorInfo"
           }
         }
         set errnum 98
         tk_messageBox -type ok -icon error -default ok \
           -title $APPDATA(titlewide) -message "$errmsg: [lindex $errinfo 2]"
       }
       default {
         set errnum 99
         tk_messageBox -type ok -icon error -default ok \
            -title $APPDATA(titlewide) \
            -message "Internal Tcl/Tk Error:\n$errorInfo"
           set stack(x) 0.0
       }
     }
   }
 
   if {$errnum >= 0} {
     set status(error) 1
     set prgstat(running) 0
     set curdisp "  ERRoR [format "%2d" $errnum]"
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_x { args } {
   global HP15 status stack curdisp
 
   if {[catch {
     if {abs($stack(x)) > 0.0 && abs($stack(x)) < 1E-99} {
       error_handler {ARITH UNDERFLOW}
     } elseif {[expr $stack(x) > $HP15(maxval)]} {
       error_handler {ARITH OVERFLOW}
     } elseif {[expr $stack(x) < -$HP15(maxval)]} {
       error_handler {ARITH NOVERFLOW}
     } else {
       if {$status(num)} {
         set curdisp [format_number $stack(x)]
       } else {
         set curdisp [format_input $stack(x)]
       }
     }
   } errorCode]} {}
   # {error_handler $errorCode}
   disp_update
 }
 
 # ------------------------------------------------------------------------------
 proc disp_flash { p1 p2 p3 } {
 
   global LAYOUT HP15 FLAG
 
   if {$FLAG(9)} {
     if {[.display itemcget d0 -fill] == "black"} {
       .display itemconfigure all -fill $LAYOUT(display)
       .status itemconfigure all -fill $LAYOUT(display)
     } else {
       .display itemconfigure all -fill black
       .status itemconfigure all -fill black
     }
     after $HP15(flash) disp_flash 1 1 1
   } else {
     .display itemconfigure all -fill black
     .status itemconfigure all -fill black
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc mem_save {} {
 
   global APPDATA HP15 stack istack storage prgstat PRGM FLAG
 
 # Keep global status but set status to be saved as for shut-off!
   array set status [array get ::status]
   set status(error) 0
   set status(f) 0
   set status(g) 0
   set status(num) 1
   set status(solve) 0
   set status(integrate) 0
   set status(PRGM) 0
   set prgstat(interrupt) 0
   set prgstat(running) 0
   set FLAG(9) 0
 
   set sepline "# [string repeat - 78]"
 
   set fid [open "$APPDATA(HOME)/$APPDATA(memfile)" {RDWR CREAT TRUNC}]
 
   puts $fid $sepline
   puts $fid "# Tcl/Tk $APPDATA(title) memory file"
   puts $fid "# The Simulator is $APPDATA(copyright)"
   puts $fid "# Version $APPDATA(version)"
   puts $fid "# Memory saved on [clock format [clock seconds] -format "%c"]"
   puts $fid $sepline
   puts $fid ""
 
   foreach aa {HP15 status stack istack storage FLAG prgstat} {
     puts $fid $sepline
     puts $fid "# $aa"
     puts $fid "array set $aa {"
     foreach ii [lsort -dictionary [array names $aa]] {
       puts $fid "  $ii {[set ${aa}($ii)]}"
     }
     puts $fid "}\n"
   }
 
   puts $fid $sepline
   puts $fid "# Program"
   puts $fid "set PRGM {"
   foreach ii $PRGM {
     puts $fid "  {$ii}"
   }
   puts $fid "}"
   puts $fid $sepline
 
   close $fid
 
 }
 
 # ------------------------------------------------------------------------------
 proc mem_load {} {
 
   global APPDATA HP15 status stack istack storage prgstat PRGM FLAG
 
   set fnam "$APPDATA(HOME)/$APPDATA(memfile)"
   if {[file exists $fnam]} {
     if {[catch {source $fnam} err]} {
       error_handler [list FILEIO EFMT $fnam $err]
     }
   }
 
 # Refresh status line
   set_status NIL
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_save {} {
 
   global APPDATA HP15 PRGM
 
   set sepline "# [string repeat - 44]"
 
   set fnam [tk_getSaveFile -title "$APPDATA(title): Save program" \
     -defaultextension ".15C" -filetypes $APPDATA(filetypes) \
     -initialdir "$HP15(prgmdir)" -initialfile "$HP15(prgmname)"]
 
   if {$fnam != ""} {
     if {[catch {set fid [open $fnam {RDWR CREAT TRUNC}]}]} {
       error_handler [list FILEIO ECREATE $fnam]
       close $fid
       return
     }
 
     if {$HP15(prgmstounicode)} {
       puts -nonewline $fid "\377\376"
       fconfigure $fid -encoding unicode
     }
 
     puts $fid $sepline
     puts $fid "# Tcl/Tk $APPDATA(title) Simulator program"
     puts $fid "# Created with version $APPDATA(version)"
     puts $fid "$sepline\n"
 
     for {set ii 0} {$ii < [llength $PRGM]} {incr ii} {
       set seq ""
       foreach cc [split [lindex $PRGM $ii] "_"] {
         append seq [format {%3d} $cc]
       }
       puts $fid "[format "   %03d {%12s } %s" $ii $seq \
         [build_mnemonic [lindex $PRGM $ii] 0]]"
     }
     puts $fid "\n$sepline"
 
     close $fid
 
     set HP15(prgmdir) [file dirname $fnam]
     set HP15(prgmname) [file tail $fnam]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_open {} {
 
   global APPDATA HP15 status prgstat PRGM errorCode
 
   set fnam [tk_getOpenFile -initialdir "$HP15(prgmdir)" \
     -title "$APPDATA(title): Open program" -defaultextension ".15C" \
     -filetypes $APPDATA(filetypes)]
   if {$fnam != ""} {
     if {[catch {set fid [open "$fnam" {RDONLY}]}]} {
       error_handler [list FILEIO EOPEN $fnam]
       close $fid
       return
     }
 
 # Check whether file is UNICODE or ASCII encoded
     set unic [read $fid 2]
     if {[string compare $unic "\377\376"] == 0 || \
         [string index $unic 1] == "\000"} {
       fconfigure $fid -encoding unicode
     }
     if {"$unic" != "\377\376"} {seek $fid 0}
 
     set lcnt 0
     set PRGMtmp {}
     if {[catch {
       while {[gets $fid curline] >= 0} {
         incr lcnt
         set curline [string trim $curline]
         if {[string length $curline] > 0 && [string index $curline 0] != "#"} {
           if {[regexp "\{(.*)\}" $curline all step] == 0} {
             error "" "" {EFMT}
           }
           set step [string map {"  " _ " " _} [string trim $step]]
           if {[lookup_keyseq $step 1] == "" && [llength $PRGMtmp] > 0} {
             error "" "" {INVCMD}
           }
           lappend PRGMtmp $step
           unset step
         }
       }
     }]} {
       error_handler [list FILEIO $::errorCode $fnam $lcnt]
       return
     }
     close $fid
 
 # Insert empty step 000 if first step is not empty
     if {[lindex $PRGMtmp 0] != ""} {set PRGMtmp [linsert $PRGMtmp 0 ""]}
 
     set prgstat(curline) 0
     set prgstat(rtnadr) {0}
     set PRGM $PRGMtmp
     if {$status(PRGM)} {show_curline}
     set HP15(prgmdir) [file dirname $fnam]
     set HP15(prgmname) [file tail $fnam]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc clipboard_set { reg } {
 
   global HP15 status stack
 
   if {[string compare $::tcl_platform(platform) "unix"]} {
     clipboard clear
     if {$HP15(clpbrdc)} {
       clipboard append $stack($reg)
     } else {
       clipboard append [string map ". $status(comma)" $stack($reg)]
     }
   } else {
     selection handle -selection PRIMARY . clipboard_transfer
     selection own -selection PRIMARY .
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc clipboard_transfer { offset maxchars } {
 
   global HP15 status stack
 
   if {$HP15(clpbrdc)} {
     return $stack(x)
   } else {
     return [string map ". $status(comma)" $stack(x)]
   }
 
 }
 
 # ----------------------------------------------------------------------------
 proc clipboard_get {} {
 
   global HP15 status stack
 
 # On Windows only CLIPBOARD selection exists. On UNIX most applications use
 # PRIMARY selection, some use CLIPBOARD (or both). We will check for both...
   if {[catch {set clpbrd [selection get -selection PRIMARY]}]} {
     catch {set clpbrd [selection get -selection CLIPBOARD]}
   }
 
   if {[info exists clpbrd]} {
     if {$HP15(clpbrdc)} {
       set clpbrd [string map {, ""} $clpbrd]
     } else {
       set clpbrd [string map {. "" , .} $clpbrd]
     }
 
     if {[string is double $clpbrd]} {
       if {$status(num)} {lift}
       set status(num) 1
       set stack(x) $clpbrd
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc exchange_seps {} {
 
   global status
 
   set tmp $status(comma)
   set status(comma) $status(dot)
   set status(dot) $tmp
   if {$status(PRGM)} {
     show_curline
   } else {
     show_x
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc help { topic } {
 
   global APPDATA HP15 argv0 errorInfo
 
   switch $topic {
     simulator {
 # Differentiate between running from a starpack or from wish
       if {[info exists starkit::topdir]} {
         set helpdir [file dirname $starkit::topdir]
       } else {
         set helpdir [file dirname $argv0]
       }
       if {[string compare $helpdir "."] == 0} {set helpdir [pwd]}
       set helpfile "$helpdir/doc/index.htm"
     }
     prgm {
       set helpfile "$HP15(prgmdir)/[file rootname $HP15(prgmname)].htm"
     }
   }
   catch {set helpfile [file nativename [lindex [glob "$helpfile*"] 0]]}
 
   if {[string length $HP15(browser)] == 0} {
     set msg "No help file browser configured.\nSee Preferences dialogue box."
     preferences
   } elseif {$topic == "prgm" && $HP15(prgmname) == ""} {
     set msg "No help file available or\nno name given for current program."
   } elseif {![file exists $helpfile]} {
     set msg "Help file not found:\n$helpfile"
   }
 
   if {[info exists msg]} {
     tk_messageBox -type ok -icon error -default ok \
       -title $APPDATA(titlewide) -message $msg
     if [winfo exists .prefs] {focus .prefs}
   } else {
     if {[catch {eval exec $HP15(browser) [list $helpfile] &} exerr]} {
       tk_messageBox -type ok -icon error -default ok \
         -title $APPDATA(titlewide) \
         -message "Could not display help file:\n$exerr"
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_on_options { trigger } {
 
   global LAYOUT status
 
   if {[winfo exists .onm]} {destroy .onm}
 
   menu .onm -tearoff 0 -title "Options" -font $LAYOUT(FnMenu)
   .onm add command -label "Open program\u2026" -underline 0 \
     -command "prgm_open"
   .onm add command -label "Save program\u2026" -underline 0 \
     -command "prgm_save"
   .onm add separator
   .onm add command -label "Save memory" -underline 5 -command "mem_save"
   .onm add command -label "Load memory" -underline 0 -command "mem_load"
   if {$status(PRGM)} {
     set st disabled
   } else {
     set st normal
   }
   .onm add command -label "Clear all" -underline 0 -command "clearall" \
     -state $st
   .onm add separator
   .onm add command \
     -label "[format "1%s000%s00 \u2192 1%s000%s00" $status(dot) $status(comma) \
       $status(comma) $status(dot)]" -underline 0 -command "exchange_seps"
   .onm add command -label "Preferences\u2026" -underline 0 \
     -command "preferences"
   .onm add separator
   .onm add command -label "Help\u2026" -underline 0 -command "help simulator"
   .onm add command -label "About\u2026" -underline 0 -command "about"
   .onm add separator
   .onm add command -label "Exit" -underline 1 -command "exit_handler"
 
   if {$trigger == 3} {
     tk_popup .onm [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .onm [winfo rootx .btn_41.btn] \
       [expr [winfo rooty .btn_41.btn]+[winfo height .btn_41.btn]]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_storage { function trigger } {
 
   global LAYOUT HP15 storage
 
   if {[winfo exists .storage]} {destroy .storage}
 
   menu .storage -tearoff 0 -title "Storage" -font $LAYOUT(FnMenu)
   set regmax [expr $HP15(dataregs) < 19 ? $HP15(dataregs) : 19]
   for {set ii 0} {$ii <= $regmax} {incr ii} {
     .storage add command \
       -label "R[format "%2d" $ii]: [format_number $storage($ii)]"
     if {$ii < 10} {
       .storage entryconfigure $ii -underline 2 \
         -command "dispatch_key $function\_$ii"
     } else {
       .storage entryconfigure 10 -columnbreak $HP15(breakstomenu)
       .storage entryconfigure $ii \
         -command "dispatch_key $function\_48_[expr $ii-10]"
     }
   }
   .storage add command
   .storage entryconfigure $ii -label "RI : [format_number $storage(I)]" \
     -underline 1 -command "dispatch_key $function\_25"
 
   if {$trigger == 3} {
     tk_popup .storage [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .storage [winfo rootx .btn_$function.gbtn] \
       [winfo rooty .btn_$function.gbtn]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_content { trigger } {
 
   global status
 
   if {$status(error)} {
     show_error $trigger
   } elseif {$status(PRGM)} {
     show_prgm $trigger
   } else {
     show_stack $trigger
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_stack { trigger } {
 
   global FLAG LAYOUT stack istack
 
   if {[winfo exists .stack]} {destroy .stack}
 
   menu .stack -tearoff 0 -title "Stack" -font $LAYOUT(FnMenu)
   set sts 3
   foreach ii {t z y x} {
     if {$FLAG(8)} {
       .stack add command -command "func_roll $sts" -hidemargin 1 -label \
         [format {%5s: %-15s %5s: %-15s} $ii [format_number $stack($ii)] \
           i$ii [format_number $istack($ii)]]
     } else {
       .stack add command -command "func_roll $sts" -hidemargin 1 -label \
         [format {%5s: %-15s} $ii [format_number $stack($ii)]]
     }
     incr sts -1
   }
   .stack add separator
   if {$FLAG(8)} {
     .stack add command -command "dispatch_key 43_36" -hidemargin 1 -label \
         [format { LSTx: %-15s iLSTX: %-15s} [format_number $stack(LSTx)] \
           [format_number $istack(LSTx)]]
   } else {
     .stack add command -label " LSTx: [format_number $stack(LSTx)]" \
       -command "dispatch_key 43_36" -hidemargin 1
   }
 
   if {$trigger == 3} {
     tk_popup .stack [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .stack [winfo rootx .status] \
       [expr [winfo rooty .status] + [winfo height .status]]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_error { trigger } {
 
   global LAYOUT stack
 
   if {![winfo exists .error]} {
 
     menu .error -tearoff 0 -title "Error" -font $LAYOUT(FnMenu)
     .error add command -label " 0 : y \u00F7 0, LN 0, \u2026" -state disabled
     .error add command -label " 1 : LN A, SIN A, \u2026" -state disabled
     .error add command -label " 2 : \u2211 Error" -state disabled
     .error add command -label " 3 : R?, Aij?" -state disabled
     .error add command -label " 4 : LBL?, GTO > MEM, PRGM > MEM" -state disabled
     .error add command -label " 5 : > 7 RTN" -state disabled
     .error add command -label " 6 : SF > 9, CF > 9, F? > 9" -state disabled
     .error add command -label " 7 : SOLVE(SOLVE), \u222Bxy(\u222Bxy)" \
       -state disabled
     .error add command -label " 8 : SOLVE ?" -state disabled
     .error add command -label " 9 : ON / \u00D7" -state disabled
     .error add command -label "10 : DIM > MEM" -state disabled
     .error add command -label "11 : DIM A \u2260 DIM B" -state disabled
     .error add separator
     .error add command -label "98 : File I/O error" -state disabled
     .error add command -label "99 : Tcl/Tk error" -state disabled
 
     .error configure -disabledforeground [.error cget -foreground]
 
   }
 
   if {$trigger == 3} {
     tk_popup .error [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .error [winfo rootx .status] \
       [expr [winfo rooty .status] + [winfo height .status]]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc lift {} {
 
   foreach ii {stack istack} {
     upvar #0 $ii st
 
     set st(t) $st(z)
     set st(z) $st(y)
     set st(y) $st(x)
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc drop {} {
 
   foreach ii {stack istack} {
     upvar #0 $ii st
 
     set st(x) $st(y)
     set st(y) $st(z)
     set st(z) $st(t)
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc move { from to } {
 
   global stack istack
 
   set stack($to) $stack($from)
   set istack($to) $istack($from)
 
 }
 
 # ------------------------------------------------------------------------------
 proc populate { val } {
 
   foreach ii {stack istack} {
     upvar #0 $ii st
 
     foreach jj {x y z t} {
       set st($jj) $val
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc set_status { st } {
 
   global status FLAG PI
 
   switch $st {
     user {
       set status(user) [expr !$status(user)]
       set status(f) 0
       toggle_user $status(user)
       show_x
     }
     f {
       if {!$status(f)} {
         set status(f) [expr !$status(f)]
         set status(g) 0
       }
     }
     g {
       if {!$status(g)} {
         set status(g) [expr !$status(g)]
         set status(f) 0
       }
     }
     fg_off {
       set status(f) 0
       set status(g) 0
     }
     BEGIN {
       set status(BEGIN) [expr !$status(BEGIN)]
     }
     DEG {
       set status(RAD) ""
       set status(RADfactor) [expr $PI/180.0]
       show_x
     }
     RAD {
       set status(RAD) $st
       set status(RADfactor) 1.0
       show_x
     }
     GRAD {
       set status(RAD) $st
       set status(RADfactor) [expr 0.9*$PI/180.0]
       show_x
     }
     PRGM {
       set status(PRGM) [expr !$status(PRGM)]
     }
   }
 
   if [winfo exists .status] {
     .status itemconfigure suser -text [expr $status(user) ? \"USER\" : \"\"]
     .status itemconfigure sf -text [expr $status(f) ? \"f\" : \" \"]
     .status itemconfigure sg -text [expr $status(g) ? \"g\" : \" \"]
     .status itemconfigure sbegin -text [expr $status(BEGIN) ? \"BEGIN\" : \" \"]
     .status itemconfigure srad -text $status(RAD)
     .status itemconfigure scomplex -text [expr $FLAG(8) ? \"C\" : \" \"]
     .status itemconfigure sprgm -text [expr $status(PRGM) ? \"PRGM\" : \"\"]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc count_digits { var } {
 
   set rc 0
 
   for {set ii 0} {$ii < [string length $var]} {incr ii} {
     if {[string is digit [string index $var $ii]]} {
       incr rc
     } elseif {[string index $var $ii] == "e"} {
       break
     }
   }
   return $rc
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_digit { digit } {
 
   global status stack istack
 
   if {$status(num)} {
     if {!$status(liftlock)} {lift}
     if {$status(liftlock) < 2} {set istack(x) 0.0}
     set status(num) 0
     if {$digit == "e+0"} {
       set digit "1$digit"
     } elseif {$digit == "."} {
       set digit "0."
     }
     set stack(x) $digit
   } else {
     set stack_x $stack(x)
     if {$digit == "e+0" &&
         ([string first "e" $stack_x] > 0 || [count_digits $stack_x] > 7)} {
       set digit ""
     }
     set comma [string first "." $stack_x]
 
     if {[count_digits $stack_x] < 10 && !($digit == "." && $comma != -1)} {
       if {[string first "e" $stack_x] > 0} {
         regsub {([-+ ]?[0-9]+e[+-])[0-9]([0-9])$} $stack_x {\1\2} stack_x
       }
       set stack_x "$stack_x$digit"
 
 # Avoid integer overflow for 10-digit integers. Obsolete with Tcl/Tk >= 8.4?
       if {[count_digits $stack_x] == 10 && $comma == -1 && \
           [string first "e" $stack_x] < 0} {
         set stack_x "$stack_x."
       }
       set stack(x) $stack_x
     }
   }
   set status(liftlock) 0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sqrt {} {
 
   global FLAG stack
 
   if {$FLAG(8)} {
     move x u
     csqrt
     move u x
   } else {
     set stack(x) [expr sqrt($stack(x))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_xpow2 {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(x) [expr 1.0*$stack(x)*$stack(x) - $istack(x)*$istack(x)]
     set istack(x) [expr 2.0*$stack(s)*$istack(x)]
   } else {
     set stack(x) [expr pow($stack(x), 2)]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_exp {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(x) [expr exp($stack(x))*cos($istack(x))]
     set istack(x) [expr exp($stack(s))*sin($istack(x))]
   } else {
     set stack(x) [expr exp($stack(x))]
   }
 
 }
 
 # The following are helper functions for the complex mode. They solely operate
 # on stack register u.
 # ------------------------------------------------------------------------------
 proc cabs {} {
 
   global stack istack
 
   return [expr sqrt(1.0*$stack(u)*$stack(u) + 1.0*$istack(u)*$istack(u))]
 
 }
 
 # ------------------------------------------------------------------------------
 proc cphi {} {
 
   global PI stack istack
 
   set ret [expr atan($istack(u)/$stack(u))]
   if {$stack(u) < 0.0} {
     set mod [expr $istack(u) >= 0.0 ? $PI : -$PI]
   } else {
     set mod 0.0
   }
   set ret [expr $ret+$mod]
 
   return $ret
 
 }
 
 # ------------------------------------------------------------------------------
 proc csqrt {} {
 
   global stack istack
 
   set tmp $stack(u)
   set xb [cabs]
   set stack(u) [expr sqrt(($stack(u) + $xb)/2.0)]
   set istack(u) [expr ($istack(u) < 0 ? -1.0 : 1.0)*sqrt((-$tmp + $xb)/2.0)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc cln {} {
 
   global PI stack istack
 
   set tmp $stack(u)
   set stack(u) [expr 0.5*log(1.0*$stack(u)*$stack(u)+1.0*$istack(u)*$istack(u))]
   if {$tmp != 0.0} {
     set mod 0.0
     if {$tmp < 0.0} {set mod [expr $istack(u) >= 0.0 ? $PI : -$PI]}
     set istack(u) [expr atan($istack(u)/$tmp) + $mod]
   } else {
     set istack(u) [expr $istack(x) >= 0.0 ? $PI/2.0 : -$PI/2.0]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_ln {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     if {$stack(x) == 0.0 && $istack(x) == 0.0} {
       error "" "" {ARITH INVALID}
     } else {
       move x u
       cln
       move u x
     }
   } else {
     if {$stack(x) == 0.0} {
       error "" "" {ARITH INVALID}
     } else {
       set stack(x) [expr log($stack(x))]
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_10powx {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(x) [expr pow(10.0,$stack(x))*cos($istack(x)*log(10.0))]
     set istack(x) [expr pow(10.0,$stack(s))*sin($istack(s)*log(10.0))]
   } else {
     set stack(x) [expr pow(10.0, $stack(x))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_log10 {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     if {$stack(x) == 0.0 && $istack(x) == 0.0} {
       error "" "" {ARITH INVALID}
     } else {
       move x u
       cln
       set stack(x) [expr $stack(u)/log(10.0)]
       set istack(x) [expr $istack(u)/log(10.0)]
     }
   } else {
     if {$stack(x) == 0.0} {
       error "" "" {ARITH INVALID}
     } else {
       set stack(x) [expr log10($stack(x))]
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_ypowx {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     move y u
     set stack(y) [expr pow([cabs],$stack(x))*exp(-$istack(x)*[cphi])]
     set istack(y) [expr $stack(x)*[cphi] + $istack(x)*log([cabs])]
     set lx $stack(y)
     set stack(y) [expr cos($istack(y))*$stack(y)]
     set istack(y) [expr sin($istack(y))*$lx]
   } else {
     set stack(y) [expr pow($stack(y), $stack(x))]
   }
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_percent {} {
 
   global stack
 
   set stack(x) [expr ($stack(y)/100.0) * $stack(x)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_inv {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     move x u
     set xb [expr pow([cabs],2)]
     set stack(x) [expr $stack(x)/$xb]
     set istack(x) [expr -$istack(s)/$xb]
   } else {
     set stack(x) [expr 1.0/$stack(x)]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_dpercent {} {
 
   global stack
 
   set stack(x) [expr ($stack(x)-$stack(y))/($stack(y)/100.0)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_dsp_mode { mode param } {
 
   global status storage
 
   if {$param == "I"} {
     if {$storage(I) < 0} {
       set param 0
     } else {
       set param [expr int($storage(I)) > 9 ? 9 : int($storage(I))]
     }
   }
 
   set status(dispmode) $mode
   set status(dispprec) $param
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc lookup_label { lbl } {
 
   global prgstat PRGM
 
   if {$lbl < 0} {
     set target "42_21_1[expr abs($lbl)]"
   } elseif {$lbl > 9} {
     set target "42_21_48_[expr int($lbl - 10)]"
   } else {
     set target "42_21_$lbl"
   }
 
   set tl -1
   set wrap 0
   set ll [expr $prgstat(curline)+1]
   while {!$wrap} {
     if {$ll > [llength $PRGM]} {set ll 0}
     if {[lindex $PRGM $ll] == "$target"} {
       set tl $ll
       break
     } elseif {$ll == $prgstat(curline)} {
       set wrap 1
     }
     incr ll
   }
 
   return $tl
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_label { lbl } {
 
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sst { {ev 0} } {
 
   global HP15 status prgstat PRGM
 
   if {$status(PRGM)} {
     if {$ev == 0 || $ev == 2 || $ev == 4} {
       incr prgstat(curline)
       if {$prgstat(curline) >= [llength $PRGM]} {
         set prgstat(curline) 0
       }
       show_curline
     }
   } else {
     if {$ev == 0 || $ev == 2 || $ev == 4} {
       if {$prgstat(curline) == 0 && [llength $PRGM] > 1} {incr prgstat(curline)}
       show_curline
       if {$ev == 0} {after $HP15(pause) {show_x}}
     } else {
       set prgstat(running) 1
       prgm_step
       set prgstat(running) 0
       show_x
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_bst { {ev 0} } {
 
   global HP15 status prgstat PRGM
 
   if {$status(PRGM) || $ev == 0 || $ev == 2 || $ev == 4} {
     if {$prgstat(curline) > 0} {
       incr prgstat(curline) -1
     } else {
       set prgstat(curline) [expr [llength $PRGM] - 1]
     }
     show_curline
   }
 
   if {!$status(PRGM)} {
     if {$ev == 0 || $ev == 2 || $ev == 4} {
       set status(num) 1
       if {$ev == 0} {after $HP15(pause) {show_x}}
     } else {
       show_x
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_gto_chs { trigger } {
 
   global status
 
   if {!$status(error)} {show_prgm $trigger}
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_gto { lbl } {
 
   global HP15 storage prgstat PRGM
 
   if {$lbl == "I"} {
     set lbl [expr int($storage(I))]
     if {$lbl < 0 && abs($lbl) <= [llength $PRGM]} {
       set ll [expr abs($lbl)]
     } elseif {$lbl >= 0 && $lbl <= $HP15(dataregs)} {
       set ll [lookup_label $lbl]
     } elseif {$lbl >= 20 && $lbl <= 24} {
       set ll [lookup_label [expr 19-$lbl]]
     } else {
       set ll -1
     }
   } else {
     set ll [lookup_label $lbl]
   }
 
   if {$ll == -1} {
     error "" "" {ADDRESS}
   } else {
     set prgstat(curline) $ll
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_gsb { lbl } {
 
   global HP15 prgstat
 
   if {$lbl == "I"} {
     set lbl [expr int($storage(I))]
     if {$lbl < 0 && abs($lbl) <= [llength $PRGM]} {
       set ll [expr abs($lbl)]
     } elseif {$lbl >= 0 && $lbl <= $HP15(dataregs)} {
       set ll [lookup_label $lbl]
     } elseif {$lbl >= 20 && $lbl <= 24} {
       set ll [lookup_label [expr 19-$lbl]]
     } else {
       set ll -1
     }
   } else {
     set ll [lookup_label $lbl]
   }
 
   if {$ll == -1} {
     error "" "" {ADDRESS}
   } elseif {$prgstat(running)} {
     if {[llength $prgstat(rtnadr)] <= $HP15(gsbmax)} {
       lappend prgstat(rtnadr) [expr $prgstat(curline)+1]
       set prgstat(curline) $ll
     } else {
       error "" "" {RTN}
     }
   } else {
     prgm_run $ll
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_hyp { func } {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     switch $func {
       sin {
         set stack(x) [expr sinh($stack(x))*cos($istack(x))]
         set istack(x) [expr cosh($stack(s))*sin($istack(x))]
       }
       cos {
         set stack(x) [expr cosh($stack(x))*cos($istack(x))]
         set istack(x) [expr sinh($stack(s))*sin($istack(x))]
       }
       tan {
         set divi [expr pow(cosh($stack(x))*cos($istack(x)),2)+ \
           pow(sinh($stack(s))*sin($istack(x)),2)]
         set stack(x) [expr sinh($stack(x))*cosh($stack(x))/$divi]
         set istack(x) [expr sin($istack(x))*cos($istack(x))/$divi]
       }
     }
   } else {
     set stack(x) [expr $func\h($stack(x))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_ahyp { func } {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(u) [expr 1.0*$stack(x)*$stack(x) - $istack(x)*$istack(x)]
     set istack(u) [expr 2.0*$stack(x)*$istack(x)]
     switch $func {
       sin {
         set stack(u) [expr $stack(u)+1.0]
         csqrt
         set stack(u) [expr $stack(x)+$stack(u)]
         set istack(u) [expr $istack(x)+$istack(u)]
         cln
         move u x
       }
       cos {
         set stack(u) [expr $stack(u)-1.0]
         csqrt
         set stack(u) [expr $stack(x)+$stack(u)]
         set istack(u) [expr $istack(x)+$istack(u)]
         cln
         set sg [expr $stack(s) < 0.0 ? -1.0 : 1.0]
         set stack(x) [expr $sg*$stack(u)]
         set istack(x) [expr $sg*$istack(u)]
       }
       tan {
         set divi [expr 1.0-2.0*$stack(x)+pow($stack(x),2)-pow($istack(x),2)]
         set stack(u) [expr (1.0-pow($stack(x),2)+pow($istack(x),2))/$divi]
         set istack(u) [expr -2.0*$stack(x)*$istack(x)/$divi]
         cln
         set stack(x) [expr 0.5*$stack(u)]
         set istack(x) [expr 0.5*$istack(u)]
       }
     }
   } else {
     switch $func {
       sin {
         set stack(x) [expr log($stack(x) + sqrt($stack(x)*$stack(x) + 1.0))]
       }
       cos {
         set stack(x) [expr log($stack(x) - sqrt($stack(x)*$stack(x) - 1.0))]
       }
       tan {
         set stack(x) [expr log(sqrt((1.0 + $stack(x)) / (1.0 - $stack(x))))]
       }
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_trign { func } {
 
   global status FLAG stack istack
 
   if {$FLAG(8)} {
     switch $func {
       sin {
         set stack(x) [expr sin($stack(x))*cosh($istack(x))]
         set istack(x) [expr cos($stack(s))*sinh($istack(x))]
       }
       cos {
         set stack(x) [expr cos($stack(x))*cosh($istack(x))]
         set istack(x) [expr -sin($stack(s))*sinh($istack(x))]
       }
       tan {
         set divi [expr cos(2.0*$stack(x))+cosh(2.0*$istack(x))]
         set stack(x) [expr sin(2.0*$stack(x))/$divi]
         set istack(x) [expr sinh(2.0*$istack(x))/$divi]
       }
     }
   } else {
     set stack(x) [expr $func\($stack(x)*$status(RADfactor))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_atrign { func } {
 
   global status FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(u) [expr $stack(x)*$stack(x) - $istack(x)*$istack(x)]
     set istack(u) [expr 2.0*$stack(x)*$istack(x)]
     switch $func {
       sin {
         set stack(u) [expr 1.0-$stack(u)]
         set istack(u) [expr -$istack(u)]
         csqrt
         set stack(u) [expr -$istack(x)+$stack(u)]
         set istack(u) [expr $stack(x)+$istack(u)]
         cln
         set stack(x) $istack(u)
         set istack(x) [expr -$stack(u)]
       }
       cos {
         set stack(u) [expr $stack(u)-1.0]
         csqrt
         set stack(u) [expr $stack(x)+$stack(u)]
         set istack(u) [expr $istack(x)+$istack(u)]
         cln
         set sg [expr $stack(s)*$istack(s) < 0.0 ? -1.0 : 1.0]
         set stack(x) [expr $sg*$istack(u)]
         set istack(x) [expr -$sg*$stack(u)]
       }
       tan {
         set divi [expr 1.0+2.0*$istack(x)+pow($istack(x),2)+pow($stack(x),2)]
         set stack(u) [expr (1.0-pow($istack(x),2)-pow($stack(x),2))/$divi]
         set istack(u) [expr 2.0*$stack(x)/$divi]
         cln
         set stack(x) [expr 0.5*$istack(u)]
         set istack(x) [expr -0.5*$stack(u)]
       }
     }
   } else {
     set stack(x) [expr a$func\($stack(x))/$status(RADfactor)]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_dim_mem {} {
 
   global HP15 stack storage
   set rr [expr abs(int($stack(x)))]
   if {$rr < 1} {set rr 1}
   if {$rr > $HP15(dataregs) + $HP15(prgmregsfree)} {
     error "" "" {DIM}
   } else {
     for {set ii [expr $rr+1]} {$ii <= $HP15(dataregs)} {incr ii} {
       array unset storage $ii
     }
     for {set ii [expr $HP15(dataregs)+1]} {$ii <= $rr} {incr ii} {
       set storage($ii) 0.0
     }
     set HP15(dataregs) $rr
     mem_recalc
   }
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_i { {ev 0} } {
 
   global HP15 status FLAG istack curdisp
 
   if {!$status(PRGM)} {
     if {$FLAG(8)} {
       if {$ev == 0 || $ev == 2 || $ev == 4} {
         set curdisp [format_number $istack(x)]
         if {$ev == 0} {after $HP15(pause) {show_x}}
       } else {
         after $HP15(pause) {show_x}
       }
     } else {
       if {$ev == 0 || $ev == 3 || $ev ==5} {error_handler {INDEX}}
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_I {} {
 
   global FLAG stack istack
 
   if {!$FLAG(8)} {func_sf 8}
   set istack(y) $stack(x)
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_pi {} {
 
   global stack istack PI
 
   lift
   set stack(x) $PI
   set istack(x) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sf { flag } {
 
   global HP15 FLAG storage
 
   if {$flag == "I"} {set flag [expr int($storage(I))]}
   if {$flag == 8 && $HP15(prgmregsfree) < 5} {
     error "" "" {DIM}
   }
   if {$flag >= 0 && $flag <= 9} {
     set FLAG($flag) 1
     set_status NIL
     show_x
   } else {
     error "" "" {FLAG}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_cf { flag } {
 
   global FLAG istack storage
 
   if {$flag == "I"} {set flag [expr int($storage(I))]}
   if {$flag >= 0 && $flag <= 9} {
     if {$flag == 8} {foreach ii {LSTx x y z t u s} {set istack($ii) 0.0 }}
     set FLAG($flag) 0
     set_status NIL
     show_x
   } else {
     error "" "" {FLAG}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_flags { trigger } {
 
   global LAYOUT status FLAG
 
   if {[winfo exists .flags]} {destroy .flags}
 
   menu .flags -tearoff 0 -title "Flags" -font $LAYOUT(FnMenu)
   if {$status(PRGM)} {
     set st normal
   } else {
     set st disabled
   }
   for {set ii 0} {$ii <= 9} {incr ii} {
     .flags add command -label "$ii: $FLAG($ii)" -state $st \
       -command "dispatch_key 43_6_$ii"
   }
 
   if {$trigger == 3} {
     tk_popup .flags [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .flags [winfo rootx .btn_29.gbtn] \
       [expr [winfo rooty .btn_29.gbtn]+[winfo height .btn_29.gbtn]]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_Finq { flag } {
 
   global prgstat storage FLAG
 
   if {$prgstat(running)} {
     if {$flag == "I"} {set flag [expr int($storage(I))]}
     if {$flag >= 0 && $flag <= 9} {
       if {$FLAG($flag) == 0} {incr prgstat(curline) 2}
     } else {
       error "" "" {FLAG}
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_clearsumregs {} {
 
   global HP15 stack istack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } else {
     for {set ii 2} {$ii < 7} {incr ii} {
       set storage($ii) 0.0
     }
   }
 
   foreach ii {x y z t} {
     set stack($ii) 0.0
     set istack($ii) 0.0
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc disp_scroll { inc } {
 
   global status
 
   if {$status(PRGM)} {
     if {$inc >= 0.0} {
       dispatch_key 21
     } else {
       dispatch_key 43_21
     }
   } else {
     func_roll [expr $inc >= 0 ? 3 : 1]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_roll { cnt } {
 
   global status
 
   set status(num) 1
   for {set ii 0} {$ii < $cnt} {incr ii} {
     foreach jj {stack istack} {
       upvar #0 $jj st
 
       set tmp   $st(y)
       set st(y) $st(z)
       set st(z) $st(t)
       set st(t) $st(x)
       set st(x) $tmp
     }
   }
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_chs {} {
 
   global status stack
 
   if {$status(num)} {
     set stack(x) [expr -$stack(x)]
   } else {
     if {[string first "e" $stack(x)] > 0} {
       set stack(x) [string map {e+ e- e- e+} $stack(x)]
     } else {
       if {[string index $stack(x) 0] == "-"} {
         set stack(x) [string range "$stack(x)" 1 end]
       } else {
         set stack(x) "-$stack(x)"
       }
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_abs {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     move x u
     set stack(x) [cabs]
     set istack(x) 0.0
   } else {
     set stack(x) [expr abs($stack(x))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_xexchg { param } {
 
   global stack storage
 
   set param [GETREG $param]
   set tmp $storage($param)
   set storage($param) $stack(x)
   set stack(x) $tmp
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_dse { param } {
 
   global storage prgstat PRGM
 
   set param [GETREG $param]
 
   set nn [expr int($storage($param))]
   set yy [expr abs(($storage($param) - $nn)*1E3)]
   set xx [expr int($yy)]
   set yy [expr int(100.0 * ($yy - $xx))]
 
   set nn [expr $nn-[expr $yy == 0.0 ? 1 : $yy]]
 
   if {$nn <= $xx} {
     if {$prgstat(curline) < [llength $PRGM]} {incr prgstat(curline) 2}
   }
   set storage($param) "$nn.[format "%03d" $xx][format "%02d" $yy]"
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_isg { param } {
 
   global storage prgstat PRGM
 
   set param [GETREG $param]
 
   set nn [expr int($storage($param))]
   set yy [expr abs(($storage($param) - $nn)*1E3)]
   set xx [expr int($yy)]
   set yy [expr int(100.0 * ($yy - $xx))]
   if {$yy == 0.0} {set yy 1}
 
   set nn [expr $nn+[expr $yy == 0.0 ? 1 : $yy]]
 
   if {$nn > $xx} {
     if {$prgstat(curline) < [llength $PRGM]} {incr prgstat(curline) 2}
   }
   set storage($param) "$nn.[format "%03d" $xx][format "%02d" $yy]"
 
 }
 
 # ------------------------------------------------------------------------------
 proc regula_falsi { lbl x0 x1 } {
 
   global stack prgstat
 
   set ebs 1E-14
   set iter 0
 
   while {1} {
 
     populate $x1
     func_gsb $lbl
     set f_x1 $stack(x)
 
     populate $x0
     func_gsb $lbl
     set f_x0 $stack(x)
     set x2 [expr $x0 - $f_x0 * (($x0 - $x1)/($f_x0 - $f_x1))]
 
     populate $x2
     func_gsb $lbl
     set f_x2 $stack(x)
 
     if {$f_x0 == $f_x2 || [incr iter] > $prgstat(maxiter)} {
       error "" "" {SOLVE}
     }
 
     set x0 $x1
     set x1 $x2
     if {[expr abs($x0 - $x1)] <= $ebs} {break}
   }
 
   set stack(z) $f_x2
   set stack(y) $x1
   set stack(x) $x2
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_solve { lbl } {
 
   global HP15 status stack
 
   if {$status(solve)} {error "" "" {RECURSION}}
 
   set status(solve) 1
   set ll [lookup_label $lbl]
   if {$HP15(prgmregsfree) < 5} {
     error "" "" {DIM}
   } elseif {$ll == -1} {
     error "" "" {ADDRESS}
   } else {
     if {$stack(x) < $stack(y)} {func_xy}
     regula_falsi $lbl $stack(y) $stack(x)
   }
   set status(solve) 0
 
 }
 
 # ------------------------------------------------------------------------------
 proc simpson { lbl lb ub steps } {
 
   global stack
 
   set st [expr ($ub-$lb)/($steps*1.0)]
   set res 0.0
 
   for {set ii 0} {$ii < $steps} {incr ii 2} {
     populate [expr $lb+$ii*$st]
     func_gsb $lbl
     set res [expr $res+$stack(x)]
     populate [expr $lb+($ii+1)*$st]
     func_gsb $lbl
     set res [expr $res+4.0*$stack(x)]
     populate [expr $lb+($ii+2)*$st]
     func_gsb $lbl
     set res [expr $res+$stack(x)]
   }
 
   return [expr $res*$st/3.0]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_integrate { lbl } {
 
   global HP15 status stack
 
   if {$status(integrate)} {error "" "" {RECURSION}}
 
   set status(integrate) 1
   set ll [lookup_label $lbl]
   if {$HP15(prgmregsfree) < 23} {
     error "" "" {DIM}
   } elseif {$ll == -1} {
     error "" "" {ADDRESS}
   } else {
     set lb $stack(y)
     set ub $stack(x)
 
     set steps 32
     set res1 0.0
     set res2 0.0
     set delta 0.0
 
     while {1} {
       if {[catch {set res [simpson $lbl $lb $ub $steps]} einf]} {
         error "" "" {INTERRUPT}
         return
       }
       if {$status(dispmode) == "FIX"} {
         set log 0
       } else {
         set log [expr $res != 0 ? int(floor(log10(abs($res)))) : 0]
       }
       set prec [expr 0.5 * pow(10, -$status(dispprec)+$log)]
       set delta [expr $delta + (($ub - $lb) / $steps * $prec)]
 
       if {[expr abs($res1-$res)] < $delta || [expr abs($res2-$res)] < $delta} {
         break
       } else {
         set res1 $res2
         set res2 $res
       }
       set steps [expr 2*$steps]
     }
 
     set stack(t) $lb
     set stack(z) $ub
 
     set status(integrate) 0
     set status(num) 1
     set stack(y) $delta
     set stack(x) $res
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_clearprgm {} {
 
   global HP15 status prgstat PRGM
 
   set prgstat(curline) 0
   set prgstat(interrupt) 0
   if {$status(PRGM)} {
     set HP15(prgmname) ""
     set prgstat(running) 0
     set prgstat(rtnadr) {0}
     set PRGM {{}}
     show_curline
     mem_recalc
   } else {
     show_x
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_clearreg {} {
 
   global HP15 storage
 
   for {set ii 0} {$ii <= $HP15(dataregs)} {incr ii} {
     set storage($ii) 0.0
   }
   set storage(I) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rnd {} {
 
   global status stack
 
   set stack(x) [format "%.$status(dispprec)f" $stack(x)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_xy {} {
 
   global status
 
   foreach ii {stack istack} {
     upvar #0 $ii st
 
     set tmp $st(y)
     set st(y) $st(x)
     set st(x) $tmp
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_prefix { {ev 0} } {
 
   global HP15 status stack curdisp
 
   if {!$status(PRGM)} {
     if {$ev == 0 || $ev == 2 || $ev == 4} {
 announce func_prefix: ev=$ev
       set curdisp " [string map {. ""} [format "%.10e" [expr abs($stack(x))]]]"
       if {$ev == 0} {after $HP15(pause) {show_x}}
     } else {
       after $HP15(pause) {show_x}
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_bs {} {
 
   global status stack FLAG prgstat PRGM
 
   if {$status(PRGM)} {
     if {$prgstat(curline) > 0} {
       set PRGM [lreplace $PRGM $prgstat(curline) $prgstat(curline)]
       incr prgstat(curline) -1
       mem_recalc
       show_curline
     }
   } else {
     if {$FLAG(9)} {
       set FLAG(9) 0
     } elseif {$status(num)} {
       set stack(x) 0.0
       set status(liftlock) 2
     } else {
       regsub {e[+-]0?$} $stack(x) "e" temp
       regsub {^-[0-9]$} $temp "" temp
       if {[string length $temp] > 1} {
 # Remove period added to 10-digit integers in 'func_digit'
         if {[count_digits $temp] == 10 && [string index $temp end] == "."} {
           set temp "[string range $temp 0 end-1]"
         }
         set stack(x) "[string range $temp 0 end-1]"
       } else {
         set status(liftlock) 2
         set status(num) 1
         set stack(x) 0.0
       }
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_clx {} {
 
   global status stack
 
   set stack(x) 0.0
   set status(liftlock) 3
 
 }
 
 # ------------------------------------------------------------------------------
 proc clearall {} {
 
   populate 0.0
   func_clearreg
   func_clx
   func_digit 0
   dispatch_key 20
   move x u
   move x m
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_frac {} {
 
   global stack
 
   set stack(x) [expr ($stack(x) - int($stack(x)))*1.0]
 
 }
 
 # ------------------------------------------------------------------------------
 proc GETREG { param } {
 
   global HP15 storage
 
   if {$param == "(i)"} {set param [expr int($storage(I))]}
   if {($param < 0 || $param > $HP15(dataregs)) && $param != "I"} {
     error "" "" {INDEX}
     return
   }
   return $param
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sto { param } {
 
   global stack storage
 
   set storage([GETREG $param ]) [expr $stack(x)*1.0]
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sto_oper { fn param } {
 
   global stack storage
 
   set param [GETREG $param ]
   set storage($param) [expr $storage($param) $fn $stack(x)*1.0]
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_int {} {
 
   global stack
 
   set stack(x) [expr 1.0*int($stack(x))]
 
 }
 
 # ------------------------------------------------------------------------------
 proc toggle_user { mode } {
 
   if {$mode} {
     for {set ii 1} {$ii < 5} {incr ii} {
       bind .btn_1$ii.fbtn "<Button-1>" "dispatch_key 1$ii"
       bind .btn_1$ii.btn "<Button-1>" "key_event 1$ii 42_1$ii"
     }
   } else {
     for {set ii 1} {$ii < 5} {incr ii} {
       bind .btn_1$ii.fbtn "<Button-1>" "dispatch_key 42_1$ii"
       bind .btn_1$ii.btn "<Button-1>" "key_event 1$ii 1$ii"
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rcl { param } {
 
   global stack istack storage
 
   lift
   set stack(x) $storage([GETREG $param])
   set istack(x) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rcl_oper { fn param } {
 
   global stack istack storage
 
   set stack(x) [expr $stack(x)*1.0 $fn $storage([GETREG $param])]
   set istack(x) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rclsum {} {
 
   global HP15 status stack istack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } else {
     lift
     if {!$status(liftlock)} {lift}
     set stack(y) $storage(5)
     set istack(y) 0.0
     set stack(x) $storage(3)
     set istack(x) 0.0
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc mem_recalc {} {
 
   global HP15 PRGM
 
   set HP15(prgmregsused) [expr int(ceil(([llength $PRGM]-1)/7.0))]
   set HP15(freebytes) [expr int(($HP15(prgmregsused)*7)-[llength $PRGM]+1)]
   set HP15(prgmregsfree) \
     [expr $HP15(totregs)-$HP15(dataregs)-$HP15(prgmregsused)]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_mem { {ev 0} } {
 
   global HP15 curdisp
 
   if {$ev == 0 || $ev == 2 || $ev == 4} {
     mem_recalc
     set curdisp [format " %2d %2d %2d-%d" \
       $HP15(dataregs) $HP15(prgmregsfree) $HP15(prgmregsused) $HP15(freebytes)]
   }
 
   if {$ev == 0 || $ev == 3 || $ev == 5} {
     after $HP15(pause) {
       if {$status(PRGM)} {
         show_curline
       } else {
         show_x
       }
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_random {} {
 
   global stack istack
 
   lift
   set stack(x) [expr rand()]
   set istack(x) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_storandom {} {
 
   global status stack
 
   set ax [expr abs($stack(x))]
   set log [expr $ax > 1.0 ? int(log10($ax))+1 : 0]
   set status(seed) [expr $ax / pow(10.0, $log)]
   expr srand(int($ax))
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rclrandom {} {
 
   global status stack
 
   set stack(x) $status(seed)
   set istack(x) 0.0
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_polar {} {
 
   global PI status FLAG stack istack
 
   if {$FLAG(8)} {
     move x u
     set stack(x) [cabs]
     set istack(x) [expr [cphi]/$status(RADfactor)]
   } else {
     set stack(x) [expr sqrt(1.0*$stack(x)*$stack(x) + 1.0*$stack(y)*$stack(y))]
     set stack(y) [expr (180.0/$PI)*asin($stack(y)/$stack(x))]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc faculty { var } {
 
   set res 1.0
   set var [expr int($var)]
   for {set ii $var} {$ii > 1} {incr ii -1} {
     set res [expr $res * $ii]
   }
   return $res
 }
 
 # ------------------------------------------------------------------------------
 proc gamma { var } {
 
   global PI
 
   set var [expr $var+1.0]
   if {$var >= 0.0} {
     set step 0.01
     set res 0.0
     for {set ii -20.0} {$ii <= 20.0 + $var} {set ii [expr $ii + $step]} {
       set old $res
       set res [expr $res + (exp($var*$ii)*exp(-exp($ii))*$step)]
       if {$old == $res} {break}
     }
     set ret $res
   } else {
     if {[expr abs($var - int($var))] > 0} {
       set var [expr abs($var)]
       set ret [gamma [expr $var-1.0]]
       set ret [expr -$PI/($var*$ret*sin($PI*$var))]
     } else {
       error "" "" {ARITH OVERFLOW}
     }
   }
 
   return $ret
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_faculty {} {
 
   global stack
 
   if {$stack(x) < 0.0 || [expr abs($stack(x) - int($stack(x)))] > 0} {
     set stack(x) [gamma $stack(x)]
   } else {
     set stack(x) [faculty $stack(x)]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_avg {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } elseif {abs($storage(2)) > 0.0} {
     lift
     if {!$status(liftlock)} {lift}
     set stack(y) [expr $storage(5)/$storage(2)]
     set istack(y) 0.0
     set stack(x) [expr $storage(3)/$storage(2)]
     set istack(x) 0.0
   } else {
     error "" "" {SUM}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_linexpolation {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } elseif {abs($storage(2)) >= 1} {
     lift
     if {!$status(liftlock)} {lift}
 
     set M [expr $storage(2)*$storage(4)-$storage(3)*$storage(3)]
     set N [expr $storage(2)*$storage(6)-$storage(5)*$storage(5)]
     set P [expr $storage(2)*$storage(7)-$storage(3)*$storage(5)]
     set stack(x) [expr ($M*$storage(5) + \
       $P*($storage(2)*$stack(x) - $storage(3)) ) / ($storage(2)*$M)]
     set istack(x)
     set stack(y) [expr $P/sqrt($M*$N)]
     set istack(y)
   } else {
     error "" "" {SUM}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_linreg {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } elseif {abs($storage(2)) >= 1} {
     lift
     if {!$status(liftlock)} {lift}
 
     set M [expr $storage(2)*$storage(4)-$storage(3)*$storage(3)]
     set N [expr $storage(2)*$storage(6)-$storage(5)*$storage(5)]
     set P [expr $storage(2)*$storage(7)-$storage(3)*$storage(5)]
     set stack(y) [expr $P/$M]
     set istack(y) 0.0
     set stack(x) [expr ($M*$storage(5) - $P*$storage(3))/($storage(2)*$M)]
     set istack(x) 0.0
 
   } else {
     error "" "" {SUM}
   }
 
 }
 # ------------------------------------------------------------------------------
 proc func_stddev {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } elseif {abs($storage(2)) > 0.0} {
     lift
     if {!$status(liftlock)} {lift}
 
     set DIVISOR [expr $storage(2)*($storage(2)-1.0)]
     set stack(y) \
       [expr sqrt(($storage(2)*$storage(6)-$storage(5)*$storage(5))/$DIVISOR)]
     set istack(y) 0.0
     set stack(x) \
       [expr sqrt(($storage(2)*$storage(4)-$storage(3)*$storage(3))/$DIVISOR)]
     set istack(x) 0.0
   } else {
     error "" "" {SUM}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sum_plus {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } else {
     set storage(2) [expr $storage(2) + 1]
     set storage(3) [expr $storage(3) + $stack(x)]
     set storage(4) [expr $storage(4) + $stack(x)*$stack(x)]
     set storage(5) [expr $storage(5) + $stack(y)]
     set storage(6) [expr $storage(6) + $stack(y)*$stack(y)]
     set storage(7) [expr $storage(7) + $stack(x)*$stack(y)]
 
     set stack(x) $storage(2)
     set status(liftlock) 2
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_sum_minus {} {
 
   global HP15 status stack storage
 
   if {$HP15(dataregs) < 7} {
     error "" "" {INDEX}
   } else {
     set storage(2) [expr $storage(2) - 1]
     set storage(3) [expr $storage(3) - $stack(x)]
     set storage(4) [expr $storage(4) - $stack(x)*$stack(x)]
     set storage(5) [expr $storage(5) - $stack(y)]
     set storage(6) [expr $storage(6) - $stack(y)*$stack(y)]
     set storage(7) [expr $storage(7) - $stack(x)*$stack(y)]
 
     set stack(x) $storage(2)
     set status(liftlock) 2
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_Pyx {} {
 
   global stack
 
   if {[expr $stack(x) - int($stack(x))] > 0 || $stack(x) < 0 || \
       [expr $stack(y) - int($stack(y))] > 0 || $stack(y) < 0 || \
       [expr $stack(x) > $stack(y)]} {
     error "" "" {ARITH INVALID}
   } else {
     set stack(y) [expr [faculty $stack(y)]/ \
       [faculty [expr int($stack(y)-$stack(x))]]]
     drop
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_Cyx {} {
 
   global stack
 
   if {[expr $stack(x) - int($stack(x))] > 0 || $stack(x) < 0 || \
       [expr $stack(y) - int($stack(y))] > 0 || $stack(y) < 0 || \
       [expr $stack(x) > $stack(y)]} {
     error "" "" {ARITH INVALID}
   } else {
     set stack(y) [expr [faculty $stack(y)]/ \
       ([faculty $stack(x)]*[faculty [expr int($stack(y)-$stack(x))]])]
     drop
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_enter {} {
 
   global status FLAG stack istack
 
   if {[string first "." "$stack(x)"] == -1 && \
       [string first "e" "$stack(x)"] == -1} {
     append stack(x) "."
   }
   if {$FLAG(8) && [string first "." "$stack(x)"] == -1 && \
       [string first "e" "$stack(x)"] == -1} {
     append istack(x) "."
   }
 
   lift
   set status(liftlock) 2
   show_x
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_lastx {} {
 
   global status FLAG stack istack
 
   lift
   set stack(x) $stack(LSTx)
   if {$FLAG(8)} {set istack(x) $istack(LSTx)}
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rectangular {} {
 
   global status FLAG stack istack
 
   if {$FLAG(8)} {
     set stack(x) [expr cos($istack(x)*$status(RADfactor))*$stack(x)]
     set istack(x) [expr sin($istack(x)*$status(RADfactor))*$stack(s)]
   } else {
     set stack(x) [expr cos($stack(y)*$status(RADfactor))*$stack(x)]
     set stack(y) [expr sin($stack(y)*$status(RADfactor))*$stack(s)]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_hms {} {
 
   global stack
 
   set hours [expr int($stack(x))]
   set m [expr ($stack(x) - $hours)*60.0]
   set minutes [expr int([string range $m 0 [string last "." $m]])/100.0]
   set seconds [expr ($stack(x) - $hours - $minutes*60.0/36.0)*0.36]
   set stack(x) [expr $hours + $minutes + $seconds]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_h {} {
 
   global stack
 
   set hours [expr int($stack(x))]
   set m [expr ($stack(x) - $hours)*100.0]
   set minutes [expr int([string range $m 0 [string last "." $m]])]
   set seconds [expr ($stack(x) - $hours - $minutes/100.0)*10000.0]
   set stack(x) [expr $hours + ($minutes*60+$seconds)/3600.0]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rad {} {
 
   global stack PI
 
   set stack(x) [expr $stack(x)*$PI/180.0]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_deg {} {
 
   global stack PI
 
   set stack(x) [expr $stack(x)*180.0/$PI]
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_re_im {} {
 
   global FLAG stack istack
 
   if {!$FLAG(8)} {func_sf 8}
   set tmp $stack(x)
   set stack(x) $istack(x)
   set istack(x) $tmp
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_test_options { trigger } {
 
   global LAYOUT status TEST
 
   if {$status(PRGM)} {
     if {[winfo exists .testops]} {destroy .testops}
 
     menu .testops -tearoff 0 -title "Test" -font $LAYOUT(FnMenu)
     for {set ii 0} {$ii <= 9} {incr ii} {
       .testops add command -label "$ii: [lindex $TEST $ii]" \
         -command "dispatch_key 43_30_$ii" -underline 0
     }
 
     if {$trigger == 3} {
       tk_popup .testops [winfo pointerx .] [winfo pointery .]
     } else {
       tk_popup .testops [winfo rootx .btn_310.gbtn] \
         [expr [winfo rooty .btn_310.gbtn]+[winfo height .btn_310.gbtn]]
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_test { op } {
 
   global status FLAG stack istack prgstat PRGM
 
   if {$prgstat(running)} {
     switch $op {
        0 {if {$FLAG(8)} {
             set rc [expr $stack(x) != 0.0 || $istack(x) != 0.0]
           } else {
             set rc [expr $stack(x) != 0.0]
           }
          }
        1 {set rc [expr $stack(x) >  0.0]}
        2 {set rc [expr $stack(x) <  0.0]}
        3 {set rc [expr $stack(x) >= 0.0]}
        4 {set rc [expr $stack(x) <= 0.0]}
        5 {if {$FLAG(8)} {
             set rc [expr $stack(x) == $stack(y) && $istack(x) == $istack(y) ]
           } else {
             set rc [expr $stack(x) == $stack(y)]
           }
          }
        6 {if {$FLAG(8)} {
             set rc [expr $stack(x) != $stack(y) || $istack(x) != $istack(y) ]
           } else {
             set rc [expr $stack(x) != $stack(y)]
           }
          }
        7 {set rc [expr $stack(x) >  $stack(y)]}
        8 {set rc [expr $stack(x) <  $stack(y)]}
        9 {set rc [expr $stack(x) >= $stack(y)]}
       10 {set rc [expr $stack(x) <= $stack(y)]}
       11 {if {$FLAG(8)} {
             set rc [expr $stack(x) == 0.0 && $istack(x) == 0.0]
           } else {
             set rc [expr $stack(x) == 0.0]
           }
          }
     }
     if {!$rc} {
       if {$prgstat(curline) < [llength $PRGM]} {incr prgstat(curline) 2}
     }
   } else {
     show_x
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_plus {} {
 
   global FLAG stack istack
 
   set stack(y) [expr $stack(y) + (1.0 * $stack(x))]
   if {$FLAG(8)} {set istack(y) [expr $istack(y) + (1.0 * $istack(x))]}
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_minus {} {
 
   global FLAG stack istack
 
   set stack(y) [expr $stack(y) - $stack(x)]
   if {$FLAG(8)} {set istack(y) [expr $istack(y) - (1.0 * $istack(x))]}
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_mult {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set tmp $stack(y)
     set stack(y) [expr $stack(x)*$stack(y) - $istack(x)*$istack(y)]
     set istack(y) [expr $stack(x)*$istack(y) + $istack(x)*$tmp]
   } else {
     set stack(y) [expr 1.0 * $stack(x) * $stack(y)]
   }
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_div {} {
 
   global FLAG stack istack
 
   if {$FLAG(8)} {
     set tmp $stack(y)
     set divi [expr $stack(x)*$stack(x) + $istack(x)*$istack(x)]
     set stack(y) [expr ($stack(x)*$stack(y) + $istack(x)*$istack(y))/$divi]
     set istack(y) [expr ($stack(x)*$istack(y) - $tmp*$istack(x))/$divi]
   } else {
     set stack(y) [expr $stack(y) / (1.0 * $stack(x))]
   }
   drop
 
 }
 
 # ------------------------------------------------------------------------------
 proc lookup_keyname { mod code } {
 
   global status HP15_KEYS TEST
 
   set kname $code
   switch $mod {
     "f DIM" -
     "STO +" -
     "STO -" -
     "STO \u00D7" -
     "STO \u00F7" -
     "STO" -
     "RCL +" -
     "RCL -" -
     "RCL \u00D7" -
     "RCL \u00F7" -
     "RCL" {
       set ind [expr [lsearch {24 25} $code] == -1 ? 5 : 4]
     }
     "GTO" -
     "GSB" -
     "f LBL" {
       set ind [expr [lsearch {11 12 13 14 15 25} $code] == -1 ? 5 : 4]
     }
     "f DSE" -
     "f ISG" -
     "f FIX" {
       set ind [expr (($code == 25) | ($code == 24)) ? 4 : 5]
     }
     "f" {
       set ind 4
     }
     "g" {
       set ind 6
     }
     "g TEST" {
       return [string map {" " ""} [lindex $TEST $code]]
     }
     "g SF" -
     "g CF" -
     "g F?" {
       set ind [expr $code == 25 ? 4 : 5]
     }
     default {
       set ind 5
     }
   }
 
   foreach kk $HP15_KEYS {
     if {[lindex $kk 3] == $code} {
       set kname [lindex $kk $ind]
       break
     }
   }
 
   return $kname
 
 }
 
 # ------------------------------------------------------------------------------
 proc build_mnemonic { step wid } {
 
   set rc {}
   while {[regexp {([0-9][0-9]?)_?(.*)} $step all key rest]} {
     set step $rest
     lappend rc [lookup_keyname [join $rc] $key]
   }
   return [format "%$wid\s" [string map {". " "."} [join $rc]]]
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_prgm { trigger } {
 
   global LAYOUT HP15 status prgstat PRGM
 
   if {[winfo exists .program]} {destroy .program}
 
   menu .program -tearoff 0 -title "Program" -font $LAYOUT(FnMenu)
   for {set ii 0} {$ii < [llength $PRGM]} {incr ii} {
     set cs [lindex $PRGM $ii]
     if {$HP15(mnemonics)} {
       set lbl "[format "%03d" $ii]-[build_mnemonic $cs 10]"
     } else {
       set lbl "[format_prgm $ii 9]"
     }
 
     if {$status(PRGM)} {
       set cmd "set prgstat(curline) $ii\nshow_curline"
     } else {
       set cmd "set prgstat(curline) $ii"
     }
     .program add command -label "$lbl" -command $cmd
     if {$HP15(prgmmenubreak) && $ii % $HP15(prgmmenubreak) == 0} {
       .program entryconfigure $ii -columnbreak 1
     }
 
     if {$HP15(prgmcoloured)} {
       if {[string first "42_21" $cs] == 0} {
         .program entryconfigure $ii -foreground $LAYOUT(fbutton_bg) \
           -background $LAYOUT(button_bg)
       }
       if {[string first "43_32" $cs] == 0} {
         .program entryconfigure $ii -foreground $LAYOUT(gbutton_bg) \
           -background $LAYOUT(button_bg)
       }
       if {[string first "22_" $cs] == 0 || [string first "32_" $cs] == 0} {
         .program entryconfigure $ii -foreground white \
           -background $LAYOUT(button_bg)
       }
     }
   }
 
   if {$trigger == 3} {
     tk_popup .program [winfo pointerx .] [winfo pointery .]
   } else {
     tk_popup .program [winfo rootx .status] \
       [expr [winfo rooty .status] + [winfo height .status]]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc show_curline {} {
 
   global curdisp prgstat
 
   set curdisp " [format_prgm $prgstat(curline) 6]"
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_addstep { step } {
 
   global HP15 prgstat PRGM
 
   if {$HP15(prgmregsfree) + $HP15(freebytes) > 0} {
     set PRGM [linsert $PRGM [expr $prgstat(curline)+1] $step]
     incr prgstat(curline)
     show_curline
     mem_recalc
   } else {
     error_handler ADDRESS
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_interrupt {} {
 
   global status prgstat
 
   set status(solve) 0
   set status(integrate) 0
   set prgstat(interrupt) 1
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_step {} {
 
   global status prgstat PRGM
 
   set oldline $prgstat(curline)
   dispatch_key [lindex $PRGM $prgstat(curline)]
   if {$prgstat(curline) == 0} {
     set prgstat(running) 0
   } elseif {$prgstat(curline) == [llength $PRGM]} {
 # Implicit return at end of program code
     if {$oldline == $prgstat(curline)} {
       dispatch_key 43_32
       dispatch_key [lindex $PRGM $prgstat(curline)]
     }
   } else {
     if {$oldline == $prgstat(curline) && !$status(error)} {
       incr prgstat(curline)
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc prgm_run { start } {
 
   global HP15 stack curdisp status prgstat
 
 # disable stack tracing for smoother display updates and performance reasons
   trace vdelete stack(x) w show_x
 
 # any key or button event will interrupt a running program
   grab .logo
   focus .logo
   bind .logo <KeyPress> {prgm_interrupt}
   bind .logo <ButtonPress> {prgm_interrupt}
 
   set iter 0
   set status(num) 1
   set prgstat(running) 1
   set prgstat(curline) $start
 
   while {$prgstat(running)} {
     if {$curdisp == ""} {
       set curdisp "  running"
     } else {
       set curdisp ""
     }
     update
     after $HP15(delay)
     prgm_step
     if {[incr iter]> $prgstat(maxiter)} {set prgstat(running) 0}
     if {$prgstat(interrupt)} {set prgstat(running) 0}
   }
 
 # re-enable tracing on stack(x) and reset interrupt handling
   trace variable stack(x) w show_x
   grab release .logo
   focus .
   set status(num) 1
 
   if {$prgstat(interrupt)} {
     error "" "" {INTERRUPT}
   } elseif {!$status(error)} {
     show_x
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_pse {} {
 
   global HP15 status
 
   if {!$status(PRGM)} {
     show_x
     update
     after $HP15(pause)
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rs {} {
 
   global prgstat
 
   if {$prgstat(running)} {
     set prgstat(running) 0
     update
   } else {
     if {$prgstat(curline) == 0} {incr prgstat(curline)}
     prgm_run $prgstat(curline)
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_pr {} {
 
   global status FLAG
 
   set_status PRGM
   if {$status(PRGM)} {
     set FLAG(9) 0
     show_curline
   } else {
     set status(num) 1
     show_x
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_rtn {} {
 
   global prgstat
 
   set prgstat(curline) [lindex $prgstat(rtnadr) end]
 
   if {[llength $prgstat(rtnadr)] > 1} {
     set prgstat(rtnadr) [lreplace $prgstat(rtnadr) end end]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc func_on {} {
 
   global APPDATA
 
   set answer [tk_messageBox -type okcancel -icon question -default ok \
         -title $APPDATA(titlewide) \
         -message "Exit Tcl/Tk $APPDATA(title) Simulator?"]
   if {"$answer" == "ok"} {exit_handler}
 
 }
 
 # ------------------------------------------------------------------------------
 proc lookup_keyseq { keyseq by_func } {
 
   global HP15_KEY_FUNCS
 
   set rc ""
   set ind [lsearch {0 42 43 44 45} [string range $keyseq 0 1]]
   if {$ind == -1} {set ind 0}
   set funclist [lindex $HP15_KEY_FUNCS $ind]
 
   if {$by_func == 1} {
     foreach ff $funclist {
       if {[regexp "^[lindex $ff 0]\$" $keyseq]} {
         set rc $ff
         break
       }
     }
   } else {
      foreach ff $funclist {
       if {[string match "$keyseq\_*" $ff]} {
         set rc $ff
         break
       }
     }
   }
 
   return $rc
 
 }
 
 # ------------------------------------------------------------------------------
 proc check_attributes { func num } {
 
   global status stack
 
 # Numbers with leading zeros are interpreted as octal number by the Tcl/Tk
 # interpreter. Must manipulate stack(x) value for most of the functions.
   if {!$status(num)} {
     if {$stack(x) != 0.0 &&
         [lsearch {func_bs func_chs func_digit} $func] == -1} {
       regsub {^\-0+} $stack(x) {-} tmp
       regsub {^0+} $tmp {} stack(x)
     }
   }
 
   move x s
   if {$num} {set status(num) 1}
 
 }
 
 # ------------------------------------------------------------------------------
 proc dispatch_key { kcode args } {
   global status FLAG isseq keyseq errorCode
 
   set fmatch ""
   set svar ""
 
   if {$status(error)} {
     set status(error) 0
     if {$status(PRGM)} {
       show_curline
     } else {
       show_x
     }
     return
   }
 
   if {$keyseq != ""} {
     if {[string match {4[23]} $kcode] && [string match {4[23]} $keyseq]} {
       set keyseq $kcode
     } else {
       set_status fg_off
       set keyseq $keyseq\_$kcode
       # This will allow abbreviated key sequences
       regsub {_4[23]} $keyseq "" keyseq
     }
   } else {
     set keyseq $kcode
   }
   set fmatch [lookup_keyseq $keyseq 1]
 
   if {$fmatch != ""} {
 # Key sequence matches a function
     foreach {kseq func alstx anum aprgm} $fmatch {
       regexp $kseq$ $keyseq mvar svar
       if {$status(PRGM) && $aprgm} {
         prgm_addstep $keyseq
       } else {
         set keyseq ""
         check_attributes [lindex $func 0] $anum
         # This is where all func_tions are executed
         if {[catch {
 # Args are not passed through if we have a sequence.
           if {$isseq} {
             eval $func$svar
           } else {
             eval $func$svar $args
           }
         }]} {error_handler $errorCode}
         if {!$status(error) && $status(num) && $alstx} {move s LSTx}
       }
     }
     set keyseq ""
     if {$aprgm && $status(liftlock)} {incr status(liftlock) -1}
   } else {
 # If key sequence doesn´t match exactly check for longer one.
     set seq [lookup_keyseq $keyseq 0]
 
 # Sequence doesn´t match. Start new sequence with last key typed in.
     if {$seq == "" && $kcode != ""} {
       set keyseq ""
       set isseq 0
       if {$status(f)} {set kcode 42_$kcode}
       if {$status(g)} {set kcode 43_$kcode}
       if {"$args" == ""} {
         dispatch_key $kcode
       } else {
         dispatch_key $kcode $args
       }
     } else {
       set isseq 1
     }
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc check_on_num {len name el op} {
 
   global $name ${name}_oldval
 
   if {[string compare $el {}]} {
     set old ${name}_oldval\($el)
     set name $name\($el)
   } else {
     set old ${name}_oldval
   }
   if {([string length [set $name]] > $len) || \
     [regexp {^[0-9]*$} [set $name]] == 0} {
     set $name [set $old]
   } else {
     set $old [set $name]
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc isInt { ii len } {
 
 #  return [regexp {^[1234567890]*$} "$ii"]
   expr {[string is integer $ii] && [string length [string trim $ii]] <= $len}
 
 }
 
 # ------------------------------------------------------------------------------
 proc browser_lookup {} {
 
   global APPDATA
 
   set bl {}
 
   foreach bw $APPDATA(browserlist) {
     set bwf [auto_execok $bw]
     if [string length $bwf] { lappend bl "$bw" "$bwf" }
   }
 
   return $bl
 
 }
 
 # ------------------------------------------------------------------------------
 proc browser_select { wid browser } {
 
   global APPDATA
 
   set nbw [tk_getOpenFile -parent .prefs -initialdir "[file dirname $browser]" \
     -title "$APPDATA(title): Select help file browser" \
     -filetypes $APPDATA(exetypes)]
   if {[string length $nbw] > 0} {
     $wid configure -state normal
     $wid delete 0 end
     $wid insert 0 $nbw
     $wid xview end
     $wid configure -state disabled
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc fontset_list {} {
 
   global APPDATA LAYOUT FONTSET
 
   set rc {}
   set fsn 0
   set dpi [expr round([tk scaling]*72)]
   foreach fs $FONTSET {
     set cfs [lindex $fs 0]
     if {$::tcl_platform(platform) == [lindex $cfs 0] && \
         $dpi >= [lindex $cfs 2] && $dpi <= [lindex $cfs 3]} {
       lappend rc [concat $fsn $cfs]
     }
     incr fsn
   }
   return $rc
 
 }
 
 # ------------------------------------------------------------------------------
 proc fontset_apply { fsn } {
 
   global APPDATA HP15 LAYOUT FONTSET
 
   set found 0
   set fntlst [fontset_list]
   foreach fs $fntlst {
     if {$fsn == [lindex $fs 0]} { set found 1 }
   }
 
   if {!$found} {
     tk_messageBox -type ok -icon error -default ok -title $APPDATA(titlewide) \
       -message "Error in memory file: Invalid fontset - using default set.
                 Check preferences for valid sets."
     set fsn [lindex [lindex $fntlst 1] 0]
     set HP15(fontset) $fsn
   }
   foreach {fs fnt} [lindex [lindex $FONTSET $fsn] 1] {
     set LAYOUT($fs) $fnt
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc preferences_apply { andExit ww } {
 
   global APPDATA HP15 HP15tmp PREFTEXT
 
   set prefs_ok true
   foreach vv {prgmmenubreak pause delay} {
     if {[string length [string trim $HP15tmp($vv)]] == 0} {
       tk_messageBox -type ok -icon error -default ok -title $APPDATA(titlewide) \
         -message "Invalid settings for '$PREFTEXT($vv)'."
       set prefs_ok false
       break
     }
   }
   if {$prefs_ok} {
     array set HP15 [array get HP15tmp]
     if {$andExit} {destroy $ww}
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc preferences {} {
 
   global APPDATA HP15 HP15tmp PREFTEXT
 
   array set HP15tmp [array get HP15]
   if [winfo exists .prefs] {
     wm deiconify .prefs
   } else {
 
     toplevel .prefs
 
     frame .prefs.outer -relief flat
 
 # Calculator and OS settings
     set fpo .prefs.outer.hp15
     labelframe $fpo -relief groove -borderwidth 2 -text $PREFTEXT(frm_os)
 
     checkbutton $fpo.clpbrdc -text $PREFTEXT(clpbrdc) \
       -variable HP15tmp(clpbrdc) -indicatoron 1
     checkbutton $fpo.mnemonics -text $PREFTEXT(mnemonics) \
       -variable HP15tmp(mnemonics) -indicatoron 1
     checkbutton $fpo.prgmcoloured -text $PREFTEXT(prgmcoloured) \
       -variable HP15tmp(prgmcoloured) -indicatoron 1
     frame $fpo.prgm
     label $fpo.prgm.label -text $PREFTEXT(prgmmenubreak) -anchor w
     spinbox $fpo.prgm.sb -width 2 -justify right -from 5 -to 45 -increment 1\
       -textvariable HP15tmp(prgmmenubreak) -validate all -vcmd "isInt %P 2"
     checkbutton $fpo.breakstomenu -text $PREFTEXT(breakstomenu) \
       -variable HP15tmp(breakstomenu) -indicatoron 1
     checkbutton $fpo.prgmstounicode -text $PREFTEXT(prgmstounicode) \
       -variable HP15tmp(prgmstounicode) -indicatoron 1
 
     pack $fpo.prgm.label -side left
     pack $fpo.prgm.sb -side right -padx 5
 
     pack $fpo.clpbrdc $fpo.mnemonics $fpo.prgmcoloured -anchor nw -padx 10
     pack $fpo.prgm -side top -anchor nw -expand no -fill x -padx 10
     pack $fpo.breakstomenu $fpo.prgmstounicode -side top -anchor nw -padx 10
 
 # Behaviour
     set fpo .prefs.outer.behave
     labelframe $fpo -relief groove -borderwidth 2 -text $PREFTEXT(frm_simulator)
 
     checkbutton $fpo.behaviour -text $PREFTEXT(strictHP15) \
       -variable HP15tmp(strictHP15) -indicatoron 1 -state disabled
     checkbutton $fpo.saveonexit -text $PREFTEXT(saveonexit) \
       -variable HP15tmp(saveonexit)
 
     frame $fpo.pause
     label $fpo.pause.label -text $PREFTEXT(pause) \
       -anchor w
     spinbox $fpo.pause.sb -width 4 -justify right -from 0 -to 2000 \
       -increment 1 -textvariable HP15tmp(pause) -validate all -vcmd "isInt %P 4"
 
     frame $fpo.delay
     label $fpo.delay.label -text $PREFTEXT(delay) -anchor w
     spinbox $fpo.delay.sb -width 3 -justify right -from 0 -to 999 \
       -increment 1 -textvariable HP15tmp(delay) -validate all -vcmd "isInt %P 3"
 
     pack $fpo.behaviour $fpo.saveonexit -side top -anchor w -padx 5
     pack $fpo.pause.label -side left
     pack $fpo.pause.sb -side right -padx 5
     pack $fpo.delay.label -side left
     pack $fpo.delay.sb -side right -padx 5
     pack $fpo.pause $fpo.delay -expand yes -fill both -side top \
       -anchor w -padx 5 -pady 2
 
 # Font settings
     set fpo .prefs.outer.fontset
     labelframe $fpo -relief groove -borderwidth 2 -text $PREFTEXT(frm_fontset)
 
     label $fpo.info -anchor nw -justify left \
       -text "Available font sets for $::tcl_platform(os) at \
         [expr round([tk scaling]*72)] dpi:"
 
     frame $fpo.fs
     foreach fs [fontset_list] {
       set fsn [lindex $fs 0]
       radiobutton $fpo.fs.$fsn -text "[lindex $fs 2]" -value $fsn \
         -variable HP15tmp(fontset)
       pack $fpo.fs.$fsn -side top -anchor w -padx 10
     }
     label $fpo.hint -anchor nw -justify left -text $PREFTEXT(fonthint)
 
     pack $fpo.info $fpo.fs $fpo.hint -side top -anchor w -expand no -fill x \
      -padx 10
 
 # Browser settings
     set fpo .prefs.outer.browser
     labelframe $fpo -relief groove -borderwidth 2 -text $PREFTEXT(browser)
 
     frame $fpo.bw
     foreach {bw bwf} [browser_lookup] {
       radiobutton $fpo.bw.$bw -text "$bw" -value "$bwf" \
         -variable HP15tmp(browser)
       pack $fpo.bw.$bw -side top -anchor w -padx 10
     }
 
     button $fpo.sel -text "Browse\u2026" \
       -anchor w -borderwidth 1 -highlightthickness 0 \
       -command "browser_select {$fpo.entry} {$HP15tmp(browser)}"
     entry $fpo.entry -width 32 -justify left -textvariable HP15tmp(browser)
 
     pack $fpo.bw -side top -anchor w
     pack $fpo.sel -side left -padx 10 -anchor n
     pack $fpo.entry -side left -anchor n
 
 # Lay out dialogue
 
     set fpo .prefs.outer
     grid $fpo.hp15 -column 0 -row 0 -sticky nsew -padx 3 -pady 3
     grid $fpo.behave -column 0 -row 1 -sticky nsew -padx 3 -pady 3
     grid $fpo.fontset -column 1 -row 0 -sticky nsew -padx 3 -pady 3
     grid $fpo.browser  -column 1 -row 1 -sticky nsew -padx 3 -pady 3
 
     pack .prefs.outer -side top
 
     set fbtn .prefs.btn
     frame $fbtn -relief flat
     button $fbtn.ok -text "OK" -width 6 -default active \
       -command "preferences_apply true .prefs"
     button $fbtn.apply -text "Apply" -width 6 \
       -command "preferences_apply false .prefs"
     button $fbtn.cancel -text "Cancel" -width 6 -command "destroy .prefs"
 
     pack $fbtn.cancel $fbtn.apply $fbtn.ok -side right -padx 5 -anchor e
     pack $fbtn -in .prefs -side top -expand no -fill x -pady 5
 
     wm title .prefs "$APPDATA(title): Preferences"
     wm transient .prefs .
     wm resizable .prefs false false
     wm geometry .prefs +[expr [winfo x .]+10]+[expr [winfo y .]+10]
 
     bind .prefs <Return> "preferences_apply true .prefs"
     bind .prefs <Escape> "destroy .prefs"
 
     raise .prefs
     focus .prefs
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc exit_handler {} {
 
   global HP15 status FLAG prgstat
 
   if {$HP15(saveonexit)} {
     if {$status(error)} {func_clx}
     mem_save
   }
   destroy .
 
 }
 
 # ------------------------------------------------------------------------------
 proc about {} {
 
   global APPDATA LAYOUT
 
   if [winfo exists .about] {destroy .about}
 
   toplevel .about
 
   wm title .about "About: $APPDATA(title) Simulator"
   frame .about.frm1 -background $LAYOUT(display_outer_frame) -relief sunken \
     -borderwidth 2
   frame .about.frm2 -background $LAYOUT(display_inner_frame) -relief sunken \
     -borderwidth 2
   frame .about.frm3 -background $LAYOUT(display) -relief sunken \
     -borderwidth 2
   text .about.text -background $LAYOUT(display) -height 26 -width 65 \
     -relief flat -font $LAYOUT(FnButton) -highlightthickness 0
   frame .about.bfrm -background $LAYOUT(keypad_bg) -relief sunken -height 20
   button .about.bfrm.off -text "OK" -default active -font $LAYOUT(FnButton) \
     -background $LAYOUT(button_bg) -foreground white -command "destroy .about" \
     -width $LAYOUT(BtnWidth) -borderwidth 2  \
 
   .about.text insert 0.0 "\n$APPDATA(titlewide)\n\nA Simulator written in Tcl/Tk" \
     Ttitle
   .about.text tag configure Ttitle -font $LAYOUT(FnButton) -justify center
 
   set text "\n\n$APPDATA(copyright)\n\nSerial No. $APPDATA(SerialNo)\n"
 
   .about.text insert end $text copyright
   .about.text tag configure copyright -font $LAYOUT(FnButton) -justify center
 
   .about.text insert end "\n[string repeat "_" 65]\n" seperator
   .about.text tag configure seperator -font $LAYOUT(FnButton) -justify center
 
   set text "\nThis program is free software; you can redistribute it and/or\
 modify it under the terms of the GNU General Public License as published by \
 the Free Software Foundation; either version 2 of the License, or any later\
 version.\n\n\This program is distributed in the hope that it will be useful,\
 but without any warranty; without even the implied warranty of merchantability \
 or fitness for a particular purpose. See the GNU General Public License for \
 more details."
 
   .about.text insert end $text warranty
   .about.text tag configure warranty -font $LAYOUT(FnButton) -justify left \
     -wrap word
 
   .about.text insert end "\n[string repeat "_" 65]\n" seperator
   .about.text tag configure seperator -font $LAYOUT(FnButton) -justify center
 
   set text "\nThis program is not a Hewlett-Packard product.\n
 HP and the HP logo are trademarks of Hewlett-Packard."
 
   .about.text insert end $text warranty
   .about.text tag configure warranty -font $LAYOUT(FnButton) -justify left \
     -wrap word
 
   .about.text configure -state disabled
 
   pack .about.text -in .about.frm3 -side top -expand no -fill x -padx 10
   pack .about.frm3 -in .about.frm2 -side top -expand no -padx 14 -pady 0
   pack .about.frm2 -in .about.frm1 -side left -expand yes
   pack .about.frm1 -in .about -side top -expand yes -fill x \
     -ipadx 10 -ipady 10
   pack .about.bfrm.off -in .about.bfrm -side right -expand no -fill none \
     -padx 15 -pady 10
   pack .about.bfrm -in .about -side top -expand no -fill x
 
   wm resizable .about false false
 
   wm geometry .about +[expr [winfo x .]+15]+[expr [winfo y .]+10]
   wm transient .about .
 
   bind .about <Return> "destroy .about"
   bind .about <Escape> "destroy .about"
 
   raise .about
   grab .about
   focus .about
 }
 
 # ------------------------------------------------------------------------------
 proc key_event { kname code } {
 
   if {[.btn_$kname.btn cget -relief] == "raised"} {
     .btn_$kname.btn configure -relief sunken
     .btn_$kname.gbtn configure -relief flat
     after 100 "
       .btn_$kname.btn configure -relief raised
       .btn_$kname.gbtn configure -relief raised
     "
     dispatch_key $code
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc key_press { kname code ev } {
   global isseq
 
   .btn_$kname.btn configure -relief sunken
   .btn_$kname.gbtn configure -relief flat
   dispatch_key $code $ev
 }
 
 # ------------------------------------------------------------------------------
 proc key_release { kname code ev } {
 
   global isseq
 
   .btn_$kname.btn configure -relief raised
   .btn_$kname.gbtn configure -relief raised
 # Do not execute release event if key is part of a sequence.
   if {!$isseq} {dispatch_key $code $ev}
 
 }
 
 # ------------------------------------------------------------------------------
 proc kp_key_press { state kcode } {
 
 # Dispatch key-pad key as digit key if NumLock is on.
   if {[expr $state & 16] == 16} {
     dispatch_key $kcode
   }
 
 }
 
 # ------------------------------------------------------------------------------
 proc hp_key { kname utext mtext ltext kcode fbnd bnd gbnd} {
 
   global LAYOUT
 
   frame .btn_$kname -relief flat -background $LAYOUT(keypad_bg)
 
 # upper (gold) function
   label .btn_$kname.fbtn -text $utext -anchor center -font $LAYOUT(FnFGBtn) \
     -foreground $LAYOUT(fbutton_bg) -background $LAYOUT(keypad_bg) \
     -borderwidth 0 -highlightthickness 0
   if {$utext != ""} {
     bind .btn_$kname.fbtn "<Button-1>" "key_event $kname 42_$kcode"
   }
   foreach kk $fbnd {
     bind . <$kk> "key_event $kname 42_$kcode"
   }
 
 # basic function
   label .btn_$kname.btn -relief raised -width $LAYOUT(BtnWidth) -text $mtext \
     -anchor center -font $LAYOUT(FnButton) -foreground white \
     -background $LAYOUT(button_bg) -borderwidth 2 -foreground white \
     -highlightbackground $LAYOUT(button_bg) -highlightthickness 0
   bind .btn_$kname.btn "<Button-1>" "key_event $kname $kcode"
   foreach kk $bnd {
     if {[string is digit $kk]} {
       bind . <Key-$kk> "key_event $kname $kcode"
     } else {
       bind . <$kk> "key_event $kname $kcode"
     }
   }
 
 # lower (blue) function
   label .btn_$kname.gbtn -text $ltext -anchor center -relief raised \
     -font $LAYOUT(FnFGBtn) -foreground $LAYOUT(gbutton_bg) \
     -background $LAYOUT(button_bg) \
     -borderwidth 1 -highlightthickness 0 -width $LAYOUT(BtnWidth)
   if {$ltext != ""} {
     bind .btn_$kname.gbtn "<Button-1>" "key_event $kname 43_$kcode"
   }
   foreach kk $gbnd {
     bind . <$kk> "key_event $kname 43_$kcode"
   }
 
   pack .btn_$kname.fbtn -side top -expand no -fill x
   if {$ltext == ""} {
     pack .btn_$kname.btn -side top -expand no -fill both -padx 7
   } else {
     pack .btn_$kname.btn -side top -expand no -fill both -padx 7
     pack .btn_$kname.gbtn -side top -expand no -fill x -padx 7
   }
 
   return .btn_$kname
 
 }
 
 # ------------------------------------------------------------------------------
 proc gui_draw {} {
 
   global LAYOUT HP15_KEYS HP15 APPDATA digits
 
   fontset_apply $HP15(fontset)
 
   . configure -background $LAYOUT(keypad_bg)
 
 # Calculate positions for X register display
   set dwid [font measure $LAYOUT(FnDisplay) "8"]
   set swid [expr int($dwid * 0.5)]
   set ypos 8
   set dspheight \
     [expr round([font actual $LAYOUT(FnDisplay) -size]*$LAYOUT(FnScale)+$ypos)]
 
   frame .dframe1 -background $LAYOUT(display_outer_frame) -relief sunken \
     -borderwidth 2
   frame .dframe2pad -background $LAYOUT(display_outer_frame) -relief sunken \
     -borderwidth 0
   frame .dframe2 -background $LAYOUT(display_inner_frame) -relief sunken \
     -borderwidth 2
   frame .dframe3 -background $LAYOUT(display) -relief sunken -borderwidth 3
 
   canvas .display -background $LAYOUT(display) -highlightthickness 0 \
     -width [expr $dwid+($dwid+$swid)*$digits] -height $dspheight
 
   set id [.display create text 0 $ypos -font $LAYOUT(FnDisplay) -anchor nw]
   .display addtag d0 withtag $id
   for {set ii 1} {$ii < 11} {incr ii} {
     set jj [expr $ii-1]
     set id [.display create text [expr $dwid*$ii + $swid*$jj] $ypos \
       -font $LAYOUT(FnDisplay) -anchor nw]
     .display addtag d$ii withtag $id
     set id [.display create text [expr $dwid*($ii+1) + $swid*$jj] $ypos \
       -font $LAYOUT(FnDisplay) -anchor nw]
     .display addtag p$ii withtag $id
   }
 
 # Calculate positions for status display
   canvas .status -background $LAYOUT(display) -highlightthickness 0 \
     -width [expr $dwid+($dwid+$swid)*$digits] \
     -height [expr [font actual $LAYOUT(FnStatus) -size] * 1.5*$LAYOUT(FnScale)]
   set ypos 0
   foreach {tname xpos} {user 1.4 f 2.25 g 3.0 begin 4.6 rad 6.4 dmy 7.2 \
     complex 8.25 prgm 9.9} {
     set id [.status create text [expr $dwid + ($dwid + $swid)*$xpos] $ypos \
       -font $LAYOUT(FnDisplay) -anchor ne]
     .status addtag s$tname withtag $id
   }
   .status itemconfigure all -font $LAYOUT(FnStatus)
 
   pack .display .status -in .dframe3 -side top -anchor center \
     -expand no -padx 3
   pack .dframe3 -in .dframe2 -side top -expand no -padx 14
   pack .dframe2pad .dframe2 -in .dframe1 -side left -expand no -pady 11
 
   set logoscale [expr $LAYOUT(FnScale)/1.35]
   set logosize  [expr int(41*$LAYOUT(FnScale)/1.35)]
   canvas .logo -relief sunken -bd 0 -highlightthickness 0 -borderwidth 0 \
     -background $LAYOUT(display_inner_frame) -width $logosize \
     -height [expr $logosize+1]
   .logo create oval 9 3 28 23 -fill $LAYOUT(keypad_bg) \
     -outline $LAYOUT(keypad_bg)
   .logo create rectangle 16 2 21 3 -fill $LAYOUT(keypad_bg) \
     -outline $LAYOUT(keypad_bg)
   .logo create rectangle 16 22 21 22 -fill $LAYOUT(keypad_bg) \
     -outline $LAYOUT(keypad_bg)
   .logo create text $APPDATA(Char1x) $APPDATA(Char1y)\
     -anchor center -text $APPDATA(Char1) -font $LAYOUT(FnLogo1) \
     -fill $LAYOUT(display_inner_frame)
   .logo create text $APPDATA(Char2x) $APPDATA(Char2y)\
     -anchor center -text $APPDATA(Char2) -font $LAYOUT(FnLogo1) \
     -fill $LAYOUT(display_inner_frame)
   .logo create rectangle 0 24 36 25 -fill black -outline $LAYOUT(keypad_bg)
   .logo create text 19 32 -anchor center -text 15C \
     -font $LAYOUT(FnLogo2) -fill $LAYOUT(keypad_bg)
   .logo create rectangle 1 1 37 38 -outline $LAYOUT(keypad_bg) -width 3
   .logo scale all 0 0 $logoscale $logoscale
   pack .logo -in .dframe1 -expand no -side right -padx 10 -pady 10 -anchor n
   pack .dframe1 -side top -expand yes -fill x
   frame .sep1 -background $LAYOUT(keypad_bg) -height 6p -relief raised \
     -borderwidth 2
   pack .sep1 -side top -expand no -fill both
 
 # Layout the keypad
 
   frame .fkey -background $LAYOUT(keypad_bg) -relief groove
 
   frame .fkplu -background $LAYOUT(keypad_frame) -relief flat -width 3
   frame .fkpcu -background $LAYOUT(keypad_frame) -relief flat -height 3
   frame .keys -background $LAYOUT(keypad_bg) -relief flat
 
   foreach kk $HP15_KEYS {
     grid [hp_key "[lindex $kk 0][lindex $kk 1]" [lindex $kk 4] [lindex $kk 5]\
         [lindex $kk 6] [lindex $kk 3] [lindex $kk 7] [lindex $kk 8]\
         [lindex $kk 9]]\
       -in .keys -row [lindex $kk 0] -column [lindex $kk 1] \
       -rowspan [lindex $kk 2] -stick ns
   }
   for {set ii 1} {$ii <= 10} {incr ii} {
     grid configure .btn_1$ii -padx $LAYOUT(BtnPadX)
   }
   for {set ii 1} {$ii <= 10} {incr ii} {
     grid configure .btn_2$ii -pady $LAYOUT(BtnPadY)
     if {$ii != 6} {grid configure .btn_4$ii -pady $LAYOUT(BtnPadY)}
   }
 
 # Re-configure keys that differ from standard layout
 
 # Depending on operating system, font and Tcl/Tk version the ENTER button is
 # sometimes slightly to high because of its vertical label. Use small font here.
   .btn_36.btn configure -font $LAYOUT(FnEnter) -wraplength 1 -height 5
   .btn_41.btn configure -height 2
   .btn_42.btn configure -background $LAYOUT(fbutton_bg) -foreground black \
     -height 2
   .btn_42.gbtn configure -background $LAYOUT(fbutton_bg) -foreground black
   .btn_43.btn configure -background $LAYOUT(gbutton_bg) -foreground black \
     -height 2
   .btn_43.gbtn configure -background $LAYOUT(gbutton_bg) -foreground black
 
   frame .fkpcll -background $LAYOUT(keypad_frame) -relief flat \
     -width 7 -height 6
   label .fkpclc -background $LAYOUT(keypad_bg) -text $APPDATA(titleverywide) \
     -font $LAYOUT(FnBrand) -foreground $LAYOUT(keypad_frame)
   frame .fkpclr -background $LAYOUT(keypad_frame) -relief flat
   update
   .fkpclr configure -width \
      [expr [winfo reqwidth .keys] - [winfo reqwidth .fkpcll] - \
      [winfo reqwidth .fkpclc]]
 
   frame .fkpru -background $LAYOUT(keypad_frame) -relief flat -width 3
 
 # Gridding
   grid .fkplu -in .fkey  -row 0 -column 0 -rowspan 4 -sticky ns
   grid .fkpcu -in .fkey  -row 0 -column 1 -columnspan 3 -sticky nsew
   grid .keys -in .fkey -row 1 -column 1 -columnspan 3
   grid .fkpcll -in .fkey -row 3 -column 1 -sticky nsw
   grid .fkpclc -in .fkey -row 2 -column 2 -rowspan 3 -sticky w -ipadx 1
   grid .fkpclr -in .fkey -row 3 -column 3 -sticky nsew
   grid .fkpru -in .fkey -row 0 -column 4 -rowspan 4 -sticky ns
 
   pack .fkey -side top -expand yes -fill both -pady 2 -padx 2
 
 # Align display according to font settings, especially scale factor
   .dframe2pad configure -width \
     [expr round([winfo x .btn_11] + [winfo reqwidth .btn_11] + 12)]
 
 # Additional keyboard and mouse bindings not done in procedure 'hp_key'.
 # Distinguish between KeyPress and KeyRelease for some of the keys.
 
   bind . <KeyPress-Right> "key_press 21 21 %T"
   bind . <KeyRelease-Right> "key_release 21 21 %T"
   bind .btn_21.btn <ButtonPress-1> "key_press 21 21 %T"
   bind .btn_21.btn <ButtonRelease-1> "key_release 21 21 %T"
 
   bind . <KeyPress-Left> "key_press 21 43_21 %T"
   bind . <KeyRelease-Left> "key_release 21 43_21 %T"
   bind .btn_21.gbtn <ButtonPress-1> "key_press 21 43_21 %T"
   bind .btn_21.gbtn <ButtonRelease-1> "key_release 21 43_21 %T"
 
   # bind . <KeyPress-space> "key_press 35 42_35 %T"
   # bind . <KeyRelease-space> "key_release 35 42_35 %T"
   bind .btn_35.fbtn <ButtonPress-1> "key_press 35 42_35 %T"
   bind .btn_35.fbtn <ButtonRelease-1> "key_release 35 42_35 %T"
 
   bind . <KeyPress-i> "key_press 24 42_24 %T"
   bind . <KeyRelease-i> "key_release 24 42_24 %T"
   bind .btn_24.fbtn <ButtonPress-1> "key_press 24 42_24 %T"
   bind .btn_24.fbtn <ButtonRelease-1> "key_release 24 42_24 %T"
 
   bind .btn_45.gbtn <ButtonPress-1> "key_press 45 43_45 %T"
   bind .btn_45.gbtn <ButtonRelease-1> "key_release 45 43_45 %T"
 
  # We must handle NumLock state on our own under UNIX but not OSX
    if {$::tcl_platform(platform) == "unix"} {
      if {$::tcl_platform(os) == "darwin"} {
        foreach {kpk kcode} {Home 7 Up 8 Prior 9 Left 4 Begin 5 Right 6 \
          End 1 Down 2 Next 3 Insert 0} {
          bind . <KeyPress-KP_$kpk> "kp_key_press %s $kcode"
        }
        bind . <KeyPress-KP_Delete> "kp_key_press %s 48"
      }
    }
 
  # Pop-up menu bindings
 
   bind .btn_41.btn <ButtonPress-3> "show_on_options %b"
   bind .dframe1 <ButtonPress-3> "show_on_options %b"
   bind . <Alt-o> "show_on_options %b"
   bind . <F10> "show_on_options %b"
 
   bind .btn_42.btn <ButtonPress-1> "set_status f \n key_event 42 42"
   bind .btn_42.gbtn <ButtonPress-1> "set_status f \n key_event 42 42"
   bind . <f> "key_event 42 42\n set_status f"
 
   bind .btn_43.btn <ButtonPress-1> "set_status g \n key_event 43 43"
   bind .btn_43.gbtn <ButtonPress-1> "set_status g \n key_event 43 43"
   bind . <g> "key_event 43 43 \n set_status g"
 
   bind .btn_44.btn <ButtonPress-3> "show_storage 44 %b"
   bind . <Alt-m> "show_storage 44 %b"
   bind .btn_45.btn <ButtonPress-3> "show_storage 45  %b"
   bind . <Alt-r> "show_storage 45 %b"
   bind .btn_29.gbtn <ButtonPress-3> "show_flags %b"
   bind . <Alt-f> "show_flags %b"
   bind .btn_310.gbtn <ButtonPress-3> "show_test_options %b"
   bind . <Alt-t> "show_test_options %b"
 
   bind .btn_22.btn <ButtonPress-3> "func_gto_chs %b"
 
   bind .display <ButtonPress-3> "show_content %b"
   bind .status <ButtonPress-3> "show_content %b"
   bind . <Alt-s> "show_content %b"
 
 # Miscellaneous HP-15C function bindings
 
   bind . <Alt-period> "exchange_seps"
   bind . <Alt-comma> "exchange_seps"
 
   for {set ii 0} {$ii < 10} {incr ii} {
     bind . <Alt-Key-$ii> "dispatch_key 32_$ii"
   }
 
   bind . <MouseWheel> "disp_scroll %D"
 
   bind . <F11> {set HP15(mnemonics) [expr !$HP15(mnemonics)]}
   bind . <Alt-F11> {set HP15(prgmcoloured) [expr !$HP15(prgmcoloured)]}
 
 # Operating system related bindings
 
   bind . <F1> {help simulator}
   bind . <Control-F1> {help prgm}
   bind . <Control-c> "clipboard_set x"
   bind . <Control-v> "clipboard_get"
   bind . <ButtonPress-2> "clipboard_get"
   bind . <Control-m> "mem_save"
   bind . <Control-l> "mem_load"
   bind . <Control-o> "prgm_open"
   bind . <Control-s> "prgm_save"
 
 }
 
 # ------------------------------------------------------------------------------
 # Startup procedure
 
 # Clear everything and reload previous session
 clearall
 mem_load
 
 # Draw the GUI and define key bindings
 gui_draw
 
 trace variable stack(x) w show_x
 trace variable curdisp w disp_update
 trace variable FLAG(9) w disp_flash
 
 # Update the display
 show_x
 set_status NIL
 
 # Check for browser configuration
 if ![string length $HP15(browser)] {
   set HP15(browser) [lindex [browser_lookup] 1]
 }
 
 # ------------------------------------------------------------------------------
 # Window manager configuration & communication
 
 wm protocol . WM_DELETE_WINDOW {exit_handler}
 wm title . " $APPDATA(titleshort) "
 wm iconname . " $APPDATA(titleshort) "
 wm resizable . false false
 
 option add *Dialog.msg.font $LAYOUT(FnMenu) userDefault
 
 # ------------------------------------------------------------------------------
 # And now show the interface in all it's beauty...
 wm deiconify .

New version 1.2.05 available from the MoHPC (see link above) - Torsten Above code now 1.2.05. I also made the "IQ" vs "HP" thing optional - Larry Smith

I am currently very happy to use 1.2.02 but wanted to upgrade since I found a bug: launch the calculator and hit space. You get some "Internal Tcl/Tk Error: can't set "curdisp": can't read "llcd(+)": no such element in array, while executing... etc ...

Larry SmithFixed in this version. I hope. The code was reacting to a space by trying to output more than 11 character spaces of the display. When using the font, there is a flicker and then something more reasonable is displayed, but the LCD engine blew up. To fix it I removed the space dispatch binding (commented out above). Hope it doesn't break anything else.

"Link above" meant the link at the very top (sorry). A more general link is [1]. The error when hitting the space bar is specific to Larry's version.

Version 1.2.08 of the original simulator should be out in a week or so. Several bug fixes and support for Windows Vista. - Torsten Larry Smith Looking forward to it.

Replace the lines at approx 4430-4436 with this:
 # We must handle NumLock state on our own under UNIX but not OSX

Larry Smith Corrected above.

I am having some problems running this on OSX 10.4.11. The logic works fine but the display is very odd with some (not all) unicode characters displaying as empty boxes. I upgraded to TclTKAqua-8.4.10 but this did not fix the problem. Any suggestions? Larry Smith I think this implies that there is no version of the desired glyph in any of Tcl's font search.

[DaveUssell] - 2012-08-20 14:42:52

Torsten Manz has done an excellent job on the HP-15 simulation but yesterday I noticed the arctangent of 1 is not 0.79 grads/0.79 radians and 0.79 degrees. It is 50 grads/0.79 radians and 45°. There may be other errors. Please let me know if this has been corrected in an updated version. Thanks. Dave Ussell dave(at)ussell.org

dcd Did you switch to the desired angle mode before you computed the answer? It's giving me the correct answers.

Torsten - 2012.09.03

Please be aware that Larry's work is based on a very old version of the simulator. With each update I update the wiki at HP-15 Simulation.

For support requests and bug reports an e-mail to the mail address on the simulator home page is the most efficient way to communicate with me.