' 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 (at your option)
' 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.
'
' You should  have received  a copy  of the  GNU General Public License along
' with this  program;  if not,  write to the Free Software Foundation,  Inc.,
' 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
'
'-------------------------------------------------------------------
' FoxCalc v0.92
'
' Author: Mateusz Viste "Fox" ([email protected])
' Compiled with FreeBASIC v0.18.3, using the GMP and MTFR libraries
' Homepage at http://mateusz.viste.free.fr/dos
'-------------------------------------------------------------------
'
#INCLUDE ONCE "VBCOMPAT.BI" ' Required by: FORMAT()
#INCLUDE ONCE "DOS\DPMI.BI" ' Required by: GetCurrentCodePage
#INCLUDE ONCE "GMP.BI"      ' Required by: MPFR.BI
#INCLUDE ONCE "MPFR.BI"     ' Required by: Calculus
#INCLUDE ONCE "COUNTRY.BI"  ' Required by: PrintWork


CONST pVer AS STRING = "0.92"
CONST pDate AS STRING = "2007"

TYPE BOOL AS BYTE        ' Creating the BOOL type, as it
CONST TRUE AS BOOL = 1   ' is not supported natively by
CONST FALSE AS BOOL = 0  ' the FreeBASIC compiler.

DECLARE SUB About()
DECLARE SUB PrintMsg(Komunikat AS STRING)
DECLARE SUB MouseRefresh(x AS INTEGER, y AS INTEGER, Forcing AS BOOL = FALSE)
DECLARE SUB Compute()
DECLARE SUB DrawButton(n AS UBYTE, Stan AS UBYTE)
DECLARE SUB PrintWork(WorkN AS STRING)
DECLARE SUB Quit()
DECLARE SUB DrawBackground(ShortCut AS BOOL)
DECLARE SUB Bip()
DECLARE SUB KeybFlush()
DECLARE SUB SoundQ(ByVal freq AS UINTEGER, dur AS UINTEGER)
DECLARE SUB GetCountrySysSettings()
DECLARE FUNCTION GetCurrentCodePage() AS USHORT
DECLARE FUNCTION Calculus(Numb1 AS STRING, Numb2 AS STRING, Oper AS STRING) AS STRING

DIM SHARED ClickMap(0 TO 24, 0 TO 79) AS BYTE
DIM SHARED AS BOOL Snd, MouseSupport, ResetTrigger, ShortCutList, ForceRefresh
DIM SHARED AS STRING Operation, TempString, WorkNumber, Result, Memory, DecSep, ThousSep
DIM SHARED MousePosition(1 TO 3) AS INTEGER
DIM SHARED AsciiButton(1 TO 4) AS STRING * 3
DIM SHARED AS BYTE InitialLocate
DIM SHARED AS INTEGER SavedMouseX, SavedMouseY
DIM AS INTEGER xPos, yPos, Buttons
DIM AS BYTE x, ClickedButton
Snd = TRUE
ResetTrigger = FALSE
MouseSupport = TRUE
Result = "0"
Memory = "0"
WorkNumber = "0"

ClickMap(10,25) = 1 : ClickMap(10,26) = 1 : ClickMap(10,27) = 1
ClickMap(10,29) = 2 : ClickMap(10,30) = 2 : ClickMap(10,31) = 2
ClickMap(10,33) = 3 : ClickMap(10,34) = 3 : ClickMap(10,35) = 3
ClickMap(10,37) = 4 : ClickMap(10,38) = 4 : ClickMap(10,39) = 4
ClickMap(10,41) = 5 : ClickMap(10,42) = 5 : ClickMap(10,43) = 5
ClickMap(12,25) = 6 : ClickMap(12,26) = 6 : ClickMap(12,27) = 6
ClickMap(12,29) = 7 : ClickMap(12,30) = 7 : ClickMap(12,31) = 7
ClickMap(12,33) = 8 : ClickMap(12,34) = 8 : ClickMap(12,35) = 8
ClickMap(12,37) = 9 : ClickMap(12,38) = 9 : ClickMap(12,39) = 9
ClickMap(12,41) = 10: ClickMap(12,42) = 10: ClickMap(12,43) = 10: ClickMap(13,41) = 10: ClickMap(13,42) = 10: ClickMap(13,43) = 10: ClickMap(14,41) = 10: ClickMap(14,42) = 10: ClickMap(14,43) = 10
ClickMap(14,25) = 11: ClickMap(14,26) = 11: ClickMap(14,27) = 11
ClickMap(14,29) = 12: ClickMap(14,30) = 12: ClickMap(14,31) = 12
ClickMap(14,33) = 13: ClickMap(14,34) = 13: ClickMap(14,35) = 13
ClickMap(14,37) = 14: ClickMap(14,38) = 14: ClickMap(14,39) = 14
ClickMap(16,25) = 15: ClickMap(16,26) = 15: ClickMap(16,27) = 15
ClickMap(16,29) = 16: ClickMap(16,30) = 16: ClickMap(16,31) = 16
ClickMap(16,33) = 17: ClickMap(16,34) = 17: ClickMap(16,35) = 17
ClickMap(16,37) = 18: ClickMap(16,38) = 18: ClickMap(16,39) = 18
ClickMap(16,41) = 19: ClickMap(16,42) = 19: ClickMap(16,43) = 19: ClickMap(17,41) = 19: ClickMap(17,42) = 19: ClickMap(17,43) = 19: ClickMap(18,41) = 19: ClickMap(18,42) = 19: ClickMap(18,43) = 19
ClickMap(18,25) = 20: ClickMap(18,26) = 20: ClickMap(18,27) = 20
ClickMap(18,29) = 21: ClickMap(18,30) = 21: ClickMap(18,31) = 21: ClickMap(18,32) = 21: ClickMap(18,33) = 21: ClickMap(18,34) = 21: ClickMap(18,35) = 21
ClickMap(18,37) = 22: ClickMap(18,38) = 22: ClickMap(18,39) = 22
ClickMap(10,48) = 23: ClickMap(10,49) = 23: ClickMap(10,50) = 23
ClickMap(10,52) = 24: ClickMap(10,53) = 24: ClickMap(10,54) = 24
ClickMap(12,48) = 25: ClickMap(12,49) = 25: ClickMap(12,50) = 25
ClickMap(12,52) = 26: ClickMap(12,53) = 26: ClickMap(12,54) = 26
ClickMap(14,48) = 27: ClickMap(14,49) = 27: ClickMap(14,50) = 27
ClickMap(14,52) = 28: ClickMap(14,53) = 28: ClickMap(14,54) = 28
ClickMap(16,48) = 29: ClickMap(16,49) = 29: ClickMap(16,50) = 29
ClickMap(16,52) = 30: ClickMap(16,53) = 30: ClickMap(16,54) = 30
ClickMap(18,48) = 31: ClickMap(18,49) = 31: ClickMap(18,50) = 31
ClickMap(18,52) = 32: ClickMap(18,53) = 32: ClickMap(18,54) = 32

IF SETMOUSE(1, 1, 1) <> 0 THEN PRINT "Mouse init failed - Please check if you loaded a mouse driver!": MouseSupport = FALSE: SLEEP 1000

GetCountrySysSettings

PCOPY(0, 1)            ' Saving the initial video page
InitialLocate = CSRLIN ' Saving initial cursor position

IF MouseSupport = TRUE THEN
   ShortCutList = FALSE
   GETMOUSE(xPos, yPos,, Buttons)
   MousePosition(1) = xPos+1
   MousePosition(2) = yPos+1
   MousePosition(3) = SCREEN(yPos+1, xPos+1, 1)
   MouseRefresh(xPos+1, yPos+1, TRUE)
 ELSE
   ShortCutList = TRUE
END IF
AsciiButton(1) = " / ": AsciiButton(2) = "SQR": AsciiButton(3) = "x^n": AsciiButton(4) = "x^2"
SELECT CASE GetCurrentCodePage
  CASE 437, 860, 861, 863, 865, 737, 790, 991
     AsciiButton(1) = " � ": AsciiButton(2) = " � ": AsciiButton(3) = " x�": AsciiButton(4) = " x�":
  CASE 775, 850, 857, 858
     AsciiButton(1) = " � ": AsciiButton(2) = "SQR": AsciiButton(3) = "x^n": AsciiButton(4) = " x�":
  CASE 852
     AsciiButton(1) = " � ": AsciiButton(2) = "SQR": AsciiButton(3) = "x^n": AsciiButton(4) = "x^2":
  CASE 866
     AsciiButton(1) = " / ": AsciiButton(2) = " � ": AsciiButton(3) = "x^n": AsciiButton(4) = "x^2":
END SELECT

LOCATE ,,0   ' Hiding the blinking text cursor

DrawBackground(ShortCutList)
PrintWork(Result)
FOR x = 1 TO 32
  DrawButton(x, 0)
NEXT x


DO
 SELECT CASE INKEY
    CASE ""
       REM It's here just to speed up the program if no key pressed.
    CASE "1"
       ClickedButton = 16
    CASE "2"
       ClickedButton = 17
    CASE "3"
       ClickedButton = 18
    CASE "4"
       ClickedButton = 12
    CASE "5"
       ClickedButton = 13
    CASE "6"
       ClickedButton = 14
    CASE "7"
       ClickedButton = 7
    CASE "8"
       ClickedButton = 8
    CASE "9"
       ClickedButton = 9
    CASE "0"
       ClickedButton = 21
    CASE CHR(13), "=" 'ENTER
       ClickedButton = 19
    CASE "*"
       ClickedButton = 4
    CASE "+"
       ClickedButton = 10
    CASE "-"
       ClickedButton = 5
    CASE ".", ","
       ClickedButton = 22
       KeybFlush
    CASE CHR(27)    'ESC
       ClickedButton = 24
    CASE CHR(8)     'BackSPC
       ClickedButton = 28
    CASE CHR(255) + "S" 'DEL
       ClickedButton = 26
    CASE "!"
       ClickedButton = 15
    CASE "s"
       ClickedButton = 30
    CASE "?"
       ClickedButton = 32
    CASE "%"
       ClickedButton = 2
    CASE "/"
       ClickedButton = 3
    CASE "\"
       ClickedButton = 31
    CASE "m"
       ClickedButton = 23
    CASE "M"
       ClickedButton = 25
    CASE "r"
       ClickedButton = 27
    CASE "c"
       ClickedButton = 29
    CASE "^"
       ClickedButton = 11
    CASE ":"
       ClickedButton = 20
    CASE "["
       ClickedButton = 6
    CASE "]"
       ClickedButton = 1
    CASE CHR(255)+";"   ' F1 pressed
       ClickedButton = 127
 END SELECT
 IF ClickedButton > 0 THEN
     DrawButton(ClickedButton, 2)
     IF Snd = TRUE THEN Bip ELSE SLEEP 50
     KeybFlush
     ClickedButton = 0 - ClickedButton
 END IF
 IF ResetTrigger = TRUE THEN ClickedButton = -26: ResetTrigger = FALSE
 IF MouseSupport = TRUE THEN
     GETMOUSE(xPos, yPos,, Buttons)
     IF ClickedButton >= 0 THEN MouseRefresh(xPos+1, yPos+1, ForceRefresh)
     ForceRefresh = FALSE
 END IF

 IF (Buttons AND 1) AND (ClickedButton = 0) THEN
    ClickedButton = ClickMap(yPos, xPos)
    DrawButton(ClickedButton, 2)
    SavedMouseX = xPos
    SavedMouseY = yPos
    IF Snd = TRUE AND ClickedButton > 0 THEN Bip
    ClickedButton = 0 - ClickedButton
 END IF
 IF Buttons = 0 AND ClickedButton < 0 THEN
    ForceRefresh = TRUE
    ClickedButton = ABS(ClickedButton)
    xPos = SavedMouseX     ' Here I am restoring the mouse position,
    yPos = SavedMouseY     ' that is the position of the mouse before
    SETMOUSE xPos, yPos    ' the click.
    DrawButton(ClickedButton, 0)
    SELECT CASE ClickedButton
      CASE 1   ' SQRT Button
        Compute
        Operation = "SQR"
        Compute
      CASE 2
        IF Operation = "-" OR Operation = "+" THEN WorkNumber = Calculus(WorkNumber, Result, "*")
        WorkNumber = Calculus(WorkNumber, "100", "/")
        Compute
      CASE 3
        Compute
        Operation = "/"
      CASE 4
        Compute
        Operation = "*"
      CASE 5
        Compute
        Operation = "-"
      CASE 6
        Compute
        WorkNumber = Result
        Operation = "*"
        Compute
      CASE 7
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "7"
          CASE "-0"
            WorkNumber = "-7"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "7"
        END SELECT
        PrintWork(WorkNumber)
      CASE 8
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "8"
          CASE "-0"
            WorkNumber = "-8"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "8"
        END SELECT
        PrintWork(WorkNumber)
      CASE 9
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "9"
          CASE "-0"
            WorkNumber = "-9"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "9"
        END SELECT
        PrintWork(WorkNumber)
      CASE 10
        Compute
        Operation = "+"
      CASE 11
        Compute
        Operation = "xn"
      CASE 12
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "4"
          CASE "-0"
            WorkNumber = "-4"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "4"
        END SELECT
        PrintWork(WorkNumber)
      CASE 13
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "5"
          CASE "-0"
            WorkNumber = "-5"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "5"
        END SELECT
        PrintWork(WorkNumber)
      CASE 14
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "6"
          CASE "-0"
            WorkNumber = "-6"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "6"
        END SELECT
        PrintWork(WorkNumber)
      CASE 15
        Compute
        Operation = "x!"
        Compute
      CASE 16
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "1"
          CASE "-0"
            WorkNumber = "-1"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "1"
        END SELECT
        PrintWork(WorkNumber)
      CASE 17
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "2"
          CASE "-0"
            WorkNumber = "-2"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "2"
        END SELECT
        PrintWork(WorkNumber)
      CASE 18
        SELECT CASE WorkNumber
          CASE "0"
            WorkNumber = "3"
          CASE "-0"
            WorkNumber = "-3"
          CASE ELSE
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "3"
        END SELECT
        PrintWork(WorkNumber)
      CASE 19
        Compute
      CASE 20
        Compute
        Operation = "MOD"
      CASE 21   ' "0" button
        IF WorkNumber <> "0" AND WorkNumber <> "-0" THEN
            IF (INSTR(WorkNumber, ".") = 0 AND LEN(WorkNumber) < 12) OR (INSTR(WorkNumber, ".") > 0 AND LEN(WorkNumber)-INSTR(WorkNumber, ".") < 10) THEN WorkNumber = WorkNumber + "0"
        END IF
        PrintWork(WorkNumber)
      CASE 22  ' "." button
        IF INSTR(WorkNumber, ".") = 0 THEN WorkNumber = WorkNumber + "."
        PrintWork(WorkNumber)
      CASE 23
        Compute
        Memory = Calculus(Memory, Result, "+")
        DrawButton(27,0)
      CASE 24
        Quit
      CASE 25
        Compute
        Memory = Calculus(Memory, Result, "-")
        DrawButton(27,0)
      CASE 26     '  "AC" Button or ResetTrigger
        Memory = "0"
        DrawButton(27,0)
        WorkNumber = "0"
        Operation = ""
        Result = "0"
        Compute
      CASE 27
        WorkNumber = Memory
        PrintWork(WorkNumber)
      CASE 28   ' BackSpace
        IF WorkNumber <> "0" THEN
            WorkNumber = MID(WorkNumber, 1, LEN(WorkNumber) - 1)
            IF WorkNumber = "" THEN WorkNumber = "0"
            PrintWork(WorkNumber)
          ELSE
            Result = "0"
            WorkNumber = "0"
            Operation = ""
            Compute
        END IF
      CASE 29   ' MC button
        Memory = "0"
        DrawButton(27, 0)
      CASE 30
        IF Snd = TRUE THEN Snd = FALSE ELSE Snd = TRUE
        DrawButton(30, 0)
        IF ClickMap(yPos, xPos) = 30 THEN MousePosition(3) = SCREEN(yPos+1, xPos+1, 1)
        MouseRefresh(xPos+1, yPos+1, TRUE)
      CASE 31  ' +/- button
        IF MID(WorkNumber,1,1) = "-" THEN WorkNumber = MID(WorkNumber, 2, LEN(WorkNumber)-1) ELSE WorkNumber = "-" + WorkNumber
        PrintWork(WorkNumber)
      CASE 32
        About
      CASE 127
        TempString = ""
        FOR x = 1 TO 30
          TempString += CHR(SCREEN(8, 25+x))
        NEXT x
        PCOPY(1, 0)
        IF ShortCutList = FALSE THEN ShortCutList = TRUE ELSE ShortCutList = FALSE
        DrawBackground(ShortCutList)
        FOR x = 1 TO 32
           DrawButton(x, 0)
        NEXT x
        COLOR 10, 0: LOCATE 8, 26: PRINT TempString;
        COLOR 7,0
    END SELECT
    IF ClickedButton > 0 THEN ClickedButton = 0
 END IF

LOOP


'***  PROGRAM'S END  ***  HERE STARTS ALL SUB PROCEDURE & FUNCTIONS  ***


SUB DrawBackground(ShortCut AS BOOL)
 COLOR 7, 1
 LOCATE  5, 22: PRINT "������������������������������������ͻ";
 LOCATE  6, 22: PRINT "�                                    �";
 LOCATE  7, 22: PRINT "�  ������������������������������Ŀ  �";
 LOCATE  8, 22: PRINT "�  �                              �  �";
 LOCATE  9, 22: PRINT "�  ��������������������������������  �";
 LOCATE 10, 22: PRINT "�                                    �";
 LOCATE 11, 22: PRINT "�                                    �";
 LOCATE 12, 22: PRINT "�                                    �";
 LOCATE 13, 22: PRINT "�                                    �";
 LOCATE 14, 22: PRINT "�                                    �";
 LOCATE 15, 22: PRINT "�                                    �";
 LOCATE 16, 22: PRINT "�                                    �";
 LOCATE 17, 22: PRINT "�                                    �";
 LOCATE 18, 22: PRINT "�                                    �";
 LOCATE 19, 22: PRINT "�                                    �";
 LOCATE 20, 22: PRINT "�                                    �";
 LOCATE 21, 22: PRINT "������������������������������������ͼ";

 IF ShortCut = TRUE THEN
     LOCATE  1, 62: PRINT "�������������[F1]�";
     LOCATE  2, 62: PRINT "� KEY SHORTCUTS: �";
     LOCATE  3, 62: PRINT "� -------------- �";
     LOCATE  4, 62: PRINT "� ]   - SQR      �";
     LOCATE  5, 62: PRINT "� %   - Percent  �";
     LOCATE  6, 62: PRINT "� /   - Division �";
     LOCATE  7, 62: PRINT "� *   - Multip.  �";
     LOCATE  8, 62: PRINT "� -   - Subtrac. �";
     LOCATE  9, 62: PRINT "� [   - x^2      �";
     LOCATE 10, 62: PRINT "� ^   - x^y      �";
     LOCATE 11, 62: PRINT "� !   - Factor.  �";
     LOCATE 12, 62: PRINT "� :   - MOD      �";
     LOCATE 13, 62: PRINT "� +   - Addition �";
     LOCATE 14, 62: PRINT "� =   - Compute  �";
     LOCATE 15, 62: PRINT "� m   - M+       �";
     LOCATE 16, 62: PRINT "� M   - M-       �";
     LOCATE 17, 62: PRINT "� r   - MR       �";
     LOCATE 18, 62: PRINT "� c   - MC       �";
     LOCATE 19, 62: PRINT "� \   - +/-      �";
     LOCATE 20, 62: PRINT "� DEL - AC       �";
     LOCATE 21, 62: PRINT "� Bck - C        �";
     LOCATE 22, 62: PRINT "� s   - Snd      �";
     LOCATE 23, 62: PRINT "� ?   - About    �";
     LOCATE 24, 62: PRINT "� ESC - OFF      �";
     LOCATE 25, 62: PRINT "������������������";
 END IF
 COLOR 7, 0
END SUB


SUB Quit
 SETMOUSE(0, 0, 0)
 CLS
 PCOPY(1, 0) ' Restore initial screen
 LOCATE InitialLocate, 1
 END
END SUB


SUB PrintWork(WorkN AS STRING)
 DIM AS STRING DisplayMe, IntegerPart, DecimalPart, Signum, IntegerPartSep, LastVisibleNum
 DIM AS INTEGER x
 IF Calculus(WorkN, "0", "CMP") = "-1" THEN Signum = "-" ELSE Signum = ""
 IF INSTR(WorkN, ".") = 0 THEN
     IntegerPart = MID(WorkN, LEN(Signum) + 1, LEN(WorkN) - LEN(Signum))
   ELSE
     IntegerPart = MID(WorkN, LEN(Signum) + 1, INSTR(WorkN, ".") - 1 - LEN(Signum))
     IF INSTR(WorkN, ".") < LEN(WorkN) THEN DecimalPart = MID(WorkN, INSTR(WorkN, ".") + 1, LEN(WorkN) - INSTR(WorkN, "."))
 END IF
REM ----- Inserting thousand separators to the integer -----
 x = LEN(IntegerPart)
 WHILE x > 3
   IntegerPartSep = ThousSep + MID(IntegerPart, x - 2, 3) + IntegerPartSep
   x -= 3
 WEND
 IntegerPartSep = MID(IntegerPart, 1, x) + IntegerPartSep
REM ----- Thousand separators inserted -----
 DisplayMe = Signum + IntegerPartSep
 IF LEN(DisplayMe) > 30 THEN
     PrintMsg("#001")   ' #001 means "Number too big"
   ELSE
     IF INSTR(WorkN, ".") > 0 THEN DisplayMe += DecSep + DecimalPart
     IF LEN(DisplayMe) > 30 THEN DisplayMe = LEFT(DisplayMe, 30)
     COLOR 10, 0
     LOCATE 8, 26
     PRINT SPACE(30 - LEN(DisplayMe)); DisplayMe;
     COLOR 7, 0
 END IF
END SUB


SUB DrawButton(n AS UBYTE, Stan AS UBYTE)
 SELECT CASE Stan
   CASE 0
     COLOR 7, 6
     IF n = 30 AND Snd = TRUE THEN COLOR 14, 6
     IF n = 27 AND Memory <> "0" THEN COLOR 14, 6
   CASE 2
     COLOR 15, 4
 END SELECT

 SELECT CASE n
   CASE 1
     LOCATE 11, 26: PRINT AsciiButton(2);
   CASE 2
     LOCATE 11, 30: PRINT " % ";
   CASE 3
     LOCATE 11, 34: PRINT AsciiButton(1);
   CASE 4
     LOCATE 11, 38: PRINT " * ";
   CASE 5
     LOCATE 11, 42: PRINT " - ";
   CASE 6
     LOCATE 13, 26: PRINT AsciiButton(4);
   CASE 7
     LOCATE 13, 30: PRINT " 7 ";
   CASE 8
     LOCATE 13, 34: PRINT " 8 ";
   CASE 9
     LOCATE 13, 38: PRINT " 9 ";
   CASE 10
     LOCATE 13, 42: PRINT "   ";
     LOCATE 14, 42: PRINT " + ";
     LOCATE 15, 42: PRINT "   ";
   CASE 11
     LOCATE 15, 26: PRINT AsciiButton(3);
   CASE 12
     LOCATE 15, 30: PRINT " 4 ";
   CASE 13
     LOCATE 15, 34: PRINT " 5 ";
   CASE 14
     LOCATE 15, 38: PRINT " 6 ";
   CASE 15
     LOCATE 17, 26: PRINT " x!";
   CASE 16
     LOCATE 17, 30: PRINT " 1 ";
   CASE 17
     LOCATE 17, 34: PRINT " 2 ";
   CASE 18
     LOCATE 17, 38: PRINT " 3 ";
   CASE 19
     LOCATE 17, 42: PRINT "   ";
     LOCATE 18, 42: PRINT " = ";
     LOCATE 19, 42: PRINT "   ";
   CASE 20
     LOCATE 19, 26: PRINT "MOD";
   CASE 21
     LOCATE 19, 30: PRINT "   0   ";
   CASE 22
     LOCATE 19, 38: PRINT " . ";
   CASE 23
     LOCATE 11, 49: PRINT " M+";
   CASE 24
     LOCATE 11, 53: PRINT "OFF";
   CASE 25
     LOCATE 13, 49: PRINT " M-";
   CASE 26
     LOCATE 13, 53: PRINT " AC";
   CASE 27
     LOCATE 15, 49: PRINT " MR";
   CASE 28
     LOCATE 15, 53: PRINT " C ";
   CASE 29
     LOCATE 17, 49: PRINT " MC";
   CASE 30
     LOCATE 17, 53: PRINT "  ";
   CASE 31
     LOCATE 19, 49: PRINT "+/-";
   CASE 32
     LOCATE 19, 53: PRINT " ? ";
 END SELECT
 COLOR 7, 0
END SUB


SUB Bip
  SoundQ(800, 60)
END SUB


SUB Compute
 SELECT CASE Operation
   CASE ""
     IF WorkNumber <> "0" THEN Result = WorkNumber
   CASE "+"
     Result = Calculus(Result, WorkNumber, "+")
   CASE "-"
     Result = Calculus(Result, WorkNumber, "-")
   CASE "/"
     IF Calculus(WorkNumber, "0", "CMP") = "0" THEN PrintMsg("#003") ELSE Result = Calculus(Result, WorkNumber, "/")   ' #003 = "ERROR: DIV BY ZERO"
   CASE "*"
     Result = Calculus(Result, WorkNumber, "*")
   CASE "xn"
     IF Calculus(Result, "0", "CMP") = "0" AND Calculus(WorkNumber, "0", "CMP") = "-1" THEN    ' If you try to exponent 0 to a negative exponent (0^-x)...
         PrintMsg("#003")   ' 003 means "Div by zero"
       ELSEIF VAL(Calculus(Calculus(Result, "0", "ln"), WorkNumber, "*")) > 70 THEN ' That a hint submited by srvaldez: if (ln(x)*y) > ln() then do the exponentiation
         PrintMsg("#001")    ' 001 means "Number too big!"
       ELSEIF Calculus(WorkNumber, "0", "INT?") = "0" AND Calculus(Result, "0", "CMP") = "-1" THEN    ' If you try to exponent a negative number to a floating point exponent...
         PrintMsg("#002")  ' 002 means "Not allowed"
       ELSE
         Result = Calculus(Result, WorkNumber, "^")
     END IF
   CASE "x!"
     IF Calculus(Result, "0", "INT?") = "0" OR Calculus(Result, "0", "CMP") = "-1" THEN
         PrintMsg("#002")   ' #002 means "Not allowed"
       ELSEIF Calculus(Result, "29", "CMP") = "1" THEN
         PrintMsg("#001") ' 001 means "Number too big! Sorry."
       ELSE
         Result = Calculus(Result, "0", "x!")
     END IF
   CASE "SQR"
     IF Calculus(Result, "0", "CMP") = "-1" THEN PrintMsg("#002") ELSE Result = Calculus(Result, "0", "SQR")   ' #002 means "Not allowed"
   CASE "MOD"
     IF Calculus(WorkNumber, "0", "CMP") = "0" THEN
        PrintMsg("#003")
      ELSEIF Calculus(Result, "0", "INT?") = "0" OR Calculus(WorkNumber, "0", "INT?") = "0" THEN
        PrintMsg("#002")   ' 002 means "Not allowed"
      ELSEIF Calculus(WorkNumber, "0", "CMP") = "1" THEN  ' If result is positive
        Result = Calculus(Result, WorkNumber, "MOD")
        IF Calculus(Result, "0", "CMP") = "-1" THEN Result = Calculus(Calculus(WorkNumber, "0", "ABS"), Result, "+") ' Because MTFR gives weird values sometimes (eg. 18 mod 5 = -2...)
      ELSEIF Calculus(WorkNumber, "0", "CMP") = "-1" THEN ' If result is negative
        Result = Calculus(Result, WorkNumber, "MOD")
        IF Calculus(Result, "0", "CMP") = "1" THEN Result = Calculus("0", Calculus(Calculus(WorkNumber, "0", "ABS"), Result, "-"), "-") ' Because MTFR gives weird values sometimes (eg. -18 mod 5 = 2...)
     END IF
 END SELECT
 ON ERROR GOTO 0
 Operation = ""
 WorkNumber = "0"
 PrintWork(Result)
END SUB


SUB About
 DIM Text AS STRING
 DIM x AS UBYTE = 0
 Text = SPACE(31) + "FoxCalc v" + pVer + " - Copyright (C) Mateusz Viste " + CHR(34) + "Fox" + CHR(34) + " " + pDate + " - email: [email protected]" + SPACE(31)
 ResetTrigger = TRUE
 COLOR 10, 0
 FOR x = 1 TO LEN(Text) - 30
    LOCATE 8, 26
    PRINT MID(Text, x, 30);
    SLEEP 80
 NEXT x
 PrintWork(WorkNumber)
 KeybFlush
END SUB


SUB KeybFlush
 DO: LOOP UNTIL INKEY = ""
END SUB


SUB PrintMsg(Komunikat AS STRING) ' It's used to display error messages.
    SELECT CASE Komunikat
      CASE "#001"
        Komunikat = "Number too big! Sorry."
      CASE "#002"
        Komunikat = "NOT ALLOWED"
      CASE "#003"
        Komunikat = "ERROR: DIV BY ZERO"
    END SELECT
    LOCATE 8, 26: COLOR 4, 0
    PRINT SPACE(30 - LEN(Komunikat)) + Komunikat;
    COLOR 7, 0
    IF snd = TRUE THEN SoundQ(200, 500): ELSE SLEEP 500
    SLEEP 1500
    ResetTrigger = TRUE
    KeybFlush
END SUB


SUB MouseRefresh(x AS INTEGER, y AS INTEGER, Forcing AS BOOL = FALSE)
 IF (x > 0 AND y > 0 AND (x <> MousePosition(1) OR y <> MousePosition(2))) OR Forcing = TRUE THEN
    LOCATE MousePosition(2), MousePosition(1)                 ' Erasing the
    COLOR MousePosition(3) AND &HF, MousePosition(3) SHR 4    ' previous
    PRINT CHR(SCREEN(MousePosition(2), MousePosition(1), 0)); ' cursor.
    MousePosition(1) = x                       ' Saving the current's
    MousePosition(2) = y                       ' cursor position and
    MousePosition(3) = SCREEN(y, x, 1)         ' colors.
    LOCATE y, x
    IF MousePosition(3) SHR 4 <> 0 THEN COLOR 15, 0 ELSE COLOR 0, 8
    PRINT CHR(SCREEN(y, x, 0));
    COLOR 7, 0
 END IF
END SUB


SUB SoundQ(ByVal freq AS UINTEGER, dur AS UINTEGER)
  DIM t AS DOUBLE, f1 AS USHORT
  IF freq > 0 THEN
     f1 = 1193181 \ freq
     OUT &H61, INP(&H61) OR 3
     OUT &H43, &HB6
     OUT &H42, lobyte(f1)
     OUT &H42, hibyte(f1)
  END IF
  t = TIMER
  WHILE ((TIMER - t) * 1000) < dur
     SLEEP 0, 1
  WEND
  IF freq > 0 THEN
     OUT &H61, INP(&H61) AND &HFC
  END IF
END SUB


FUNCTION GetCurrentCodePage() AS USHORT
       CONST CF = 1
       DIM regs AS __dpmi_regs
       regs.x.ax = &h6601
       IF __dpmi_int(&h21, @regs) = 0 AND (regs.x.flags And CF) = 0 THEN
               RETURN regs.x.bx
       ELSE
               RETURN 0
       END IF
END FUNCTION


FUNCTION Calculus(Numb1 AS STRING, Numb2 AS STRING, Oper AS STRING) AS STRING
 REM ----- Initializing MPFR variables -----
  DIM AS mpfr_ptr mpfresult = allocate(len(__mpfr_struct))
  DIM AS mpfr_ptr mpfvar1 = allocate(len(__mpfr_struct))
  DIM AS mpfr_ptr mpfvar2 = allocate(len(__mpfr_struct))
  mpfr_set_default_prec(256)  ' Set the precision to 256 bits (default is 64)
  mpfr_set_default_rounding_mode(GMP_RNDN)  ' Set the default rounding mode to "nearest"
  mpfr_init(mpfresult)
  mpfr_init(mpfvar1)
  mpfr_init(mpfvar2)
  mpfr_set_str(mpfvar1, Numb1, 10)
  mpfr_set_str(mpfvar2, Numb2, 10)
 REM ----- Initializing other variables -----
  DIM AS STRING Rezultat

  SELECT CASE Oper
    CASE "+"
      mpfr_add(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "-"
      mpfr_sub(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "*"
      mpfr_mul(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "/"
      mpfr_div(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "SQR"
      mpfr_sqrt(mpfresult, mpfvar1, GMP_RNDN)
    CASE "x!"
      mpfr_fac_ui(mpfresult, mpfr_get_ui(mpfvar1, GMP_RNDN), GMP_RNDN)
    CASE "MOD"
      mpfr_remainder(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "^"
      mpfr_pow(mpfresult, mpfvar1, mpfvar2, GMP_RNDN)
    CASE "CMP"   ' It's used for internal comparisions
      mpfr_set_str(mpfresult, STR(mpfr_cmp(mpfvar1, mpfvar2)), 10)
    CASE "ln"   ' It's used for internal overflow checking in x^y operations
      mpfr_log(mpfresult, mpfvar1, GMP_RNDN)
    CASE "INT?"   ' It's used for internal checking.
      mpfr_set_str(mpfresult, STR(mpfr_integer_p(mpfvar1)), 10)
    CASE "ABS"   ' It's used for internal checking.
      mpfr_abs(mpfresult, mpfvar1, GMP_RNDN)
  END SELECT

 REM ----- Here begins the MPFR -> STRING conversion -----
  DIM AS ZSTRING PTR s
  DIM AS mp_exp_t PTR exppn = allocate(len(mp_exp_t))
  DIM AS INTEGER Exponent
  s = mpfr_get_str(0, exppn, 10, 60, mpfresult, GMP_RNDN)
  Rezultat = *s
  Exponent = *exppn
  IF mpfr_cmp_si(mpfresult, 0) < 0 THEN Exponent += 1  ' That's for the additional byte (the "-" sign)
  IF Exponent < 0 THEN Rezultat = STRING(ABS(Exponent), "0") + Rezultat: Exponent = 0
  IF Exponent > LEN(Rezultat) THEN Rezultat += STRING(Exponent - LEN(Rezultat), "0")
  IF Exponent < LEN(Rezultat) THEN Rezultat = MID(Rezultat, 1, Exponent) + "." + MID(Rezultat, Exponent + 1, LEN(Rezultat) - Exponent)
  deallocate(exppn)
  deallocate(s)
 REM ----- Preformatting the output -----
  IF Rezultat = "" AND Exponent = 0 THEN Rezultat = "0"
  IF MID(Rezultat, 1, 1) = "." THEN Rezultat = "0" + Rezultat
  IF MID(Rezultat, 1, 2) = "-." THEN Rezultat = "-0" + MID(Rezultat, 2, LEN(Rezultat) - 1)
  IF INSTR(Rezultat, ".") <> 0 AND RIGHT(Rezultat, 1) = "0" THEN
     DO: Rezultat = MID(Rezultat, 1, LEN(Rezultat) - 1)
     LOOP UNTIL RIGHT(Rezultat, 1) <> "0"
  END IF
  IF RIGHT(Rezultat, 1) = "." THEN Rezultat = MID(Rezultat, 1, LEN(Rezultat) - 1)
 REM ----- Clearing all unneeded MPFR variables -----
  mpfr_clear(mpfresult)   '  Clearing unneeded variables,
  mpfr_clear(mpfvar1)     '  as they are still occuping
  mpfr_clear(mpfvar2)     '  memory. [floating point op.]

  RETURN Rezultat
END FUNCTION

SUB GetCountrySysSettings()
 DIM ci AS COUNTRYINFO
 IF GetCountryInfo(@ci) = 0 THEN
     ThousSep = ci.ciThousands
     DecSep = ci.ciDecimal
   ELSE
     ThousSep = "'"
     DecSep = "."
 END IF
 'DecSep = FORMAT(0.5, ".#")  ' That was the old way to get the decimal separator.
END SUB

You are viewing proxied material from gopher.viste.fr. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.