REM Hex-To-Dec Calculator v1.1a PD 2007.

' declare arrays at runtime.
REM $DYNAMIC

' declare default variables.
DEFINT A-Z

' read include files.
REM $INCLUDE: 'qbx.bi'

' screen area storage variables.
COMMON SHARED TempArrayY() AS INTEGER
COMMON SHARED TempArrayZ() AS INTEGER

' declare time slice release variable.
COMMON SHARED Supported.Call AS INTEGER

' declare interrupt structures.
COMMON SHARED OutregsX AS RegTypeX, InregsX AS RegTypeX

' declare time release function.
FUNCTION ReleaseTime
 ON LOCAL ERROR RESUME NEXT
 IF Supported.Call = 0 THEN
    InregsX.AX = &H1680
    InregsX.BX = &H0
    CALL InterruptX(&H2F, InregsX, OutregsX)
    IF (OutregsX.AX AND &HFF) = &H80 THEN
       Supported.Call = -1
    END IF
 END IF
 ReleaseTime = -1
END FUNCTION

' declare common error routine.
ON ERROR GOTO Error.Routine

' store screen area.
CurrentX = Csrlin
GOSUB SaveScreen

' upper-left coordinate of editing box on screen.
Xcoor = 4
Ycoor = 6

' reset insert mode.
Ins = -1

GOSUB MakeBox ' create edit box.

CalcBox = 1 ' reset to left box.

Box$ = "0" ' current box
Box1$ = "0" ' left box string
Box2$ = "0" ' right box string

GOSUB SelectBox2 ' display box 2.
GOSUB SelectBox1 ' display box 1.

DO ' calculator loop
   DO ' keystroke loop
      Var$ = INKEY$ ' get keystroke
      IF LEN(Var$) THEN ' check keystroke
         EXIT DO
      END IF
      ' release time slice.
      R = ReleaseTime
   LOOP
   SELECT CASE LEN(Var$)
   CASE 1 ' single ascii key
      SELECT CASE ASC(Var$)
      CASE 8 ' backspace
         IF Ycoor1 - Column3 > 0 THEN
            IF Ins THEN
               Box$ = LEFT$(Box$, Ycoor1 - Column3 - 1) + MID$(Box$, Ycoor1 - Column3 + 1)
               Ycoor1 = Ycoor1 - 1
               LOCATE Xcoor1, Ycoor1, 1
               Var$ = MID$(Box$, Ycoor1 - Column3 + 1) + " "
               COLOR 15, 0
               PRINT Var$;
               LOCATE Xcoor1, Ycoor1, 1
               GOSUB PrintBoxes
            ELSE ' move left
               Ycoor1 = Ycoor1 - 1
               LOCATE Xcoor1, Ycoor1, 1
            END IF
         END IF
      CASE 9 ' tab
         IF CalcBox = 1 THEN
            CalcBox = 2
            GOSUB SelectBox2
            GOSUB PrintBoxes
         END IF
      CASE 27 ' escape
         EXIT DO
      CASE ELSE ' keystroke
         VarX = 0 ' valid char flag
         TempX$ = UCASE$(Var$)
         SELECT CASE TempX$ ' validate char
         CASE "0" TO "9"
            VarX = -1
         CASE "A" TO "F"
            IF CalcBox = 1 THEN
               VarX = -1
            END IF
         END SELECT
         IF VarX THEN
            IF Ycoor1 - Column3 + 1 <= LineLength THEN
               ' insert digit
               IF Ins THEN
                  Box$ = LEFT$(Box$, Ycoor1 - Column3) + TempX$ + MID$(Box$, Ycoor1 - Column3 + 1)
                  Box$ = LEFT$(Box$, LineLength)
                  LOCATE Xcoor1, Ycoor1, 1
                  Var$ = MID$(Box$, Ycoor1 - Column3 + 1)
                  COLOR 15, 0
                  PRINT Var$;
                  Ycoor1 = Ycoor1 + 1
                  LOCATE Xcoor1, Ycoor1, 1
                  GOSUB PrintBoxes
               ELSE ' overstrike char
                  IF Ycoor1 - Column3 + 1 > LEN(Box$) THEN
                     Box$ = Box$ + TempX$ ' append box
                  ELSE
                     MID$(Box$, Ycoor1 - Column3 + 1, 1) = TempX$ ' replace
                  END IF
                  LOCATE Xcoor1, Ycoor1, 1
                  COLOR 15, 0
                  PRINT TempX$;
                  Ycoor1 = Ycoor1 + 1
                  LOCATE Xcoor1, Ycoor1, 1
                  GOSUB PrintBoxes
               END IF
            END IF
         END IF
      END SELECT
   CASE 2 ' extended key
      SELECT CASE ASC(RIGHT$(Var$, 1))
      CASE 15 ' shift-tab
         IF CalcBox = 2 THEN
            CalcBox = 1
            GOSUB SelectBox1
            GOSUB PrintBoxes
         END IF
      CASE 71 ' home
         Ycoor1 = Column3
      CASE 79 ' end
         Ycoor1 = LEN(Box$) + Column3
      CASE 77 ' right
         IF Ycoor1 - Column3 + 1 <= LEN(Box$) THEN
            Ycoor1 = Ycoor1 + 1
         END IF
      CASE 75 ' left
         IF Ycoor1 - Column3 > 0 THEN
            Ycoor1 = Ycoor1 - 1
         END IF
      CASE 82 ' insert
         Ins = NOT Ins
         COLOR 14, 1
         IF Ins THEN
            LOCATE Xcoor, Ycoor + 24, 1
            PRINT "<ins>";
         ELSE
            LOCATE Xcoor, Ycoor + 24, 1
            PRINT STRING$(5, 205);
         END IF
         COLOR 15, 0
      CASE 83 ' delete
         IF Ycoor1 - Column3 + 1 <= LEN(Box$) THEN
            Box$ = LEFT$(Box$, Ycoor1 - Column3) + MID$(Box$, Ycoor1 - Column3 + 2)
            LOCATE Xcoor1, Ycoor1, 1
            Var$ = MID$(Box$, Ycoor1 - Column3 + 1) + " "
            COLOR 15, 0
            PRINT Var$;
            LOCATE Xcoor1, Ycoor1, 1
            GOSUB PrintBoxes
         END IF
      CASE 119 ' control-home
         Ycoor1 = Column3
      CASE 117 ' control-end
         Ycoor1 = LEN(Box$) + Column3
      END SELECT
      LOCATE Xcoor1, Ycoor1, 1
   END SELECT
LOOP
GOSUB RestoreScreen ' restore screen area.
COLOR 7, 0
LOCATE CurrentX, 1, 1
END

' create edit box.
MakeBox:
 ' Y-coordinate of editing boxes.
 Box1 = Ycoor + 3
 Box2 = Ycoor + 15
 ' display editing box.
 COLOR 14, 1
 LOCATE Xcoor, Ycoor, 1
 Var$ = " " + CHR$(201) + STRING$(1, 205) + "<esc>=Quit" + STRING$(11, 205) + "<ins>" + CHR$(187) + " "
 PRINT Var$;
 LOCATE Xcoor + 1, Ycoor, 1
 Var$ = " " + CHR$(186) + SPACE$(9) + "Hex" + SPACE$(11) + "Dec " + CHR$(186) + " "
 PRINT Var$;
 LOCATE Xcoor + 2, Ycoor, 1
 Var$ = " " + CHR$(200) + STRING$(1, 205) + "<tab>/<shift-tab>=switch" + STRING$(2, 205) + CHR$(188) + " "
 PRINT Var$;
 RETURN

' move to box 1 (left box).
SelectBox1:
 Box2$ = Box$ ' store right box.
 Box$ = Box1$ ' reset to left box.

 ' reset editing parameters.
 Xcoor1 = Xcoor + 1
 Ycoor1 = Ycoor + 3
 Column3 = Ycoor1
 LineLength = 8

 ' display left box.
 COLOR 15, 0
 LOCATE Xcoor1, Ycoor1, 1
 PRINT SPACE$(8);
 LOCATE Xcoor1, Ycoor1, 1
 PRINT Box$;
 Ycoor1 = Ycoor1 + LEN(Box$)
 LOCATE Xcoor1, Ycoor1, 1
 RETURN

' move to box 2 (right box).
SelectBox2:
 Box1$ = Box$ ' store left box.
 Box$ = Box2$ ' reset to right box.

 ' reset editing parameters.
 Xcoor1 = Xcoor + 1
 Ycoor1 = Ycoor + 15
 Column3 = Ycoor1
 LineLength = 10

 ' display right box.
 COLOR 15, 0
 LOCATE Xcoor1, Ycoor1, 1
 PRINT SPACE$(10);
 LOCATE Xcoor1, Ycoor1, 1
 PRINT Box$;
 Ycoor1 = Ycoor1 + LEN(Box$)
 LOCATE Xcoor1, Ycoor1, 1
 RETURN

' calculates value of current box,
'  displays result in calculated form in opposite box.
PrintBoxes:
 IF CalcBox = 1 THEN ' is in hex box.
    ' strip leading zeroes for signed bit conversion.
    TempBox$ = Box$
    DO
       IF LEFT$(TempBox$, 1) = "0" THEN
          TempBox$ = MID$(TempBox$, 2)
       ELSE
          EXIT DO
       END IF
    LOOP
    Value# = VAL("&H" + TempBox$) ' retreive decimal value.
    IF Value# < 0# THEN ' check twos-complement from signed value.
       IF LEN(TempBox$) = 8 THEN ' 8000 0000 to FFFF FFFF
          Value# = Value# + 4294967296#
       ELSE
          IF LEN(TempBox$) = 4 THEN ' 8000 to FFFF
             Value# = Value# + 65536#
          END IF
       END IF
    END IF
    ' display decimal value.
    Box2$ = MID$(STR$(Value#), 2)
    COLOR 15, 0
    LOCATE Xcoor1, Box2, 1
    PRINT SPACE$(10);
    LOCATE Xcoor1, Box2, 1
    PRINT Box2$;
 END IF
 IF CalcBox = 2 THEN ' is in decimal box.
    Value# = VAL(Box$) ' retreive hex value.
    IF Value# >= 4294967296# THEN ' check overflow.
       COLOR 15, 0
       LOCATE Xcoor1, Box1, 1
       Var$ = "overflow"
       PRINT Var$;
       Box1$ = "0"
    ELSE
       IF Value# > 2147483647# THEN ' force to twos-complement.
          Value# = Value# - 4294967296# ' 8000 0000 to FFFF FFFF
       END IF
       ' display hex value.
       Box1$ = HEX$(Value#)
       COLOR 15, 0
       LOCATE Xcoor1, Box1, 1
       PRINT SPACE$(8);
       LOCATE Xcoor1, Box1, 1
       PRINT Box1$;
    END IF
 END IF
 LOCATE Xcoor1, Ycoor1, 1
 RETURN
Error.Routine:
 COLOR 7, 0
 CLS
 PRINT "Crash!"
 END

' screen save
SaveScreen:
 REDIM TempArrayY(1 TO 2000) AS INTEGER
 REDIM TempArrayZ(1 TO 2000) AS INTEGER
 FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
       TempZ1 = SCREEN(Var1, Var2) ' screen char
       TempZ2 = SCREEN(Var1, Var2, 1) ' char color
       TempArrayY((Var1 - 1) * 80 + Var2) = TempZ1
       TempArrayZ((Var1 - 1) * 80 + Var2) = TempZ2
    NEXT
 NEXT
 RETURN

' screen restore
RestoreScreen:
 FOR Var1 = 1 TO 25
    FOR Var2 = 1 TO 80
       VarB = INT(TempArrayZ((Var1 - 1) * 80 + Var2) / 16)
       VarF = TempArrayZ((Var1 - 1) * 80 + Var2) MOD 16
       TempZ1 = TempArrayY((Var1 - 1) * 80 + Var2)
       LOCATE Var1, Var2, 0
       COLOR VarF, VarB
       PRINT CHR$(TempZ1);
    NEXT
 NEXT
 RETURN
