Form DEMO_CALCULATOR_FORM /* /* © Copyright 2005 Hewlett-Packard Development Company, L.P. /* /* Consistent with FAR 12.211 and 12.212, Commercial Computer Software, /* Computer Software Documentation, and Technical Data for Commercial /* Items are licensed to the U.S. Government under vendor's standard /* commercial license. /* /**/ /************************************************************************ /* /* This form demonstrates how you can do some /* things in IFDL, without any program involvement. /* /* /* This form shows examples of: /* /* HIGHLIGHT WHENS /* It shows how HIGHLIGHT WHENS are applied immediately, as soon as /* the when condition changes. (This is how the flashing is done.) /* /* INCREMENTING AN ARRAY INDEX /* It shows a method for getting around the "no arithmetic" restriction /* in IFDL, when you need to access the *next* element in an array. /* (Essentially a LET X = X + 1 operation) /* /*********************************************************************/ /* /* 01-Mar-89 JEF Original /* /*********************************************************************/ Form Data /* DISPLAY VARIABLES */ /* Display only field used for the sign of the calculated result */ SIGN_DISPLAY Character(1) Value "+" /* Display only field. When this data item is assigned a new value the result is dispalyed immediately in the EXTERNAL_DISPLAY field */ EXTERNAL_DISPLAY DECIMAL(17,2) Value 0 /* An internal data item that may contain a decimal point*/ INTERNAL_DISPLAY Character(20) VARYING Value "0" /* An internal data item that may *NOT* contain a decimal point */ internal_register Character(20) VARYING Value "0" /* A temporary internal string variable */ TEMP_DISPLAY Character(20) VARYING Value "0" /* A temporary internal integer variable */ NUM_INTEGER Longword Integer /* Internal Arithmetic Registers */ accum_sign Unsigned Longword accum_exp Longword Integer accumulator Character(18) VARYING Value "0" bsign Unsigned Longword bexp Longword Integer b_register Character(18) VARYING Value "0" result_sign Unsigned Longword result_exp Longword Integer result_register Character(18) VARYING Value "0" xsign Unsigned Longword xexp Longword Integer x_register Character(18) VARYING Value "0" ysign Unsigned Longword yexp Longword Integer y_register Character(18) VARYING Value "0" zsign Unsigned Longword zexp Longword Integer z_register Character(18) VARYING Value "0" /* Temporary Numeric variable */ Number Longword Integer /* String division constants */ precision Longword Integer Value 2 Round Unsigned Longword Value 1 /* Misc. String RTL variables */ str_length Unsigned Word Value 0 str_address Unsigned Longword Value 0 /* Constants */ TRUE Unsigned Byte Value 1 FALSE Unsigned Byte Value 0 NULLC Character(1) Value "" NULL Unsigned Byte Value 0 /* Enumerated Types */ /* Addition subop values */ ADDITION Unsigned Byte Value 1 SUBTRACTION Unsigned Byte Value 2 MULTIPLICATION Unsigned Byte Value 3 /* LAST_KEYPRESS values */ NUMERIC Unsigned Byte Value 1 TERMINATOR Unsigned Byte Value 2 EQUALS Unsigned Byte Value 3 CLEAR Unsigned Byte Value 4 /* Booleans */ POINT_DISPLAYED Unsigned Byte Value 0 /* False */ First_Number Unsigned Byte Value 1 /* True */ INITIAL_STATE Unsigned Byte Value 1 /* True */ Sign_Set Unsigned Byte Value 0 /* False */ demo_error Unsigned Byte Value 0 /* False */ /* Miscellaneous */ char_count Character(2) VARYING Value "0" /* Sub-operation variable used to determine which internal response included the addition response */ Sub_Op Unsigned Byte Value 0 /* Variable containing current arithmetic operation to be performed */ LAST_OP Character(1) /* Variables containing current and last key pressed */ KEYSAVE Character(1) KEYPRESS Character(1) /* Variables containing the type of last key pressed */ LAST_KEYPRESS Unsigned Byte Value 0 /* Variable containing next arithmetic operation to be performed */ OPERATOR Character(1) /* Return status from all RTL routines called */ STATUS Unsigned Longword /* STR$ RTL parameters */ start_pos Longword Integer end_pos Longword Integer /* Array of constants used to decrement and take the absolute value of integers from -19 to +20 */ Group NUMR /* Integer Array */ Occurs 40 Base -19 DECR_X Longword Integer /* Used to do X = X - 1 */ ABS_X Longword Integer /* Used to do |X| */ End Group End Data Layout VT_LAYOUT Device Terminal Type %VT100 End Device Size 24 Lines by 80 Columns Viewport VIEW_CALC Lines 2 Through 20 Columns 20 Through 53 End Viewport Function KEY_PRESS_0 Is %KP_0 End Function Function KEY_PRESS_1 Is %KP_1 End Function Function KEY_PRESS_2 Is %KP_2 End Function Function KEY_PRESS_3 Is %KP_3 End Function Function KEY_PRESS_4 Is %KP_4 End Function Function KEY_PRESS_5 Is %KP_5 End Function Function KEY_PRESS_6 Is %KP_6 End Function Function KEY_PRESS_7 Is %KP_7 End Function Function KEY_PRESS_8 Is %KP_8 End Function Function KEY_PRESS_9 Is %KP_9 End Function Function KEY_PRESS_MINUS Is %KP_MINUS End Function Function KEY_PRESS_PLUS Is %KP_COMMA End Function Function KEY_PRESS_MULT Is %PF4 End Function Function KEY_PRESS_DIV Is %PF3 End Function Function KEY_PRESS_CLEAR Is %PF1 End Function Function KEY_PRESS_OFF Is %PF2 End Function Function KEY_PRESS_EQUALS Is %KP_ENTER End Function Function KEY_PRESS_POINT Is %KP_PERIOD End Function Function SELECT Is %SELECT End Function Internal Response ABS_VAL If ((NUMBER < -19) OR (NUMBER > 20)) Then Message "DEMO-F-ABSVAL Value out of range... Aborting Calculator Demo" Return Immediate Else Let NUMBER = NUMR(NUMBER).ABS_X /* Let X = | X | */ End If End Response Internal Response CHECK_STR_STATUS If (STATUS <> 1) Then Message "DEMO-E-STR String PEU Error" End If End Response Internal Response RESET_INTERNALS Let INTERNAL_DISPLAY = "0" Let INTERNAL_REGISTER = "0" Let POINT_DISPLAYED = FALSE Let CHAR_COUNT = "0" End Response Internal Response DO_DIVIDE Let NUM_INTEGER = B_REGISTER If (NUM_INTEGER <> 0) Then Call "str$divide" Using By Reference ACCUM_SIGN By Reference ACCUM_EXP By Descriptor ACCUMULATOR By Reference BSIGN By Reference BEXP By Descriptor B_REGISTER By Reference PRECISION By Reference ROUND By Reference RESULT_SIGN By Reference RESULT_EXP By Descriptor RESULT_REGISTER Giving STATUS If (STATUS <> 1) Then Message "Internal Division Error... All Registers Cleared" Let DEMO_ERROR = TRUE Include CLEAR_ALL End If Else Message "Internal Division Error... Divide by Zero attempted" End If End Response Internal Response ADD_ROUTINE Call "str$add" Using By Reference ACCUM_SIGN By Reference ACCUM_EXP By Descriptor ACCUMULATOR By Reference BSIGN By Reference BEXP By Descriptor B_REGISTER By Reference RESULT_SIGN By Reference RESULT_EXP By Descriptor RESULT_REGISTER Giving STATUS If (STATUS <> 1) Then If (SUB_OP = ADDITION) Then Message "Internal Addition Error... All Registers Cleared" Else If (SUB_OP = SUBTRACTION) Then Message "Internal Subtraction Error... All Registers Cleared" Else If (SUB_OP = MULTIPLICATION) Then Message "Internal Multiplication Error... All Registers Cleared" Else Message "DEMO-F-SUBOP Fatal Internal Error... Aborting Calculator Demo" Return Immediate End If End If End If Let DEMO_ERROR = TRUE Include CLEAR_ALL End If End Response Internal Response INTERNAL_ADD /* Special add routine used by the calculator form to do internal arithmetic. Use of a separate internal response allows separation of register variables that would otherwise need to be saved and restored if just one internal response were used. */ Call "str$add" Using By Reference XSIGN By Reference XEXP By Descriptor X_REGISTER By Reference YSIGN By Reference YEXP By Descriptor Y_REGISTER By Reference ZSIGN By Reference ZEXP By Descriptor Z_REGISTER Giving STATUS If (STATUS <> 1) Then Message "DEMO-F-ADDINT Fatal Internal Error Bad special ADD" Return Immediate End If If (ZEXP > 0) Then Call "str$dupl_char" Using By Descriptor TEMP_DISPLAY By Reference ZEXP By Reference "0" Include CHECK_STR_STATUS Call "str$append" Using By Descriptor Z_REGISTER By Descriptor TEMP_DISPLAY Giving STATUS Include CHECK_STR_STATUS Let ZEXP = 0 End If End Response Internal Response DO_ADDITION Let SUB_OP = ADDITION Include ADD_ROUTINE End Response Internal Response DO_SUBTRACTION /* Negate sign of second argument */ If (BSIGN = 1) Then Let BSIGN = 0 Else If (BSIGN = 0) Then Let BSIGN = 1 Else Message "Internal Sign Error... All Registers Cleared" Let DEMO_ERROR = TRUE Include CLEAR_ALL End If End If /* Set the suboperation value */ Let SUB_OP = SUBTRACTION Include ADD_ROUTINE End Response Internal Response DO_MULTIPLY Call "str$mul" Using By Reference ACCUM_SIGN By Reference ACCUM_EXP By Descriptor ACCUMULATOR By Reference BSIGN By Reference BEXP By Descriptor B_REGISTER By Reference RESULT_SIGN By Reference RESULT_EXP By Descriptor RESULT_REGISTER Giving STATUS If (STATUS <> 1) Then Message "Internal Multiplication Error... All Registers Cleared" Let DEMO_ERROR = TRUE Include CLEAR_ALL Else /* Store the answer in the accumulator */ Let ACCUM_SIGN = RESULT_SIGN Let ACCUM_EXP = RESULT_EXP Let ACCUMULATOR = RESULT_REGISTER End If End Response Internal Response DECR_INT /* Alternate method for decrementing an integer using a table in the form of a group (array) instead of a string arithmetic RTL routine */ If ((NUMBER < -19) OR (NUMBER > 20)) Then Message "DEMO-E-DECR Integer Decrement Error" Else Let NUMBER = NUMR(NUMBER).DECR_X /* Let X = X - 1 */ End If End Response Internal Response CLEAR_BC_NUMERICS /* Clear all registers except the first arguments to the STR$ arithmetic routines */ Let BEXP = 0 Let BSIGN = 0 Let B_REGISTER = "0" Let RESULT_EXP = 0 Let RESULT_SIGN = 0 Let RESULT_REGISTER = "0" End Response Internal Response CLEAR_STRING_NUMERICS /* Clear all registers including first arguments to the STR$ arithmetic routines and internal display variables*/ Let ACCUM_EXP = 0 Let ACCUM_SIGN = 0 Let ACCUMULATOR = "0" Include CLEAR_BC_NUMERICS Let INTERNAL_REGISTER = "0" Let INTERNAL_DISPLAY = "0" Let TEMP_DISPLAY = "0" End Response Internal Response CLEAR_ALL /* Clear all registers and other non-constant form data items to initial values. */ /* Flash the key on and off */ Let KEYPRESS = "C" Let KEYPRESS = NULLC Let LAST_KEYPRESS = CLEAR Let INTERNAL_DISPLAY = "0" Let EXTERNAL_DISPLAY = "0" Let POINT_DISPLAYED = FALSE Let FIRST_NUMBER = TRUE Let SIGN_DISPLAY = "+" Let OPERATOR = NULLC Let INITIAL_STATE = TRUE If (DEMO_ERROR = FALSE) Then Message "ALL CLEARED" Else Let DEMO_ERROR = FALSE End If Let CHAR_COUNT = "0" Include CLEAR_STRING_NUMERICS End Response Internal Response CLEAR_ENTRY /* Clear the current display and associated registers. */ /* Flash the key on and off */ Let KEYPRESS = "C" Let KEYPRESS = NULLC Let LAST_KEYPRESS = CLEAR Let INTERNAL_DISPLAY = "0" Let EXTERNAL_DISPLAY = "0" Let INTERNAL_REGISTER = "0" Let INTERNAL_DISPLAY = "0" Let TEMP_DISPLAY = "0" Let POINT_DISPLAYED = FALSE Let SIGN_DISPLAY = "+" Let CHAR_COUNT = "0" Message "ENTRY CLEARED" End Response Internal Response BUILD_DISPLAY /* Build internal representation of the display in INTERNAL_DISPLAY from result_register of STR$ RTL arithmetic routines */ If (RESULT_EXP > 0) Then Let INTERNAL_DISPLAY = RESULT_REGISTER /* The resulting number is an integer to be multiplied by positive power of 10 (one or more trailing zeros) */ Call "str$dupl_char" Using By Descriptor TEMP_DISPLAY By Reference RESULT_EXP By Reference "0" Call "str$append" Using By Descriptor INTERNAL_DISPLAY By Descriptor TEMP_DISPLAY Giving STATUS Include CHECK_STR_STATUS Else If (RESULT_EXP < 0) Then /* The resulting number has a fractional part */ /* Calculate substring positions of integer and fractional parts from the value of the resulting exponent */ Call "str$analyze_sdesc" Using By Descriptor RESULT_REGISTER By Reference STR_LENGTH By Reference STR_ADDRESS Giving STATUS Let X_REGISTER = STR_LENGTH Let XSIGN = 0 Let XEXP = 0 Let NUMBER = RESULT_EXP Include ABS_VAL Let Y_REGISTER = NUMBER If (Y_REGISTER < X_REGISTER) Then Let YSIGN = 1 Let YEXP = 0 Include INTERNAL_ADD Let END_POS = Z_REGISTER Let X_REGISTER = Z_REGISTER Let Y_REGISTER = "1" Let YSIGN = 0 Include INTERNAL_ADD Let START_POS = Z_REGISTER Call "str$left" Using By Descriptor INTERNAL_DISPLAY By Descriptor RESULT_REGISTER By Reference END_POS Giving STATUS Include CHECK_STR_STATUS Call "str$append" Using By Descriptor INTERNAL_DISPLAY By Descriptor "." Giving STATUS Include CHECK_STR_STATUS Call "str$right" Using By Descriptor TEMP_DISPLAY By Descriptor RESULT_REGISTER By Reference START_POS Giving STATUS Include CHECK_STR_STATUS Call "str$append" Using By Descriptor INTERNAL_DISPLAY By Descriptor TEMP_DISPLAY Giving STATUS Include CHECK_STR_STATUS Else If (RESULT_EXP < -2) Then /* In this case only zero is displayed because the decimal is fixed at two places and the result is less than .01 */ Let INTERNAL_DISPLAY = ".00" Else Let INTERNAL_DISPLAY = RESULT_REGISTER If ((RESULT_EXP = -2) AND (STR_LENGTH = 1)) Then /* This covers a special case where the result is equivalent to .0x */ Call "str$prefix" Using By Descriptor INTERNAL_DISPLAY By Descriptor "0" Giving STATUS Include CHECK_STR_STATUS End If /* Prepend the decimal point to ensure proper alignment in the external display */ Call "str$prefix" Using By Descriptor INTERNAL_DISPLAY By Descriptor "." Giving STATUS Include CHECK_STR_STATUS End If End If Else /* result_exp = 0 */ /* The resulting number is an integer without trailing zeros. However, we must cover a special case where X minus X = zero. In this case the result string has a length of one but the string is *not* equal to any of the characters "0" through "9". */ Call "str$analyze_sdesc" Using By Descriptor RESULT_REGISTER By Reference STR_LENGTH By Reference STR_ADDRESS Giving STATUS If (STR_LENGTH = 1) Then Call "str$find_first_in_set" Using By Descriptor RESULT_REGISTER By Descriptor "0123456789" Giving STATUS If (STATUS = 0) Then Let RESULT_REGISTER = "0" End If End If Let INTERNAL_DISPLAY = RESULT_REGISTER End If /* result_exp < 0 */ End If /* result_exp > 0 */ /* Set the sign in the display */ If (RESULT_SIGN = 0) Then Let SIGN_DISPLAY = "+" Else If (RESULT_SIGN = 1) Then Let SIGN_DISPLAY = "-" End If End If End Response Internal Response NUMERIC_KEY_RESP /* This response is performed after every numeric key press (including the decimal point). A check in made to see if the display might be overflowed. If not, the character equivalent to the key press is appended to the current internal representaion of the display and then moved to the external display. */ /* Flash the key on and off */ Let KEYPRESS = KEYSAVE Let KEYPRESS = NULLC /* Increment character count and check to to see if the display string has grown too long */ Let X_REGISTER = CHAR_COUNT Let XSIGN = 0 Let XEXP = 0 Let Y_REGISTER = "1" Let YSIGN = 0 Let YEXP = 0 Include INTERNAL_ADD Let CHAR_COUNT = Z_REGISTER If (CHAR_COUNT = "14") Then /* There are too many characters to be displayed */ Message "DEMO-E-NUM2BIG Display number too large" Else /* Continue appending characters to the internal representations of the display */ /* Clear the message area */ Message " " /* Set state booleans */ Let INITIAL_STATE = FALSE /* Set the displayed sign */ If (SIGN_SET = FALSE) Then Let SIGN_DISPLAY = "+" Let SIGN_SET = TRUE End If If (LAST_KEYPRESS = EQUALS) Then /* If the last key pressed was the EQUALS key, clear the arithmetic registers and reset the First_Number boolean */ Include CLEAR_STRING_NUMERICS Let FIRST_NUMBER = TRUE End If If KEYSAVE <> "0" OR (KEYSAVE = "0" AND (LAST_KEYPRESS = NUMERIC OR LAST_KEYPRESS = TERMINATOR OR LAST_KEYPRESS = EQUALS) ) Then /* NOTE: Do not append succesive zeros if the numeric value of the display is zero */ If (POINT_DISPLAYED = TRUE) Then /* If the decimal point has been used in this number, decrement the exponent for the appropriate register */ If (FIRST_NUMBER = TRUE) Then Let NUMBER = ACCUM_EXP Else Let NUMBER = BEXP End If Include DECR_INT If (FIRST_NUMBER = TRUE) Then Let ACCUM_EXP = NUMBER Else Let BEXP = NUMBER End If End If /* Append each succeeding keystroke to internal representations and display the results */ Call "str$append" Using By Descriptor INTERNAL_DISPLAY By Descriptor KEYSAVE Giving STATUS Include CHECK_STR_STATUS Call "str$append" Using By Descriptor INTERNAL_REGISTER By Descriptor KEYSAVE Giving STATUS Include CHECK_STR_STATUS Let EXTERNAL_DISPLAY = INTERNAL_DISPLAY /* Set the last keypress */ Let LAST_KEYPRESS = NUMERIC End If End If End Response Internal Response EXECUTE_OP /* Execute current pending arithemetic operation */ If (LAST_OP = "+") Then Include DO_ADDITION Else If (LAST_OP = "-") Then Include DO_SUBTRACTION Else If (LAST_OP = "*") Then Include DO_MULTIPLY Else If (LAST_OP = "/") Then Include DO_DIVIDE Else Message "DEMO-F-LASTOP Unknown operator type... Aborting Calculator Demo" Return Immediate End If End If End If End If If (RESULT_EXP > 0) Then /* Check the length of the result_register string for overflow */ Call "str$analyze_sdesc" Using By Descriptor RESULT_REGISTER By Reference STR_LENGTH By Reference STR_ADDRESS Giving STATUS Let X_REGISTER = STR_LENGTH Let XSIGN = 0 Let XEXP = 0 Let Y_REGISTER = RESULT_EXP Let YSIGN = 0 Let YEXP = 0 Include INTERNAL_ADD If (Z_REGISTER > 13) Then Message "DEMO-E-OFLO Result is too large... All Registers cleared" Let DEMO_ERROR = TRUE Include CLEAR_ALL End If End If If (RESULT_EXP < -19) Then /* Checked for underflow. This implementation will internally handle 1 times 10 to the -10 before underflow occurs. However, only two significant digits to the right of the point will be displayed */ Message "DEMO-E-UFLO Result is too small... All Registers cleared" Let DEMO_ERROR = TRUE Include CLEAR_ALL End If End Response Internal Response DO_CALCULATION /* Flash the key on and off */ Let KEYPRESS = OPERATOR Let KEYPRESS = NULLC Message " " Let LAST_KEYPRESS = TERMINATOR If (FIRST_NUMBER = TRUE) Then /* Store the number */ Let ACCUMULATOR = INTERNAL_REGISTER Let FIRST_NUMBER = FALSE Else If (LAST_OP = NULLC) Then /* This is going to be a chained calculation */ Let LAST_OP = OPERATOR Else /* Store the second number and perform the calculation */ Let B_REGISTER = INTERNAL_REGISTER Include EXECUTE_OP /* Store the answer in the accumulator */ Let ACCUM_SIGN = RESULT_SIGN Let ACCUM_EXP = RESULT_EXP Let ACCUMULATOR = RESULT_REGISTER /* Display the Results */ Include BUILD_DISPLAY Let EXTERNAL_DISPLAY = INTERNAL_DISPLAY /* Clear the non-accumulator registers */ Include CLEAR_BC_NUMERICS End If End If Include RESET_INTERNALS /* Move last operator key pressed to next operation pending */ Let LAST_OP = OPERATOR End Response Internal Response DO_POINT Let KEYSAVE = "." /* Flash the key on and off */ Let KEYPRESS = KEYSAVE Let KEYPRESS = NULLC Let INITIAL_STATE = FALSE If (SIGN_SET = FALSE) Then Let SIGN_DISPLAY = "+" Let SIGN_SET = TRUE End If /* Only one decimal point may be displayed for a given number */ If (POINT_DISPLAYED = FALSE) Then Call "str$append" Using By Descriptor INTERNAL_DISPLAY By Descriptor KEYSAVE Giving STATUS Include CHECK_STR_STATUS Let EXTERNAL_DISPLAY = INTERNAL_DISPLAY Let LAST_KEYPRESS = NUMERIC Let POINT_DISPLAYED = TRUE Else Message "Only one decimal point per number." End If End Response Internal Response DO_EQUALS Let KEYSAVE = "=" /* Flash the key on and off */ Let KEYPRESS = KEYSAVE Let KEYPRESS = NULLC Let LAST_KEYPRESS = EQUALS Let SIGN_SET = FALSE /* If there is a calcultion pending, execute it */ If (OPERATOR <> NULLC) Then /* Load the second register */ Let B_REGISTER = INTERNAL_REGISTER Include EXECUTE_OP /* Load the results into the accumulator for possible chained calculations */ Let ACCUMULATOR = RESULT_REGISTER Let ACCUM_SIGN = RESULT_SIGN Let ACCUM_EXP = RESULT_EXP Include BUILD_DISPLAY Let EXTERNAL_DISPLAY = INTERNAL_DISPLAY /* Reset registers and other internals */ Let OPERATOR = NULLC Let LAST_OP = NULLC Include CLEAR_BC_NUMERICS Include RESET_INTERNALS End If End Response Enable Response /* Perform all Calculator form initialization. Initialize the Decrement and Absolute value array constants */ Let NUMR(-19).DECR_X = -20 Let NUMR(-18).DECR_X = -19 Let NUMR(-17).DECR_X = -18 Let NUMR(-16).DECR_X = -17 Let NUMR(-15).DECR_X = -16 Let NUMR(-14).DECR_X = -15 Let NUMR(-13).DECR_X = -14 Let NUMR(-12).DECR_X = -13 Let NUMR(-11).DECR_X = -12 Let NUMR(-10).DECR_X = -11 Let NUMR(-9).DECR_X = -10 Let NUMR(-8).DECR_X = -9 Let NUMR(-7).DECR_X = -8 Let NUMR(-6).DECR_X = -7 Let NUMR(-5).DECR_X = -6 Let NUMR(-4).DECR_X = -5 Let NUMR(-3).DECR_X = -4 Let NUMR(-2).DECR_X = -3 Let NUMR(-1).DECR_X = -2 Let NUMR(0).DECR_X = -1 Let NUMR(1).DECR_X = 0 Let NUMR(2).DECR_X = 1 Let NUMR(3).DECR_X = 2 Let NUMR(4).DECR_X = 3 Let NUMR(5).DECR_X = 4 Let NUMR(6).DECR_X = 5 Let NUMR(7).DECR_X = 6 Let NUMR(8).DECR_X = 7 Let NUMR(9).DECR_X = 8 Let NUMR(10).DECR_X = 9 Let NUMR(11).DECR_X = 10 Let NUMR(12).DECR_X = 11 Let NUMR(13).DECR_X = 12 Let NUMR(14).DECR_X = 13 Let NUMR(15).DECR_X = 14 Let NUMR(16).DECR_X = 15 Let NUMR(17).DECR_X = 16 Let NUMR(18).DECR_X = 17 Let NUMR(19).DECR_X = 18 Let NUMR(20).DECR_X = 19 Let NUMR(-19).ABS_X = 19 Let NUMR(-18).ABS_X = 18 Let NUMR(-17).ABS_X = 17 Let NUMR(-16).ABS_X = 16 Let NUMR(-15).ABS_X = 15 Let NUMR(-14).ABS_X = 14 Let NUMR(-13).ABS_X = 13 Let NUMR(-12).ABS_X = 12 Let NUMR(-11).ABS_X = 11 Let NUMR(-10).ABS_X = 10 Let NUMR(-9).ABS_X = 9 Let NUMR(-8).ABS_X = 8 Let NUMR(-7).ABS_X = 7 Let NUMR(-6).ABS_X = 6 Let NUMR(-5).ABS_X = 5 Let NUMR(-4).ABS_X = 4 Let NUMR(-3).ABS_X = 3 Let NUMR(-2).ABS_X = 2 Let NUMR(-1).ABS_X = 1 Let NUMR(0).ABS_X = 0 Let NUMR(1).ABS_X = 1 Let NUMR(2).ABS_X = 2 Let NUMR(3).ABS_X = 3 Let NUMR(4).ABS_X = 4 Let NUMR(5).ABS_X = 5 Let NUMR(6).ABS_X = 6 Let NUMR(7).ABS_X = 7 Let NUMR(8).ABS_X = 8 Let NUMR(9).ABS_X = 9 Let NUMR(10).ABS_X = 10 Let NUMR(11).ABS_X = 11 Let NUMR(12).ABS_X = 12 Let NUMR(13).ABS_X = 13 Let NUMR(14).ABS_X = 15 Let NUMR(15).ABS_X = 15 Let NUMR(16).ABS_X = 16 Let NUMR(17).ABS_X = 17 Let NUMR(18).ABS_X = 18 Let NUMR(19).ABS_X = 19 Let NUMR(20).ABS_X = 20 Activate All End Response Function Response KEY_PRESS_7 Let KEYSAVE = "7" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_8 Let KEYSAVE = "8" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_9 Let KEYSAVE = "9" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_4 Let KEYSAVE = "4" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_5 Let KEYSAVE = "5" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_6 Let KEYSAVE = "6" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_1 Let KEYSAVE = "1" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_2 Let KEYSAVE = "2" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_3 Let KEYSAVE = "3" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_0 Let KEYSAVE = "0" Include NUMERIC_KEY_RESP End Response Function Response KEY_PRESS_POINT Include DO_POINT End Response Function Response KEY_PRESS_EQUALS Include DO_EQUALS End Response Function Response KEY_PRESS_MINUS Let OPERATOR = "-" Let SIGN_SET = FALSE Include DO_CALCULATION End Response Function Response KEY_PRESS_PLUS Let OPERATOR = "+" Include DO_CALCULATION End Response Function Response KEY_PRESS_MULT Let OPERATOR = "*" Include DO_CALCULATION End Response Function Response KEY_PRESS_DIV Let OPERATOR = "/" Include DO_CALCULATION End Response Function Response KEY_PRESS_CLEAR /* On first press, clear entry only. On subsequent presses, clear all */ If (LAST_KEYPRESS <> CLEAR) Then Include CLEAR_ENTRY Else Include CLEAR_ALL End If End Response Function Response KEY_PRESS_OFF /* Clear the Calculator from the screen and exit the form */ Let KEYPRESS = "O" Remove All Return Immediate End Response Function Response BOUNDARY CURSOR LEFT Position To Left Item End Response Function Response BOUNDARY CURSOR RIGHT Position To Right Item End Response Function Response BOUNDARY CURSOR UP Position To Up Item End Response Function Response BOUNDARY CURSOR DOWN Position To Down Item End Response Panel CALCULATOR Viewport VIEW_CALC Display Viewport %Terminal_Width_80 Display %Keypad_Application /* The icons in this panel represent the keys on the numeric keypad. When the select key is hit when the cursor is on one of the icons, the select function response for that key is performed. Identical function responses can be executed by typing the keypad key on the keypad directly. The keys highlight briefly when pressed due to the highlight when clauses. */ No Help Panel No Help Message Literal Text Line 1 Column 6 Value " CALCULATOR " Display Reverse Font Size Double Wide End Literal Literal Rectangle Line 2 Column 2 Line 4 Column 32 End Literal Field SIGN_DISPLAY Line 3 Column 7 Output Picture X Protected End Field Field EXTERNAL_DISPLAY Line 3 Column 8 Output Picture 9,999,999,999,99R9.99 Replace Leading " " Protected End Field Icon KEYPAD_CLEAR Highlight Reverse When (KEYPRESS = "C") Function Response SELECT /* On first press, clear entry only. On subsequent presses, clear all */ If (LAST_KEYPRESS <> CLEAR) Then Include CLEAR_ENTRY Else Include CLEAR_ALL End If End Response Literal Text Line 6 Column 4 Value " C " End Literal Literal Rectangle Line 5 Column 2 Line 7 Column 8 End Literal End Icon Icon KEYPAD_OFF Highlight Reverse When (KEYPRESS = "O") Function Response SELECT /* Clear the Calculator from the screen and exit the form */ Let KEYPRESS = "O" Remove All Return Immediate End Response Literal Text Line 6 Column 11 Value " OFF " End Literal Literal Rectangle Line 5 Column 10 Line 7 Column 16 End Literal End Icon Icon KEYPAD_DIV Highlight Reverse When (KEYPRESS = "/") Function Response SELECT Let OPERATOR = "/" Include DO_CALCULATION End Response Literal Text Line 6 Column 20 Value " / " End Literal Literal Rectangle Line 5 Column 18 Line 7 Column 24 End Literal End Icon Icon KEYPAD_MULT Highlight Reverse When (KEYPRESS = "*") Function Response SELECT Let OPERATOR = "*" Include DO_CALCULATION End Response Literal Text Line 6 Column 28 Value " * " End Literal Literal Rectangle Line 5 Column 26 Line 7 Column 32 End Literal End Icon Icon KEYPAD_7 Highlight Reverse When (KEYPRESS = "7") Function Response SELECT Let KEYSAVE = "7" Include NUMERIC_KEY_RESP End Response Literal Text Line 9 Column 4 Value " 7 " End Literal Literal Rectangle Line 8 Column 2 Line 10 Column 8 End Literal End Icon Icon KEYPAD_8 Highlight Reverse When (KEYPRESS = "8") Function Response SELECT Let KEYSAVE = "8" Include NUMERIC_KEY_RESP End Response Literal Text Line 9 Column 12 Value " 8 " End Literal Literal Rectangle Line 8 Column 10 Line 10 Column 16 End Literal End Icon Icon KEYPAD_9 Highlight Reverse When (KEYPRESS = "9") Function Response SELECT Let KEYSAVE = "9" Include NUMERIC_KEY_RESP End Response Literal Text Line 9 Column 20 Value " 9 " End Literal Literal Rectangle Line 8 Column 18 Line 10 Column 24 End Literal End Icon Icon KEYPAD_MINUS Highlight Reverse When (KEYPRESS = "-") Function Response SELECT Let OPERATOR = "-" Let SIGN_SET = FALSE Include DO_CALCULATION End Response Literal Text Line 9 Column 28 Value " - " End Literal Literal Rectangle Line 8 Column 26 Line 10 Column 32 End Literal End Icon Icon KEYPAD_4 Highlight Reverse When (KEYPRESS = "4") Function Response SELECT Let KEYSAVE = "4" Include NUMERIC_KEY_RESP End Response Literal Text Line 12 Column 4 Value " 4 " End Literal Literal Rectangle Line 11 Column 2 Line 13 Column 8 End Literal End Icon Icon KEYPAD_5 Highlight Reverse When (KEYPRESS = "5") Function Response SELECT Let KEYSAVE = "5" Include NUMERIC_KEY_RESP End Response Literal Text Line 12 Column 12 Value " 5 " End Literal Literal Rectangle Line 11 Column 10 Line 13 Column 16 End Literal End Icon Icon KEYPAD_6 Highlight Reverse When (KEYPRESS = "6") Function Response SELECT Let KEYSAVE = "6" Include NUMERIC_KEY_RESP End Response Literal Text Line 12 Column 20 Value " 6 " End Literal Literal Rectangle Line 11 Column 18 Line 13 Column 24 End Literal End Icon Icon KEYPAD_PLUS Highlight Reverse When (KEYPRESS = "+") Function Response SELECT Let OPERATOR = "+" Include DO_CALCULATION End Response Literal Text Line 12 Column 28 Value " + " End Literal Literal Rectangle Line 11 Column 26 Line 13 Column 32 End Literal End Icon Icon KEYPAD_1 Highlight Reverse When (KEYPRESS = "1") Function Response SELECT Let KEYSAVE = "1" Include NUMERIC_KEY_RESP End Response Literal Text Line 15 Column 4 Value " 1 " End Literal Literal Rectangle Line 14 Column 2 Line 16 Column 8 End Literal End Icon Icon KEYPAD_2 Highlight Reverse When (KEYPRESS = "2") Function Response SELECT Let KEYSAVE = "2" Include NUMERIC_KEY_RESP End Response Literal Text Line 15 Column 12 Value " 2 " End Literal Literal Rectangle Line 14 Column 10 Line 16 Column 16 End Literal End Icon Icon KEYPAD_3 Highlight Reverse When (KEYPRESS = "3") Function Response SELECT Let KEYSAVE = "3" Include NUMERIC_KEY_RESP End Response Literal Text Line 15 Column 20 Value " 3 " End Literal Literal Rectangle Line 14 Column 18 Line 16 Column 24 End Literal End Icon Icon KEYPAD_0 Highlight Reverse When (KEYPRESS = "0") Function Response SELECT Let KEYSAVE = "0" Include NUMERIC_KEY_RESP End Response Literal Text Line 18 Column 8 Value " 0 " End Literal Literal Rectangle Line 17 Column 2 Line 19 Column 16 End Literal End Icon Icon KEYPAD_POINT Highlight Reverse When (KEYPRESS = ".") Function Response SELECT Include DO_POINT End Response Literal Text Line 18 Column 20 Value " . " End Literal Literal Rectangle Line 17 Column 18 Line 19 Column 24 End Literal End Icon Icon KEYPAD_EQUALS Highlight Reverse When (KEYPRESS = "=") Function Response SELECT Include DO_EQUALS End Response Literal Text Line 16 Column 28 Value " = " End Literal Literal Rectangle Line 14 Column 26 Line 19 Column 32 End Literal End Icon End Panel End Layout End Form