weeCalc

2004-08-02 SRIV weeCalc: a proof of concept calculator app for weeDesk. I know the name was reserved for a speadsheet app, but until someone takes 10 minutes to code one up, this will be weeCalc.

Background: This app was originally a Visual Tcl project that I coded for my linux iPaq, hence the dimensions. The buttons are big enough to be easily operated by my index fingers. I gutted all the Vtcl crap out, Still needs a lot of reformatting to make it readable, so dont complain about its ugliness. This calculator script runs fine from wish or tclkit. I use it as my everyday calculator app.

Here's a screenshot:

http://www.sriv.net/images/weedesk1.png

01Nov04 SRIV Updated to version 1.3 WeeCalc to handle octal and binary numbers! Get calc.tk from http://www.sr-tech.com/testing/calc.tk and save this file as calc.tk in the same directory as weeDesk. Then, add these lines to the end of weedesk.tcl:

 #start of weeCalc code
 pack forget .win1.t
 set base .win1
 source calc.tk
 bind .win1.ent38 <ButtonPress-1> "winSelect .win1"

07oct04 jcw - Steve, is your identcl-as-a-weeApp code public? It could be nice under GooWee, what it needs for that is a way to use an arbitrary frame as "toplevel".

Larry Smith Latest version, courtesy of Michael Doyle and Eolas.


 #
 #                    H E W L E T T · P A C K A R D  15C
 #
 #                      A simulator written in Tcl/TK
 #
 #                        © 1997-2005 Torsten Manz
 #                  extensive mods by Larry Smith 1/20/06
 #
 # ------------------------------------------------------------------------------
 #
 # 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
 
 # ------------------------------------------------------------------------------
 # 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 11
 
  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 showLCD { n1 n2 op } {
     global curdisp llcd lcdshape eurostyle dwidth
 
     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
 
 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"
   version 1.2.02
   copyright "COPYRIGHT \u00A9 1997-2005, Torsten Manz, et al"
   filetypes {{"IQ-15C Programs" {.15c}} {"Text files" {.txt}}}
 }
 set APPDATA(SerialNo) "4537G0[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 #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
 }
   # display_outer_frame #F1F6F5
 
 # 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} 18"
     FnLogo2 "{Sans} 12 bold"
     FnMenu "{Courier} 12 bold"
   }}
   { {"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} 18"
     FnLogo2 "{Sans} 12 bold"
     FnMenu "{Courier} 12 bold"
   }}
   { {"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} 18"
     FnLogo2 "{Sans} 12 bold"
     FnMenu "{Courier New} 12 bold"
   }}
   { {"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} 18"
     FnLogo2 "{Sans} 10 bold"
     FnMenu "{Courier} 10 bold"
   }}
   { {"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} 18"
     FnLogo2 "{Sans} 10 bold"
     FnMenu "{Courier} 12 bold"
   }}
   { {"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} 18"
     FnLogo2 "{Sans} 10 bold"
     FnMenu "{Courier New} 12 bold"
   }}
   { {"unix" "Microsoft fonts" 81 135} {
     FnDisplay "{Sans} 26"
     FnStatus "{Microsoft Sans Serif} 8"
     FnButton "Arial 12 bold"
     FnEnter "Arial 10 bold"
     FnFGBtn "Arial 9 bold"
     FnBrand "Arial 9 bold"
     FnLogo1 "{Chancery} 18"
     FnLogo2 "{Sans} 10 bold"
     FnMenu "{Courier New} 12 bold"
   }}
   { {"windows" "Microsoft fonts, small" 91 135} {
     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} 12"
     FnLogo2 "{Sans} 9 bold"
     FnMenu "{Courier New} 10 bold"
   }}
   { {"windows" "Microsoft fonts" 91 135} {
     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} 12"
     FnLogo2 "{Sans} 9 bold"
     FnMenu "{Courier New} 10 bold"
   }}
   { {"windows" "URW fonts, small" 91 135} {
     FnDisplay "{Sans} 17"
     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} 18"
     FnLogo2 "{Sans} 9 bold"
     FnMenu "{Courier New} 10 bold"
   }}
 }
 
 # 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) 8
   }
   unix {
     set APPDATA(memfile) ".hp-15c.mem"
     set APPDATA(exetypes) {{"All files" {*}}}
     set APPDATA(browserlist) {mozilla firefox 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 3
   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-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} {} }
   { 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 {
       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]
     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}
 
 }
 
 set oldLCD ""
 proc disp_flash { p1 p2 p3 } {
   global curdisp oldLCD HP15 FLAG
 
   set save $curdisp
   if { $oldLCD == "" } {
     set oldLCD $curdisp
     set curdisp "          "
     update
   } else {
     set curdisp $oldLCD
     set oldLCD ""
     if !$FLAG(9) {
       after $HP15(flash) disp_flash 1 1 1
     }
   }
 }
 # ------------------------------------------------------------------------------
 proc mem_save {} {
 
   global APPDATA HP15 status stack istack storage prgstat PRGM FLAG
 
   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 "Radix: (.) or (,)" -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) $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 PI status 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 PI
 
   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} {
       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 minutes [expr int(($stack(x) - $hours)*60.0)/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 minutes [expr int(($stack(x) - $hours)*100.0)]
   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 remove variable stack(x) write 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 add variable stack(x) write 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_apply { fsn } {
   global LAYOUT FONTSET HP15
 
   set fslist [lindex $FONTSET $fsn]
   foreach {fs fnt} [lindex $fslist 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 FONTSET PREFTEXT
 
   array set HP15tmp [array get HP15]
   if [winfo exists .pre
   fs] {
     place forget .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)
 
     set dpi [expr round([tk scaling]*72)]
     label $fpo.info -anchor nw -justify left \
       -text "Available font sets for $::tcl_platform(os) at $dpi dpi:"
 
     frame $fpo.fs
     set fsn 0
     foreach fs $FONTSET {
       set cfs [lindex $fs 0]
       if {$::tcl_platform(platform) == [lindex $cfs 0] && \
           $dpi >= [lindex $cfs 2] && $dpi <= [lindex $cfs 3]} {
         radiobutton $fpo.fs.$fsn -text "[lindex $cfs 1]" -value $fsn \
           -variable HP15tmp(fontset)
         pack $fpo.fs.$fsn -side top -anchor w -padx 10
       }
       incr fsn
     }
     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}
     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
     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 (yellow) 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 digits dwidth dheight
 
 # Layout display and logo
   fontset_apply $HP15(fontset)
 
   . configure -background $LAYOUT(keypad_bg)
 
   set dwid 18
   set swid [expr int($dwid * 0.5)]
   set ypos 8
   set dspheight [ expr round($dheight * 1.35) ]
 
   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 $dwidth*$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)*10] \
     -height [expr [font actual $LAYOUT(FnStatus) -size] * 2]
   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
 
   canvas .logo -relief sunken -bd 0 -highlightthickness 0 -borderwidth 0 \
     -background $LAYOUT(display_inner_frame) -width 40 -height 41
   .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 18 14 -anchor center -text IQ -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
 
   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 "  I  N  T  E  L  L  I  G  E  N  C  E     Q  U  O  T  I  E  N  T   " \
     -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
   if {$::tcl_platform(platform) == "unix"} {
     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
 gui_draw
 
 trace add variable stack(x) write show_x
 trace add variable curdisp write showLCD
 trace add variable FLAG(9) write 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(titlewide)"
 wm iconname . "IQ-15C"
 wm resizable . false false
 
 option add *Dialog.msg.font $LAYOUT(FnMenu) userDefault
 
 # ------------------------------------------------------------------------------
 # And now show the interface in all it's beauty...
 update