' ABACUS uses the keyboard to allow manipulating the beads in the abacus.
' Created by Ralph A. Esquivel, August 26, 2007, based on an idea from
' http://www.network54.com/Forum/13959/message/1187057755/
' PROGRAM DEVELOPEMENT
' 1. Dimension variables
' 2. Select foreground and background colors ''NOT USED
' 2. GOSUBs to: ''CHANGED 3 TO 2
' Default values and variables
' Display instructions for using the abacus
' Draw the abacus 'NEW LINE
' Allow moving beads
' 1. Dimension variables
' 2. Fix O$ and I$ to be len(4), fixed borders
' ======================
DEFINT I-K
' Fives is upper part of abacus, Units is lower part
DIM Fives(10, 2) AS STRING * 4, Units(10, 8) AS STRING * 4
O$ = " O" + SPACE$(2)
I$ = " |" + SPACE$(2)
' variable for current column
DIM c AS INTEGER 'c will hold column number, 1, 2, ...9, 0
' variables to manipulate Units NOT USED!
' DIM u1 AS STRING * 1' u1 = up 1 row
' DIM d1 AS STRING * 1' d1 = down 1 row
' DIM a1 AS STRING * 1 'a1 = add 1 unit
' DIM s1 AS STRING * 1 's1 = subrtract 1 unit
' Color foreground and background ''RELOCATED IN Instructions2 subroutine
' -------------------------------
' 'COLOR 15, 9 'foreground bright white, background bright blue
' 'CLS
' 2. GOSUBS
' ========= ''CHANGED 3 TO 2
''NEW LINE

Start:
GOSUB DefaultValues1 ''Start: ''REMARKED OUT
GOSUB Instructions2
GOSUB DrawAbacus3
GOSUB ColorSelectedColumn4
GOSUB MoveBeads5

fin:
COLOR 7, 0: LOCATE 24, 1: PRINT ""
SYSTEM
' SUBROUTINES
' ===========================================================
DefaultValues1:
' initial position of beads
FOR j = 1 TO 10
  Fives(j, 1) = O$
  Fives(j, 2) = I$
  FOR k = 1 TO 4
    Units(j, k) = I$
  NEXT k
  FOR k = 5 TO 8
    Units(j, k) = O$
  NEXT k
NEXT j
' default column
c = 10
RETURN
' ===========================================================
Instructions2:
' ------------
COLOR 15, 9 ''foreground bright white, background bright blue ''NEW LINE
CLS
LOCATE 17
s10$ = SPACE$(10)
PRINT s10$; "INSTRUCTIONS:"
PRINT
PRINT s10$; "1. Press left and right arrow keys to select active column"
PRINT s10$; "2. Press 5 to add or subtract Fives." ''CHANGED 0 TO 5
PRINT s10$; "3. Press up and down arrow keys to add or subtract; Units."
PRINT s10$; "4. Press S to Start over. "
PRINT s10$; "5. Press Q to quit program."
RETURN
' ===========================================================
DrawAbacus3:
' ----------
' Elements for drawing the abacus' frame
CONST ul = "Ú", ur = "¿"
CONST h = "Ä", v = "³"
CONST ml = "Ã", mr = "´"
CONST bl = "À", br = "Ù"
COLOR 15, 9
s = 17 ' Left border location
s$ = SPACE$(s - 1)
w = 40
LOCATE 1, 1
A$ = "A B A C U S"
PRINT SPACE$(40 - LEN(A$) / 2); A$
' draw top
PRINT s$; ul; : FOR I = 1 TO 4 * 10 + 1: PRINT h; : NEXT I: PRINT ur
' draw Fives part
PRINT s$; v; " ";
FOR I = 1 TO 10: PRINT Fives(I, 1); : NEXT I: PRINT v
PRINT s$; v; " ";
FOR I = 1 TO 10: PRINT Fives(I, 2); : NEXT I: PRINT v
' draw middle line
PRINT s$; ml; : FOR I = 1 TO 4 * 10 + 1: PRINT h; : NEXT I: PRINT mr
' draw UNITS PART
FOR j = 1 TO 8
  PRINT s$; v; " ";
  FOR I = 1 TO 10: PRINT Units(I, j); : NEXT I: PRINT v
NEXT j
' draw bottom
PRINT s$; bl; : FOR I = 1 TO 4 * 10 + 1: PRINT h; : NEXT I: PRINT br
' show column units
LOCATE , s + 1: PRINT "10^9";
LOCATE , s + 13: PRINT "10^6";
LOCATE , s + 25: PRINT "1000 100 10";
LOCATE , s + 39: PRINT "1";
RETURN
' ===========================================================
ColorSelectedColumn4:
' -------------------
' use current column number, c
COLOR 8 + 4 'foreground bright red
FOR j = 1 TO 2
  LOCATE 2 + j, s - 2 + 4 * c: PRINT Fives(c, j)
NEXT j
FOR j = 1 TO 8
  LOCATE 5 + j, s - 2 + 4 * c: PRINT Units(c, j)
NEXT j
' 'COLOR 15, 9 ''REMARKED OUT
RETURN
' ===========================================================
MoveBeads5:
' ---------
top:
' determine status of unit slots in selected column
FOR j = 1 TO 8
  IF Units(c, j) = I$ THEN u(j) = 1 ELSE u(j) = 0
NEXT j
DO
  GOSUB GetKeyPressed
  IF k$ = "H" THEN GOTO up
  IF k$ = "P" THEN GOTO down
  IF k$ = "M" THEN GOTO right
  IF k$ = "K" THEN GOTO left
  IF k$ = "S" THEN RUN
  IF k$ = "Q" THEN GOTO fin
  IF k = 5 THEN GOTO Fives ''CHANGED 0 to 5
LOOP

Fives:
' ----
IF Fives(c, 1) = O$ THEN
  Fives(c, 1) = I$
  Fives(c, 2) = O$
ELSE
  Fives(c, 1) = O$
  Fives(c, 2) = I$
END IF
LOCATE 3, s - 2 + 4 * c: PRINT Fives(c, 1)
LOCATE 4, s - 2 + 4 * c: PRINT Fives(c, 2)
GOTO top
' Units
' -----
'add one unit

up:
IF u(1) = 1 THEN
  j = 1
ELSEIF u(1) = 0 AND u(2) = 1 THEN
  j = 2
ELSEIF u(2) = 0 AND u(3) = 1 THEN
  j = 3
ELSEIF u(3) = 0 AND u(4) = 1 THEN
  j = 4
ELSEIF u(4) = 0 THEN
  GOTO CannotAdd
END IF
Units(c, j) = O$: Units(c, j + 4) = I$
LOCATE 5 + j, s - 2 + 4 * c: PRINT Units(c, j)
LOCATE 5 + j + 4, s - 2 + 4 * c: PRINT Units(c, j + 4)

CannotAdd:
GOTO top
'subtract one unit

down:
IF u(8) = 1 THEN
  j = 4
ELSEIF u(8) = 0 AND u(7) = 1 THEN
  j = 3
ELSEIF u(7) = 0 AND u(6) = 1 THEN
  j = 2
ELSEIF u(6) = 0 AND u(5) = 1 THEN
  j = 1
ELSEIF u(5) = 0 THEN
  GOTO CannotSubtract
END IF
Units(c, j) = I$: Units(c, j + 4) = O$
LOCATE 5 + j, s - 2 + 4 * c: PRINT Units(c, j)
LOCATE 5 + j + 4, s - 2 + 4 * c: PRINT Units(c, j + 4)

CannotSubtract:
GOTO top
' columns
' -------
right:
' select column to the right
IF c < 10 THEN c = c + 1
GOSUB DrawAbacus3
GOSUB ColorSelectedColumn4
GOTO top
'select column to the left

left:
IF c > 1 THEN c = c - 1
GOSUB DrawAbacus3
GOSUB ColorSelectedColumn4
GOTO top
RETURN
' ===========================================================
' Auxiliary Subroutines
' -----------------------------------------------------------
GetKeyPressed:
' ----------
k$ = "": WHILE k$ = "": k$ = UCASE$(INKEY$): WEND
IF LEN(k$) = 2 THEN k$ = RIGHT$(k$, 1)
IF k$ = CHR$(27) THEN k$ = "Q"
k = VAL(k$)
RETURN