'=========================================================================== ' Subject: HUGE NUMBER CALCULATION ROUTINE Date: 07-25-99 (12:15) ' Author: Robert Merkin Code: QB, QBasic, PDS ' Origin: bobmer@javanet.com Packet: ALGOR.ABC '=========================================================================== DECLARE SUB Izzit () DECLARE SUB Ed () DECLARE SUB Su () DECLARE SUB Mu () DECLARE SUB Di () DECLARE SUB Ska () DECLARE SUB Kmpr () DECLARE SUB NrmlZ () DECLARE SUB DspZ () DECLARE SUB Ink1 () DECLARE SUB Ink2 () DECLARE SUB Ink3 () DECLARE SUB BigPi () DECLARE SUB Kosher () DECLARE SUB Klaxon () DECLARE SUB Thyme () DECLARE SUB Logo () DECLARE SUB UPAinfo () DECLARE SUB Gre () DECLARE SUB Blu () DECLARE SUB Whi () DECLARE SUB Bri () DECLARE SUB Red () ' =========================================================== ' || HUGO.BAS [V.2.0] and HUGO_2_0.DOC || ' || Code and Text Copyright (c) 1997 by Robert Merkin || ' || Yankee Magnetic Software || ' || 55 Milton Street / Northampton MA 01060 USA || ' || 413-586-1616 / bobmer@javanet.com || ' =========================================================== ' =================================================== ' >> QuickBASIC does everything C++ and LISP do, << ' >> only backwards and in high heels. << ' =================================================== ' What we got here is SUBs that do arithmetic on ' HUGe positive Integers with perfect precision. ' ================================================== ' standard integer string format: ' 1 and only 1 leading zero: "03312885" ' Zero is represented: "0" ' ================================================== ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' @@ JOB JAR: [S]wap after [q] --> ??? @@ ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ Q$ = CHR$(34): T$ = CHR$(179) ' Beta-Test THIS! C04: : Blu: LOCATE , , 0: CLS : PRINT "Sail the HUGe integers with ... "; : Gre: PRINT "HUGO!": PRINT : Blu: PRINT " Menu": PRINT " "; STRING$(58, 196) : Bri: PRINT " Monster RPN calculator + - * / "; CHR$(251) PRINT " Fibonacci series 0, 1, 1, 2, 3, 5, 8, 13 ..." PRINT " Factorials n!" PRINT " Ascending powers n^p" PRINT " Pascal's triangle C(p,q)" PRINT " String search 0521"; : Blu: PRINT "977"; : Bri: PRINT "4381"; : Blu: PRINT "977"; : Bri: PRINT "591160"; : Blu: PRINT "977"; : Bri: PRINT "3812" PRINT " Primes 2, 3, 5, 7, 11, 13, 17 ..." : Gre: PRINT " User Program Area "; : Blu: PRINT "[9]" PRINT " "; STRING$(58, 196): Red: PRINT SPC(31); "e[X]it"; : Blu: FOR JJ = 1 TO 7: LOCATE (JJ + 4), 33 PRINT USING "[#]"; JJ; : NEXT JJ: LUL = 18: Logo C08: G$ = INKEY$: IF G$ = "" GOTO C08 IF G$ = "X" OR G$ = "x" THEN CLS : LUL = 1: Logo: LOCATE 12, 1: END GG = ASC(G$) - 48: IF GG < 1 OR GG > 9 THEN BEEP: GOTO C08 ON GG GOTO C20, D00, C60, D40, D80, E00, E24, A20, A00 ' ++++++++ Monster RPN Calculator +++++++++++++++++++++++++++++ C20: CLS : LOCATE 10, 1: Blu: PRINT STRING$(79, 196) PRINT "{number} ["; : Bri: PRINT "<"; CHR$(217); : Blu: PRINT "] {number} ["; : Bri: PRINT "+"; : Blu: PRINT "]" PRINT "{number} ["; : Bri: PRINT "<"; CHR$(217); : Blu: PRINT "] {number} ["; : Bri: PRINT "-"; : Blu: PRINT "]" PRINT "{number} ["; : Bri: PRINT "<"; CHR$(217); : Blu: PRINT "] {number} ["; : Bri: PRINT "*"; : Blu: PRINT "]" PRINT "{number} ["; : Bri: PRINT "<"; CHR$(217); : Blu: PRINT "] {number} ["; : Bri: PRINT "/"; : Blu: PRINT "]" PRINT SPC(16); "{number} ["; : Bri: PRINT "q"; : Blu: PRINT "] square root "; : Bri: PRINT "(perfect highlighted)" : Blu: PRINT SPC(26); "["; : Bri: PRINT "C"; : Blu: PRINT "] clear calculator" PRINT SPC(26); "["; : Bri: PRINT "S"; : Blu: PRINT "] swap last two numbers" PRINT SPC(26); "["; : Bri: PRINT "r"; : Blu: PRINT "] make remainder last number": PRINT STRING$(79, 196); LOCATE 25, 1: PRINT "["; : Bri: PRINT "0-9"; : Blu: PRINT "] ["; : Bri: PRINT "+"; : Blu: PRINT "] ["; : Bri: PRINT "-"; : Blu: PRINT "] ["; : Bri: PRINT "*"; : Blu: PRINT "] ["; : Bri: PRINT "/"; : Blu: PRINT "] ["; : Bri: PRINT "q"; : Blu: PRINT "] ["; : Bri: PRINT "<"; CHR$(217); : Blu: PRINT "] ["; : Bri: PRINT "S"; : Blu: PRINT "] ["; : Bri: PRINT "C"; : Blu: PRINT "] "; : Gre: PRINT "HUGO RPN Calculator "; : Blu: PRINT "[M]enu"; : Red: LOCATE 24, 1: PRINT "> "; : Whi: PRINT "0"; AA$ = "0": BB$ = "": LB = 0 C32: G$ = INKEY$: IF G$ = "" GOTO C32 C36: IF G$ = "C" OR G$ = "c" GOTO C20 IF G$ = "M" OR G$ = "m" GOTO C04 IF G$ = "S" OR G$ = "s" GOTO C56 IF G$ = CHR$(13) GOTO C44 IF G$ <> "+" AND G$ <> "-" AND G$ <> "*" AND G$ <> "/" AND G$ <> "Q" AND G$ <> "q" GOTO C38 COLOR 27, 0: LOCATE 25, 69: PRINT "Working ..."; IF G$ = "+" THEN Ed: GOTO C48 IF G$ = "*" THEN Mu: GOTO C48 IF G$ = "/" THEN Di: GOTO C48 IF G$ = "Q" OR G$ = "q" THEN G$ = CHR$(251): AA$ = BB$: Ska: GOTO C48 : Kmpr: IF G$ = "-" AND KK = -1 THEN BEEP: LB = 0: GOTO C32 IF G$ = "-" THEN Su: GOTO C48 C38: GG = ASC(G$) - 48: IF GG < 0 OR GG > 9 THEN BEEP: GOTO C32 ' ++++++++ 0 - 9, maybe 1st digit +++++ IF LB > 1 GOTO C40 AA$ = BB$: BB$ = "0": Whi: PRINT : PRINT STRING$(79, 196): Red PRINT "> "; : Whi: PRINT BB$; : LB = 1 C40: LB = LB + 1: PRINT G$; : BB$ = BB$ + G$ IF (LB MOD 60) = 0 THEN PRINT : PRINT " "; : GOTO C32 IF (LB MOD 5) = 0 THEN PRINT " "; GOTO C32 ' +++++++ [Enter] ++++++++ C44: PRINT : PRINT STRING$(79, 196): Red: PRINT "> "; : Whi AA$ = BB$: ZZ$ = BB$: DspZ: LB = 0: GOTO C32 ' ++++++ [+] [-] [*] ++++++ C48: Blu: LOCATE 25, 69: PRINT " [M]enu"; : LOCATE 24, 79: Whi PRINT : PRINT STRING$(79, 196): Red: PRINT G$; " "; : Whi: AA$ = BB$ BB$ = CC$: ZZ$ = CC$: IF G$ = CHR$(251) AND RR$ = "0" THEN Bri : DspZ: LB = 0: IF G$ <> "/" GOTO C32 ' ++++++ [/] ++++++++++++++ IF RR$ = "0" GOTO C32 : Blu: PRINT : PRINT STRING$(79, 196): PRINT "r "; ZZ$ = RR$: DspZ: LOCATE 25, 42: PRINT "["; : Bri: PRINT "r"; : Blu: PRINT "]"; C52: G$ = INKEY$: IF G$ = "" GOTO C52 LOCATE 25, 42: PRINT " "; : LOCATE 24, 79: Whi: IF G$ <> "R" AND G$ <> "r" GOTO C36 PRINT : PRINT STRING$(79, 196): Red: PRINT "> "; : Whi AA$ = BB$: BB$ = RR$: ZZ$ = BB$: DspZ: GOTO C32 ' ++++++++++ [S]wap ++++++++ C56: SWAP AA$, BB$: PRINT : PRINT STRING$(79, 196): Red: PRINT "> "; : Whi ZZ$ = BB$: DspZ: GOTO C32 ' ++++ Factorials n! ++++++++++++++++++++++++++++++++++++++++++ C60: CLS : Gre: PRINT "HUGO Factorials n!": PRINT : PRINT PRINT " To trap Factorial n! enter: "; : Blu: PRINT "n [return]" : Gre: PRINT " For no trap enter: "; : Blu: PRINT " [return]" : Red: PRINT CHR$(218); STRING$(43, 196) PRINT T$; " Trap n! n =": PRINT CHR$(192); STRING$(14, 196); LOCATE 7, 18: Whi: INPUT "", TRAPP: IF TRAPP = 0 GOTO C64 TRAPP = INT(TRAPP): IF TRAPP < 3 THEN BEEP: GOTO C60 C64: CLS : Gre: LOCATE 25, 23: PRINT "HUGO Factorials n! "; : Blu: PRINT "[F]reeze [R]eset [M]enu"; IF TRAPP > 2 THEN LOCATE 25, 1: Red: PRINT TRAPP; "!"; : LOCATE 25, 1: PRINT "0"; : Blu LOCATE 24, 1: PRINT "The first 20 go slowly ...": PRINT : Whi PRINT "0 ! =": PRINT " 01": PRINT "01 ! =": PRINT " 01"; FF$ = "01": KNTR1$ = "01": MMM = 1 C72: AA$ = "01": Ink1: PRINT : PRINT KNTR1$; " ! ="; AA$ = KNTR1$: BB$ = FF$: Mu: FF$ = CC$: PRINT : PRINT " "; ZZ$ = FF$: MMM = MMM + 1: IF MMM = TRAPP THEN Bri : DspZ: Whi: IF MMM < 21 THEN SLEEP 1 IF MMM = TRAPP GOTO C80 G$ = INKEY$: IF G$ = "" GOTO C72 IF G$ = "R" OR G$ = "r" GOTO C60 IF G$ = "M" OR G$ = "m" GOTO C04 C80: LOCATE 25, 53: Blu: PRINT "[T]haw "; C88: G$ = INKEY$: IF G$ = "" GOTO C88 IF MMM = TRAPP THEN LOCATE 25, 1: PRINT SPACE$(20); LOCATE 25, 53: PRINT "[F]reeze [R]eset [M]enu"; : Whi LOCATE 24, 79: GOTO C72 ' ++++ Fibonacci Numbers +++++++++++++++++++++++++ D00: CLS : Gre: PRINT "HUGO Fibonacci Series": PRINT : PRINT : Gre: PRINT " To trap Fibonacci Number F(n) enter: "; : Blu: PRINT "n [return]" : Gre: PRINT " For no trap enter: "; : Blu: PRINT " [return]" : Red: PRINT CHR$(218); STRING$(53, 196) PRINT T$; " Trap F(n) n =": PRINT CHR$(192); STRING$(16, 196); LOCATE 7, 20: Whi: INPUT "", TRAPP: IF TRAPP = 0 GOTO D16 TRAPP = INT(TRAPP): IF TRAPP < 3 THEN BEEP: GOTO D00 D16: CLS : Gre: LOCATE 25, 23: PRINT "HUGO Fibonacci Series "; : Blu: PRINT "[F]reeze [R]eset [M]enu"; IF TRAPP > 2 THEN LOCATE 25, 1: Red: PRINT "F("; TRAPP; ")"; : Blu LOCATE 24, 1: PRINT "The first 20 go slowly ...": PRINT : Whi PRINT "F( 0 ) =": PRINT " 0": PRINT "F( 1 ) =": PRINT " 01"; MMM = 1: AA$ = "0": BB$ = "01" D20: MMM = MMM + 1: Ed: PRINT : PRINT "F("; MMM; ") =": PRINT " "; ZZ$ = CC$: IF MMM = TRAPP THEN Bri : DspZ: Whi: AA$ = BB$: BB$ = CC$: IF MMM < 21 THEN SLEEP 1 IF MMM = TRAPP GOTO D24 G$ = INKEY$: IF G$ = "" GOTO D20 IF G$ = "M" OR G$ = "m" GOTO C04 IF G$ = "R" OR G$ = "r" GOTO D00 D24: LOCATE 25, 53: Blu: PRINT "[T]haw "; D32: G$ = INKEY$: IF G$ = "" GOTO D32 IF MMM = TRAPP THEN LOCATE 25, 1: PRINT SPACE$(20); LOCATE 25, 53: PRINT "[F]reeze [R]eset [M]enu"; : Whi LOCATE 24, 79: GOTO D20 ' ++++ Ascending Powers +++++++++++++++++++++++++ D40: CLS : Gre: PRINT SPC(25); "p": PRINT "HUGO Ascending Powers n" PRINT : PRINT : Red PRINT CHR$(218); STRING$(33, 196): PRINT T$; " Enter an integer n > 1" PRINT CHR$(192); STRING$(24, 196); LOCATE 6, 28: Whi: INPUT "", AA$: IF AA$ = "" GOTO C04 II = 0: LA = LEN(AA$) D44: II = II + 1: IF II > LA GOTO D48 ' <- kosher TT = ASC(MID$(AA$, II, 1)) IF TT < 48 OR TT > 57 THEN BEEP: GOTO D40 ELSE GOTO D44 D48: ZZ$ = AA$: NrmlZ: AA$ = ZZ$: LOCATE 11, 1 : Gre: PRINT " To trap the pth power enter: "; : Blu: PRINT "p [return]": : Gre: PRINT " For no trap enter: "; : Blu: PRINT " [return]": Red: PRINT CHR$(218); STRING$(43, 196) PRINT T$; " Trap pth power p =": PRINT CHR$(192); STRING$(21, 196); LOCATE 14, 25: Whi: INPUT "", TRAPP: IF TRAPP = 0 GOTO D52 TRAPP = INT(TRAPP): IF TRAPP < 3 THEN BEEP: GOTO D40 D52: CLS : Gre: LOCATE 25, 23: PRINT "HUGO Ascending Powers "; : Blu: PRINT "[F]reeze [R]eset [M]enu"; IF TRAPP > 2 THEN LOCATE 25, 1: Red: PRINT AA$; " ^"; TRAPP; : Blu LOCATE 24, 1: PRINT "The first 20 go slowly ...": PRINT : Whi PRINT AA$; " ^ 0 =": PRINT " 01": PRINT AA$; " ^ 1 =": PRINT " "; AA$; MMM = 1: BB$ = AA$ D60: MMM = MMM + 1: IF MMM < 21 THEN SLEEP 1 PRINT : PRINT AA$; " ^"; MMM; "="; : Mu: PRINT : PRINT " "; ZZ$ = CC$: IF MMM = TRAPP THEN Bri : DspZ: Whi: BB$ = CC$: IF MMM = TRAPP GOTO D64 G$ = INKEY$: IF G$ = "" GOTO D60 IF G$ = "M" OR G$ = "m" GOTO C04 IF G$ = "R" OR G$ = "r" GOTO D40 D64: LOCATE 25, 53: Blu: PRINT "[T]haw "; D72: G$ = INKEY$: IF G$ = "" GOTO D72 IF MMM = TRAPP THEN LOCATE 25, 1: PRINT SPACE$(20); LOCATE 25, 53: PRINT "[F]reeze [R]eset [M]enu"; : Whi LOCATE 24, 79: GOTO D60 ' +++++++++++++ Pascal's Triangle +++++++++++++++++++++++++++++++++ D80: Red: CLS : PRINT " p" PRINT " "; CHR$(25): PRINT "q "; CHR$(26); : Blu: PRINT " 0 1 2 3 4 5 6 7" : Red: PRINT " "; STRING$(40, 196): : Blu: PRINT " 1 1" PRINT " 1 2 1": PRINT " 1 3 3 1" PRINT " 1 4 6 4 1" PRINT " 1 5 10 10 5 1" PRINT " 1 6 15 20 15 6 1" PRINT " 1 7 21 35 35 21 7 1"; : Red: PRINT " etc."; : Gre: LOCATE 1, 57, 0: PRINT "HUGO Pascal's triangle"; : Blu: LOCATE 5, 68: PRINT "p!"; LOCATE 6, 57: PRINT "C(p,q) = "; STRING$(8, 196); LOCATE 7, 68: PRINT "q!(p-q)!"; : Red: LOCATE 14, 1 PRINT CHR$(218); STRING$(45, 196): PRINT T$; " Enter an integer p > 1" PRINT CHR$(192); STRING$(24, 196); : Whi: LOCATE 15, 29, 1 INPUT "", PP$: IF PP$ = "" THEN BEEP: GOTO C04 ZZ$ = PP$: Kosher: IF KSHR = 1 THEN BEEP: GOTO C04 PP$ = ZZ$: IF PP$ = "0" THEN BEEP: GOTO C04 IF PP$ = "01" THEN BEEP: GOTO D80 LP = LEN(PP$): Red: LOCATE 18, 1: PRINT CHR$(218); STRING$(45, 196) PRINT T$; " Enter an integer 0 < q < "; PP$ PRINT CHR$(192); STRING$((LP + 27), 196); : Whi: LOCATE 19, (LP + 32), 1 INPUT "", QQ$: IF QQ$ = "" THEN BEEP: GOTO D80 ZZ$ = QQ$: Kosher: IF KSHR = 1 THEN BEEP: GOTO D80 QQ$ = ZZ$: IF QQ$ = "0" THEN BEEP: GOTO D80 AA$ = QQ$: BB$ = PP$: Kmpr: IF KK > -1 THEN BEEP: GOTO D80 : Red: CLS : LOCATE 25, 1, 0: PRINT "C( "; PP$; " , "; QQ$; " )"; : Gre: LOCATE 25, 27: PRINT "Pascal's triangle C(p,q)"; SPC(17); COLOR 27, 0: PRINT "Working ..."; : Whi: LOCATE 24, 1 TYM = TIMER: AA$ = PP$: BB$ = QQ$: Su: BIG$ = CC$: SMA$ = QQ$ AA$ = BIG$: BB$ = SMA$: Kmpr: IF KK = -1 THEN SWAP BIG$, SMA$ AA$ = "01": BB$ = BIG$: Ed FFF$ = CC$: TTT$ = PP$: PRINT SPC(12); : Blu: PRINT TTT$ PRINT SPC(12); CHR$(196); CHR$(194); CHR$(196); CHR$(194); CHR$(196) : Blu: PRINT "numerator = "; CHR$(179); " "; CHR$(179); " n" PRINT SPC(12); "n = "; FFF$: Whi: BigPi: NNNN$ = PPP$ ZZ$ = PPP$: PRINT " "; : DspZ: PRINT : PRINT STRING$(79, 196) FFF$ = "01": TTT$ = SMA$: Blu: PRINT "denominator = "; TTT$; " !" : Whi: BigPi: DDDD$ = PPP$: ZZ$ = PPP$: PRINT " "; : DspZ: PRINT PRINT STRING$(79, 196); : Bri: AA$ = NNNN$: BB$ = DDDD$: Di ZZ$ = CC$: PRINT : PRINT " "; : DspZ: AIR = 2: IF RR$ <> "0" THEN Klaxon : Gre: Thyme: LOCATE 25, 46: PRINT USING "##.#### "; TYM; : PRINT U$; : Blu: PRINT " [A]gain [M]enu"; D96: G$ = INKEY$: IF G$ = "M" OR G$ = "m" GOTO C04 IF G$ = "A" OR G$ = "a" GOTO D80 ELSE GOTO D96 ' +++++++++++ String search +++++++++++++++++++++++++++++++++++++ E00: CLS : RANDOMIZE TIMER: ZZ$ = "0" + RIGHT$(STR$(INT(9 * RND) + 1), 1) FOR NN = 1 TO (INT(40 * RND) + 720) ZZ$ = ZZ$ + RIGHT$(STR$(INT(10 * RND)), 1): NEXT NN E08: : Gre: LOCATE 25, 1, 0: PRINT "HUGO String Search"; : LOCATE 1, 1 : Whi: PRINT " "; : DspZ: LZ = LEN(ZZ$): Red: LOCATE 16, 1 PRINT CHR$(218); STRING$(45, 196): PRINT T$; " Enter a digit string:" PRINT CHR$(192); STRING$(22, 196); : Blu: LOCATE 18, 26, 1 INPUT "", SS$: IF SS$ = "" THEN BEEP: GOTO C04 LS = LEN(SS$): IF LS > 21 THEN BEEP: GOTO E00 YY = 0: YYS = -1: HTZ = 0: LOCATE , , 0 E12: YY = YY + 1: YYS = (YYS + 1) MOD 60: IF (YY + LS - 1) > LZ GOTO E16 ZAP$ = MID$(ZZ$, YY, LS): IF ZAP$ <> SS$ GOTO E12 HTZ = HTZ + 1: FOR JJ = 1 TO LEN(ZAP$) LOCATE (INT((YY - 1) / 60) + 1), ((YYS + INT(YYS / 5)) + 3) PRINT MID$(ZAP$, JJ, 1); : YY = YY + 1: YYS = (YYS + 1) MOD 60 NEXT JJ: YY = YY - 1: YYS = (YYS + 59) MOD 60: GOTO E12 E16: LOCATE 17, 3: PRINT SPACE$(30); : LOCATE 17, 3 PRINT HTZ; "match"; : IF HTZ > 1 THEN PRINT "es"; DIM BUK(0 TO 9): XPKT = (LZ - 1) / 10 FOR JJ = 2 TO LZ: JJJ = VAL(MID$(ZZ$, JJ, 1)): BUK(JJJ) = BUK(JJJ) + 1 NEXT JJ: Bri: FOR JJ = 0 TO 9: LOCATE (JJ + 16), 54 PRINT USING " # ### ###.####"; JJ; BUK(JJ); ((100 * BUK(JJ)) / (LZ - 1)); PRINT USING " ##.####"; (((BUK(JJ) - XPKT) ^ 2) / XPKT); : NEXT JJ ERASE BUK: Blu: LOCATE 14, 51 PRINT "digit no. % X"; CHR$(253); : LOCATE 15, 51 PRINT STRING$(27, 196); : LOCATE 21, 5: PRINT "[S]ame number"; LOCATE 22, 5: PRINT "[N]ew number"; : LOCATE 23, 5: PRINT "[M]enu"; E20: G$ = INKEY$: IF G$ = "M" OR G$ = "m" GOTO C04 IF G$ = "N" OR G$ = "n" GOTO E00 IF G$ = "S" OR G$ = "s" THEN CLS : GOTO E08 ELSE GOTO E20 ' ++++++++++++++ Primes ++++++++++++++++++++++++++++++++++++++++++++ E24: : Gre: CLS : PRINT "HUGO Primes p(1), p(2), p(3) ...": PRINT : PRINT PRINT " To trap the nth prime enter: "; : Blu: PRINT "n [return]" : Gre: PRINT " For no trap enter: "; : Blu: PRINT " [return]" : Red: PRINT CHR$(218); STRING$(43, 196) PRINT T$; " Trap p(n) n =": PRINT CHR$(192); STRING$(16, 196); LOCATE 7, 20: Whi: INPUT "", TRAPP: IF TRAPP = 0 THEN TRAP$ = "0": GOTO E32 TRAPP = INT(TRAPP): IF TRAPP < 4 THEN BEEP: GOTO E24 ZZ$ = STR$(TRAPP): NrmlZ: TRAP$ = ZZ$ E32: : Gre: CLS : LOCATE 25, 30: PRINT "HUGO Primes "; : Blu: PRINT "[F]reeze [R]eset [M]enu"; IF TRAP$ <> "0" THEN LOCATE 25, 1: Red: PRINT "p( "; TRAP$; " )"; : Blu LOCATE 24, 1: PRINT "The first 20 go slowly ...": PRINT : PRINT : Whi PRINT "p( 01 ) =": PRINT " 02"; : SLEEP 1 PRINT : PRINT "p( 02 ) =": PRINT " 03"; : SLEEP 1 PRINT : PRINT "p( 03 ) =": PRINT " 05"; : SLEEP 1: SLO = 0 KNTR1$ = "03": KNTR2$ = "05" E36: Ink2: Ink2: IF RIGHT$(KNTR2$, 1) = "5" GOTO E36 : Izzit: IF WIZ = 0 GOTO E36 : Ink1: IF KNTR1$ = TRAP$ THEN Bri PRINT : PRINT "p( "; KNTR1$; " ) =": PRINT " "; : ZZ$ = KNTR2$: DspZ: Whi IF KNTR1$ = TRAP$ THEN LOCATE 25, 1: PRINT SPACE$(22); : LOCATE 24, 79: GOTO E52 IF SLO = 1 GOTO E48 IF KNTR1$ <> "021" THEN SLEEP 1 ELSE SLO = 1 E48: G$ = INKEY$: IF G$ = "" GOTO E36 IF G$ = "R" OR G$ = "r" GOTO E24 IF G$ = "M" OR G$ = "m" GOTO C04 E52: LOCATE 25, 53: Blu: PRINT "[T]haw "; E56: G$ = INKEY$: IF G$ = "" GOTO E56 LOCATE 25, 53: PRINT "[F]reeze [R]eset [M]enu"; : Whi: LOCATE 24, 79: GOTO E36 ' +++++++ User Program Area +++++++++++++++++++++++++++++++++++++ A00: UPAinfo: : Gre: PRINT STRING$(79, 196) PRINT "There's currently no User Program." ' PRINT "Sorry, can't program in HUGO.EXE. e-mail for HUGO.BAS." PRINT STRING$(79, 196); : Red: LOCATE 25, 74: PRINT "[M]enu"; : Whi A04: G$ = INKEY$: IF G$ = "" GOTO A04 ELSE GOTO C04 ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' ^^^^^^^^^^^^^^^^^^^^^^ Das ENDE ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ' +++++ devo tests +++++++++++++++++++++++++++++++++++++++++++ A20: GOTO C08 A96: G$ = INKEY$: IF G$ = "" GOTO A96 ELSE CLS : END SUB BigPi SHARED FFF$, TTT$, PPP$, AA$, BB$, CC$, ZZ$, KNTR1$ PPP$ = "01": KNTR1$ = FFF$ P12: AA$ = PPP$: BB$ = KNTR1$: Mu: PPP$ = CC$ IF KNTR1$ <> TTT$ THEN Ink1: GOTO P12 ZZ$ = PPP$: NrmlZ: PPP$ = ZZ$ END SUB SUB Blu COLOR 11, 0 END SUB SUB Bri COLOR 15, 0 END SUB SUB Di SHARED AA$, BB$, CC$, RR$, ZZ$, KK, AIR ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' @@ NOTE: This is HUGO [V.2.0]. It divides CORRECTLY! @@ ' @@ ====================================================== @@ ' @@ If you used HUGO [V.1] for your homework ... @@ ' @@ well ... sorry. @@ ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' ===================================== ' >>>> TAMPERING WITH THIS SUB <<<< ' >>>> WILL CAUSE GREAT MISERY <<<< ' ===================================== ' Long Division Algorithm (Henry Briggs, 1561-1630) ' -------------------------------------------------- ' inputs: AA$ BB$ ' restriction: BB$ <> "0" ' outputs: CC$ = int(AA$ / BB$) ' RR$ = AA$ mod BB$ = remainder ' -------------------------------------------------- ' ++++++++ Normalize inputs +++++++++++++++++++++++++++++++++++++ ZZ$ = AA$: NrmlZ: AA$ = ZZ$: ZZ$ = BB$: NrmlZ: BB$ = ZZ$ ' ++++++++++ special cases +++++++++++++++++++++++++++++++++++++++++ AIR = 1: IF BB$ = "0" THEN Klaxon RR$ = "0": IF BB$ = "01" THEN CC$ = AA$: GOTO H48 IF AA$ = BB$ THEN CC$ = "01": GOTO H48 : Kmpr: IF KK = -1 THEN CC$ = "0": RR$ = AA$: GOTO H48 ' +++++++++ setup for full long division +++++++++++++++++++++++++++ AAAA$ = AA$: BBBB$ = BB$ ' <-- Kold Storage LAA = LEN(AA$): LBB = LEN(BB$): DRPDN = LBB ' <-- dropdown Kounter ' +++++ compute Multiples Of BB$ +++++++++++++++++++++++++++++++++ ' MOB$(1) = 1 x BB$ ' MOB$(2) = 2 x BB$ ' . . . ' MOB$(9) = 9 x BB$ ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ DIM MOB$(1 TO 9): MOB$(1) = BB$: AA$ = BB$: FOR NN = 2 TO 9: Ed MOB$(NN) = CC$: AA$ = CC$: NEXT NN: RR$ = LEFT$(AAAA$, LBB): CCCC$ = "0" ' ++++++++ begin the beguine +++++++++++++++++++++++++++++++++++++ H24: NN = 10 H32: NN = NN - 1: IF NN = 0 THEN CCCC$ = CCCC$ + "0": GOTO H40 ' 5-Aspirin Logic Headache No. 1 ' ================================================================ ' We're testing MOB$(9), MOB$(8) ... MOB$(2), MOB$(1) ' to set up RR$ - MOB$(n) ' which NoCanDo until MOB$(n) <= RR$ ' which is equivalent to BB$ <= AA$ ' which is equivalent to AA$ >= BB$ KK = 0 or KK = 1 ' ================================================================ AA$ = RR$: BB$ = MOB$(NN): Kmpr: IF KK = -1 GOTO H32 ' ++++++++ we got a winner here! +++++++++++++++++++++++++++++++++ CCCC$ = CCCC$ + RIGHT$(STR$(NN), 1): Su: RR$ = CC$ ' +++++ increment Dropdown Kounter, ' test for No_More_Digits = AllDone! +++++++++++++++++++++++ H40: DRPDN = DRPDN + 1 IF DRPDN <= LAA THEN RR$ = RR$ + MID$(AAAA$, DRPDN, 1): GOTO H24 ' +++++ AllDone! Clean up, turn off lights, lock up. ++++++++++++ AA$ = AAAA$: BB$ = BBBB$: ERASE MOB$ ZZ$ = CCCC$: NrmlZ: CC$ = ZZ$: ZZ$ = RR$: NrmlZ: RR$ = ZZ$ H48: ' <-- special cases went here END SUB SUB DspZ SHARED ZZ$ GG = 0: NrmlZ: LZ = LEN(ZZ$) Q12: GG = GG + 1: IF GG > LZ GOTO Q28 IF (GG MOD 60) = 1 AND GG > 1 THEN PRINT : PRINT " "; : GOTO Q20 IF (GG MOD 5) = 1 AND GG > 1 THEN PRINT " "; Q20: PRINT MID$(ZZ$, GG, 1); : GOTO Q12 Q28: END SUB SUB Ed SHARED AA$, BB$, CC$, ZZ$ ' ===================================== ' >>>> TAMPERING WITH THIS SUB <<<< ' >>>> WILL CAUSE GREAT MISERY <<<< ' ===================================== ' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' ------------------------------- @@ New! Improved! Scientific! @@ ' inputs: AA$ BB$ @@ Much Much Faster! @@ ' output: CC$ = AA$ + BB$ @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' ------------------------------- ' The Three Phases of Ed ' ---------------------- ZZ$ = AA$: NrmlZ: AA$ = ZZ$: ZZ$ = BB$: NrmlZ: BB$ = ZZ$ CC$ = "": LA = LEN(AA$): LB = LEN(BB$): DWS = 0 IF LA < LB THEN DWS = 1: SWAP AA$, BB$: SWAP LA, LB KRY = 0: FF = LA + 1: FOR DD = LB TO 1 STEP -1: FF = FF - 1 EE = VAL(MID$(AA$, FF, 1)) + VAL(MID$(BB$, DD, 1)) + KRY KRY = INT(EE / 10): CC$ = RIGHT$(STR$(EE), 1) + CC$: NEXT DD FF = 0: DD = LA - LB: DO WHILE KRY = 1 EE = VAL(MID$(AA$, DD, 1)) + KRY: KRY = INT(EE / 10) CC$ = RIGHT$(STR$(EE), 1) + CC$: DD = DD - 1: FF = FF + 1: LOOP CC$ = LEFT$(AA$, (LA - LB - FF)) + CC$ ZZ$ = CC$: NrmlZ: CC$ = ZZ$: IF DWS = 1 THEN SWAP AA$, BB$ END SUB SUB Gre COLOR 10, 0 END SUB SUB Ink1 SHARED AA$, BB$, CC$, KNTR1$ AA$ = "01": BB$ = KNTR1$: Ed: KNTR1$ = CC$ END SUB SUB Ink2 SHARED AA$, BB$, CC$, KNTR2$ AA$ = "01": BB$ = KNTR2$: Ed: KNTR2$ = CC$ END SUB SUB Ink3 SHARED AA$, BB$, CC$, KNTR3$ AA$ = "01": BB$ = KNTR3$: Ed: KNTR3$ = CC$ END SUB SUB Izzit SHARED KNTR2$, KNTR3$, AA$, BB$, CC$, RR$, KK, WIZ ' output input ' WIZ KNTR2$ ' ------------------- ' 0 composite ' 1 prime ' 2 "0" ' 3 "01" ' ------------------- WIZ = 0: IF KNTR2$ = "0" THEN WIZ = 2: GOTO I08 IF KNTR2$ = "01" THEN WIZ = 3: GOTO I08 IF KNTR2$ = "02" OR KNTR2$ = "05" THEN WIZ = 1: GOTO I08 TT$ = RIGHT$(KNTR2$, 1): IF TT$ = "5" GOTO I08 IF (VAL(TT$) MOD 2) = 0 GOTO I08 AA$ = KNTR2$: Ska: SS$ = CC$: KNTR3$ = "01" I04: Ink3: Ink3: IF RIGHT$(KNTR3$, 1) = "5" GOTO I04 AA$ = KNTR3$: BB$ = SS$: Kmpr: IF KK = 1 THEN WIZ = 1: GOTO I08 AA$ = KNTR2$: BB$ = KNTR3$: Di: IF RR$ <> "0" GOTO I04 I08: END SUB SUB Klaxon SHARED LUL, AIR, Q$, T$, PP$, QQ$ IF AIR = 2 GOTO J20 CLS : Red: KLAX = 1: FRQ = 750: DF = 12 PRINT "*********************************************************" PRINT ">> FATAL HUGO ERROR: Attempted Division by Zero! <<" PRINT "*********************************************************" PRINT ">> This is a Disallowed Operation. <<" PRINT ">> Division by Zero is Undefined. <<" PRINT ">> A permanent record of this event has been made. <<" PRINT ">> HUGO will now terminate the program. <<" PRINT ">> <<" PRINT ">> Do not press: [K] <<" PRINT ">> <<" PRINT "*********************************************************" PRINT ">> Reference: "; Q$; "Fun with Numbers,"; Q$; " Grade 5 <<" PRINT "*********************************************************" J00: FRQ = FRQ + DF: SOUND FRQ, .05 IF FRQ < 200 OR FRQ > 1300 THEN DF = -DF: GOTO J00 J04: G$ = INKEY$: IF G$ = "" AND KLAX = 1 GOTO J00 IF G$ = "" AND KLAX = 0 GOTO J04 IF G$ = "K" OR G$ = "k" THEN KLAX = ABS(KLAX - 1): GOTO J04 J08: CLS : LUL = 1: Logo: LOCATE 12, 1: END J20: Red: LOCATE 25, 69: PRINT " e[X]it"; LOCATE 1, 41: PRINT " "; CHR$(218); STRING$(36, 196); CHR$(191); LOCATE 7, 41: PRINT " "; CHR$(192); STRING$(36, 196); CHR$(217); FOR LL = 2 TO 6: LOCATE LL, 41: PRINT " "; T$; SPACE$(36); T$; : NEXT LL LOCATE 2, 44: PRINT ">>> ERROR! Nonzero Remainder <<<"; LOCATE 3, 44: PRINT "Please e-mail: bobmer@javanet.com"; LOCATE 4, 44: PRINT "Specify: p = "; PP$; LOCATE 5, 44: PRINT " q = "; QQ$; LOCATE 6, 44: PRINT " version = [V.2.0] Thanks!"; J24: G$ = INKEY$: IF G$ = "" GOTO J24 ELSE GOTO J08 END SUB SUB Kmpr SHARED AA$, BB$, ZZ$, KK ' Returns KK if ' ------------------------ ===================================== ' -1 AA$ < BB$ >>>> TAMPERING WITH THIS SUB <<<< ' 0 AA$ = BB$ >>>> WILL CAUSE GREAT MISERY <<<< ' 1 AA$ > BB$ ===================================== ' ------------------------ ZZ$ = AA$: NrmlZ: AA$ = ZZ$ ZZ$ = BB$: NrmlZ: BB$ = ZZ$: IF AA$ = BB$ THEN KK = 0: GOTO K08 LA = LEN(AA$): LB = LEN(BB$): IF LA <> LB THEN KK = SGN(LA - LB): GOTO K08 GG = 0 K04: GG = GG + 1: AA = VAL(MID$(AA$, GG, 1)): BB = VAL(MID$(BB$, GG, 1)) IF AA = BB GOTO K04 ELSE KK = SGN(AA - BB) K08: END SUB SUB Kosher SHARED ZZ$, KSHR II = 0: LZ = LEN(ZZ$): KSHR = 0 J12: II = II + 1: IF II > LZ THEN NrmlZ: GOTO J16 ' <- kosher TT = ASC(MID$(ZZ$, II, 1)) IF TT > 47 AND TT < 58 GOTO J12 ELSE BEEP: KSHR = 1 J16: END SUB SUB Logo SHARED T$, LUL LOCATE (LUL + 1), 3: Gre: PRINT "HUGO.BAS [V.2.0]"; : Bri LOCATE (LUL + 2), 3: PRINT "Copyright (c) 1997 by Robert Merkin"; LOCATE (LUL + 3), 3: PRINT "Yankee Magnetic Software"; LOCATE (LUL + 4), 3: PRINT "55 Milton Street / Northampton MA 01060 USA"; LOCATE (LUL + 5), 3: PRINT "413-586-1616 / bobmer@javanet.com"; : Gre LOCATE (LUL + 6), 3: PRINT "Solving things you never knew were problems!"; LOCATE LUL, 1: Red: PRINT CHR$(218); STRING$(46, 196); CHR$(191); LOCATE (LUL + 7), 1: PRINT CHR$(192); STRING$(46, 196); CHR$(217); FOR LL = (LUL + 1) TO (LUL + 6): LOCATE LL, 1: PRINT T$; LOCATE LL, 48: PRINT T$; : NEXT LL: Whi END SUB SUB Mu SHARED AA$, BB$, CC$, ZZ$ ' ===================================== ' >>>> TAMPERING WITH THIS SUB <<<< ' >>>> WILL CAUSE GREAT MISERY <<<< ' ===================================== ' New! Improved! Supercharged! 1.123 x faster! ' Who says IF tests are bad? ' ------------------------------- ' inputs: AA$ BB$ ' output: CC$ = AA$ x BB$ ' ------------------------------- ZZ$ = AA$: NrmlZ: AA$ = ZZ$: ZZ$ = BB$: NrmlZ: BB$ = ZZ$ CC$ = "": LA = LEN(AA$): LB = LEN(BB$): DIM BUK(0 TO (LA + LB)) DDD = -1: FOR DD = LB TO 2 STEP -1: DDD = DDD + 1 DDDD = VAL(MID$(BB$, DD, 1)): IF DDDD = 0 GOTO M12 EEE = -1: FOR EE = LA TO 1 STEP -1: EEE = EEE + 1 EEEE = VAL(MID$(AA$, EE, 1)) BUK(DDD + EEE) = BUK(DDD + EEE) + (DDDD * EEEE) NEXT EE M12: NEXT DD: FOR DD = 0 TO (LA + LB) IF BUK(DD) > 9 THEN BUK(DD + 1) = BUK(DD + 1) + INT(BUK(DD) / 10) BUK(DD) = BUK(DD) MOD 10: CC$ = RIGHT$(STR$(BUK(DD)), 1) + CC$ NEXT DD: ERASE BUK: ZZ$ = CC$: NrmlZ: CC$ = ZZ$ END SUB SUB NrmlZ SHARED ZZ$ ' ====================================== ' >>>> DON'T MESS AROUND IN HERE! <<<< ' ====================================== LZ = LEN(ZZ$): IF LEFT$(ZZ$, 1) = " " THEN ZZ$ = RIGHT$(ZZ$, (LZ - 1)) GG = 0: ZZ$ = "0" + ZZ$: LZ = LEN(ZZ$) N20: GG = GG + 1: IF GG > LZ THEN ZZ$ = "0": GOTO N24 IF MID$(ZZ$, GG, 1) = "0" GOTO N20 ZZ$ = RIGHT$(ZZ$, (LZ - GG + 2)) N24: END SUB SUB Red COLOR 12, 0 END SUB SUB Ska SHARED AA$, BB$, CC$, ZZ$, RR$, KK ' ++++++++ Long-Division-Style Square Root Algorithm ++++++++++ ' outputs input ' -------------------------- ' CC$ = int(sqr(AA$)) ' RR$ = remainder ' If RR$ = "0" then AA$ is a perfect square. ' +++++++ setup +++++++++++++++++++++++++++++++++++++++++++++++ ZZ$ = AA$: NrmlZ: AA$ = ZZ$: AAA$ = AA$: ZZ = LEN(AAA$) YY = (ZZ MOD 2) + 3: AA = VAL(LEFT$(AAA$, (YY - 1))) VV = 10: DO WHILE (VV * VV) > AA: VV = VV - 1: LOOP ZZ$ = STR$(VV): NrmlZ: UU$ = RIGHT$(ZZ$, 1) ZZ$ = STR$(AA - (VV * VV)): NrmlZ: PP$ = ZZ$ ' +++++++ iterative stuph ++++++++++++++++++++++++++++++++++++ O04: IF YY > ZZ GOTO O12 PP$ = PP$ + MID$(AAA$, YY, 2): YY = YY + 2 AA$ = UU$: BB$ = UU$: Ed: TT$ = CC$ + "0" AA$ = PP$: BB$ = TT$: Di: SS$ = CC$ O08: AA$ = TT$: BB$ = SS$: Ed: VV$ = CC$ AA$ = VV$: BB$ = SS$: Mu: QQ$ = CC$ AA$ = PP$: BB$ = QQ$: Kmpr IF KK = -1 THEN AA$ = SS$: BB$ = "01": Su: SS$ = CC$: GOTO O08 UU$ = UU$ + RIGHT$(SS$, 1): Su: PP$ = CC$: GOTO O04 ' +++++ alldone: clean up, turn lights off, lock up +++++++++ O12: ZZ$ = UU$: NrmlZ: CC$ = ZZ$ ZZ$ = PP$: NrmlZ: RR$ = ZZ$: AA$ = AAA$ END SUB SUB Su SHARED AA$, BB$, CC$, ZZ$ ' ===================================== ' >>>> TAMPERING WITH THIS SUB <<<< ' >>>> WILL CAUSE GREAT MISERY <<<< ' ===================================== ' ----------------------------------- ' inputs: AA$ BB$ ' restriction: AA$ >= BB$ ' output: CC$ = AA$ - BB$ ' ----------------------------------- ZZ$ = AA$: NrmlZ: AA$ = ZZ$ ZZ$ = BB$: NrmlZ: BB$ = ZZ$: BBBB$ = BB$ CC$ = "": LA = LEN(AA$): LB = LEN(BB$) BB$ = STRING$((LA - LB), 48) + BB$ BRO = 0: FOR DD = LA TO 1 STEP -1 EE = VAL(MID$(AA$, DD, 1)) - VAL(MID$(BB$, DD, 1)) - BRO BRO = 0: IF EE < 0 THEN BRO = 1: EE = EE + 10 CC$ = RIGHT$(STR$(EE), 1) + CC$: NEXT DD BB$ = BBBB$: ZZ$ = CC$: NrmlZ: CC$ = ZZ$ END SUB SUB Thyme SHARED TYM, U$ TYM = TIMER - TYM: IF TYM < 0 THEN TYM = TYM + 86400 U$ = "sec": IF TYM > 60 THEN TYM = TYM / 60: U$ = "min" IF TYM > 60 THEN TYM = TYM / 60: U$ = "hrs" END SUB SUB UPAinfo SHARED Q$ CLS : LOCATE 12, 1: Gre: PRINT "HUGO User Program Area": PRINT STRING$(79, 196): Whi PRINT "In this Area, you can use HUGO's SUBs to assemble functions of HUGe" PRINT "positive integers with perfect-precision results. DspZ displays input" PRINT "and output integers in easy-to-read format. "; : Bri: PRINT "HUGO_2_0.DOC "; : Whi: PRINT "has the details." : Bri: PRINT PRINT "SUB inputs outputs"; SPC(21); "restrictions" PRINT STRING$(64, 196): Whi: PRINT "Ed AA$ BB$ CC$ = AA$ + BB$" PRINT "Su AA$ BB$ CC$ = AA$ - BB$"; SPC(16); "AA$ "; CHR$(242); " BB$" PRINT "Mu AA$ BB$ CC$ = AA$ x BB$": Bri: PRINT STRING$(64, 196): Whi PRINT "Di AA$ BB$ CC$ = int(AA$ / BB$) BB$ "; CHR$(216); " 0" PRINT " RR$ = AA$ mod BB$ (remainder)" : Bri: PRINT STRING$(64, 196): Whi PRINT "Ska AA$ CC$ = int( "; CHR$(251); "AA$ )"; SPC(14); "AA$ "; CHR$(242); " 0" PRINT " if RR$ (remainder) = "; Q$; "0"; Q$; " then AA$ = perfect square" : Bri: PRINT STRING$(64, 196): Whi PRINT "Kmpr AA$ BB$ KK = -1 if AA$ < BB$" PRINT " KK = 0 if AA$ = BB$" PRINT " KK = 1 if AA$ > BB$": Bri: PRINT STRING$(64, 196); : Blu: LOCATE 25, 74: PRINT "[M]ore"; U04: IF INKEY$ = "" GOTO U04 LOCATE 25, 74: PRINT " "; : LOCATE 24, 79 : Whi PRINT : PRINT "Izzit KNTR2$ WIZ = 0 if KNTR2$ = composite" PRINT " WIZ = 1 if KNTR2$ = prime" PRINT " WIZ = 2 if KNTR2$ = "; Q$; "0"; Q$ PRINT " WIZ = 3 if KNTR2$ = "; Q$; "01"; Q$ END SUB SUB Whi COLOR 7, 0 END SUB