Category : BASIC Source Code
Archive   : ALGEBRA2.ZIP
Filename : CBS.BAS

 
Output of file : CBS.BAS contained in archive : ALGEBRA2.ZIP
1 DEF SEG=0:POKE 108,&H39:POKE 109,&HE7:POKE 110,&H0:POKE 111,&HF0
2 DEF SEG=64:POKE 23,&H40 OR PEEK(23)
3 KEY OFF:CLEAR ,,2048:FOR I=1 TO 10:KEY I,"":NEXT
4 KEY (9) ON:KEY(10) ON
5 ON KEY(9) GOSUB 61000:ON KEY(10) GOSUB 61020
6 GOSUB 61040
7 R=0:X=0
8 GOSUB 62000
9 CLS
15 '
18 '*****************************
19 '* "Factoring" *
20 '* translated to *
21 '* the IBM PC in 1984 *
22 '* by *
23 '* The Owego Translators *
24 '*---------------------------*
25 '* Revised & Debugged By *
26 '* Kevin Vessio 1/18/85 *
27 '* *
28 '* Copyright 1984 *
29 '* Microcomputer Workshops *
38 '*****************************
39 '
60 DIM C1%(2),C2%(2),D(2),E%(7),EF%(7),FA%(1,6,1),TE%(7),M1%(1),M2%(1),ME$(11),MU(2),POLY%(2),R%(1),RE%(2)
70 DEF FN R(X) = INT (X * RND (1) + 1) ' Random number
80 DEF FN SIGN(X) = INT (2 * FN R(2)) - 3 'Return random sign
90 DEF FN DIVQQ(X) = (X / QQ) = (X \ QQ) 'Returns -1 if x is a mult. of QQ, 0 if not.
95 DEF FN RAND(X)= X*VAL(RIGHT$(TIME$,2))*VAL(MID$(TIME$,4,2)):GOTO 500
100 ME$(0)="Very impressive, "+N$+"!"
110 ME$(1)="I see you've been doing your homework!"
120 ME$(2)="Too bad your teacher can't see this!"
125 ME$(3)="The math department is proud of you!"
130 ME$(4)="Well, we can't all be perfect."
140 ME$(5)="Okay "+N$+",that was a good try."
150 ME$(6)="You almost made it on that one."
155 ME$(7)="Keep trying. You're doing well."
160 ME$(8)="These problems are not easy."
170 ME$(9)="Keep trying, "+N$+". You'll get it."
180 ME$(10)="Don't be discouraged. You'll get better."
190 ME$(11)="Try again. Practice makes perfect."
200 GOTO 650
500 REM Print a title page.
510 CLS:LOCATE 7,5,0:PRINT "FACTORING ALGEBRAIC EXPRESSIONS"
515 LOCATE 11,10:PRINT "Designed by Don Ross"
530 LOCATE 15,4:PRINT "Microcomputer Workshops Courseware"
540 LOCATE 17,13:PRINT "Copyright 1984"
545 LOCATE 1,1:PRINT STRING$(40,219);:FOR I=2 TO 22:LOCATE I,1:PRINT "Û";:LOCATE I,40:PRINT "Û";:NEXT:LOCATE 23,1:PRINT STRING$(40,219);
550 GOSUB 30000: GOSUB 30000
600 REM Get student's name.
610 FL=0:GOSUB 64000:GOTO 100
620 REM Instructions?
650 CLS : LOCATE 2,1,0:PRINT "Hi, ";N$;"!": PRINT:PRINT"This program will help you practice":PRINT:PRINT"factoring different kinds of algebraic":PRINT:PRINT"expressions."
660 LOCATE 12,1,1:PRINT "Do you want instructions (Y or N)? ";
670 Q$ = INKEY$:IF Q$="" THEN 670
680 IF Q$ = "Y" OR Q$ = "y" THEN PRINT"Y":LOCATE ,,0:GOSUB 60000:GOTO 700
690 IF Q$ <>"n" AND Q$ <>"N" THEN 670 ELSE PRINT"N":LOCATE ,,0
700 CLS:LOCATE 3,,0
710 PRINT "What kind of problems do you want?": PRINT : PRINT : PRINT
720 PRINT " 1. Easy quadratic trinomials":PRINT
730 PRINT " 2. Hard quadratic trinomials":PRINT
740 PRINT " 3. Difference of two squares":PRINT
750 PRINT " 4. Common factors":PRINT
760 PRINT " 5. Mixed problems":PRINT
762 IF N% <> 0 THEN PRINT " 6. Exit program":PRINT
765 PRINT:PRINT:LOCATE ,4,1:PRINT "Your selection: ";
780 Q$ = INPUT$(1)
782 IF INSTR("123456",Q$)=0 THEN 780
790 IF Q$="6" AND N%=0 THEN 780
795 LOCATE ,,0:PRINT Q$:TYPE%=VAL(Q$)
799 IF Q$ = "6" THEN CLS :GOSUB 45000: END
800 GOSUB 64500
820 FOR QQ=1 TO 9:QUAD(QQ,0)=0:QUAD(QQ,1)=0:DIF(QQ,0)=0:DIF(QQ,1)=0:NEXT
830 N% = NP
840 FOR QQ = 1 TO 7:TE%(QQ) = 0: NEXT QQ:TE% = 0
1000 ' Do N% problems.
1005 FOR P = 1 TO N% :FOR QQ = 1 TO 7:E%(QQ) = 0: NEXT QQ:QUIT% = 0
1010 ON TYPE% GOSUB 2000,3000,4000,5000:IF TYPE% = 5 THEN ON FN R(5) GOSUB 2000,3000,3000,4000,5000
1015 CLS :PRINT:PRINT:COLOR 0,7 :PRINT " FACTOR " :COLOR 7,0
1017 LOCATE 1,1:PRINT "Problem #";USING"#";P;
1020 D(2) = POLY%(2):D(1) = POLY%(1):D(0) = POLY%(0):LOCATE 3,15:GOSUB 10000
1025 PRINT :PRINT STRING$(40,"-");
1030 BASE%=VARPTR(CLRSCRN$)+1:CLR=PEEK(BASE%)+256*PEEK(BASE%+1):T%=6:B%=25:CALL CLR(T%,B%)
1035 LOCATE 6,1:COLOR 0,7:PRINT " WORK SPACE ":COLOR 7,0:PRINT
1040 IF CF% THEN LOCATE ,11:GOSUB 22000:IF NOT HELP% AND OK% THEN D(2) = MU(2):D(1) = MU(1):D(0) = MU(0):LOCATE ,21 :PRINT " = ";:GOSUB 10000:GOTO 1050
1045 IF NOT CF% THEN LOCATE ,4:GOSUB 20000:IF NOT HELP% AND OK% THEN D(2) = MU(2):D(1) = MU(1):D(0) = MU(0):LOCATE ,20:PRINT " = ";:GOSUB 10000
1050 LOCATE 12,1,0 ' turn off cursor
1055 EF%(1) = NOT OK% :EF%(2) = NOT (F0% = 0 AND M0% = 1 OR F0% = 1 AND M0% = 0 OR F0% = M0%) :EF%(3) = D2% AND (POLY%(2) < > MU(2) OR POLY%(1) < > MU(1) OR POLY%(0) <> MU(0)):EF%(4) = POLY%(2) < > MU(2)
1060 EF%(5) = SGN(POLY%(0)) < > SGN(MU(0)) :EF%(6) =ABS(POLY%(0)) < > ABS(MU(0)):EF%(7) = POLY%(1) < > MU(1)
1065 EF%(0) = 0:FOR QQ = 1 TO 7:EF%(0) =EF%(0) - EF%(QQ): NEXT QQ
1100 IF NOT EF%(1) THEN 1200
1110 E%(1) = E%(1) + 1
1120 LOCATE 16:PRINT "Sorry, ";N$;".":PRINT
1130 PRINT "Any factor must have the form Ax + B,":PRINT
1140 PRINT "where A and B are integers.":PRINT
1150 GOSUB 50000:GOTO 1030
1200 IF NOT CF% THEN 1300
1210 IF EF%(0) - ABS(EF%(2)) = 0 AND FX% = XF% AND LF% = F0% THEN 1900
1220 E%(2) = E%(2) + 1
1230 IF LF%=1 AND NOT XF% THEN PRINT "You're not being careful, ";N$;".":PRINT:PRINT"Don't forget that the terms of this":PRINT:PRINT"binomial have a common factor.":PRINT:PRINT"Once you remove that factor, you'll be":PRINT:PRINT"done with this problem."
1235 IF LF%=1 AND NOT XF% THEN GOSUB 50000:GOTO 1030
1240 IF FX% = XF% AND LF% = F0% THEN LOCATE 16 :PRINT "Very close, ";N$;".":PRINT :PRINT "You found the right common factor, but ":PRINT :PRINT "you made an error in computation.": GOSUB 50000:GOTO 1030
1250 IF LF% = F0% AND FX% THEN LOCATE 16 :PRINT "You made a small oversight, ";N$;".":PRINT :PRINT "Notice that X is also a factor in each ":PRINT :PRINT "term of this polynomial.":GOSUB 50000:GOTO 1030
1255 COLOR 0,0
1260 IF NOT ((F0%/LF% <> F0%\LF%) OR XF% AND NOT FX%) THEN LOCATE 16:COLOR 7,0:PRINT "You're on the right track, "N$",":PRINT : PRINT "but you did not find the largest ":PRINT :PRINT "common factor for this polynomial. ":GOSUB 50000:GOTO 1030
1270 COLOR 7,0:LOCATE 16:PRINT "That's not right, ";N$;".":PRINT :PRINT "The terms of this polynomial are not ":PRINT :PRINT "all divisible by ";
1280 D(2) = 0:D(1) = 0:D(0) = LF% : IF XF% THEN D(1) = D(0):D(0) = 0
1290 GOSUB 10000:PRINT ".":GOSUB 50000 :GOTO 1030
1300 IF NOT EF%(2) THEN 1400
1305 E%(2) = E%(2) + 1
1310 IF EF%(3) THEN IF F0%>1 THEN 1365:ELSE 1410
1315 IF M0% = 0 OR M0% = 1 THEN 1335
1320 IF F0% = 0 OR F0% = 1 THEN 1345
1325 LOCATE 12:PRINT "That's not right, ";N$;".":PRINT :PRINT M0%;"is not the largest common factor":PRINT
1330 PRINT "of ";POLY%(2);CHR$(29);",and ";POLY%(0);".":GOTO 1355
1335 LOCATE 12:PRINT "Sorry, ";N$;".":PRINT :PRINT "You've left out an important step.":PRINT
1340 PRINT "Don't forget that ";POLY%(2);CHR$(29);", and ";POLY%(0):PRINT:PRINT "have a common factor. ":GOTO 1355
1345 LOCATE 12:PRINT "Not quite, ";N$;".":PRINT
1350 PRINT "The terms of this polynomial don't ":PRINT :PRINT "have any common factors. "
1355 IF EF%(0) = 1 THEN PRINT :PRINT "Find the right factor, and you're done.":GOTO 1375
1360 PRINT :PRINT "Get this part right, then worry":PRINT :PRINT "about the rest of the problem.":GOTO 1375
1365 E%(3)=E%(3)+1:LOCATE 12,1:PRINT "I can see two mistakes, ";N$;".":PRINT :PRINT "You didn't factor out a correct common":PRINT :PRINT "factor, and you didn't use the proper ":PRINT :PRINT "method for a difference of two squares."
1370 PRINT :PRINT "If you fix these errors, you'll have ":PRINT :PRINT "the right answer."
1375 GOSUB 50000 :GOTO 1030
1400 IF NOT EF%(3)THEN 1500
1410 E%(3) = E%(3) + 1
1420 PRINT "I'm afraid that's wrong, ";N$;".":PRINT
1430 IF MU(1) = MU(0) THEN 1460
1440 PRINT "If you look carefully, you'll notice":PRINT :PRINT "that this is a difference of two squares"
1450 PRINT "problem. You must use a special ":PRINT :PRINT "method for this kind of problem. ":GOTO 1499
1460 PRINT "You have the wrong factors.":PRINT
1465 T1% = POLY%(2):T2% = -POLY%(0):IF M0% < > 1 AND M0%<>0 THEN T1% = T1%/M0%:T2% = T2%/M0%
1470 PRINT "Let me give you a hint.":PRINT :PRINT "The square root of ";:D(2) = T1% : D(1) = 0 :D(0) = 0:GOSUB 10000:PRINT " is ";:D(2) = 0 :D(1) = R%(1):GOSUB 10000:PRINT ", and ":PRINT
1480 PRINT "the square root of ";T2%; " is ";R%(0);CHR$(29)"."
1499 GOSUB 50000:GOTO 1030
1500 IF NOT EF%(4) THEN 1600
1505 E%(4) = E%(4) + 1
1510 IF EF%(5) OR EF%(6) THEN 1550
1515 PRINT "You're a little off, ";N$;". To get": PRINT
1520 PRINT "the right xý term, the product of the": PRINT
1525 PRINT "coefficients of x in the factors":PRINT
1530 IF M0% > 1 THEN PRINT "and the";STR$(M0%);" which you have factored out":PRINT
1535 PRINT "must be equal to";STR$(POLY%(2));".";
1540 IF NOT EF%(7) THEN 1595
1545 PRINT " Once you get the":PRINT :PRINT "first term, you can fix the linear term.";: GOTO 1595
1550 IF EF%(5) AND EF%(6) THEN 1580
1555 PRINT "Well, ";N$;", I see two problems.":PRINT :PRINT "First, the ";:D(2) = 1:D(1) = 0:D(0) = 0: GOSUB 10000:PRINT " term is wrong. Second,":PRINT
1560 PRINT "the constant term ";: IF EF%(5) THEN E%(5) = E%(5) + 1: PRINT "has the wrong sign.":PRINT : GOTO 1570
1565 E%(6) = E%(6) + 1: PRINT "is incorrect.":PRINT
1570 IF NOT EF%(7) THEN 1595
1575 GOTO 1590
1580 E%(5) = E%(5) + 1:E%(6) = E%(6) + 1:PRINT "You have made three errors, ";N$;".":PRINT
1585 PRINT "The ";:D(2) = 1:D(1) = 0:D(0) = 0: GOSUB 10000:PRINT " term is wrong, and the constant":PRINT :PRINT "term is wrong in both sign and value.":PRINT :IF NOT EF%(7) THEN 1595
1590 PRINT "Correct these errors before you try to":PRINT :PRINT "get the right linear term."
1595 GOSUB 50000:GOTO 1030
1600 IF NOT EF%(5) THEN 1700
1605 E%(5) = E%(5) + 1
1610 IF EF%(6) THEN 1660
1615 IF SGN (POLY%(0)) = - 1 THEN 1635
1620 LOCATE 12:PRINT "That isn't correct, ";N$;".":PRINT
1625 PRINT "Since the constant term is positive, ":PRINT :PRINT "the constant terms in the factors must ":PRINT
1630 PRINT "have the same sign: both positive ":PRINT :PRINT "or both negative.";:GOTO 1650
1635 LOCATE 12:PRINT "That isn't correct, ";N$;".":PRINT
1640 PRINT "Since the constant term is negative,": PRINT :PRINT "the constant terms in the factor must ":PRINT
1645 PRINT "have different signs: one positive ":PRINT :PRINT "and one negative.";
1650 IF NOT EF%(7) THEN 1670
1655 PRINT " Once you correct the":PRINT :PRINT "sign, you can work on the linear term. ":GOTO 1670
1660 E%(6) = E%(6)+1: PRINT :PRINT N$;", you have made two mistakes.":PRINT :PRINT "The constant term has the wrong sign as":PRINT :PRINT "well as the wrong value.":PRINT :IF NOT EF%(7) THEN 1670
1665 PRINT "If you fix both of these errors, then":PRINT :PRINT "getting the linear term will be ":PRINT :PRINT "the last step."
1670 GOSUB 50000:GOTO 1030
1700 IF NOT EF%(6) THEN 1800
1710 E%(6) = E%(6) + 1
1720 LOCATE 12:PRINT "You're not quite right, ";N$;".":PRINT
1730 PRINT "To get the correct constant term, the":PRINT
1740 PRINT "product of the constants in the factors":PRINT
1750 IF M0% > 1 THEN PRINT "times the ";M0%;" you factored out": PRINT
1760 PRINT "must be equal to ";POLY%(0);CHR$(29);".";
1770 'IF NOT EF%(7) THEN 1790
1780 PRINT " Fix this term,":PRINT :PRINT "and you just have the linear term left."
1790 GOSUB 50000:GOTO 1030
1800 IF NOT EF%(7) THEN 1900
1810 E%(7) = E%(7) + 1
1820 LOCATE 12:PRINT "Close, ";N$;", but no cigar. ":PRINT
1830 PRINT "To get the linear term to match, you": PRINT
1840 PRINT "must make sure that the sum of the": PRINT
1850 PRINT "products of the inner and outer terms":PRINT
1860 IF M0% > 1 THEN PRINT "times the factor of ";M0%;" ";
1870 PRINT "is ";:D(2) = 0:D(1) = POLY%(1):D(0) = 0: GOSUB 10000: PRINT "."
1880 GOSUB 50000 :GOTO 1030
1900 LOCATE 16,20-((LEN(N$)+12)/2):PRINT "Good work, ";N$;".":PRINT
1910 LOCATE ,13,0:PRINT "That is correct."
1920 GOSUB 50000
1930 GOSUB 35000:REM Print error breakdown.
1940 NEXT P
1950 GOSUB 40000:REM Final error breakdown.
1960 LOCATE 20:GOTO 650
2000 REM Create an easy trinomial problem.
2010 D2% = 0:CF% = 0:F0% = 0:M0% = 0:M1%(1) = 1:M2%(1) = 1:M1%(0) = FN R(9) * FN SIGN(0):M2%(0) = FN R(9) * FN SIGN(0): IF M1%(0) = - M2%(0) THEN 2010
2020 GOSUB 15000
2030 POLY%(2) = MU(2):IF POLY%(2)=72 THEN 2000:ELSE POLY%(1) = MU(1):POLY%(0) = MU(0)
2040 OK2=0:FOR QQ=1 TO P:IF POLY%(1)=QUAD(QQ,0) AND POLY%(2)=QUAD(QQ,1) THEN OK2=1
2050 NEXT:IF OK2=1 THEN 2000:ELSE QUAD(P,0)=POLY%(1):QUAD(P,1)=POLY%(2):RETURN
3000 REM Create a hard trinomial problem.
3005 '
3010 D2% = 0:CF% = 0:M0% =1:M1%(1) = FN R(3):M2%(1) = FN R(3):M1%(0) = FN R(9) * FN SIGN(0):M2%(0) = FN R(9) * FN SIGN(0)
3015 IF M0%*M1%(1)*M2%(1)>4 THEN 3005
3020 FOR QQ = 2 TO 9:IF FN DIVQQ(M1%(1)) AND FN DIVQQ(M1%(0)) OR FN DIVQQ(M2%(1)) AND FN DIVQQ(M2%(0)) THEN 3005
3030 NEXT QQ
3040 IF (M1%(1) = M2%(1) AND M1%(0) = - M2%(0)) OR (M1%(1) = 1 AND M2%(1) = 1 AND M0% = 1) THEN 3005
3050 GOSUB 15000
3060 POLY%(2) = MU(2):IF POLY%(2)=72 THEN 3000:ELSE POLY%(1) = MU(1):POLY%(0) = MU(0):F0% = M0%:RETURN
4000 REM Create a difference of squares problem.
4005 LC1%= NOT LC1%
4010 D2% =-1:CF% = 0:R%(1) = FN R(3):R%(0) = FN R(9):FOR QQ = 2 TO R%(1):IF FN DIVQQ(R%(1)) AND FN DIVQQ(R%(0)) THEN 4010
4011 M0%=1:IF FN R(4)=2 THEN M0%=FN R(5)+1
4012 IF M0%*R%(1)^2>9 THEN 4010
4015 IF (LC1% AND (M0%<>1 OR R%(1)<>1)) OR ( NOT LC1% AND M0%=1 AND R%(1)=1) THEN 4010
4020 NEXT QQ
4030 M1%(1) = R%(1):M2%(1) = R%(1):M1%(0) = R%(0):M2%(0) = - R%(0)
4040 GOSUB 15000
4050 POLY%(2) = MU(2):POLY%(1) = MU(1):POLY%(0) = MU(0):F0% = M0%
4060 OK2=0:FOR QQ=1 TO P:IF POLY%(2)=DIF(QQ,0) AND POLY%(0)=DIF(QQ,1) THEN OK2=1
4070 NEXT:IF OK2=1 THEN 4000:ELSE DIF(P,0)=POLY%(2):DIF(P,1)=POLY%(0):RETURN
5000 REM Create a common factor problem.
5010 D2% = 0:CF% = -1:M0% = FN R(9):FX% = 0:M1%(1) = 0:M1%(0) = 1:M2%(1) = FN R(3):M2%(0) = FN R(9):IF M2%(0) / M2%(1) = M2%(0) \ M2%(1) THEN 5010
5020 IF FN R(2)=2 THEN FX% =-1:M1%(1) = 1:M1%(0) = 0
5030 IF NOT FX% AND M0% = 1 THEN 5010
5040 GOSUB 15000
5050 POLY%(2) = MU(2):POLY%(1) = MU(1):POLY%(0)=MU(0):F0% = M0%: RETURN
5996 '
5997 '******************
5998 '* Sample Problem *
5999 '******************
6000 CLS:LOCATE 7,1:PRINT N$",":PRINT:PRINT"let's use an easy quadratic trinomial":PRINT:PRINT"as our sample problem.":GOSUB 50000
6010 CLS:PRINT"Sample":PRINT:COLOR 0,7:PRINT" FACTOR ";:COLOR 7,0:PRINT TAB(15)"X"CHR$(253);"-11X+30":PRINT STRING$(40,"-")
6020 LOCATE 6,1:COLOR 0,7:PRINT" WORK SPACE ":COLOR 7,0:PRINT:PRINT TAB(6)"( x )( x )":LOCATE 14,1:PRINT STRING$(40,"-")
6030 PRINT" The cursor will appear inside the":PRINT:PRINT"parentheses. This is where you will":PRINT:PRINT"enter your factors.":GOSUB 50000:GOSUB 6900
6040 PRINT" The factors for this equation are":PRINT:PRINT"( x-5 ) and ( x-6 ). Now you must":PRINT:PRINT"type the factors in.":GOSUB 50000:GOSUB 6900
6050 PRINT"The first factor is ( x-5 ).":LOCATE 22,1:PRINT" To move the cursor, press the right":PRINT:PRINT" arrow key.";:LOCATE 8,7,1
6060 GOSUB 6800:IF I$<>CHR$(0)+"M" THEN 6060
6070 LOCATE ,,0:T%=21:B%=25:CALL CLR(T%,B%):LOCATE 22,7:PRINT"Now press the minus key <->.":LOCATE 8,9,1
6075 GOSUB 6800:IF I$<>"-" THEN 6075 ELSE LOCATE ,,0:PRINT"-";
6080 T%=21:CALL CLR(T%,B%):LOCATE 22,13:PRINT"Now press <5>.":LOCATE 8,10,1
6085 GOSUB 6800:IF I$<>"5" THEN 6085 ELSE LOCATE ,,0:PRINT"5";
6090 CALL CLR(T%,B%):LOCATE 18,1:PRINT"Now we must move the cusor again.":LOCATE 22,4:PRINT"Press the right arrow key twice.":LOCATE 8,11,1
6095 GOSUB 6800:IF I$<>CHR$(0)+"M" THEN 6095 ELSE LOCATE 8,14,1
6100 GOSUB 6800:IF I$<>CHR$(0)+"M" THEN 6100
6110 LOCATE ,,0:GOSUB 6900:PRINT"The second factor is ( x-6 ).":LOCATE 22,9:PRINT"Press the minus key <->.":LOCATE 8,16,1
6120 GOSUB 6800:IF I$<>"-" THEN 6120 ELSE LOCATE ,,0:PRINT"-";
6130 T%=21:CALL CLR(T%,B%):LOCATE 22,13:PRINT"Now press <6>.":LOCATE 8,17,1
6140 GOSUB 6800:IF I$<>"6" THEN 6140 ELSE LOCATE ,,0:PRINT"6 ) = X"CHR$(253)"-11X+30";
6150 GOSUB 6900:PRINT TAB(15)"Well done!":PRINT:PRINT" You've completed the sample problem.":GOSUB 50000:GOTO 60900
6800 I$=INKEY$
6805 DEF SEG=&H40:QQ=PEEK(&H17):IF (QQ AND &H20)<>0 THEN POKE &H17,QQ-32:IF M$="4" THEN M$=" K":ELSE IF M$="6" THEN M$=" M"
6806 DEF SEG
6810 I$=INKEY$:IF I$="" THEN 6805:ELSE RETURN
6900 T%=15:B%=25:CALL CLR(T%,B%):LOCATE 16,1:RETURN
10000 REM Display Subroutine
10001 REM Pass Coefficients of Poly. in
10002 REM D(2-0)
10010 IF D(2) = 0 THEN 10100
10020 IF D(2) <> 1 THEN PRINT RIGHT$(STR$(D(2)),LEN(STR$(D(2)))-1);
10030 PRINT "xý";
10100 IF D(1) = 0 THEN 10200
10110 IF D(1) > 0 AND D(2) < > 0 THEN PRINT "+";
10120 IF D(1)<0 AND D(1)<>-1 THEN PRINT "-";
10130 IF ABS (D(1)) < > 1 THEN PRINT RIGHT$(STR$(D(1)),LEN(STR$(D(1)))-1);
10135 IF D(1) = - 1 THEN PRINT "-";
10140 PRINT "x";
10200 IF D(0) = 0 THEN 10300
10210 IF D(0) > 0 AND (D(2) < > 0 OR D(1) < > 0) THEN PRINT "+";
10220 IF D(0)<0 THEN PRINT "-";
10230 PRINT RIGHT$(STR$(D(0)),LEN(STR$(D(0)))-1);
10300 IF D(2) = 0 AND D(1) = 0 AND D(0) = 0 THEN PRINT 0;
10400 RETURN
15000 REM Multiply Subroutine
15001 REM Pass Coefficients of
15002 REM factors in
15003 REM M1%(1-0), M2%(1-0)
15004 REM Pass Constant Factor
15005 REM (if any) in M0%.
15006 REM Result returned in
15007 REM MU(2-0).
15010 MU(2) = M1%(1) * M2%(1):MU(1) = M1%(1) * M2%(0) + M1%(0) * M2%(1):MU(0) = M1%(0) * M2%(0)
15020 IF M0% <> 0 AND M0% <> 1 THEN MU(2) = M0% * MU(2):MU(1) = M0% * MU(1):MU(0) = M0% * MU(0)
15030 RETURN
20000 REM Enter Subroutine
20001 REM Set Help% to non-zero
20002 REM to display running
20003 REM product.
20005 V% = CSRLIN:START% = POS(0):HELP% =0:MO%=0:M1%(1)=1:S1%=0:C1%(1)=0:C1%(2)=0:M2%(1)=1:S2%=0:C2%(1)=0:C2%(2)=0
20006 GOSUB 24100 ' Print instructions
20008 LOCATE V% + 1,START%+1,1
20009 IF HELP% THEN GOSUB 21000:GOTO 20020
20010 PRINT " ( x )( x )";:LOCATE ,START%+1,1,5,7:OK% = 0:M0% = 0:M1%(1) = 1:M2%(1) = 1:S1% = 0:S2% = 0:C1%(1) = -1:C1%(2) = -1:C2%(1) = -1:C2%(2) = -1
20020 M$ = INKEY$:IF M$="" THEN 20020
20025 DEF SEG=&H40:QQ=PEEK(&H17):IF (QQ AND &H20)<>0 THEN POKE &H17,QQ-32:IF M$="4" THEN M$=" K":ELSE IF M$="6" THEN M$=" M"
20026 DEF SEG
20030 IF M$ = " " THEN GOSUB 20600
20035 IF RIGHT$(M$,1)="K" THEN GOSUB 20100
20040 IF RIGHT$(M$,1)="M" THEN GOSUB 20200
20041 IF M$="0" AND (POS(0)-START%=3 OR POS(0)-START%=10) THEN M$="1"
20045 IF M$ > ="0" AND M$ < = "9" THEN GOSUB 20300
20050 IF M$ = CHR$(13) AND (M0% OR M1%(1) <>1 OR M2%(1) <>1 OR S1% OR S2% OR C1%(1)<>-1 OR C1%(2)<>-1 OR C2%(1)<>-1 OR C2%(2)<>-1) THEN T%=12:B%=25:CALL CLR(T%,B%):LOCATE V%+1:RETURN
20055 IF M$ = "+" OR M$ = "-" THEN GOSUB 20500
20060 IF M$ = "S" OR M$ = "s" THEN GOSUB 55000 ' returns to 1015
20065 IF M$ = "Q" OR M$ = "q" THEN QUIT% =-1:GOTO 1950
20070 IF M$<>"H" AND M$<>"h" THEN 20020
20075 T%=14:B%=25:CALL CLR(T%,B%):LOCATE 15,1
20080 IF HELP% THEN PRINT "Sorry, ";N$;".":PRINT :PRINT "I can't help you any more without":PRINT :PRINT "telling you the answer. If you're":PRINT :PRINT "really stuck, you can always press S.":GOSUB 50000:GOTO 20095
20085 HELP% =-1:PRINT "All right, ";:PRINT N$;".":PRINT :PRINT "To help you, I'll keep track of the":PRINT :PRINT "product as you change the factors.":GOSUB 50000
20090 T%=14:B%=25:CALL CLR(T%,B%):LOCATE 15:PRINT "I won't tell you if you're right or":PRINT :PRINT "wrong, and mistakes won't count against":PRINT :PRINT "you until you finish working.":GOSUB 50000
20095 T%=14:B%=25:CALL CLR(T%,B%):LOCATE 15:GOTO 20006
20100 ON POS(0)-START% GOTO 20190,20110,20120,20110,20120,20110,20110,20110,20120,20130,20110,20120,20110,20110,20110
20105 GOTO 20190
20110 LOCATE ,POS(0) - 1 :RETURN
20120 LOCATE ,POS(0) - 2 :RETURN
20130 LOCATE ,POS(0) - 3 :RETURN
20190 RETURN
20200 ON POS(0) - START% GOTO 20220,20210,20220,20210,20210,20210,20230,20220,20210,20220,20210,20210,20210,20290,20290
20205 GOTO 20290
20210 LOCATE ,POS(0) + 1 :RETURN
20220 LOCATE ,POS(0) + 2 :RETURN
20230 LOCATE ,POS(0) + 3 :RETURN
20290 RETURN
20300 ON POS(0) - START% GOTO 20310,20390,20320,20390,20390,20330,20340,20390,20390,20350,20390,20390,20360,20370,20390
20305 GOTO 20390
20310 M0% = VAL (M$):IF (M$ = "1") OR (M$ = "0") THEN PRINT " (";:GOTO 20380
20315 PRINT M$;"(";:GOTO 20380
20320 M1%(1) = VAL (M$):IF M$ = "1" THEN PRINT " x";:GOTO 20380
20325 PRINT M$;"x";:GOTO 20380
20330 C1%(1) = VAL (M$):PRINT M$;:GOTO 20380
20340 C1%(2) = VAL (M$):PRINT M$;")(";:GOTO 20380
20350 M2%(1) = VAL (M$):IF M$ = "1" THEN PRINT " x";:GOTO 20380
20355 PRINT M$;"x";:GOTO 20380
20360 C2%(1) = VAL (M$) :PRINT M$;:GOTO 20380
20370 C2%(2) = VAL (M$) :PRINT M$;CHR$ (29);:GOTO 20380
20380 GOSUB 21000:REM Digest new info
20390 RETURN
20500 IF POS(0) - START% < > 5 THEN 20550
20510 IF M$ = "+" THEN S1% = 1:GOTO 20530
20520 S1% = -1
20530 PRINT M$;:GOSUB 21000:RETURN
20550 IF POS(0) - START% <> 12 THEN RETURN
20560 IF M$ = "+" THEN S2% = 1:GOTO 20580
20570 S2% = -1
20580 PRINT M$;:GOSUB 21000:RETURN
20600 ON POS(0)-START% GOTO 20610,20699,20620,20699,20630,20640,20650,20699,20699,20660,20699,20670,20680,20690,20699
20605 GOTO 20699
20610 M0% = 0:PRINT " (";:GOTO 20695
20620 M1%(1) = 1:PRINT " x";:GOTO 20695
20630 S1% = 0:PRINT " ";:GOTO 20695
20640 C1%(1) = -1:PRINT " ";:GOTO 20695
20650 C1%(2) = -1:PRINT " )(";:GOTO 20695
20660 M2%(1) = 1:PRINT " x";:GOTO 20695
20670 S2% = 0:PRINT " ";:GOTO 20695
20680 C2%(1) = -1 :PRINT " ";:GOTO 20695
20690 C2%(2) = -1:PRINT " ";CHR$ (29);
20695 GOSUB 21000:REM Digest new information
20699 RETURN
21000 REM Check to see that factors are good.
21010 IF C1%(2) = -1 THEN M1%(0) = C1%(1):GOTO 21050
21020 IF C1%(1) = -1 THEN M1%(0) = C1%(2):GOTO 21050
21030 M1%(0) = 10 * C1%(1) + C1%(2)
21050 IF C2%(2) = -1 THEN M2%(0) = C2%(1):GOTO 21100
21060 IF C2%(1) = -1 THEN M2%(0) = C2%(2) :GOTO 21100
21070 M2%(0) = 10 * C2%(1) + C2%(2)
21100 IF M1%(1) < 0 OR S1% =0 OR M2%(1) < 0 OR S2%=0 OR (C1%(1) = -1 AND C1%(2) = -1) OR (C2%(1) = -1 AND C2%(2) = -1) THEN OK% = 0:T1%=POS(0):T2%=CSRLIN:LOCATE ,START%+16,0:PRINT STRING$(41-POS(0),32);:LOCATE T2%,T1%,1:RETURN
21110 OK% =-1
21120 M1%(0) = M1%(0) * S1%:M2%(0) = M2%(0) * S2%
21130 GOSUB 15000
21140 IF NOT HELP% THEN RETURN
21145 T1%=POS(0):T2%=CSRLIN:LOCATE T2%,START% + 16,0:PRINT SPACE$(40-POS(0)+1);:LOCATE T2% + 1,START% + 16: PRINT SPC(21);
21150 LOCATE T2%,START% + 16:PRINT " = ";:D(2) = MU(2):D(1) = MU(1):D(0) = MU(0):GOSUB 10000:LOCATE T2%,T1%,1:RETURN
22000 REM Enter2 Subroutine
22005 V% = CSRLIN:START% = POS(0):HELP% = 0:C1%(1)=0:XF%=0:C1%(2)=0:M2%(1)=0:S2%=0:C2%(1)=0:C2%(2)=0
22007 GOSUB 24100 ' print instructions
22009 LOCATE V%+1,START%+1:IF HELP% THEN GOSUB 23000:LOCATE ,,1:GOTO 22020
22010 PRINT " ( x )";:LOCATE ,START%+1,1,5,7:OK% = 0:M0% = 0:M2%(1) = 1:S2% = 0:XF% = 0:C1%(1) = -1:C1%(2)=-1:C2%(1) = -1:C2%(2) = -1
22020 M$=INKEY$:IF M$="" THEN 22020
22025 DEF SEG=&H40:QQ=PEEK(&H17):IF (QQ AND &H20)<>0 THEN POKE &H17,QQ-32:IF M$="4" THEN M$=" K":ELSE IF M$="6" THEN M$=" M"
22026 DEF SEG
22030 IF M$ = " " THEN GOSUB 22600
22035 IF RIGHT$(M$,1) = "K" THEN GOSUB 22100
22040 IF RIGHT$(M$,1) = "M" THEN GOSUB 22200
22041 IF M$="0" THEN IF POS(0)-START%=4 THEN M$="1":ELSE IF POS(0)-START%=1 OR (POS(0)-START%=2 AND C1%(1)=-1) THEN M$=""
22045 IF M$ > = "0" AND M$ < = "9" THEN GOSUB 22300
22047 IF M$ = "X" OR M$ = "x" THEN GOSUB 22700
22050 IF M$=CHR$(13) AND (M0% OR M2%(1) <> 1 OR XF% OR S2% OR C1%(1)<>-1 OR C1%(2)<>-1 OR C2%(1)<>-1 OR C2%(2)<>-1) THEN T%=12:B%=25:CALL CLR(T%,B%):LOCATE V%+1:RETURN
22055 IF (M$ = "+") OR (M$ = "-") THEN GOSUB 22500
22060 IF (M$ = "S") OR (M$ = "s") THEN GOSUB 55000 ' returns to 1015
22065 IF (M$ = "Q") OR (M$ = "q") THEN QUIT%=-1:GOTO 1950
22070 IF M$ <>"H" AND M$ <>"h" THEN 22020
22075 T%=14:B%=25:CALL CLR(T%,B%):LOCATE 15,1
22080 IF HELP% THEN PRINT "Sorry, ";N$;".":PRINT :PRINT "I can't help you any more without":PRINT :PRINT "telling you the answer. If you're":PRINT :PRINT "really stuck, you can always press S.":GOSUB 50000:GOTO 22095
22085 HELP% =-1:PRINT "All right, ";:PRINT N$;".":PRINT :PRINT "To help you, I'll keep track of the":PRINT :PRINT "product as you change the factors.":GOSUB 50000
22090 T%=14:B%=25:CALL CLR(T%,B%):LOCATE 15,1:PRINT "I won't tell if you're right or":PRINT :PRINT "wrong, and mistakes won't count against":PRINT :PRINT "you until you finish working.":GOSUB 50000
22095 T%=14:B%=25:CALL CLR(T%,B%):GOTO 22007
22100 ON POS(0)-START% GOTO 22190,22110,22110,22120,22110,22120,22110,22110,22110
22105 GOTO 22190
22110 LOCATE ,POS(0)-1:RETURN
22120 LOCATE ,POS(0)-2:RETURN
22190 RETURN
22200 ON POS(0)-START% GOTO 22210, 22220, 22210, 22220, 22210,22210,22210,22290,22290
22205 GOTO 22290
22210 LOCATE ,POS(0)+1:RETURN
22220 LOCATE ,POS(0)+2:RETURN
22290 RETURN
22300 ON POS(0)-START% GOTO 22310,22320,22390,22330,22390,22390,22340,22350,22390
22305 GOTO 22390
22310 C1%(1) = VAL (M$):PRINT M$;:GOTO 22380
22320 XF% = 0:C1%(2) = VAL (M$):PRINT M$;"(";:GOTO 22380
22330 M2%(1) = VAL (M$):IF M$ = "1" THEN PRINT " x";:GOTO 22380
22335 PRINT M$;"x";: GOTO 22380
22340 C2%(1) = VAL (M$):PRINT M$;:GOTO 22380
22350 C2%(2) = VAL (M$):PRINT M$;CHR$(29);:GOTO 22380
22380 GOSUB 23000:REM Digest new information
22390 RETURN
22500 IF POS(0)-START% <> 6 THEN RETURN
22510 IF M$ = "+" THEN S2% = 1:GOTO 22530
22520 S2% = -1
22530 PRINT M$;:GOSUB 23000:RETURN
22600 ON POS(0)-START% GOTO 22610,22620,22690,22630,22690,22640,22650,22660,22690
22605 GOTO 22690
22610 C1%(1) = - 1:PRINT " ";:IF XF% THEN 22680:ELSE IF C1%(2)=0 THEN PRINT" (";:C1%(2)=-1:GOTO 22680:ELSE 22680
22620 XF% = 0:C1%(2) = -1:PRINT " (";: GOTO 22680
22630 M2%(1) = 1:PRINT " x";:GOTO 22680
22640 S2% = 0: PRINT " ";: GOTO 22680
22650 C2%(1) = -1:PRINT " ";:GOTO 22680
22660 C2%(2) = -1:PRINT " "; CHR$ (29);: GOTO 22680
22680 GOSUB 23000: REM Digest new information
22690 RETURN
22700 IF POS(0)-START% <> 2 THEN RETURN
22710 XF% = -1 :C1%(2) = -1:PRINT "x(";
22750 GOSUB 23000: REM Digest new information
22760 RETURN
23000 REM Digest new information
23010 IF XF% THEN 23030
23015 M1%(1) = 0
23020 IF C1%(1) = -1 AND C1%(2) = -1 THEN M1%(0) = 1:GOTO 23050
23023 IF C1%(2) = -1 THEN M1%(0) = C1%(1):GOTO 23050
23025 IF C1%(1) = -1 THEN M1%(0) = C1%(2):GOTO 23050
23028 M1%(0) = 10 * C1%(1) + C1%(2):GOTO 23050
23030 M1%(0) = 0
23040 IF C1%(1) = -1 THEN M1%(1) = 1:GOTO 23050
23045 M1%(1) = C1%(1)
23050 IF C2%(2) = -1 THEN M2%(0) = C2%(1):GOTO 23090
23060 IF C2%(1) = -1 THEN M2%(0) = C2%(2):GOTO 23090
23070 M2%(0) = 10 * C2%(1) + C2%(2)
23090 LF% = M1%(0):IF XF% THEN LF% = M1%(1)
23100 IF M2%(1) < 0 OR S2% = 0 OR (C2%(1) = -1 AND C2%(2) = -1) THEN OK% = 0 :T1%=POS(0):T2%=CSRLIN:LOCATE T2%,START%+10,0:PRINT SPACE$(41-POS(0));:LOCATE T2%,T1%,1:RETURN
23110 OK% =-1
23120 M2%(0) = M2%(0) * S2%
23130 GOSUB 15000
23140 IF NOT HELP% THEN RETURN
23145 T1% = POS(0):T2% = CSRLIN:LOCATE T2%,START%+10,0:PRINT SPACE$(40-POS(0)+1);:LOCATE T2%+1,START%+10:PRINT SPC(13);
23150 LOCATE T2%,START% + 10:PRINT " = ";:D(2) = MU(2):D(1) = MU(1):D(0) = MU(0):GOSUB 10000 :LOCATE T2%,T1%,1:RETURN
24000 ' ********************************
24005 ' * Area for misc. subroutines *
24010 ' * Put here to be called by *
24015 ' * various routines to *
24020 ' * save space *
24025 ' ********************************
24030 ' **
24035 ' **
24100 ' Print out instructions below workspace
24110 LOCATE 14,1:PRINT STRING$(40,"-"):LOCATE 16,5:PRINT "Use ARROW keys to move cursor."
24120 LOCATE 18,9:PRINT "Use SPACEBAR to erase.":LOCATE 20,16:PRINT"Press:"
24130 LOCATE 22,1:COLOR 0,7:PRINT"ENTER";:COLOR 7,0:PRINT" when done.";TAB(21);:COLOR 0,7:PRINT "S";:COLOR 7,0:PRINT " to see solution."
24140 LOCATE 24,1:COLOR 0,7:PRINT "H";:COLOR 7,0:PRINT " for help.";TAB(21);:COLOR 0,7:PRINT"Q";:COLOR 7,0:PRINT" to quit.";
24160 RETURN
25000 REM Show subroutine
25001 REM Displays a Multiplication
25002 REM Variables as in Multiply
25010 GOSUB 15000
25020 IF M0%=0 OR M0%=1 THEN PRINT " ";: GOTO 25100
25030 PRINT RIGHT$(STR$(M0%),LEN(STR$(M0%))-1);
25100 PRINT "(";: IF M1%(1) = 1 THEN PRINT " ";: GOTO 25120
25110 PRINT RIGHT$(STR$(M1%(1)),LEN(STR$(M1%(1)))-1);
25120 PRINT "x";
25130 IF M1%(0) > 0 THEN PRINT "+";:GOTO 25150
25140 PRINT "-";
25150 PRINT RIGHT$(STR$(M1%(0)),LEN(STR$(M1%(0)))-1);
25155 IF ABS (M1%(0)) < 10 THEN PRINT " ";
25160 PRINT ")";
25200 PRINT "(";: IF M2%(1) = 1 THEN PRINT " ";:GOTO 25220
25210 PRINT RIGHT$(STR$(M2%(1)),LEN(STR$(M2%(1)))-1);
25220 PRINT "x";
25230 IF M2%(0) > 0 THEN PRINT "+";:GOTO 25250
25240 PRINT "-";
25250 PRINT RIGHT$(STR$(M2%(0)),LEN(STR$(M2%(0)))-1);
25255 IF ABS (M2%(0)) < 10 THEN PRINT " ";
25260 PRINT ") = ";
25300 D(2) = MU(2):D(1) = MU(1):D(0) = MU(0):GOSUB 10000
25400 RETURN
30000 REM Delay Subroutine -- 2 sec.
30010 FOR DD = 1 TO 1000:NEXT DD:RETURN
35000 REM Error Subroutine.
35001 REM Prints Error Summary
35002 REM for this problem.
35003 REM Updates totals.
35010 CLS:PRINT TAB(5)"Error Summary for Problem #";USING"#";P:PRINT:PRINT " Error Number"
35020 PRINT " ----- ------":PRINT
35030 PRINT "Incorrect Format of Factors.. ";USING"###";E%(1):PRINT
35040 PRINT "Finding Common Factors ...... ";USING"###";E%(2):PRINT
35050 PRINT "Difference of Two Squares ... ";USING"###";E%(3):PRINT
35060 PRINT "Leading Coefficient ......... ";USING"###";E%(4):PRINT
35070 PRINT "Sign of Constant Term ....... ";USING"###";E%(5):PRINT
35080 PRINT "Constant Term ............... ";USING"###";E%(6):PRINT
35090 PRINT "Linear Term ................. ";USING"###";E%(7)
35100 E% = 0 :FOR DD = 1 TO 7:TE%(DD) = TE%(DD)+E%(DD):E% = E% + E%(DD):NEXT DD:TE% = TE% + E%
35200 PRINT
35210 PRINT "Total ....................... ";USING"###";E%:PRINT
35300 DD=INT(4*RND(1)):IF E%=1 THEN DD=DD+4 ELSE IF E%>1 THEN DD=DD+8
35310 PRINT TAB((40-LEN(ME$(DD)))/2)ME$(DD)
35400 GOSUB 50000 :RETURN
40000 REM Total Errors.
40001 REM Prints Error Summary
40002 REM for all problems.
40003 GOTO 40010
40005 LOCATE ,34:IF P-1=0 THEN PRINT" 0.00":RETURN:ELSE PRINT USING"###.##";DD/(P-1):RETURN
40010 CLS:LOCATE ,10,0:COLOR 0,7:PRINT "Total Error Analysis":COLOR 7,0:PRINT
40020 PRINT TAB(34)"Average";:PRINT TAB(36)"per":PRINT"Error";TAB(27)"Number Problem";
40030 PRINT STRING$(5,"-");TAB(27)STRING$(6,"-");TAB(34)STRING$(7,"-");
40040 PRINT "Incorrect Format of Factors ";USING"###";TE%(1);:DD=TE%(1):GOSUB 40005:PRINT

40050 PRINT "Finding Common Factors .... ";USING"###";TE%(2);:DD=TE%(2):GOSUB 40005:PRINT
40060 PRINT "Difference of Two Squares . ";USING"###";TE%(3);:DD=TE%(3):GOSUB 40005:PRINT
40070 PRINT "Leading Coefficient ....... ";USING"###";TE%(4);:DD=TE%(4):GOSUB 40005:PRINT
40080 PRINT "Sign of Constant Term ..... ";USING"###";TE%(5);:DD=TE%(5):GOSUB 40005:PRINT
40090 PRINT "Constant Term ............. ";USING"###";TE%(6);:DD=TE%(6):GOSUB 40005:PRINT
40100 PRINT "Linear Term ............... ";USING"###";TE%(7);:DD=TE%(7):GOSUB 40005:PRINT
40120 PRINT "Total ..................... ";USING"###";TE%;:DD=TE%:GOSUB 40005:PRINT
40122 IF P-1=0 THEN PRINT TAB(4)"You didn't complete any problems.":ELSE PRINT TAB(9)"You completed"P-1"problem";:IF P-1=1 THEN PRINT"." ELSE PRINT"s."
40130 GOSUB 50000:RETURN
45000 CLS:I$="Thank you, "+N$+".":LOCATE 9,(40-LEN(I$))/2:PRINT I$:PRINT:PRINT TAB(5)"I hope you enjoyed this program."
45030 FOR X=1 TO 5000:NEXT:SYSTEM:END
45050 RETURN
50000 REM Subroutine: wait for
50010 REM user to hit return.
50020 DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG
50030 LOCATE 25,9,0:PRINT "Press ";:COLOR 0,7:PRINT "ENTER";:COLOR 7,0:PRINT " to continue.";
50040 WHILE INKEY$<>CHR$(13):WEND
50060 LOCATE 25,8:PRINT SPC(30);
50080 RETURN
55000 REM Show how to factor expression
55010 CLS:PRINT "Okay, ";N$;".":PRINT
55020 PRINT "I'm going to show you how to factor":PRINT
55030 PRINT "this polynomial.":GOSUB 50000:CLS
55040 CLS:PRINT"Problem #";USING"#";P:PRINT:COLOR 0,7:PRINT " FACTOR ";:COLOR 7,0:FOR ZZ = 0 TO 2 :D(ZZ) = POLY%(ZZ):NEXT ZZ:LOCATE 3,15:GOSUB 10000:PRINT:PRINT STRING$(40,"-")
55050 IF CF% AND FX% AND F0% < 2 THEN 55700
55100 FOR ZZ = 0 TO 2 :RE%(ZZ) = POLY%(ZZ):NEXT ZZ:IF F0% = 0 OR F0% = 1 THEN M0% = 1:GOTO 56000
55110 FOR ZZ = 0 TO 2 :RE%(ZZ) = RE%(ZZ) / F0%:NEXT ZZ:M0% = F0%
55120 PRINT "First, we notice that";F0%;"is a factor":PRINT
55130 PRINT "of each term of the polynomial.":PRINT:PRINT "Therefore, we can write ";:FOR ZZ = 0 TO 2 :D(ZZ)=POLY%(ZZ):NEXT ZZ:GOSUB 10000:PRINT:PRINT
55140 PRINT "as"STR$(F0%);"(";:FOR ZZ=0 TO 2:D(ZZ)=RE%(ZZ):NEXT ZZ:GOSUB 10000:PRINT ").":PRINT
55150 IF FX% THEN PRINT "Now we continue factoring.":GOSUB 50000:ELSE GOSUB 50000
55160 CLS:PRINT"Problem #";USING"#";P:PRINT:COLOR 0,7:PRINT " FACTOR ";:COLOR 7,0:LOCATE 3,10:FOR ZZ = 0 TO 2:D(ZZ) = POLY%(ZZ):NEXT ZZ:GOSUB 10000
55170 FOR ZZ=0 TO 2:D(ZZ)=RE%(ZZ):NEXT ZZ:PRINT " = ";STR$(F0%);"(";:GOSUB 10000:PRINT ")":PRINT STRING$(40,"-")
55200 IF NOT CF% THEN 56000
55210 IF FX% THEN 55500
55220 PRINT "Now that we have have factored out a";STR$(F0%);",":PRINT
55230 PRINT "the polynomial can not be further":PRINT
55240 PRINT "simplfied. The polynomial is fully":PRINT
55250 PRINT "factored.":TP=1:GOTO 55800
55500 PRINT "There is only one step left.":PRINT
55510 PRINT "Each term in the polynomial is a":PRINT
55520 PRINT "multiple of x. So we must also":PRINT
55530 PRINT "factor out an x. When we do, we get":PRINT
55540 PRINT "this result:":PRINT :PRINT
55550 FOR ZZ = 0 TO 2:D(ZZ) = POLY%(ZZ):NEXT ZZ:GOSUB 10000:PRINT " =";STR$(M0%);"x(";:D(2) = 0:D(1) = RE%(2):D(0) = RE%(1):GOSUB 10000:PRINT ")":TP=2:GOTO 55800
55700 PRINT "Looking at this binomial, we see that":PRINT
55710 PRINT "there is no constant which is a factor":PRINT
55720 PRINT "of both terms. However, both terms are":PRINT
55730 PRINT "divisible by x. To factor this ":PRINT
55740 PRINT "expression, we simply factor out an x.":PRINT :PRINT
55750 FOR ZZ = 0 TO 2:D(ZZ) = POLY%(ZZ):NEXT ZZ:GOSUB 10000:PRINT " = x(";:D(2) = 0:D(1) = POLY%(2):D(0) = POLY%(1):GOSUB 10000:PRINT ")":TP=3
55800 GOSUB 50000:CLS:PRINT"Problem #";USING"#";P:PRINT:COLOR 0,7:PRINT " FACTOR ";:COLOR 7,0:FOR ZZ = 0 TO 2 :D(ZZ) = POLY%(ZZ):NEXT ZZ:LOCATE 3,15:GOSUB 10000:PRINT:PRINT STRING$(40,"-")
55810 LOCATE 7,1:COLOR 0,7:PRINT"RESULT";:COLOR 7,0:LOCATE 10,6
55820 IF TP=1 THEN PRINT STR$(F0%)"(";:FOR ZZ=0 TO 2:D(ZZ)=RE%(ZZ):NEXT:GOSUB 10000:PRINT")";
55830 IF TP=2 THEN PRINT STR$(M0%)"x(";:D(2)=0:D(1)=RE%(2):D(0)=RE%(1):GOSUB 10000:PRINT")";
55840 IF TP=3 THEN PRINT"x(";:D(2)=0:D(1)=POLY%(2):D(0)=POLY%(1):GOSUB 10000:PRINT")";
55850 PRINT" = ";:FOR ZZ=0 TO 2:D(ZZ)=POLY%(ZZ):NEXT:GOSUB 10000:GOTO 59030
56000 IF NOT D2% THEN 57000
56010 FOR ZZ = 0 TO 2:D(ZZ) = RE%(ZZ):NEXT ZZ:PRINT "We see that ";:GOSUB 10000:PRINT " is the difference":PRINT
56020 PRINT "of two squares. This means that we":PRINT
56030 PRINT "can use a special technique.":PRINT
56040 PRINT:PRINT "If we take the square roots of the":PRINT
56050 PRINT "first and last terms, then one factor":PRINT
56060 PRINT "will be the sum of the square roots,":PRINT
56070 PRINT "and the other factor will be their":PRINT :PRINT "difference.":GOSUB 50000
56080 T%=5:B%=25:CALL CLR(T%,B%):LOCATE 7
56100 D(0) = 0:PRINT "The square root of ";:GOSUB 10000:PRINT " is ";:IF R%(1) < > 1 THEN PRINT STR$(R%(1));
56110 PRINT "x, and":PRINT
56120 PRINT "the square root of";STR$(-RE%(0));" is";STR$(R%(0))".":PRINT :PRINT
56130 PRINT "This tells us that the factors are":PRINT
56140 PRINT "(";:IF R%(1) < > 1 THEN PRINT RIGHT$(STR$(R%(1)),1);
56150 PRINT "x+";RIGHT$(STR$(R%(0)),1);") and (";:IF R%(1) < > 1 THEN PRINT RIGHT$(STR$(R%(1)),1);
56160 PRINT "x-";RIGHT$(STR$(R%(0)),1);")."
56200 M1%(1) = R%(1):M2%(1) = R%(1):M1%(0) = R%(0):M2%(0) = - R%(0)
56210 GOSUB 50000:GOTO 59000
57000 PRINT "To begin, list the factors of the first":PRINT
57010 PRINT "and last terms, ignoring the signs.":PRINT :PRINT
57020 GOSUB 50000:T%=5:B%=25:CALL CLR(T%,B%)
57030 LOCATE 7,9:D(2) = RE%(2) :D(1) = 0:D(0) = 0:GOSUB 10000:LOCATE ,29:PRINT ABS (RE%(0))
57040 N1% = 0:N0% = 0
57100 FOR TF = 1 TO 9
57110 IF RE%(2) / TF <> (RE%(2) \ TF) OR TF*TF > RE%(2) THEN 57160
57120 N1%=N1%+1:FA%(1,N1%,0) = TF:FA%(1,N1%,1) = RE%(2) / TF
57130 LOCATE 8+N1%,5:IF TF<>1 THEN PRINT STR$(TF); ELSE PRINT " ";
57140 PRINT "x";SPC(5);:IF TF<>RE%(2) THEN PRINT STR$(RE%(2)/TF);
57150 PRINT "x";
57160 IF RE%(0) / TF < > (RE%(0) \ TF) OR TF * TF > ABS (RE%(0)) THEN 57200
57170 N0% = N0% + 1:FA%(0,N0%,0) = TF:FA%(0,N0%,1) = ABS (RE%(0) / TF)
57190 LOCATE 8+N0%,25:PRINT STR$(TF);SPC(6);STR$(ABS (RE%(0) / TF));
57200 NEXT TF
58000 LOCATE 16,1:IF RE%(0) < 0 THEN 58100
58010 PRINT "Since the last term is positive and":PRINT
58020 PRINT "the linear term is ";:IF RE%(1) > 0 THEN PRINT "also positive";:GOTO 58040
58030 PRINT "negative";
58040 PRINT ", the":PRINT :PRINT "constants in the factors must both be":PRINT
58050 IF RE%(1) > 0 THEN PRINT "positive."
58060 IF RE%(1) < 0 THEN PRINT "negative."
58070 GOSUB 50000:GOTO 58400
58100 PRINT "Since the last term is negative,":PRINT
58110 PRINT "the constants in the factors must":PRINT
58120 PRINT "have different signs, one positive":PRINT
58130 PRINT "and one negative."
58140 GOSUB 50000
58400 T%=14:B%=24:CALL CLR(T%,B%):LOCATE 15,1
58410 PRINT "We'll try all possible combinations":PRINT
58420 PRINT "of the above factors until we get":PRINT
58430 PRINT "a solution."
58440 GOSUB 50000
58500 FOR FC = 1 TO N1%:M1%(1) = FA%(1,FC,0):M2%(1) = FA%(1,FC,1)
58510 FOR SC = 1 TO N0%:M1%(0) = FA%(0,SC,0):M2%(0) = FA%(0,SC,1)
58520 IF RE%(0) < 0 THEN M2%(0) = -M2%(0):GOTO 58540
58530 IF RE%(1) < 0 THEN M1%(0) = -M1%(0):M2%(0) = -M2%(0)
58540 T%=13:B%=25:CALL CLR(T%,B%):LOCATE 16,4:GOSUB 25000:GOSUB 50000:IF POLY%(2) = MU(2) AND POLY%(1) = MU(1) AND POLY%(0) = MU(0) THEN 58900
58550 IF RE%(0) > 0 THEN 58600
58560 M1%(0) = - M1%(0):M2%(0) = - M2%(0)
58570 T%=13:B%=25:CALL CLR(T%,B%):LOCATE 16,4:GOSUB 25000:GOSUB 50000:IF POLY%(2) = MU(2) AND POLY%(1) = MU(1) AND POLY%(0) = MU(0) THEN 58900
58600 IF M1%(1) = M2%(1) THEN 58700
58610 M1%(0) = FA%(0,SC,1):M2%(0) = FA%(0,SC,0)
58620 IF RE%(0) < 0 THEN M2%(0) = -M2%(0):GOTO 58640
58630 IF RE%(1) < 0 THEN M1%(0) = -M1%(0):M2%(0) = - M2%(0)
58640 T%=13:B%=24:CALL CLR(T%,B%):LOCATE 16,4:GOSUB 25000:GOSUB 50000:IF POLY%(2) = MU(2) AND POLY%(1) = MU(1) AND POLY%(0) = MU(0) THEN 58900
58650 IF RE%(0) > 0 THEN 58700
58660 M1%(0) = - M1%(0):M2%(0) = - M2%(0)
58670 T%=13:B%=24:CALL CLR(T%,B%):LOCATE 16,4:GOSUB 25000:GOSUB 50000:IF POLY%(2) = MU(2) AND POLY%(1) = MU(1) AND POLY%(0) = MU(0) THEN 58900
58700 NEXT SC,FC
58900 LOCATE 20,15:COLOR 0,7:PRINT "That's it!":COLOR 7,0:GOSUB 50000
58910 FOR SC = 1 TO 2:NEXT SC:FOR FC = 1 TO 2:NEXT FC
58920 GOTO 59000
59000 T%=5:B%=25:CALL CLR(T%,B%):LOCATE 7,1
59010 COLOR 0,7:PRINT "RESULT":COLOR 7,0
59020 LOCATE 10,6:GOSUB 25000
59030 GOSUB 50000:T%=5:B%=24:CALL CLR(T%,B%)
59050 RETURN 59060 ' pop off return address from GOSUB 22000 or GOSUB 20000
59060 RETURN 1015
60000 REM Print instructions
60010 CLS
60060 CLS
60100 PRINT "I know four kinds of problems: "
60120 LOCATE 4,4:PRINT "1. Easy quadratic trinomials":LOCATE 6,7:PRINT "(coefficient of xý is 1)":LOCATE 9,4:PRINT "2. Hard quadratic trinomials"
60140 LOCATE 11,7:PRINT "(coefficient of xý is more than 1)"
60150 LOCATE 14,4:PRINT "3. Difference of two squares"
60160 LOCATE 17,4:PRINT "4. Common factor problems"
60170 LOCATE 20,1:PRINT "You may choose any of these types or you":PRINT "may mix them."
60190 GOSUB 50000:CLS:LOCATE 9
60200 PRINT "For each problem, the computer will":PRINT
60210 PRINT "display the polynomial you will factor.":PRINT
60220 LOCATE 15:PRINT "There will be a work area where you will":PRINT "enter the factors."
60240 GOSUB 50000:CLS
60300 LOCATE 7:PRINT "When you start, each set of parentheses":PRINT :PRINT "will contain an X.":LOCATE 13:PRINT "Using the arrow keys to move the cursor,":PRINT "enter the appropriate numbers, signs, or":PRINT "letters."
60310 GOSUB 50000:CLS
60360 LOCATE 9:PRINT "If you make a mistake, move the cursor":PRINT :PRINT "over the error, erase it with the space":PRINT :PRINT "bar, and enter the correction."
60370 GOSUB 50000:CLS
60400 LOCATE 5:PRINT "When you finish factoring, press the":PRINT :COLOR 0,7:PRINT "ENTER";:COLOR 7,0:PRINT " key."
60410 LOCATE 11:PRINT "If you are right, I will tell you so.":LOCATE 15:PRINT "If you are wrong, I will point out your":PRINT :PRINT "mistake and give you another chance."
60460 GOSUB 50000:CLS
60500 LOCATE 5:PRINT "If you need help, press the ";:COLOR 15:PRINT "H";:COLOR 7:PRINT " key.":LOCATE 8:PRINT "I will help you by keeping track of the":PRINT :PRINT "product as you change the factors."
60510 LOCATE 14:PRINT "If you can't do a problem, press the ";:COLOR 15:PRINT "S":COLOR 7:PRINT :PRINT "key. I will then show you how to factor":PRINT :PRINT "the polynomial."
60520 GOSUB 50000:CLS
60530 LOCATE 2:PRINT "Asking for help does not count against":PRINT :PRINT"you. Don't be afraid to use these":PRINT :PRINT"features."
60535 LOCATE 10:PRINT"Remember:":LOCATE 14,4:COLOR 15:PRINT"H ";:COLOR 7:PRINT"For help to keep track of factors.":LOCATE 17,4:COLOR 15:PRINT"S ";
60540 COLOR 7:PRINT"For solution to problem.":GOSUB 50000:CLS
60600 LOCATE 5:PRINT"After each problem, I will give you a":PRINT:PRINT"summary of your errors.":LOCATE 12:PRINT "When you finish a set of problems, I ":PRINT "will give you a total error analysis."
60610 GOSUB 50000:CLS
60700 LOCATE 8:PRINT "If you wish to stop before you finish ":PRINT "all the problems, press the ";:COLOR 15:PRINT "Q";:COLOR 7,0:PRINT " key to":PRINT :PRINT "quit and go to the total error analysis."
60710 GOSUB 50000:CLS
60800 LOCATE 7,4:PRINT N$",":PRINT:PRINT TAB(4)"would you like to try a":PRINT:PRINT TAB(4)"sample problem (Y or N)? ";:LOCATE ,,1
60805 M$=INKEY$
60810 M$=INKEY$:IF M$="" THEN 60810 ELSE IF M$="N" OR M$="n" THEN LOCATE ,,0:PRINT"N":GOTO 60900
60815 IF M$<>"Y" AND M$<>"y" THEN 60810
60820 LOCATE ,,0:PRINT"Y":GOTO 6000
60900 CLS:LOCATE 8,4:PRINT TAB(5)"Do you wish to review the":PRINT:PRINT TAB(5)"instructions (Y or N)? ";:LOCATE ,,1
60910 M$=INKEY$:IF M$="" THEN 60910 ELSE IF M$="N" OR M$="n" THEN LOCATE ,,0:PRINT"N":RETURN
60920 IF M$<>"Y" AND M$<>"y" THEN 60910 ELSE LOCATE ,,0:PRINT"Y":GOTO 60000
61000 IF KOLOR=TRUE THEN IF INDENT<45 THEN INDENT=INDENT+1:OUT 980,2:OUT 981,INDENT
61010 RETURN
61020 IF KOLOR=TRUE THEN IF INDENT>40 THEN INDENT=INDENT-1:OUT 980,2:OUT 981,INDENT
61030 RETURN
61040 REM
61050 REM
61060 ' ***************************
61070 ' *** CHOOSE & SWITCH ***
61080 ' *** MONITORS ***
61090 ' ***************************
61100 TRUE=-1:FALSE=0
61110 '*** find out which adapters exist ***
61120 DEF SEG=&HB000
61130 POKE 0,&H20
61140 MONO=(PEEK(0)=&H20)
61150 POKE 0,0
61160 MONO=(PEEK(0)=0) AND MONO
61170 DEF SEG=&HB800
61180 POKE 0,&H20
61190 KOLOR=(PEEK(0)=&H20)
61200 POKE 0,0
61210 KOLOR=(PEEK(0)=0) AND KOLOR
61220 IF MONO AND KOLOR GOTO 61280
61230 IF KOLOR GOTO 61360
61240 IF MONO GOTO 61420
61250 '*** if we reach here there is a problem ***
61260 CLS:LOCATE 1,2,0:PRINT "SOMETHING WRONG -- NO ADAPTERS ..."
61270 END
61280 REM *** both adapters exist ***
61290 CLS:WIDTH 40:BEEP:LOCATE 1,2,0:PRINT "Choose a display ..."
61300 LOCATE 4,2,0:PRINT "C for color, M for monochrome"
61310 I$=INKEY$:IF I$="" GOTO 61310
61320 IF I$="C" OR I$="c" GOTO 61360
61330 IF I$="m" OR I$="M" GOTO 61420
61340 GOTO 61300
61350 '*** switch to color graphics adapter ***
61360 DEF SEG=&H40:I=PEEK(&H10):POKE &H10,(I AND &HCF) OR &H20
61370 SCREEN 1:BLOAD"CBSLOGO.PIC":FOR IIX=1 TO 7000:NEXT:SCREEN 0,0,0,0:WIDTH 40:LOCATE ,,0,6,7
61380 KOLOR=TRUE:MONO=FALSE:X=12:INDENT=45:SEGMENT=&HB800
61390 COLOR 7,0,0
61400 GOTO 61460
61410 '*** switch to monochrome adapter ***
61420 DEF SEG=0:I=PEEK(&H410):POKE &H410,I OR &H30
61430 SCREEN 0,0,0,0
61431 LOCATE 9,28:PRINT STRING$(25,219):LOCATE 17,28:PRINT STRING$(25,219):FOR IIX=10 TO 16:LOCATE IIX,28:PRINT CHR$(219);SPACE$(23);CHR$(219):NEXT:LOCATE 12,39:PRINT"CBS":LOCATE 14,37:PRINT"PRESENTS":FOR IIX=1 TO 5000:NEXT
61433 WIDTH 40:LOCATE ,,0,12,13
61435 OUT 948,2:OUT 949,62
61440 KOLOR=FALSE:MONO=TRUE:X=26:SEGMENT=&HB000
61450 COLOR 7,0
61460 RETURN
62000 '===== Poke in machine language subroutine to clear only ======
62010 '===== part of the display ======
62020 '===== Area to be cleared will be specified in the ======
62030 '===== variables TOP% and BOTTOM% ======
62040 '===== Routine can be called up by the following format ======
62050 '----- CALL CLR ( T% , B% ) ======
62060 '
62070 DEF SEG
62080 CLRSCRN$=STRING$(35," ")
62090 BASE%=VARPTR(CLRSCRN$)
62100 CLR=PEEK(BASE%+1)+(256*PEEK(BASE%+2))
62110 RESTORE 62170
62120 FOR I%=0 TO 31
62130 READ A%
62140 POKE CLR+I%,A%
62150 NEXT
62160 RETURN
62170 '===== Hex data for a subroutine to clear part of the display =====
62180 DATA &H55,&H8B,&HEC,&H8B,&H76,&H08,&H8A,&H24,&H8A,&HEC,&H8B,&H76,&H06,&H8A,&H24,&H8A
62190 DATA &HF4,&HB8,&H00,&H06,&HB7,&H07,&HB1,&H00,&HB2,&H28,&HCD,&H10,&H5D,&HCA,&H04,&H00
64000 CLS:PRINT:Z=0:X=0:N$="":DEF SEG=0:POKE 1050,PEEK(1052):DEF SEG:XC%=0
64010 PRINT " Please enter your first name (up to":PRINT:PRINT" ten letters) and press .":PRINT:PRINT
64020 PRINT TAB(12)"Name: ";:LOCATE ,,1
64030 I$=INKEY$:XC%=XC%+1:IF XC%>32000 THEN XC%=0
64035 IF I$="" THEN 64030
64040 IF I$=CHR$(13) AND N$<>"" THEN 64600 ELSE IF I$=CHR$(8) THEN 64110
64050 IF X>=10 THEN 64030 ELSE Z=ASC(I$)
64060 IF (Z<65 OR Z>122) OR (Z>90 AND Z<97) THEN 64030
64070 IF X=0 AND Z>90 THEN Z=Z-32
64080 IF X>0 AND Z<97 THEN Z=Z+32
64090 PRINT CHR$(Z);:N$=N$+CHR$(Z):X=X+1:GOTO 64030
64110 IF X=0 THEN 64030 ELSE PRINT CHR$(29)" "CHR$(29);:X=X-1:IF X=0 THEN N$="":GOTO 64030
64120 N$=LEFT$(N$,X):GOTO 64030
64500 REM Get number of problems
64510 CLS:LOCATE 5,1,0:PRINT N$",":PRINT:PRINT"you may try up to 9 problems.":PRINT:PRINT"How many would you like? ";:LOCATE ,,1
64520 P$=INKEY$:IF P$<>"" THEN 64520
64530 P$=INKEY$:IF P$<"1" OR P$>"9" THEN 64530
64580 LOCATE ,,0:PRINT P$:NP=VAL(P$):RETURN
64600 RANDOMIZE -XC%:IF KOLOR=TRUE THEN LOCATE 12,1:PRINT"<"STRING$(38,"-")">";" To center your screen, use the F9":PRINT:PRINT" and F10 keys.":GOSUB 50000
64610 RETURN
65000 P$=INPUT$(1):ON -(P$<>CHR$(13)) GOTO 65000:DEF SEG=&H40:POKE &H72,&H34:POKE &H73,&H12:DEF SEG=&HFFFF:L=1:O!=PEEK(L)+256*PEEK(L+1):S!=PEEK(L+2)+256*PEEK(L+3):DEF SEG=S!:CALL O!: REM reboot


  3 Responses to “Category : BASIC Source Code
Archive   : ALGEBRA2.ZIP
Filename : CBS.BAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/