FLORIDA HIGH SCHOOLS COMPUTING COMPETITION '94
BASIC PROGRAM SOLUTIONS
'1.1
' This program will display the 1994 FHSCC sponsors.
'
PRINT "FHSCC '94 IS SPONSORED BY:": PRINT
FOR I = 1 TO 4
PRINT "GTEDS GTEDS GTEDS GTEDS GTEDS"
NEXT I
PRINT
FOR I = 1 TO 4
PRINT "USF CENTER FOR EXCELLENCE"
NEXT I
PRINT
FOR I = 1 TO 4
PRINT "FLORIDA DEPARTMENT OF EDUCATION"
NEXT I
'1.2
' This program will determine if an applicant is hired.
'
INPUT "Entrance requirement:"; ENT$
INPUT "Plans to accept or reject offer:"; OFFER$
PRINT "APPLICANT WILL ";
IF ENT$ <> "PASSED" OR OFFER$ <> "ACCEPT" THEN PRINT "NOT ";
PRINT "BE HIRED"
'1.3
' This program will display number of employees.
'
INPUT "Enter current number:"; CURRENT
INPUT "Enter number hiring:"; HIRING
INPUT "Enter number leaving:"; LEAVING
PRINT CURRENT + HIRING - LEAVING; "EMPLOYEES"
'1.4
' This program will total the millions converted.
'
INPUT "Enter number of accounts: "; NUM$
WHILE VAL(NUM$) > -999
SUM = SUM + VAL(NUM$)
INPUT "Enter number of accounts:"; NUM$
WEND
IF SUM = INT(SUM) THEN
PRINT SUM;
ELSE
PRINT USING "#.# "; SUM;
END IF
PRINT "MILLION ACCOUNTS CONVERTED TO CBSS"
'1.5
' This program will compute the gross wages earned.
'
INPUT "Enter hours, rate:"; HOURS, RATE
IF HOURS > 40 THEN HOURS = HOURS + (HOURS - 40) * .5
PRINT USING "GROSS WAGES ARE $###.##"; HOURS * RATE
'1.6
' This program will tally the number of accounts sold.
'
DATA 706,95000, 208,54321, 912,99825, 605,88776, 404,90175
FOR I = 1 TO 5: READ AREAC(I), ACCT(I): NEXT I
INPUT "Enter number of area codes:"; NUM
FOR I = 1 TO NUM
INPUT "Enter area code:"; ACODE
FOR J = 1 TO 5
IF AREAC(J) = ACODE THEN SUM = SUM + ACCT(J)
NEXT J
NEXT I
PRINT "TOTAL NUMBER OF ACCOUNTS BEING SOLD ="; SUM
'1.7
' This program will display the cost to fix error in phase.
'
DATA REQUIREMENTS,DESIGN,CODING,SYSTEM TEST,ACCEPTANCE TEST
DATA MAINTENANCE
DATA 1, 5, 10, 20, 50, 100
FOR I = 1 TO 6: READ PHASES$(I): NEXT I
FOR I = 1 TO 6: READ FACTOR(I): NEXT I
INPUT "Enter cost $:"; COST
INPUT "Enter phase:"; PH$
I = 1
WHILE PH$ <> PHASES$(I): I = I + 1: WEND
C$ = LTRIM$(STR$(COST * FACTOR(I)))
PRINT "COST IS $"; C$;
PRINT " TO FIX PROBLEM IN "; PHASES$(I); " PHASE"
'1.8
' This program will compute the maximum blocksize.
'
INPUT "Enter logical record length: "; LRECL
NUM = INT(23476 / LRECL)
PRINT "BLOCKSIZE ="; LRECL * NUM; "BYTES"
'1.9
' This program will compute an electric bill.
'
INPUT "Enter kilowatt hours:"; HOURS
IF HOURS < 10 THEN RATE = 4.95 ELSE RATE = 5.65
BILL = RATE * HOURS
BILL = BILL * (1 + .03 + .06)
IF HOURS > 30 THEN BILL = BILL + 25
PRINT "THE CUSTOMER'S BILL IS $";
IF BILL < 100 THEN PRINT USING "##.##"; BILL: END
PRINT USING "###.##"; BILL
'1.10
' This program will determine if a 5x5 matrix is symmetric
'
DEFINT A-Z
FOR I = 1 TO 5
PRINT "Enter row:";
INPUT A(I, 1), A(I, 2), A(I, 3), A(I, 4), A(I, 5)
NEXT I
SYM = -1
FOR I = 1 TO 5
FOR J = 1 TO 5
IF A(I, J) <> A(J, I) THEN SYM = 0
NEXT J
NEXT I
PRINT "MATRIX IS ";
IF NOT SYM THEN PRINT "NOT ";
PRINT "SYMMETRIC"
'2.1
' This program will simulate NTF's ESP utility.
'
DIM JOB$(20)
INPUT "Enter jobs/CK:"; JOBS$
L = INT((LEN(JOBS$) + 1) / 3)
FOR I = 1 TO L
JOB$(I) = MID$(JOBS$, I * 3 - 2, 2)
NEXT I
I = 0: LASTCK = 0
WHILE I < L
I = LASTCK + 1
WHILE JOB$(I) <> "CK"
PRINT JOB$(I)
I = I + 1
WEND
PRINT "EVERYTHING OK?": INPUT OK$
IF OK$ = "N" THEN I = LASTCK ELSE LASTCK = I
WEND
'2.2
' This program will display random letters in random areas.
'
RANDOMIZE TIMER
CH$ = " ": LASTLET$ = " "
WHILE CH$ = " " OR (CH$ >= "A" AND CH$ <= "Z")
CLS
IF CH$ <> " " THEN
LETTER$ = CH$
ELSE
LETTER$ = CHR$(65 + INT(RND(3) * 26)): CH$ = LETTER$
END IF
LASTLET$ = LETTER$
WHILE CH$ = LASTLET$
R = INT(RND(3) * 23) + 1: C = INT(RND(3) * 79) + 1
LOCATE R, C: PRINT LETTER$;
FOR I = 1 TO 500: NEXT I
A$ = INKEY$: IF A$ <> "" THEN LETTER$ = A$: CH$ = A$
WEND
WEND
'2.3
' This program will transliterate Hebrew to English.
'
INPUT "Enter letters:"; ST$
LASTCH$ = " "
FOR I = 1 TO LEN(ST$)
CH$ = MID$(ST$, I, 1): LET$ = CH$
IF LASTCH$ = " " THEN
IF CH$ = "A" THEN
MD$ = MID$(ST$, I + 1, 1)
IF MD$ = "L" THEN LET$ = ")" ELSE LET$ = "("
END IF
IF MID$(ST$, I, 3) = "HET" THEN LET$ = "CH"
IF MID$(ST$, I, 2) = "TS" THEN LET$ = "TS"
TRANS$ = LET$ + TRANS$
END IF
LASTCH$ = CH$
NEXT I
PRINT TRANS$
'2.4
' This program will append a "security digit" to an account.
'
INPUT "Enter account number:"; ACCT$
L = LEN(ACCT$)
IF L <> 7 AND L <> 9 THEN
PRINT "ERROR - INCORRECT LENGTH": ER = -1
END IF
' Sum the valid digits
FOR I = 1 TO L
CH$ = MID$(ACCT$, I, 1)
DIG = ASC(CH$) - ASC("0")
IF DIG < 0 OR DIG > 9 THEN
PRINT "ERROR - NUM-NUMERIC": END
END IF
SUM = SUM + DIG
NEXT I
' If account is valid, append security digit
IF ER THEN END
PRINT ACCT$;
IF SUM MOD 2 = 0 THEN PRINT "1"; ELSE PRINT "0"
'2.5
' This program will count the digits used in a book.
'
DEFINT A-Z
INPUT "Enter last page:"; LPAGE
INPUT "Enter M:"; M
FOR I = 2 TO LPAGE
IF I MOD M > 0 THEN
PAGE$ = MID$(STR$(I), 2)
FOR J = 1 TO LEN(PAGE$)
DIG = VAL(MID$(PAGE$, J, 1))
A(DIG) = A(DIG) + 1
NEXT J
END IF
NEXT I
MIN = 32000
FOR I = 0 TO 9
PRINT I; "APPEARS"; A(I); "TIMES"
IF A(I) > MAX THEN MAX = A(I)
IF A(I) < MIN THEN MIN = A(I)
NEXT I
PRINT
PRINT "DIGIT(S) APPEARING THE MOST:";
FOR I = 0 TO 9
IF A(I) = MAX THEN PRINT USING "##"; I;
NEXT I: PRINT
PRINT "DIGIT(S) APPEARING THE LEAST:";
FOR I = 0 TO 9
IF A(I) = MIN THEN PRINT USING "##"; I;
NEXT I
'2.6
' This program will compute the roots for a quadratic.
'
DEFINT A-Z
INPUT "Enter coefficients A, B, C:"; A, B, C
D = B * B - 4 * A * C
PRINT "THE ROOTS ARE ";
IF D >= 0 THEN
PRINT "REAL"
R1 = (-B + INT(SQR(D))) / (2 * A)
R2 = (-B - INT(SQR(D))) / (2 * A)
GOSUB RemoveSpace
IF D > 0 THEN
PRINT "THE ROOTS ARE "; R1$; " AND "; R2$: END
ELSE
PRINT "THE ONLY ROOT IS "; R1$: END
END IF
END IF
' D < 0 Roots are Complex
PRINT "COMPLEX"
R1 = -B / (2 * A)
R2 = INT(SQR(-D)) / (2 * A)
GOSUB RemoveSpace
PRINT "THE ROOTS ARE "; R1$; " + "; R2$; "I AND ";
PRINT R1$; " - "; R2$; "I"
END
' Subroutine to remove leading space, not negative sign
RemoveSpace:
R1$ = LTRIM$(STR$(R1)): R2$ = LTRIM$(STR$(R2))
RETURN
'2.7
' This program will generate 5 customer account numbers.
'
DEFINT A-Z
DEFDBL S
INPUT "Enter seed used last:"; S
WHILE I < 15
' -- Add 1 and reverse last 2 digits
S = S + 1
CUST$ = MID$(STR$(S), 2): L = LEN(CUST$)
IF L < 9 THEN CUST$ = STRING$(9 - L, "0") + CUST$
LAST2$ = MID$(CUST$, 9, 1) + MID$(CUST$, 8, 1)
CUST$ = LEFT$(CUST$, 2) + LAST2$ + MID$(CUST$, 3, 5)
' -- Calculate check digit
SUM = 0
FOR J = 1 TO 9
DIG = VAL(MID$(CUST$, J, 1))
SUM = SUM + DIG * (11 - J)
NEXT J
CDIG = 11 - (SUM MOD 11)
IF CDIG = 11 THEN CDIG = 0
IF CDIG < 10 THEN
PRINT CUST$; : PRINT USING "#"; CDIG: I = I + 1
END IF
WEND
'2.8
' This program will compute speed, distance, and time.
'
INPUT "Enter speed, distance:"; S, D
INPUT "Enter time: "; TIM$
IF TIM$ <> "0" THEN
L = LEN(TIM$)
TTYPE$ = MID$(TIM$, L, 1)
IF TTYPE$ <> "C" THEN
T = VAL(MID$(TIM$, 1, L - 1))
ELSE
HH = VAL(MID$(TIM$, 1, 2))
MM = VAL(MID$(TIM$, 4, 2))
T = HH + MM / 60
END IF
IF TTYPE$ = "M" THEN T = T / 60
END IF
IF S = 0 THEN
PRINT USING "SPEED = ###.#"; D / T; : PRINT " MPH"
ELSE
IF D = 0 THEN
PRINT USING "DISTANCE = ####.#"; S * T; : PRINT " MILES"
ELSE ' TIM$ = "0"
PRINT USING "TIME = #.##"; D / S; : PRINT " HOURS"
END IF
END IF
'2.9
' This program will compute the response time.
'
INPUT "Enter reported date:"; RDATE$
INPUT "Enter reported time:"; RTIME$
INPUT "Enter cleared date:"; CDATE$
INPUT "Enter cleared time:"; CTIME$
RDAY = VAL(MID$(RDATE$, 4, 2))
CDAY = VAL(MID$(CDATE$, 4, 2))
RHOUR = VAL(MID$(RTIME$, 1, 2))
RMIN = VAL(MID$(RTIME$, 4, 2))
CHOUR = VAL(MID$(CTIME$, 1, 2))
CMIN = VAL(MID$(CTIME$, 4, 2))
IF RHOUR < 8 THEN RHOUR = 8: RMIN = 0
IF CHOUR < 8 THEN CHOUR = 8: CMIN = 0
IF CHOUR >= 17 THEN CHOUR = 17: CMIN = 0
IF RHOUR >= 17 THEN RHOUR = 17: RMIN = 0
RES = (CDAY - RDAY) * 9 * 60
RES = RES + (CHOUR - RHOUR) * 60 + (CMIN - RMIN)
PRINT "RESPONSE TIME WAS"; RES; "MINUTES"
'2.10
' This program will display the discounts for calling plans.
'
INPUT "Enter originating number:"; ORIGNUM$
INPUT "Enter number called:"; TONUM$
INPUT "Handicapped person?:"; HANDICAP$
INPUT "Enter length of call:"; CALLLEN
INPUT "Enter cost of call $:"; COST
ORIGAREA$ = LEFT$(ORIGNUM$, 3)
TOAREA$ = LEFT$(TONUM$, 3)
DIFFAREA = (ORIGAREA$ <> TOAREA$)
PLANA = 9999: PLANB = 9999: PLANC = 9999
IF (CALLLEN >= 5!) AND DIFFAREA THEN
PLANA = COST * .85
PCOST = PLANA: P$ = "A": GOSUB DisplayPlan
END IF
IF HANDICAP$ = "YES" THEN
PLANB = COST * .9
PCOST = PLANB: P$ = "B": GOSUB DisplayPlan
END IF
IF (TOAREA$ = "407") AND DIFFAREA AND (CALLEN < 3.5) THEN
PLANC = COST * .8775
PCOST = PLANC: P$ = "C": GOSUB DisplayPlan
END IF
IF P$ = "" THEN
PRINT "THIS PERSON DOES NOT QUALIFY FOR ANY PLANS"
ELSE
PRINT "THIS PERSON WOULD RECEIVE PLAN ";
IF PLANA < PLANB AND PLANA < PLANC THEN PRINT "A": END
IF PLANB < PLANA AND PLANB < PLANC THEN PRINT "B": END
PRINT "C"
END IF
END
' Subroutine to display plan charges
DisplayPlan:
PRINT "THE PLAN "; P$; " CHARGE WOULD BE $";
IF PCOST < 10 THEN
PRINT USING "#.##"; PCOST
ELSE
PRINT USING "##.##"; PCOST
END IF
RETURN
'3.1
' This program will convert transliterated English to Greek
'
DIM NAME$(24), VALUE(24)
DATA ALPHA,BETA,GAMMA,DELTA,EPSILON,ZETA,-TA,IOTA,KAPPA
DATA LAMBDA,MU,NU,XI,-MICRON,PI,RHO,SIGMA,TAU,UPSILON
DATA PHI,CHI,PSI,OMEGA,THETA
DATA 1,2,3,4,5,7,8,10,20,30,40,50,60,70,80
DATA 100,200,300,400,500,600,700,800,9
FOR I = 1 TO 24: READ NAME$(I): NEXT I
FOR I = 1 TO 24: READ VALUE(I): NEXT I
INPUT "Enter transliteration:"; TRANS$
I = 1
WHILE I <= LEN(TRANS$)
CH$ = MID$(TRANS$, I, 2)
DOUB = (CH$ = "TH") OR (CH$ = "PH")
DOUB = DOUB OR (CH$ = "CH") OR (CH$ = "PS")
IF DOUB THEN INC = 2 ELSE INC = 1
J = 1
WHILE MID$(TRANS$, I, INC) <> MID$(NAME$(J), 1, INC)
J = J + 1
WEND
PRINT NAME$(J); " ";
SUM = SUM + VALUE(J)
I = I + INC
WEND
PRINT : PRINT "NUMERICAL SUM ="; SUM
'3.2
' This program will move a taxi in a grid.
'
SOUTH = 8
INPUT "Enter starting position:"; SLET$, SNUM
NUM = SNUM
SNUMLET = ASC(SLET$) - ASC("A") + 1: NUMLET = SNUMLET
DO UNTIL DIR$ = "Q"
INPUT "Enter direction:"; DIR$
OCL = 0: TOOFAR = 0
SELECT CASE DIR$
CASE "N"
IF NUM = 1 THEN
OCL = -1
ELSE
IF SNUM - 2 = NUM THEN TOOFAR = -1 ELSE NUM = NUM - 1
END IF
CASE "S"
IF NUM = SOUTH THEN
OCL = -1
ELSE
IF SNUM + 2 = NUM THEN TOOFAR = -1 ELSE NUM = NUM + 1
END IF
CASE "W"
IF NUMLET = 1 THEN
OCL = -1
ELSE
IF SNUMLET - 2 = NUMLET THEN
TOOFAR = -1
ELSE
NUMLET = NUMLET - 1
END IF
END IF
CASE "E"
IF NUMLET = 26 THEN
OCL = -1
ELSE
IF SNUMLET + 2 = NUMLET THEN
TOOFAR = -1
ELSE
NUMLET = NUMLET + 1
END IF
END IF
END SELECT
' -- Display error or location
IF OCL THEN
PRINT "LOCATION IS OUTSIDE CITY LIMITS"
ELSE
IF TOOFAR THEN
PRINT "LOCATION IS TOO FAR ";
SELECT CASE DIR$
CASE "N": PRINT "NORTH"
CASE "S": PRINT "SOUTH"
CASE "W": PRINT "WEST"
CASE "E": PRINT "EAST"
END SELECT
ELSE
IF DIR$ <> "Q" THEN
PRINT "TAXI LOCATION IS ";
PRINT CHR$(NUMLET + 64); ","; LTRIM$(STR$(NUM))
END IF
END IF
END IF
LOOP
'3.3
' This program will display anagrams.
'
INPUT "Enter number of words:"; NUM
FOR I = 1 TO NUM
INPUT "Enter word:"; W$(I)
NEXT I
' -- Sort words in ascending order
FOR I = 1 TO NUM - 1
FOR J = I + 1 TO NUM
IF W$(I) > W$(J) THEN SWAP W$(I), W$(J)
NEXT J
NEXT I
' -- Sort letters within word and store in W2$()
FOR I = 1 TO NUM
L = LEN(W$(I))
FOR J = 1 TO L
SORTW$(J) = MID$(W$(I), J, 1)
NEXT J
FOR J = 1 TO L - 1
FOR K = J + 1 TO L
IF SORTW$(J) > SORTW$(K) THEN SWAP SORTW$(J), SORTW$(K)
NEXT K
NEXT J
FOR J = 1 TO L: W2$(I) = W2$(I) + SORTW$(J): NEXT J
NEXT I
' -- Compare every pair of sorted words for a match
FOR I = 1 TO NUM - 1
FOR J = I + 1 TO NUM
IF W2$(I) = W2$(J) THEN
TOT = TOT + 1
IF TOT = 1 THEN PRINT "ANAGRAMS: ";
IF TOT > 1 THEN PRINT " ";
PRINT W$(I); ", "; W$(J)
END IF
NEXT J
NEXT I
IF TOT = 0 THEN PRINT "NO ANAGRAMS IN LIST"
'3.4
' This program will place money in envelopes.
'
INPUT "Enter amount of money:"; MONEY
INC = INT(MONEY / 2)
FOR A = 1 TO INC - 2
FOR B = A + 1 TO INC - 1
FOR C = B + 1 TO INC
' { -- D will contain the largest amount to disperse }
D = MONEY - A - B - C
IF (A < B) AND (B < C) AND (C < D) THEN
' { -- (D - A) dollars are dispersed to make }
' { -- A=B, B=C, C=D, and D=A }
PRINT "TAKE ";
PRINT LTRIM$(STR$(A)); " "; LTRIM$(STR$(B)); " ";
PRINT LTRIM$(STR$(C)); " "; LTRIM$(STR$(D));
PRINT " AND DISPERSE"; D - A; "DOLLARS TO MAKE ";
PRINT LTRIM$(STR$(B)); " "; LTRIM$(STR$(C)); " ";
PRINT LTRIM$(STR$(D)); " "; LTRIM$(STR$(A))
TOTAL = TOTAL + 1
END IF
NEXT C
NEXT B
NEXT A
PRINT "TOTAL NUMBER OF SOLUTIONS ="; TOTAL
'3.5
' This program will convert Gregorian and Julian dates.
'
DIM MONTH(12)
DATA 31,28,31,30,31,30,31,31,30,31,30,31
FOR I = 1 TO 12: READ MONTH(I): NEXT I
INPUT "Enter Julian or Gregorian:"; DTYPE$
INPUT "Enter date:"; DTE$
IF DTYPE$ = "GREGORIAN" THEN
' Convert Gregorian to Julian
M = VAL(LEFT$(DTE$, 2))
D = VAL(MID$(DTE$, 4, 2))
YY$ = MID$(DTE$, 7, 2)
Y = VAL(YY$)
DAYS = D
FOR I = 1 TO M - 1: DAYS = DAYS + MONTH(I): NEXT I
IF (Y MOD 4 = 0) AND (M > 2) THEN DAYS = DAYS + 1
PRINT "JULIAN DATE = "; YY$;
IF DAYS < 100 THEN PRINT "0";
IF DAYS < 10 THEN PRINT "0";
PRINT LTRIM$(STR$(DAYS))
ELSE
' Convert Julian to Gregorian
YY$ = LEFT$(DTE$, 2)
Y = VAL(YY$)
D = VAL(MID$(DTE$, 3, 3))
M = 1
IF Y MOD 4 = 0 THEN MONTH(2) = 29
WHILE D > MONTH(M)
D = D - MONTH(M)
M = M + 1
WEND
PRINT "GREGORIAN DATE = ";
PRINT RIGHT$(STR$(100 + M), 2); "/";
PRINT RIGHT$(STR$(100 + D), 2); "/";
PRINT YY$
END IF
'3.6
' This program will convert a number from one base to another.
'
INPUT "Enter base of first number:"; BASE1
INPUT "Enter number:"; NUM1$
INPUT "Enter base of output:"; BASE2
' Convert Num1$ to base 10 number Num1V
FOR I = 1 TO LEN(NUM1$)
CH$ = MID$(NUM1$, I, 1)
DIGIT = ASC(CH$) - ASC("0")
IF DIGIT > 9 THEN DIGIT = DIGIT - 7
POWER = 1
FOR J = 1 TO LEN(NUM1$) - I
POWER = POWER * BASE1
NEXT J
NUM1V = NUM1V + DIGIT * POWER
NEXT I
' Convert Num1V to Base2 number
J = INT(LOG(NUM1V) / LOG(BASE2))
FOR I = J TO 0 STEP -1
POWER = 1
FOR K = 1 TO I: POWER = POWER * BASE2: NEXT K
X = INT(NUM1V / POWER)
NUMOUT$ = MID$("0123456789ABCDEF", X + 1, 1) + NUMOUT$
NUM1V = NUM1V - X * POWER
NEXT I
PRINT NUMOUT$
'3.7
' This program will SHELL sort numbers generated.
'
DIM X(-1093 TO 8000)
NUM = 8000: MAX = 7
INPUT "Enter seed X(0):"; X(0)
POW = 1
FOR I = 1 TO 20: POW = POW * 2: NEXT I
FOR I = 1 TO 8000
Q = INT((69069 * X(I - 1)) / POW)
X(I) = 69069 * X(I - 1) - POW * Q
NEXT I
' Shell sort routine
INCR(MAX) = 1
FOR I = MAX - 1 TO 1 STEP -1
INCR(I) = 3 * INCR(I + 1) + 1
NEXT I
FOR I = 1 TO MAX
INCREMENT = INCR(I)
FOR J = 1 TO INCREMENT
LAST = INCREMENT + J
WHILE LAST <= NUM
P = LAST
T = X(P)
X(1 - INCREMENT) = T
WHILE T < X(P - INCREMENT)
X(P) = X(P - INCREMENT)
P = P - INCREMENT
WEND
X(P) = T
LAST = LAST + INCREMENT
WEND
NEXT J
NEXT I
' Display every 1000th number in ascending order
FOR I = 1 TO INT(NUM / 1000)
PRINT USING "####"; I * 1000;
PRINT "TH NUMBER ="; X(I * 1000)
NEXT I
'3.8
' This program will compute the volume of a sphere using PI.
'
DEFINT A-Z
PI1$ = "3141592653589793238462643383279502884"
PI2$ = "1971693993751058209749445923078164062"
PI3$ = "8620899862803482534211706798214808651"
PI$ = PI1$ + PI2$ + PI3$
DIM PROD(120)
INPUT "Enter N:"; N
INPUT "Enter radius:"; RADIUS
' Assign digits of PI to Array PI()
L = LEN(PI$)
FOR I = 1 TO L
PROD(I) = VAL(MID$(PI$, L - I + 1, 1))
NEXT I
'
FOR I = 1 TO 3: A(I) = RADIUS: NEXT I
A(4) = 4
' Multiply PI by Radius (3 times) then by 4
FOR I = 1 TO 4
FOR J = 1 TO L
PROD(J) = PROD(J) * A(I) + C
C = INT(PROD(J) / 10)
PROD(J) = PROD(J) - C * 10
NEXT J
WHILE C > 0
CC = INT(C / 10)
L = L + 1
PROD(L) = C - CC * 10
C = CC
WEND
NEXT I
' Divide the product by 3
FOR I = L TO 1 STEP -1
PR = PROD(I) + R * 10
PROD(I) = INT(PR / 3)
R = PR - PROD(I) * 3
NEXT I
IF PROD(L) = 0 THEN L = L - 1
' Display the Volume with the decimal point.
FOR I = L TO 111 - N STEP -1
IF I = 110 THEN PRINT ".";
PRINT USING "#"; PROD(I);
NEXT I
'3.9
' This program will display the barcode of an address.
'
DATA 7,4,2,1,0
FOR I = 1 TO 5: READ VALUE(I): NEXT I
INPUT "Enter address 1:"; ADDR1$
INPUT "Enter address 2:"; ADDR2$
' Extract Zip+4 or Zip from 2nd line of address
L = LEN(ADDR2$)
I = L
WHILE MID$(ADDR2$, I, 1) <> " ": I = I - 1: WEND
IF L - I = 10 THEN
BARCODE$ = MID$(ADDR2$, I + 1, 5) + MID$(ADDR2$, L - 3, 4)
ELSE
BARCODE$ = MID$(ADDR2$, L - 4, 5)
END IF
' Extact possible Zip+4 and/or next 2 Delivery points
IF MID$(ADDR1$, 1, 8) = "P.O. BOX" THEN
L = LEN(ADDR1$)
I = L
WHILE MID$(ADDR1$, I, 1) <> " ": I = I - 1: WEND
FOR J = 1 TO 4 - (L - I): ZIP4$ = ZIP4$ + "0": NEXT J
ZIP4$ = ZIP4$ + MID$(ADDR1$, I + 1, L - I)
DPOINT$ = MID$(ZIP4$, 3, 2)
ELSE
ZIP4$ = "0000"
ADDR1$ = "0" + ADDR1$
P = INSTR(1, ADDR1$, " ")
DPOINT$ = MID$(ADDR1$, P - 2, 2)
END IF
'
IF LEN(BARCODE$) = 5 THEN BARCODE$ = BARCODE$ + ZIP4$
BARCODE$ = BARCODE$ + DPOINT$
' Calculate Check Digit for 12-digit Barcode and display
FOR I = 1 TO 11
SUM = SUM + VAL(MID$(BARCODE$, I, 1))
NEXT I
CHECKDIG = 10 - (SUM MOD 10)
IF CHECKDIG = 10 THEN CHECKDIG = 0
BARCODE$ = BARCODE$ + CHR$(CHECKDIG + 48)
PRINT SPACE$(12); "DELIVERY POINT BAR CODE = "; BARCODE$
PRINT
' Display Fram bars and encoded Barcode
PRINT "!";
FOR I = 1 TO 12
DIG = VAL(MID$(BARCODE$, I, 1))
NUMBARS = 0
IF DIG = 0 THEN DIG = 11 ' Exception for 0 = 7 + 4
FOR J = 1 TO 5
IF (DIG >= VALUE(J)) AND (NUMBARS < 2) THEN
PRINT "!";
DIG = DIG - VALUE(J)
NUMBARS = NUMBARS + 1
ELSE
PRINT " ";
END IF
NEXT J
NEXT I
PRINT "!"
FOR I = 1 TO 62: PRINT "!"; : NEXT I
'3.10
' This program produces a 3 x 3 magic square.
'
INPUT "Enter first number:"; FIRSTNUM
INPUT "Enter increment:"; INC
INPUT "Enter number:"; NUM1
INPUT "Enter row, col:"; ROW, COL
POS1 = (ROW - 1) * 3 + COL
INPUT "Enter number:"; NUM2
INPUT "Enter row, col:"; ROW, COL
POS2 = (ROW - 1) * 3 + COL
NUMBER = 7
FOR I = 1 TO NUMBER + 2
NUM = FIRSTNUM + (I - 1) * INC
SUM = SUM + NUM
IF NUM <> NUM1 AND NUM <> NUM2 THEN J = J + 1: S(J) = NUM
NEXT I
MNUM = SUM / 3
' Permute 7 numbers in 3x3 array
FOR N7 = 1 TO 7: H = 6: GOSUB ShiftNums
FOR N6 = 1 TO 6: H = 5: GOSUB ShiftNums
FOR N5 = 1 TO 5: H = 4: GOSUB ShiftNums
FOR N4 = 1 TO 4: H = 3: GOSUB ShiftNums
FOR N3 = 1 TO 3: H = 2: GOSUB ShiftNums
FOR N2 = 1 TO 2: J = 0
FOR I = 1 TO 9
' Place 2 entered numbers in correct positions
IF I = POS1 THEN
SS(I) = NUM1
ELSE
IF I = POS2 THEN
SS(I) = NUM2
ELSE
J = J + 1: SS(I) = S(J)
END IF
END IF
NEXT I
MAGICN = -1
' Check if row elements sum to Magic Number
FOR J = 0 TO 2
SUM = SS(J * 3 + 1) + SS(J * 3 + 2) + SS(J * 3 + 3)
IF SUM <> MNUM THEN MAGICN = 0
NEXT J
' Check if column elements sum to Magic Number
FOR J = 1 TO 3
IF SS(J) + SS(J + 3) + SS(J + 6) <> MNUM THEN MAGICN = 0
NEXT J
' Check if diagonal elements sum to Magic Number
IF MAGICN THEN
IF (SS(1) + SS(5) + SS(9) = MNUM) THEN
IF (SS(3) + SS(5) + SS(7) = MNUM) THEN
FOR J = 0 TO 2
FOR K = 1 TO 3
PRINT USING "###"; SS(J * 3 + K);
NEXT K: PRINT
NEXT J
PRINT
PRINT "MAGIC NUMBER ="; MNUM: END
END IF
END IF
END IF
SWAP S(NUMBER), S(NUMBER - 1)
NEXT N2
NEXT N3
NEXT N4
NEXT N5
NEXT N6
NEXT N7: END
' Subroutine to shift numbers in array
ShiftNums:
TEMP = S(NUMBER - H)
FOR J = NUMBER - H TO NUMBER - 1
S(J) = S(J + 1)
NEXT J
S(NUMBER) = TEMP
RETURN