From 0f95cc4b3314aff66038b3bf60ff6db6790bc15c Mon Sep 17 00:00:00 2001 From: Harvie Date: Tue, 25 May 2010 16:53:58 +0200 Subject: [PATCH] Borland TurboBASIC & TurboPASCAL stuff from 1998 when i started with programming... --- .gitignore | 1 + turbobasic/001FORMA.BAS | 5 + turbobasic/007.BAS | 10 + turbobasic/111AAA.BAS | 18 + turbobasic/111SYS.BAS | 4 + turbobasic/1PROGRAM.BAS | 232 ++++ turbobasic/255-ZNAK.BAS | 15 + turbobasic/3RD-PA.RTY/DEK.BAS | 85 ++ turbobasic/3RD-PA.RTY/MENU-VZ.BAS | 139 ++ turbobasic/3RD-PA.RTY/MENU.BAS | 143 ++ turbobasic/3RD-PA.RTY/QBASIC/GORILLA.BAS | 1135 ++++++++++++++++ turbobasic/3RD-PA.RTY/QBASIC/MONEY.BAS | 1536 ++++++++++++++++++++++ turbobasic/3RD-PA.RTY/QBASIC/NIBBLES.BAS | 722 ++++++++++ turbobasic/3RD-PA.RTY/REMLINE.BAS | 395 ++++++ turbobasic/AAAAAAAA.BAS | 3 + turbobasic/ALARM.BAS | 16 + turbobasic/ASCI2-25.BAS | 16 + turbobasic/ASCI255.BAS | 16 + turbobasic/BARVY.BAS | 7 + turbobasic/BINGO.BAS | 8 + turbobasic/BINGO2.BAS | 10 + turbobasic/BUDIK.BAS | 12 + turbobasic/CH | 153 +++ turbobasic/CH ZABAR.BAS | 153 +++ turbobasic/CH.BAS | 159 +++ turbobasic/CHKLIST.MS | Bin 0 -> 81 bytes turbobasic/CIS1AZ10.BAS | 11 + turbobasic/COPY.BAS | 8 + turbobasic/DDM-CTV2.BAS | 11 + turbobasic/DDM-CTVE.BAS | 6 + turbobasic/DEK.BAS | 85 ++ turbobasic/DISC-A.BAS | 2 + turbobasic/DODELAM.BAS | 373 ++++++ turbobasic/DOOM2.BAS | 586 +++++++++ turbobasic/GORILLA.BAS | 1135 ++++++++++++++++ turbobasic/GRANATOM.BAS | 19 + turbobasic/HESLO.BAS | 11 + turbobasic/HESLO.DTA | 7 + turbobasic/HESLO.TXT | 9 + turbobasic/HMOTNOST.BAS | 45 + turbobasic/HUSTOTA.BAS | 45 + turbobasic/INKEY.BAS | 16 + turbobasic/INSTALAC.BAS | 4 + turbobasic/JMENOVKA.BAS | 10 + turbobasic/KALK.BAS | 9 + turbobasic/KALKUL-S.BAS | 25 + turbobasic/LINE.BAS | 232 ++++ turbobasic/LINES.BAS | 7 + turbobasic/LOSO2.BAS | 23 + turbobasic/LOSO9.BAS | 10 + turbobasic/LOVEC.BAS | 29 + turbobasic/MENU-VZ.BAS | 139 ++ turbobasic/MENU.BAS | 139 ++ turbobasic/MM.BAS | 11 + turbobasic/NAH-CISL.BAS | 17 + turbobasic/NASOBENI.BAS | 43 + turbobasic/NASOBIT.BAS | 38 + turbobasic/NASOBIT2.BAS | 41 + turbobasic/NAVOD.BAS | 8 + turbobasic/NONAME.BAS | 9 + turbobasic/NORMAL.TB | Bin 0 -> 886 bytes turbobasic/NOTY1.BAS | 39 + turbobasic/OPRAV.BAS | 7 + turbobasic/OPRAVIT9.BAS | 32 + turbobasic/PARTA.BAS | 160 +++ turbobasic/POZDR-BL.BAS | 26 + turbobasic/POZDR2.BAS | 28 + turbobasic/POZDRAV.BAS | 16 + turbobasic/PROGRAM1.BAS | 236 ++++ turbobasic/PROGRAM2.BAS | 240 ++++ turbobasic/ROZVRH | 14 + turbobasic/ROZVRH H.BAS | 14 + turbobasic/SCITANI.BAS | 77 ++ turbobasic/SCITANI2.BAS | 73 + turbobasic/SPOLECNI.BAS | 26 + turbobasic/STICKS.BAS | 13 + turbobasic/SYSTEM.BAS | 18 + turbobasic/T-BASIC.BAS | 45 + turbobasic/TELEFON1.BAS | 155 +++ turbobasic/TOM | 9 + turbobasic/TOM HESL.BAS | 10 + turbobasic/TOM.BAS | 10 + turbobasic/UZIVATEL.BAS | 12 + turbobasic/VIPIS.BAS | 10 + turbobasic/VO-PSANI.BAS | 31 + turbobasic/ZVUKY.BAS | 5 + "turbobasic/Z\303\241loha menu1.BAS" | 232 ++++ turbobasic/noty2.bas | 143 ++ turbopascal/MORSE.PAS | 21 + 89 files changed, 9858 insertions(+) create mode 100755 turbobasic/001FORMA.BAS create mode 100755 turbobasic/007.BAS create mode 100755 turbobasic/111AAA.BAS create mode 100755 turbobasic/111SYS.BAS create mode 100755 turbobasic/1PROGRAM.BAS create mode 100755 turbobasic/255-ZNAK.BAS create mode 100755 turbobasic/3RD-PA.RTY/DEK.BAS create mode 100755 turbobasic/3RD-PA.RTY/MENU-VZ.BAS create mode 100755 turbobasic/3RD-PA.RTY/MENU.BAS create mode 100755 turbobasic/3RD-PA.RTY/QBASIC/GORILLA.BAS create mode 100755 turbobasic/3RD-PA.RTY/QBASIC/MONEY.BAS create mode 100755 turbobasic/3RD-PA.RTY/QBASIC/NIBBLES.BAS create mode 100755 turbobasic/3RD-PA.RTY/REMLINE.BAS create mode 100755 turbobasic/AAAAAAAA.BAS create mode 100755 turbobasic/ALARM.BAS create mode 100755 turbobasic/ASCI2-25.BAS create mode 100755 turbobasic/ASCI255.BAS create mode 100755 turbobasic/BARVY.BAS create mode 100755 turbobasic/BINGO.BAS create mode 100755 turbobasic/BINGO2.BAS create mode 100755 turbobasic/BUDIK.BAS create mode 100755 turbobasic/CH create mode 100755 turbobasic/CH ZABAR.BAS create mode 100755 turbobasic/CH.BAS create mode 100755 turbobasic/CHKLIST.MS create mode 100755 turbobasic/CIS1AZ10.BAS create mode 100755 turbobasic/COPY.BAS create mode 100755 turbobasic/DDM-CTV2.BAS create mode 100755 turbobasic/DDM-CTVE.BAS create mode 100755 turbobasic/DEK.BAS create mode 100755 turbobasic/DISC-A.BAS create mode 100755 turbobasic/DODELAM.BAS create mode 100755 turbobasic/DOOM2.BAS create mode 100755 turbobasic/GORILLA.BAS create mode 100755 turbobasic/GRANATOM.BAS create mode 100755 turbobasic/HESLO.BAS create mode 100755 turbobasic/HESLO.DTA create mode 100755 turbobasic/HESLO.TXT create mode 100755 turbobasic/HMOTNOST.BAS create mode 100755 turbobasic/HUSTOTA.BAS create mode 100755 turbobasic/INKEY.BAS create mode 100755 turbobasic/INSTALAC.BAS create mode 100755 turbobasic/JMENOVKA.BAS create mode 100755 turbobasic/KALK.BAS create mode 100755 turbobasic/KALKUL-S.BAS create mode 100755 turbobasic/LINE.BAS create mode 100755 turbobasic/LINES.BAS create mode 100755 turbobasic/LOSO2.BAS create mode 100755 turbobasic/LOSO9.BAS create mode 100755 turbobasic/LOVEC.BAS create mode 100755 turbobasic/MENU-VZ.BAS create mode 100755 turbobasic/MENU.BAS create mode 100755 turbobasic/MM.BAS create mode 100755 turbobasic/NAH-CISL.BAS create mode 100755 turbobasic/NASOBENI.BAS create mode 100755 turbobasic/NASOBIT.BAS create mode 100755 turbobasic/NASOBIT2.BAS create mode 100755 turbobasic/NAVOD.BAS create mode 100755 turbobasic/NONAME.BAS create mode 100755 turbobasic/NORMAL.TB create mode 100755 turbobasic/NOTY1.BAS create mode 100755 turbobasic/OPRAV.BAS create mode 100755 turbobasic/OPRAVIT9.BAS create mode 100755 turbobasic/PARTA.BAS create mode 100755 turbobasic/POZDR-BL.BAS create mode 100755 turbobasic/POZDR2.BAS create mode 100755 turbobasic/POZDRAV.BAS create mode 100755 turbobasic/PROGRAM1.BAS create mode 100755 turbobasic/PROGRAM2.BAS create mode 100755 turbobasic/ROZVRH create mode 100755 turbobasic/ROZVRH H.BAS create mode 100755 turbobasic/SCITANI.BAS create mode 100755 turbobasic/SCITANI2.BAS create mode 100755 turbobasic/SPOLECNI.BAS create mode 100755 turbobasic/STICKS.BAS create mode 100755 turbobasic/SYSTEM.BAS create mode 100755 turbobasic/T-BASIC.BAS create mode 100755 turbobasic/TELEFON1.BAS create mode 100755 turbobasic/TOM create mode 100755 turbobasic/TOM HESL.BAS create mode 100755 turbobasic/TOM.BAS create mode 100755 turbobasic/UZIVATEL.BAS create mode 100755 turbobasic/VIPIS.BAS create mode 100755 turbobasic/VO-PSANI.BAS create mode 100755 turbobasic/ZVUKY.BAS create mode 100755 "turbobasic/Z\303\241loha menu1.BAS" create mode 100755 turbobasic/noty2.bas create mode 100755 turbopascal/MORSE.PAS diff --git a/.gitignore b/.gitignore index 6f62985..97458d5 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,7 @@ *.old *.exe +*.EXE *.dll *.com *.o diff --git a/turbobasic/001FORMA.BAS b/turbobasic/001FORMA.BAS new file mode 100755 index 0000000..db7f0fe --- /dev/null +++ b/turbobasic/001FORMA.BAS @@ -0,0 +1,5 @@ +CLS +SHELL "A:" +SHELL "FORMAT A:" +INPUT "KONEC" ;A$ +END \ No newline at end of file diff --git a/turbobasic/007.BAS b/turbobasic/007.BAS new file mode 100755 index 0000000..8e55657 --- /dev/null +++ b/turbobasic/007.BAS @@ -0,0 +1,10 @@ +START: +CLS +COLOR 14,1 +SCREEN 8 +LOCATE 2,2 +INPUT " ZADEJTE STARTOVACÖ PIN " ;A +IF A<>007 THEN GOTO START +REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007 +STOP +END \ No newline at end of file diff --git a/turbobasic/111AAA.BAS b/turbobasic/111AAA.BAS new file mode 100755 index 0000000..c2f70d1 --- /dev/null +++ b/turbobasic/111AAA.BAS @@ -0,0 +1,18 @@ +CLS +COLOR 4,15 +SCREEN 1 +LOCATE 2,2 +INPUT " ZAKàDUJTE " ;A$ +CLS +LOCATE 2,2 +INPUT " ODKàDUJTE " ;C$ +IF A$=C$ THEN GOTO JEDNA +CLS +LOCATE 2,2 +PRINT " æPATNí KàD ( !!! ZABLOKOVµNO !!! ) " +DO +SOUND RND*800+12,13 +LOOP +JEDNA: +END + \ No newline at end of file diff --git a/turbobasic/111SYS.BAS b/turbobasic/111SYS.BAS new file mode 100755 index 0000000..74c1be9 --- /dev/null +++ b/turbobasic/111SYS.BAS @@ -0,0 +1,4 @@ +CLS +SHELL "C:" +SHELL "SYS A:" +END \ No newline at end of file diff --git a/turbobasic/1PROGRAM.BAS b/turbobasic/1PROGRAM.BAS new file mode 100755 index 0000000..11ea7d4 --- /dev/null +++ b/turbobasic/1PROGRAM.BAS @@ -0,0 +1,232 @@ + GOTO POKR + +POKR : +SCREEN 0 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +REM zadani polozek adresare +DO + A$="NASOB AHOJ POZDR NASO2 KONEC " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC +LOOP + +'----------------------------------------------------------------------------- +TEXT : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +NASOB : +SCREEN 0 +CLS +SOUND RND*1000+20,70 +COLOR 4,15 +N=0 +S=0 +V=0 +SOUND RND*300+12,13 +SOUND RND*10000+12,13 +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +SOUND RND*10000+12,13 +S=S+1 +GOTO VOLBA +SOUND RND*100+12,13 +ANO: +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +REM pise chybu sound rnd*100+12,13 +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlac klavesu Enter" +end +'----------------------------------------------------------------------------- +NIC1 : +A$="Zdravi Vas Tomas Mudrunka" +CALL ECHO (5,16,A$,13) +A$="Jak se mate?" +CALL ECHO (7,17,A$,13) +A$="Jak se Vam libi tento program?" +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +NASOB2 : + +SCREEN 0 +CLS +rem SOUND RND*1000+20,70 +COLOR 4,15 +S=0 +V=0 +rem SOUND RND*300+12,13 +rem SOUND RND*10000+12,13 + +FOR I=1 TO 10 + rem nechat pokud nebude vadit CLS + LOCATE 4,20 + PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU" + + A=INT(RND(5)*10+1) + B=INT(RND(4)*10+1) + LOCATE 10,5 + REM vymaze radek + PRINT " " + PRINT " " + LOCATE 10,5 + PRINT "NAPIS VYSLEDEK" A "x" B "=" + INPUT " STISKNI ENTER";C + D=A*B + + IF D=C THEN ANO2 + PRINT " SPATNY VYSLEDEK" + rem SOUND RND*10000+12,13 + S=S+1 + GOTO VOLBA2 + rem SOUND RND*100+12,13 + ANO2: + PRINT " SPRAVNE" + V=V+1 + VOLBA2: + LOCATE 18,10 + PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + REM zdrzeni programu + FOR G=1 TO 10 + rem SOUND RND*1000+12,13 + NEXT G +NEXT I + +LOCATE 18,10 +PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +LOCATE 20,10 +PRINT "VYSLEDNA ZNAMKA" T + +Input "Ukonci stiskem klavesy ENTER";A +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/255-ZNAK.BAS b/turbobasic/255-ZNAK.BAS new file mode 100755 index 0000000..afd1bb3 --- /dev/null +++ b/turbobasic/255-ZNAK.BAS @@ -0,0 +1,15 @@ +CLS +FOR A=0 TO 255 +COLOR 0,15 +SCREEN 0 +LOCATE B,A +PRINT A CHR$ (A)"* " + + +REM POKR: +REM LOCATE 5,5 +REM PRINT CHR$ (A) +REM FOR I=0 TO 99999 +REM NEXT I +NEXT A +END \ No newline at end of file diff --git a/turbobasic/3RD-PA.RTY/DEK.BAS b/turbobasic/3RD-PA.RTY/DEK.BAS new file mode 100755 index 0000000..96abaa1 --- /dev/null +++ b/turbobasic/3RD-PA.RTY/DEK.BAS @@ -0,0 +1,85 @@ +SCREEN 0 +COLOR 0,15 +GOTO pet + +pet: +CLS +LOCATE 10,5 +input "NORMA SPOTREBY = 8.2 => Enter; NEBO ZAPIS JINOU";S1 +IF S1=0 THEN S1= 8.2 +CLS +LOCATE 10,5 +INPUT "POCET UJETYCH km OD ZACATKU MESICE";K +CLS +LOCATE 10,5 +INPUT "STAV BENZINU - BLOKY NA ZAC. DEKADY";B +CLS +LOCATE 10,5 +INPUT "STAV BENZINU - NADRZ NA ZAC. DEKADY";B4 +CLS +LOCATE 10,5 +INPUT "CERPANE BLOKY OD ZAC. MESICE - SL.9";B1 +CLS +LOCATE 10,5 +INPUT "STAV TACHOMETRU NA ZAC. DEKADY";O +CLS +PRINT SPC(32) "DEKADA" +PRINT "===============================================================================" +PRINT " SLOUPEC 6 ! SLOUPEC 7 ! SLOUPEC 9 ! BENZIN " +PRINT " TACH.KONEC DNE ! KmDen KmCelk! ZAC DOPL CELK ! BLOKY NADRZ " +PRINT "================================================================================" +R=8:K2=0:B6=0 +FOR I =1 TO 9: R=R+1 +LOCATE 20,1 +PRINT +LOCATE 20,1 +INPUT "UDEJ POCET UJETYCH km ZA DEN";K1 +IF K1=0 THEN konec +K=K1+K:B5=B1+B5:A=(K1/100)*S1:A1=A-INT(A) +IF A1< = .7 THEN raz +IF A1> .7 THEN dva + +raz: +B3=INT(A) +GOTO tri + +dva: +B3=INT(A)+1 +GOTO tri + +tri: +LOCATE 20,1:PRINT" " +LOCATE 20,1 +PRINT"SPOTREBA/NADRZ:";B3;"/";B4;"=>DOPLNENI NADRZE?":INPUT B2 +LOCATE 20,1:PRINT " " +LOCATE 21,1:PRINT " " +B4=B4-B3+B2:B=B-B2:B5=B1+B2 +O2=O+K1 +LOCATE R-2,9:PRINT O2 +LOCATE R-2,22:PRINT K1 +LOCATE R-2,30:PRINT K +LOCATE R-2,39:PRINT B1 +LOCATE R-2,44:PRINT B2 +LOCATE R-2,49:PRINT B5 +LOCATE R-2,70:PRINT B4 +LOCATE R-2,62:PRINT B +LOCATE R-2,20:PRINT "!" +LOCATE R-2,36:PRINT "!" +LOCATE R-2,58:PRINT "!" +O=O2 +B1=B1+B2:K2=K2+K1:B6=B6+B3 +NEXT +GOTO konec + +konec: +S=S1*(K2/100) +LOCATE 20,1:PRINT " NORMOVANA SPOTREBA:";S;" " + +LOCATE 20,30:PRINT" " + +LOCATE 21,2:PRINT"SKUTECNA SPOTREBA:";B6;" " +LOCATE 22,2:PRINT"UJETE km V DEKADE:";K2;" " +LOCATE 24,15 +INPUT "KONEC = Enter ; OPAKOVANI = 1 ";A +IF A=1 GOTO pet + END \ No newline at end of file diff --git a/turbobasic/3RD-PA.RTY/MENU-VZ.BAS b/turbobasic/3RD-PA.RTY/MENU-VZ.BAS new file mode 100755 index 0000000..b7bd296 --- /dev/null +++ b/turbobasic/3RD-PA.RTY/MENU-VZ.BAS @@ -0,0 +1,139 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : + +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/3RD-PA.RTY/MENU.BAS b/turbobasic/3RD-PA.RTY/MENU.BAS new file mode 100755 index 0000000..1740e7d --- /dev/null +++ b/turbobasic/3RD-PA.RTY/MENU.BAS @@ -0,0 +1,143 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP TELEF " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : + +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlaŸ kl vesu Enter A CEKEJ " +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : +PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 " +LOCATE 9,23 +PRINT " TADY TOMAS MUDRUNKA " + + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/3RD-PA.RTY/QBASIC/GORILLA.BAS b/turbobasic/3RD-PA.RTY/QBASIC/GORILLA.BAS new file mode 100755 index 0000000..4948055 --- /dev/null +++ b/turbobasic/3RD-PA.RTY/QBASIC/GORILLA.BAS @@ -0,0 +1,1135 @@ +' Q B a s i c G o r i l l a s +' +' Copyright (C) Microsoft Corporation 1990 +' +' Your mission is to hit your opponent with the exploding banana +' by varying the angle and power of your throw, taking into account +' wind speed, gravity, and the city skyline. +' +' Speed of this game is determined by the constant SPEEDCONST. If the +' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line +' below. The larger the number the faster the game will go. +' +' To run this game, press Shift+F5. +' +' To exit QBasic, press Alt, F, X. +' +' To get help on a BASIC keyword, move the cursor to the keyword and press +' F1 or click the right mouse button. +' + +'Set default data type to integer for faster game play +DEFINT A-Z + +'Sub Declarations +DECLARE SUB DoSun (Mouth) +DECLARE SUB SetScreen () +DECLARE SUB EndGame () +DECLARE SUB Center (Row, Text$) +DECLARE SUB Intro () +DECLARE SUB SparklePause () +DECLARE SUB GetInputs (Player1$, Player2$, NumGames) +DECLARE SUB PlayGame (Player1$, Player2$, NumGames) +DECLARE SUB DoExplosion (x#, y#) +DECLARE SUB MakeCityScape (BCoor() AS ANY) +DECLARE SUB PlaceGorillas (BCoor() AS ANY) +DECLARE SUB UpdateScores (Record(), PlayerNum, Results) +DECLARE SUB DrawGorilla (x, y, arms) +DECLARE SUB GorillaIntro (Player1$, Player2$) +DECLARE SUB Rest (t#) +DECLARE SUB VictoryDance (Player) +DECLARE SUB ClearGorillas () +DECLARE SUB DrawBan (xc#, yc#, r, bc) +DECLARE FUNCTION Scl (n!) +DECLARE FUNCTION GetNum# (Row, Col) +DECLARE FUNCTION DoShot (PlayerNum, x, y) +DECLARE FUNCTION ExplodeGorilla (x#, y#) +DECLARE FUNCTION Getn# (Row, Col) +DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) +DECLARE FUNCTION CalcDelay! () + +'Make all arrays Dynamic +'$DYNAMIC + +'User-Defined TYPEs +TYPE XYPoint + XCoor AS INTEGER + YCoor AS INTEGER +END TYPE + +'Constants +CONST SPEEDCONST = 500 +CONST TRUE = -1 +CONST FALSE = NOT TRUE +CONST HITSELF = 1 +CONST BACKATTR = 0 +CONST OBJECTCOLOR = 1 +CONST WINDOWCOLOR = 14 +CONST SUNATTR = 3 +CONST SUNHAPPY = FALSE +CONST SUNSHOCK = TRUE +CONST RIGHTUP = 1 +CONST LEFTUP = 2 +CONST ARMSDOWN = 3 + +'Global Variables +DIM SHARED GorillaX(1 TO 2) 'Location of the two gorillas +DIM SHARED GorillaY(1 TO 2) +DIM SHARED LastBuilding + +DIM SHARED pi# +DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana +DIM SHARED GorD&(120) 'Graphical picture of Gorilla arms down +DIM SHARED GorL&(120) 'Gorilla left arm raised +DIM SHARED GorR&(120) 'Gorilla right arm raised + +DIM SHARED gravity# +DIM SHARED Wind + +'Screen Mode Variables +DIM SHARED ScrHeight +DIM SHARED ScrWidth +DIM SHARED Mode +DIM SHARED MaxCol + +'Screen Color Variables +DIM SHARED ExplosionColor +DIM SHARED SunColor +DIM SHARED BackColor +DIM SHARED SunHit + +DIM SHARED SunHt +DIM SHARED GHeight +DIM SHARED MachSpeed AS SINGLE + + DEF FnRan (x) = INT(RND(1) * x) + 1 + DEF SEG = 0 ' Set NumLock to ON + KeyFlags = PEEK(1047) + IF (KeyFlags AND 32) = 0 THEN + POKE 1047, KeyFlags OR 32 + END IF + DEF SEG + + GOSUB InitVars + Intro + GetInputs Name1$, Name2$, NumGames + GorillaIntro Name1$, Name2$ + PlayGame Name1$, Name2$, NumGames + + DEF SEG = 0 ' Restore NumLock state + POKE 1047, KeyFlags + DEF SEG +END + + +CGABanana: + 'BananaLeft + DATA 327686, -252645316, 60 + 'BananaDown + DATA 196618, -1057030081, 49344 + 'BananaUp + DATA 196618, -1056980800, 63 + 'BananaRight + DATA 327686, 1010580720, 240 + +EGABanana: + 'BananaLeft + DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0 + 'BananaDown + DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294 + 'BananaUp + DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239 + 'BananaRight + DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0 + +InitVars: + pi# = 4 * ATN(1#) + + 'This is a clever way to pick the best graphics mode available + ON ERROR GOTO ScreenModeError + Mode = 9 + SCREEN Mode + ON ERROR GOTO PaletteError + IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA + ON ERROR GOTO 0 + + MachSpeed = CalcDelay + + IF Mode = 9 THEN + ScrWidth = 640 + ScrHeight = 350 + GHeight = 25 + RESTORE EGABanana + REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8) + + FOR i = 0 TO 8 + READ LBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ DBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ UBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ RBan&(i) + NEXT i + + SunHt = 39 + + ELSE + + ScrWidth = 320 + ScrHeight = 200 + GHeight = 12 + RESTORE CGABanana + REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2) + REDIM GorL&(20), GorD&(20), GorR&(20) + + FOR i = 0 TO 2 + READ LBan&(i) + NEXT i + FOR i = 0 TO 2 + READ DBan&(i) + NEXT i + FOR i = 0 TO 2 + READ UBan&(i) + NEXT i + FOR i = 0 TO 2 + READ RBan&(i) + NEXT i + + MachSpeed = MachSpeed * 1.3 + SunHt = 20 + END IF +RETURN + +ScreenModeError: + IF Mode = 1 THEN + CLS + LOCATE 10, 5 + PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS" + END + ELSE + Mode = 1 + RESUME + END IF + +PaletteError: + Mode = 1 '64K EGA cards will run in CGA mode. + RESUME NEXT + +REM $STATIC +'CalcDelay: +' Checks speed of the machine. +FUNCTION CalcDelay! + + s! = TIMER + DO + i! = i! + 1 + LOOP UNTIL TIMER - s! >= .5 + CalcDelay! = i! + +END FUNCTION + +' Center: +' Centers and prints a text string on a given row +' Parameters: +' Row - screen row number +' Text$ - text to be printed +' +SUB Center (Row, Text$) + Col = MaxCol \ 2 + LOCATE Row, Col - (LEN(Text$) / 2 + .5) + PRINT Text$; +END SUB + +' DoExplosion: +' Produces explosion when a shot is fired +' Parameters: +' X#, Y# - location of explosion +' +SUB DoExplosion (x#, y#) + + PLAY "MBO0L32EFGEFDC" + Radius = ScrHeight / 50 + IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41 + FOR c# = 0 TO Radius STEP Inc# + CIRCLE (x#, y#), c#, ExplosionColor + NEXT c# + FOR c# = Radius TO 0 STEP (-1 * Inc#) + CIRCLE (x#, y#), c#, BACKATTR + FOR i = 1 TO 100 + NEXT i + Rest .005 + NEXT c# +END SUB + +' DoShot: +' Controls banana shots by accepting player input and plotting +' shot angle +' Parameters: +' PlayerNum - Player +' x, y - Player's gorilla position +' +FUNCTION DoShot (PlayerNum, x, y) + + 'Input shot + IF PlayerNum = 1 THEN + LocateCol = 1 + ELSE + IF Mode = 9 THEN + LocateCol = 66 + ELSE + LocateCol = 26 + END IF + END IF + + LOCATE 2, LocateCol + PRINT "Angle:"; + Angle# = GetNum#(2, LocateCol + 7) + + LOCATE 3, LocateCol + PRINT "Velocity:"; + Velocity = GetNum#(3, LocateCol + 10) + + IF PlayerNum = 2 THEN + Angle# = 180 - Angle# + END IF + + 'Erase input + FOR i = 1 TO 4 + LOCATE i, 1 + PRINT SPACE$(30 \ (80 \ MaxCol)); + LOCATE i, (50 \ (80 \ MaxCol)) + PRINT SPACE$(30 \ (80 \ MaxCol)); + NEXT + + SunHit = FALSE + PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum) + IF PlayerHit = 0 THEN + DoShot = FALSE + ELSE + DoShot = TRUE + IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum + VictoryDance PlayerNum + END IF + +END FUNCTION + +' DoSun: +' Draws the sun at the top of the screen. +' Parameters: +' Mouth - If TRUE draws "O" mouth else draws a smile mouth. +' +SUB DoSun (Mouth) + + 'set position of sun + x = ScrWidth \ 2: y = Scl(25) + + 'clear old sun + LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF + + 'draw new sun: + 'body + CIRCLE (x, y), Scl(12), SUNATTR + PAINT (x, y), SUNATTR + + 'rays + LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR + LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR + + LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR + LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR + + LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR + LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR + + LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR + LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR + + 'mouth + IF Mouth THEN 'draw "o" mouth + CIRCLE (x, y + Scl(5)), Scl(2.9), 0 + PAINT (x, y + Scl(5)), 0, 0 + ELSE 'draw smile + CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180) + END IF + + 'eyes + CIRCLE (x - 3, y - 2), 1, 0 + CIRCLE (x + 3, y - 2), 1, 0 + PSET (x - 3, y - 2), 0 + PSET (x + 3, y - 2), 0 + +END SUB + +'DrawBan: +' Draws the banana +'Parameters: +' xc# - Horizontal Coordinate +' yc# - Vertical Coordinate +' r - rotation position (0-3). ( \_/ ) /-\ +' bc - if TRUE then DrawBan draws the banana ELSE it erases the banana +SUB DrawBan (xc#, yc#, r, bc) + +SELECT CASE r + CASE 0 + IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR + CASE 1 + IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR + CASE 2 + IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR + CASE 3 + IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR +END SELECT + +END SUB + +'DrawGorilla: +' Draws the Gorilla in either CGA or EGA mode +' and saves the graphics data in an array. +'Parameters: +' x - x coordinate of gorilla +' y - y coordinate of the gorilla +' arms - either Left up, Right up, or both down +SUB DrawGorilla (x, y, arms) + DIM i AS SINGLE ' Local index must be single precision + + 'draw head + LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF + LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF + + 'draw eyes/brow + LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0 + + 'draw nose if ega + IF Mode = 9 THEN + FOR i = -2 TO -1 + PSET (x + i, y + 4), 0 + PSET (x + i + 3, y + 4), 0 + NEXT i + END IF + + 'neck + LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR + + 'body + LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF + LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF + + 'legs + FOR i = 0 TO 4 + CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8 + CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4 + NEXT + + 'chest + CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0 + CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2 + + FOR i = -5 TO -1 + SELECT CASE arms + CASE 1 + 'Right arm up + CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR& + CASE 2 + 'Left arm up + CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL& + CASE 3 + 'Both arms down + CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD& + END SELECT + NEXT i +END SUB + +'ExplodeGorilla: +' Causes gorilla explosion when a direct hit occurs +'Parameters: +' X#, Y# - shot location +FUNCTION ExplodeGorilla (x#, y#) + YAdj = Scl(12) + XAdj = Scl(5) + SclX# = ScrWidth / 320 + SclY# = ScrHeight / 200 + IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2 + PLAY "MBO0L16EFGEFDC" + + FOR i = 1 TO 8 * SclX# + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57 + LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor + NEXT i + + FOR i = 1 TO 16 * SclX# + IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57 + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57 + NEXT i + + FOR i = 24 * SclX# TO 1 STEP -1 + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57 + FOR Count = 1 TO 200 + NEXT + NEXT i + + ExplodeGorilla = PlayerHit +END FUNCTION + +'GetInputs: +' Gets user inputs at beginning of game +'Parameters: +' Player1$, Player2$ - player names +' NumGames - number of games to play +SUB GetInputs (Player1$, Player2$, NumGames) + COLOR 7, 0 + CLS + + LOCATE 8, 15 + LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$ + IF Player1$ = "" THEN + Player1$ = "Player 1" + ELSE + Player1$ = LEFT$(Player1$, 10) + END IF + + LOCATE 10, 15 + LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$ + IF Player2$ = "" THEN + Player2$ = "Player 2" + ELSE + Player2$ = LEFT$(Player2$, 10) + END IF + + DO + LOCATE 12, 56: PRINT SPACE$(25); + LOCATE 12, 13 + INPUT "Play to how many total points (Default = 3)"; game$ + NumGames = VAL(LEFT$(game$, 2)) + LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0 + IF NumGames = 0 THEN NumGames = 3 + + DO + LOCATE 14, 53: PRINT SPACE$(28); + LOCATE 14, 17 + INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$ + gravity# = VAL(grav$) + LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0 + IF gravity# = 0 THEN gravity# = 9.8 +END SUB + +'GetNum: +' Gets valid numeric input from user +'Parameters: +' Row, Col - location to echo input +FUNCTION GetNum# (Row, Col) + Result$ = "" + Done = FALSE + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + DO WHILE NOT Done + + LOCATE Row, Col + PRINT Result$; CHR$(95); " "; + + Kbd$ = INKEY$ + SELECT CASE Kbd$ + CASE "0" TO "9" + Result$ = Result$ + Kbd$ + CASE "." + IF INSTR(Result$, ".") = 0 THEN + Result$ = Result$ + Kbd$ + END IF + CASE CHR$(13) + IF VAL(Result$) > 360 THEN + Result$ = "" + ELSE + Done = TRUE + END IF + CASE CHR$(8) + IF LEN(Result$) > 0 THEN + Result$ = LEFT$(Result$, LEN(Result$) - 1) + END IF + CASE ELSE + IF LEN(Kbd$) > 0 THEN + BEEP + END IF + END SELECT + LOOP + + LOCATE Row, Col + PRINT Result$; " "; + + GetNum# = VAL(Result$) +END FUNCTION + +'GorillaIntro: +' Displays gorillas on screen for the first time +' allows the graphical data to be put into an array +'Parameters: +' Player1$, Player2$ - The names of the players +' +SUB GorillaIntro (Player1$, Player2$) + LOCATE 16, 34: PRINT "--------------" + LOCATE 18, 34: PRINT "V = View Intro" + LOCATE 19, 34: PRINT "P = Play Game" + LOCATE 21, 35: PRINT "Your Choice?" + + DO WHILE Char$ = "" + Char$ = INKEY$ + LOOP + + IF Mode = 1 THEN + x = 125 + y = 100 + ELSE + x = 278 + y = 175 + END IF + + SCREEN Mode + SetScreen + + IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn." + + VIEW PRINT 9 TO 24 + + IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor + + DrawGorilla x, y, ARMSDOWN + CLS 2 + DrawGorilla x, y, LEFTUP + CLS 2 + DrawGorilla x, y, RIGHTUP + CLS 2 + + VIEW PRINT 1 TO 25 + IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46 + + IF UCASE$(Char$) = "V" THEN + Center 2, "Q B A S I C G O R I L L A S" + Center 5, " STARRING: " + P$ = Player1$ + " AND " + Player2$ + Center 7, P$ + + PUT (x - 13, y), GorD&, PSET + PUT (x + 47, y), GorD&, PSET + Rest 1 + + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b" + Rest .3 + + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-" + Rest .3 + + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-" + Rest .3 + + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b" + Rest .3 + + FOR i = 1 TO 4 + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "T160O0L32EFGEFDC" + Rest .1 + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "T160O0L32EFGEFDC" + Rest .1 + NEXT + END IF +END SUB + +'Intro: +' Displays game introduction +SUB Intro + + SCREEN 0 + WIDTH 80, 25 + MaxCol = 80 + COLOR 15, 0 + CLS + + Center 4, "Q B a s i c G O R I L L A S" + COLOR 7 + Center 6, "Copyright (C) Microsoft Corporation 1990" + Center 8, "Your mission is to hit your opponent with the exploding" + Center 9, "banana by varying the angle and power of your throw, taking" + Center 10, "into account wind speed, gravity, and the city skyline." + Center 11, "The wind speed is shown by a directional arrow at the bottom" + Center 12, "of the playing field, its length relative to its strength." + Center 24, "Press any key to continue" + + PLAY "MBT160O1L8CDEDCDL4ECC" + SparklePause + IF Mode = 1 THEN MaxCol = 40 +END SUB + +'MakeCityScape: +' Creates random skyline for game +'Parameters: +' BCoor() - a user-defined type array which stores the coordinates of +' the upper left corner of each building. +SUB MakeCityScape (BCoor() AS XYPoint) + + x = 2 + + 'Set the sloping trend of the city scape. NewHt is new building height + Slope = FnRan(6) + SELECT CASE Slope + CASE 1: NewHt = 15 'Upward slope + CASE 2: NewHt = 130 'Downward slope + CASE 3 TO 5: NewHt = 15 '"V" slope - most common + CASE 6: NewHt = 130 'Inverted "V" slope + END SELECT + + IF Mode = 9 THEN + BottomLine = 335 'Bottom of building + HtInc = 10 'Increase value for new height + DefBWidth = 37 'Default building height + RandomHeight = 120 'Random height difference + WWidth = 3 'Window width + WHeight = 6 'Window height + WDifV = 15 'Counter for window spacing - vertical + WDifh = 10 'Counter for window spacing - horizontal + ELSE + BottomLine = 190 + HtInc = 6 + NewHt = NewHt * 20 \ 35 'Adjust for CGA + DefBWidth = 18 + RandomHeight = 54 + WWidth = 1 + WHeight = 2 + WDifV = 5 + WDifh = 4 + END IF + + CurBuilding = 1 + DO + + SELECT CASE Slope + CASE 1 + NewHt = NewHt + HtInc + CASE 2 + NewHt = NewHt - HtInc + CASE 3 TO 5 + IF x > ScrWidth \ 2 THEN + NewHt = NewHt - 2 * HtInc + ELSE + NewHt = NewHt + 2 * HtInc + END IF + CASE 4 + IF x > ScrWidth \ 2 THEN + NewHt = NewHt + 2 * HtInc + ELSE + NewHt = NewHt - 2 * HtInc + END IF + END SELECT + + 'Set width of building and check to see if it would go off the screen + BWidth = FnRan(DefBWidth) + DefBWidth + IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2 + + 'Set height of building and check to see if it goes below screen + BHeight = FnRan(RandomHeight) + NewHt + IF BHeight < HtInc THEN BHeight = HtInc + + 'Check to see if Building is too high + IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5 + + 'Set the coordinates of the building into the array + BCoor(CurBuilding).XCoor = x + BCoor(CurBuilding).YCoor = BottomLine - BHeight + + IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2 + + 'Draw the building, outline first, then filled + LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B + LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF + + 'Draw the windows + c = x + 3 + DO + FOR i = BHeight - 3 TO 7 STEP -WDifV + IF Mode <> 9 THEN + WinColr = (FnRan(2) - 2) * -3 + ELSEIF FnRan(4) = 1 THEN + WinColr = 8 + ELSE + WinColr = WINDOWCOLOR + END IF + LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF + NEXT + c = c + WDifh + LOOP UNTIL c >= x + BWidth - 3 + + x = x + BWidth + 2 + + CurBuilding = CurBuilding + 1 + + LOOP UNTIL x > ScrWidth - HtInc + + LastBuilding = CurBuilding - 1 + + 'Set Wind speed + Wind = FnRan(10) - 5 + IF FnRan(3) = 1 THEN + IF Wind > 0 THEN + Wind = Wind + FnRan(10) + ELSE + Wind = Wind - FnRan(10) + END IF + END IF + + 'Draw Wind speed arrow + IF Wind <> 0 THEN + WindLine = Wind * 3 * (ScrWidth \ 320) + LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor + IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2 + LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor + LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor + END IF +END SUB + +'PlaceGorillas: +' PUTs the Gorillas on top of the buildings. Must have drawn +' Gorillas first. +'Parameters: +' BCoor() - user-defined TYPE array which stores upper left coordinates +' of each building. +SUB PlaceGorillas (BCoor() AS XYPoint) + + IF Mode = 9 THEN + XAdj = 14 + YAdj = 30 + ELSE + XAdj = 7 + YAdj = 16 + END IF + SclX# = ScrWidth / 320 + SclY# = ScrHeight / 200 + + 'Place gorillas on second or third building from edge + FOR i = 1 TO 2 + IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2) + + BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor + GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj + GorillaY(i) = BCoor(BNum).YCoor - YAdj + PUT (GorillaX(i), GorillaY(i)), GorD&, PSET + NEXT i + +END SUB + +'PlayGame: +' Main game play routine +'Parameters: +' Player1$, Player2$ - player names +' NumGames - number of games to play +SUB PlayGame (Player1$, Player2$, NumGames) + DIM BCoor(0 TO 30) AS XYPoint + DIM TotalWins(1 TO 2) + + J = 1 + + FOR i = 1 TO NumGames + + CLS + RANDOMIZE (TIMER) + CALL MakeCityScape(BCoor()) + CALL PlaceGorillas(BCoor()) + DoSun SUNHAPPY + Hit = FALSE + DO WHILE Hit = FALSE + J = 1 - J + LOCATE 1, 1 + PRINT Player1$ + LOCATE 1, (MaxCol - 1 - LEN(Player2$)) + PRINT Player2$ + Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2))) + Tosser = J + 1: Tossee = 3 - J + + 'Plot the shot. Hit is true if Gorilla gets hit. + Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser)) + + 'Reset the sun, if it got hit + IF SunHit THEN DoSun SUNHAPPY + + IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit) + LOOP + SLEEP 1 + NEXT i + + SCREEN 0 + WIDTH 80, 25 + COLOR 7, 0 + MaxCol = 80 + CLS + + Center 8, "GAME OVER!" + Center 10, "Score:" + LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1) + LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2) + Center 24, "Press any key to continue" + SparklePause + COLOR 7, 0 + CLS +END SUB + +'PlayGame: +' Plots banana shot across the screen +'Parameters: +' StartX, StartY - starting shot location +' Angle - shot angle +' Velocity - shot velocity +' PlayerNum - the banana thrower +FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) + + Angle# = Angle# / 180 * pi# 'Convert degree angle to radians + Radius = Mode MOD 7 + + InitXVel# = COS(Angle#) * Velocity + InitYVel# = SIN(Angle#) * Velocity + + oldx# = StartX + oldy# = StartY + + 'draw gorilla toss + IF PlayerNum = 1 THEN + PUT (StartX, StartY), GorL&, PSET + ELSE + PUT (StartX, StartY), GorR&, PSET + END IF + + 'throw sound + PLAY "MBo0L32A-L64CL16BL64A+" + Rest .1 + + 'redraw gorilla + PUT (StartX, StartY), GorD&, PSET + + adjust = Scl(4) 'For scaling CGA + + xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check + + Impact = FALSE + ShotInSun = FALSE + OnScreen = TRUE + PlayerHit = 0 + NeedErase = FALSE + + StartXPos = StartX + StartYPos = StartY - adjust - 3 + + IF PlayerNum = 2 THEN + StartXPos = StartXPos + Scl(25) + direction = Scl(4) + ELSE + direction = Scl(-4) + END IF + + IF Velocity < 2 THEN 'Shot too slow - hit self + x# = StartX + y# = StartY + pointval = OBJECTCOLOR + END IF + + DO WHILE (NOT Impact) AND OnScreen + + Rest .02 + + 'Erase old banana, if necessary + IF NeedErase THEN + NeedErase = FALSE + CALL DrawBan(oldx#, oldy#, oldrot, FALSE) + END IF + + x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2) + y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350) + + IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN + OnScreen = FALSE + END IF + + + IF OnScreen AND y# > 0 THEN + + 'check it + LookY = 0 + LookX = Scl(8 * (2 - PlayerNum)) + DO + pointval = POINT(x# + LookX, y# + LookY) + IF pointval = 0 THEN + Impact = FALSE + IF ShotInSun = TRUE THEN + IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE + END IF + ELSEIF pointval = SUNATTR AND y# < SunHt THEN + IF NOT SunHit THEN DoSun SUNSHOCK + SunHit = TRUE + ShotInSun = TRUE + ELSE + Impact = TRUE + END IF + LookX = LookX + direction + LookY = LookY + Scl(6) + LOOP UNTIL Impact OR LookX <> Scl(4) + + IF NOT ShotInSun AND NOT Impact THEN + 'plot it + rot = (t# * 10) MOD 4 + CALL DrawBan(x#, y#, rot, TRUE) + NeedErase = TRUE + END IF + + oldx# = x# + oldy# = y# + oldrot = rot + + END IF + + + t# = t# + .1 + + LOOP + + IF pointval <> OBJECTCOLOR AND Impact THEN + CALL DoExplosion(x# + adjust, y# + adjust) + ELSEIF pointval = OBJECTCOLOR THEN + PlayerHit = ExplodeGorilla(x#, y#) + END IF + + PlotShot = PlayerHit + +END FUNCTION + +'Rest: +' pauses the program +SUB Rest (t#) + s# = TIMER + t2# = MachSpeed * t# / SPEEDCONST + DO + LOOP UNTIL TIMER - s# > t2# +END SUB + +'Scl: +' Pass the number in to scaling for cga. If the number is a decimal, then we +' want to scale down for cga or scale up for ega. This allows a full range +' of numbers to be generated for scaling. +' (i.e. for 3 to get scaled to 1, pass in 2.9) +FUNCTION Scl (n!) + + IF n! <> INT(n!) THEN + IF Mode = 1 THEN n! = n! - 1 + END IF + IF Mode = 1 THEN + Scl = CINT(n! / 2 + .1) + ELSE + Scl = CINT(n!) + END IF + +END FUNCTION + +'SetScreen: +' Sets the appropriate color statements +SUB SetScreen + + IF Mode = 9 THEN + ExplosionColor = 2 + BackColor = 1 + PALETTE 0, 1 + PALETTE 1, 46 + PALETTE 2, 44 + PALETTE 3, 54 + PALETTE 5, 7 + PALETTE 6, 4 + PALETTE 7, 3 + PALETTE 9, 63 'Display Color + ELSE + ExplosionColor = 2 + BackColor = 0 + COLOR BackColor, 2 + + END IF + +END SUB + +'SparklePause: +' Creates flashing border for intro and game over screens +SUB SparklePause + + COLOR 4, 0 + A$ = "* * * * * * * * * * * * * * * * * " + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + WHILE INKEY$ = "" + FOR A = 1 TO 5 + LOCATE 1, 1 'print horizontal sparkles + PRINT MID$(A$, A, 80); + LOCATE 22, 1 + PRINT MID$(A$, 6 - A, 80); + + FOR b = 2 TO 21 'Print Vertical sparkles + c = (A + b) MOD 5 + IF c = 1 THEN + LOCATE b, 80 + PRINT "*"; + LOCATE 23 - b, 1 + PRINT "*"; + ELSE + LOCATE b, 80 + PRINT " "; + LOCATE 23 - b, 1 + PRINT " "; + END IF + NEXT b + NEXT A + WEND +END SUB + +'UpdateScores: +' Updates players' scores +'Parameters: +' Record - players' scores +' PlayerNum - player +' Results - results of player's shot +SUB UpdateScores (Record(), PlayerNum, Results) + IF Results = HITSELF THEN + Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1 + ELSE + Record(PlayerNum) = Record(PlayerNum) + 1 + END IF +END SUB + +'VictoryDance: +' gorilla dances after he has eliminated his opponent +'Parameters: +' Player - which gorilla is dancing +SUB VictoryDance (Player) + + FOR i# = 1 TO 4 + PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + NEXT +END SUB + diff --git a/turbobasic/3RD-PA.RTY/QBASIC/MONEY.BAS b/turbobasic/3RD-PA.RTY/QBASIC/MONEY.BAS new file mode 100755 index 0000000..fc0d324 --- /dev/null +++ b/turbobasic/3RD-PA.RTY/QBASIC/MONEY.BAS @@ -0,0 +1,1536 @@ +' +' Q B a s i c M O N E Y M A N A G E R +' +' Copyright (C) Microsoft Corporation 1990 +' +' The Money Manager is a personal finance manager that allows you +' to enter account transactions while tracking your account balances +' and net worth. +' +' To run this program, press Shift+F5. +' +' To exit QBasic, press Alt, F, X. +' +' To get help on a BASIC keyword, move the cursor to the keyword and press +' F1 or click the right mouse button. +' + + +'Set default data type to integer for faster operation +DEFINT A-Z + +'Sub and function declarations +DECLARE SUB TransactionSummary (item%) +DECLARE SUB LCenter (text$) +DECLARE SUB ScrollUp () +DECLARE SUB ScrollDown () +DECLARE SUB Initialize () +DECLARE SUB Intro () +DECLARE SUB SparklePause () +DECLARE SUB Center (row%, text$) +DECLARE SUB FancyCls (dots%, Background%) +DECLARE SUB LoadState () +DECLARE SUB SaveState () +DECLARE SUB MenuSystem () +DECLARE SUB MakeBackup () +DECLARE SUB RestoreBackup () +DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%) +DECLARE SUB NetWorthReport () +DECLARE SUB EditAccounts () +DECLARE SUB PrintHelpLine (help$) +DECLARE SUB EditTrans (item%) +DECLARE FUNCTION Cvdt$ (X#) +DECLARE FUNCTION Cvst$ (X!) +DECLARE FUNCTION Cvit$ (X%) +DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%) +DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%) +DECLARE FUNCTION Trim$ (X$) + +'Constants +CONST TRUE = -1 +CONST FALSE = NOT TRUE + +'User-defined types +TYPE AccountType + Title AS STRING * 20 + AType AS STRING * 1 + Desc AS STRING * 50 +END TYPE + +TYPE Recordtype + Date AS STRING * 8 + Ref AS STRING * 10 + Desc AS STRING * 50 + Fig1 AS DOUBLE + Fig2 AS DOUBLE +END TYPE + +'Global variables +DIM SHARED account(1 TO 19) AS AccountType 'Stores the 19 account titles +DIM SHARED ColorPref 'Color Preference +DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors +DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines +DIM SHARED ScrollDownAsm(1 TO 7) +DIM SHARED PrintErr AS INTEGER 'Printer error flag + + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + + 'Open money manager data file. If it does not exist in current directory, + ' goto error handler to create and initialize it. + ON ERROR GOTO ErrorTrap + OPEN "money.dat" FOR INPUT AS #1 + CLOSE + ON ERROR GOTO 0 'Reset error handler + + Initialize 'Initialize program + Intro 'Display introduction screen + MenuSystem 'This is the main program + COLOR 7, 0 'Clear screen and end + CLS + + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + + END + +' Error handler for program +' If data file not found, create and initialize a new one. +ErrorTrap: + SELECT CASE ERR + ' If data file not found, create and initialize a new one. + CASE 53 + CLOSE + ColorPref = 1 + FOR a = 1 TO 19 + account(a).Title = "" + account(a).AType = "" + account(a).Desc = "" + NEXT a + SaveState + RESUME + CASE 24, 25 + PrintErr = TRUE + Box 8, 13, 14, 69 + Center 11, "Printer not responding ... Press Space to continue" + WHILE INKEY$ <> "": WEND + WHILE INKEY$ <> " ": WEND + RESUME NEXT + CASE ELSE + END SELECT + RESUME NEXT + + +'The following data defines the color schemes available via the main menu. +' +' scrn dots bar back title shdow choice curs cursbk shdow +DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0 +DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0 +DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0 +DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0 + +'The following data is actually a machine language program to +'scroll the screen up or down very fast using a BIOS call. +DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB +DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB + +'Box: +' Draw a box on the screen between the given coordinates. +SUB Box (Row1, Col1, Row2, Col2) STATIC + + BoxWidth = Col2 - Col1 + 1 + + LOCATE Row1, Col1 + PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿"; + + FOR a = Row1 + 1 TO Row2 - 1 + LOCATE a, Col1 + PRINT "³"; SPACE$(BoxWidth - 2); "³"; + NEXT a + + LOCATE Row2, Col1 + PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù"; + +END SUB + +'Center: +' Center text on the given row. +SUB Center (row, text$) + LOCATE row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'Cvdt$: +' Convert a double precision number to a string WITHOUT a leading space. +FUNCTION Cvdt$ (X#) + + Cvdt$ = RIGHT$(STR$(X#), LEN(STR$(X#)) - 1) + +END FUNCTION + +'Cvit$: +' Convert an integer to a string WITHOUT a leading space. +FUNCTION Cvit$ (X) + Cvit$ = RIGHT$(STR$(X), LEN(STR$(X)) - 1) +END FUNCTION + +'Cvst$: +' Convert a single precision number to a string WITHOUT a leading space +FUNCTION Cvst$ (X!) + Cvst$ = RIGHT$(STR$(X!), LEN(STR$(X!)) - 1) +END FUNCTION + +'EditAccounts: +' This is the full-screen editor which allows you to change your account +' titles and descriptions +SUB EditAccounts + + 'Information about each column + REDIM help$(4), col(4), Vis(4), Max(4), edit$(19, 3) + + 'Draw the screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 2, 1, 24, 80 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80) + LOCATE 1, 4: PRINT "Account Editor"; + COLOR colors(7, ColorPref), colors(4, ColorPref) + + LOCATE 3, 2: PRINT "No³ Account Title ³ Description ³A/L" + LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄ" + u$ = "##³\ \³\ \³ ! " + FOR a = 5 TO 23 + LOCATE a, 2 + X = a - 4 + PRINT USING u$; X; account(X).Title; account(X).Desc; account(X).AType; + NEXT a + + 'Initialize variables + help$(1) = " Account name | " + help$(2) = " Account description | " + help$(3) = " Account type (A = Asset, L = Liability) | " + + col(1) = 5: col(2) = 26: col(3) = 78 + Vis(1) = 20: Vis(2) = 50: Vis(3) = 1 + Max(1) = 20: Max(2) = 50: Max(3) = 1 + + FOR a = 1 TO 19 + edit$(a, 1) = account(a).Title + edit$(a, 2) = account(a).Desc + edit$(a, 3) = account(a).AType + NEXT a + + finished = FALSE + + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + + 'Loop until F2 or is pressed + DO + GOSUB EditAccountsShowCursor 'Show Cursor + DO 'Wait for key + Kbd$ = INKEY$ + LOOP UNTIL Kbd$ <> "" + + IF Kbd$ >= " " AND Kbd$ < "~" THEN 'If legal, edit item + GOSUB EditAccountsEditItem + END IF + GOSUB EditAccountsHideCursor 'Hide Cursor so it can move + 'If it needs to + SELECT CASE Kbd$ + CASE CHR$(0) + "H" 'Up Arrow + CurrRow = (CurrRow + 17) MOD 19 + 1 + CASE CHR$(0) + "P" 'Down Arrow + CurrRow = (CurrRow) MOD 19 + 1 + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab + CurrCol = (CurrCol + 1) MOD 3 + 1 + PrintHelpLine help$(CurrCol) + CASE CHR$(0) + "M", CHR$(9) 'Right or Tab + CurrCol = (CurrCol) MOD 3 + 1 + PrintHelpLine help$(CurrCol) + CASE CHR$(0) + "<" 'F2 + finished = TRUE + Save = TRUE + CASE CHR$(27) 'Esc + finished = TRUE + Save = FALSE + CASE CHR$(13) 'Return + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + IF Save THEN + GOSUB EditAccountsSaveData + END IF + + EXIT SUB + +EditAccountsShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol)); + RETURN + +EditAccountsEditItem: + COLOR colors(8, ColorPref), colors(9, ColorPref) + ok = FALSE + start$ = Kbd$ + DO + Kbd$ = GetString$(CurrRow + 4, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol)) + edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol)) + start$ = "" + + IF CurrCol = 3 THEN + X$ = UCASE$(end$) + IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN + ok = TRUE + IF X$ = "" THEN X$ = " " + edit$(CurrRow, CurrCol) = X$ + ELSE + BEEP + END IF + ELSE + ok = TRUE + END IF + + LOOP UNTIL ok + RETURN + +EditAccountsHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol)); + RETURN + + +EditAccountsSaveData: + FOR a = 1 TO 19 + account(a).Title = edit$(a, 1) + account(a).Desc = edit$(a, 2) + account(a).AType = edit$(a, 3) + NEXT a + SaveState + RETURN + +END SUB + +'EditTrans: +' This is the full-screen editor which allows you to enter and change +' transactions +SUB EditTrans (item) + + 'Stores info about each column + REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5) + 'Array to keep the current balance at all the transactions + REDIM Balance#(1000) + + 'Open random access file + file$ = "money." + Cvit$(item) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$ + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + + 'Initialize variables + CurrString$(1) = "" + CurrString$(2) = "" + CurrString$(3) = "" + CurrFig#(4) = 0 + CurrFig#(5) = 0 + + GET #1, 1 + IF valid$ <> "THISISVALID" THEN + LSET IoDate$ = "" + LSET IoRef$ = "" + LSET IoDesc$ = "" + LSET IoFig1$ = MKD$(0) + LSET IoFig2$ = MKD$(0) + PUT #1, 2 + LSET valid$ = "THISISVALID" + LSET IoMaxRecord$ = "1" + LSET IoBalance$ = MKD$(0) + PUT #1, 1 + END IF + + MaxRecord = VAL(IoMaxRecord$) + + Balance#(0) = 0 + a = 1 + WHILE a <= MaxRecord + GET #1, a + 1 + Balance#(a) = Balance#(a - 1) + CVD(IoFig1$) - CVD(IoFig2$) + a = a + 1 + WEND + GOSUB EditTransWriteBalance + + help$(1) = "Date of transaction (mm/dd/yy) " + help$(2) = "Transaction reference number " + help$(3) = "Transaction description " + help$(4) = "Increase asset or debt value " + help$(5) = "Decrease asset or debt value " + + col(1) = 2 + col(2) = 11 + col(3) = 18 + col(4) = 44 + col(5) = 55 + + Vis(1) = 8 + Vis(2) = 6 + Vis(3) = 25 + Vis(4) = 10 + Vis(5) = 10 + + Max(1) = 8 + Max(2) = 6 + Max(3) = 25 + Max(4) = 10 + Max(5) = 10 + + + 'Draw Screen + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 2, 1, 24, 80 + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Transaction Editor: " + Trim$(account(item).Title); + + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 3, 2: PRINT " Date ³ Ref# ³ Description ³ Increase ³ Decrease ³ Balance " + LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" + + u$ = "\ \³\ \³\ \³" + u1$ = " ³ ³ ³ ³ ³ " + u1x$ = "ßßßßßßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß" + u2$ = "###,###.##" + u3$ = "###,###,###.##" + u4$ = " " + + CurrTopline = 1 + GOSUB EditTransPrintWholeScreen + + CurrRow = 1 + CurrCol = 1 + PrintHelpLine help$(CurrCol) + "| " + + GOSUB EditTransGetLine + + finished = FALSE + + + 'Loop until is pressed + DO + GOSUB EditTransShowCursor 'Show Cursor, Wait for key + DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> "" + GOSUB EditTransHideCursor + + IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN 'If legal key, edit item + GOSUB EditTransEditItem + END IF + + SELECT CASE Kbd$ 'Handle Special keys + CASE CHR$(0) + "H" 'up arrow + GOSUB EditTransMoveUp + CASE CHR$(0) + "P" 'Down arrow + GOSUB EditTransMoveDown + CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab + CurrCol = (CurrCol + 3) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab + CurrCol = (CurrCol) MOD 5 + 1 + PrintHelpLine help$(CurrCol) + "| " + CASE CHR$(0) + "G" 'Home + CurrCol = 1 + CASE CHR$(0) + "O" 'End + CurrCol = 5 + CASE CHR$(0) + "I" 'Page Up + CurrRow = 1 + CurrTopline = CurrTopline - 19 + IF CurrTopline < 1 THEN + CurrTopline = 1 + END IF + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + CASE CHR$(0) + "Q" 'Page Down + CurrRow = 1 + CurrTopline = CurrTopline + 19 + IF CurrTopline > MaxRecord THEN + CurrTopline = MaxRecord + END IF + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "C" 'F9 + GOSUB EditTransAddRecord + CASE CHR$(0) + "D" 'F10 + GOSUB EditTransDeleteRecord + CASE CHR$(13) 'Enter + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + + CLOSE + + EXIT SUB + + +EditTransShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1, 2, 3 + PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol)); + CASE 4 + IF CurrFig#(4) <> 0 THEN + PRINT USING u2$; CurrFig#(4); + ELSE + PRINT SPACE$(Vis(CurrCol)); + END IF + CASE 5 + IF CurrFig#(5) <> 0 THEN + PRINT USING u2$; CurrFig#(5); + ELSE + PRINT SPACE$(Vis(CurrCol)); + END IF + END SELECT + RETURN + + +EditTransHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE CurrRow + 4, col(CurrCol) + SELECT CASE CurrCol + CASE 1, 2, 3 + PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol)); + CASE 4 + IF CurrFig#(4) <> 0 THEN + PRINT USING u2$; CurrFig#(4); + ELSE + PRINT SPACE$(Vis(CurrCol)); + END IF + CASE 5 + IF CurrFig#(5) <> 0 THEN + PRINT USING u2$; CurrFig#(5); + ELSE + PRINT SPACE$(Vis(CurrCol)); + END IF + END SELECT + RETURN + + +EditTransEditItem: + + CurrRecord = CurrTopline + CurrRow - 1 + COLOR colors(8, ColorPref), colors(9, ColorPref) + + SELECT CASE CurrCol + CASE 1, 2, 3 + Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol)) + CurrString$(CurrCol) = new$ + GOSUB EditTransPutLine + GOSUB EditTransGetLine + CASE 4 + start$ = Kbd$ + DO + Kbd$ = GetString$(CurrRow + 4, col(4), start$, new$, Vis(4), Max(4)) + new4# = VAL(new$) + start$ = "" + LOOP WHILE new4# >= 999999.99# OR new4# < 0 + + a = CurrRecord + WHILE a <= MaxRecord + Balance#(a) = Balance#(a) + new4# - CurrFig#(4) + CurrFig#(5) + a = a + 1 + WEND + CurrFig#(4) = new4# + CurrFig#(5) = 0 + GOSUB EditTransPutLine + GOSUB EditTransGetLine + GOSUB EditTransPrintBalances + GOSUB EditTransWriteBalance + CASE 5 + start$ = Kbd$ + DO + Kbd$ = GetString$(CurrRow + 4, col(5), start$, new$, Vis(5), Max(5)) + new5# = VAL(new$) + start$ = "" + LOOP WHILE new5# >= 999999.99# OR new5# < 0 + + a = CurrRecord + WHILE a <= MaxRecord + Balance#(a) = Balance#(a) - new5# + CurrFig#(5) - CurrFig#(4) + a = a + 1 + WEND + CurrFig#(4) = 0 + CurrFig#(5) = new5# + GOSUB EditTransPutLine + GOSUB EditTransGetLine + GOSUB EditTransPrintBalances + GOSUB EditTransWriteBalance + CASE ELSE + END SELECT + GOSUB EditTransPrintLine + RETURN + +EditTransMoveUp: + IF CurrRow = 1 THEN + IF CurrTopline = 1 THEN + BEEP + ELSE + ScrollDown + CurrTopline = CurrTopline - 1 + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + END IF + ELSE + CurrRow = CurrRow - 1 + GOSUB EditTransGetLine + END IF + RETURN + +EditTransMoveDown: + IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN + BEEP + ELSE + IF CurrRow = 19 THEN + ScrollUp + CurrTopline = CurrTopline + 1 + GOSUB EditTransGetLine + GOSUB EditTransPrintLine + ELSE + CurrRow = CurrRow + 1 + GOSUB EditTransGetLine + END IF + END IF + RETURN + +EditTransPrintLine: + COLOR colors(7, ColorPref), colors(4, ColorPref) + CurrRecord = CurrTopline + CurrRow - 1 + LOCATE CurrRow + 4, 2 + IF CurrRecord = MaxRecord + 1 THEN + PRINT u1x$; + ELSEIF CurrRecord > MaxRecord THEN + PRINT u1$; + ELSE + PRINT USING u$; CurrString$(1); CurrString$(2); CurrString$(3); + IF CurrFig#(4) = 0 AND CurrFig#(5) = 0 THEN + PRINT USING u4$ + "³" + u4$ + "³" + u3$; Balance#(CurrRecord) + ELSEIF CurrFig#(5) = 0 THEN + PRINT USING u2$ + "³" + u4$ + "³" + u3$; CurrFig#(4); Balance#(CurrRecord) + ELSE + PRINT USING u4$ + "³" + u2$ + "³" + u3$; CurrFig#(5); Balance#(CurrRecord) + END IF + END IF + RETURN + +EditTransPrintBalances: + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO 19 + CurrRecord = CurrTopline + a - 1 + IF CurrRecord <= MaxRecord THEN + LOCATE 4 + a, 66 + PRINT USING u3$; Balance#(CurrTopline + a - 1); + END IF + NEXT a + RETURN + +EditTransDeleteRecord: + IF MaxRecord = 1 THEN + BEEP + ELSE + CurrRecord = CurrTopline + CurrRow - 1 + MaxRecord = MaxRecord - 1 + a = CurrRecord + WHILE a <= MaxRecord + GET #1, a + 2 + PUT #1, a + 1 + Balance#(a) = Balance#(a + 1) - CurrFig#(4) + CurrFig#(5) + a = a + 1 + WEND + + LSET valid$ = "THISISVALID" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord > MaxRecord THEN + GOSUB EditTransMoveUp + END IF + GOSUB EditTransGetLine + GOSUB EditTransWriteBalance + END IF + RETURN + +EditTransAddRecord: + CurrRecord = CurrTopline + CurrRow - 1 + a = MaxRecord + WHILE a > CurrRecord + GET #1, a + 1 + PUT #1, a + 2 + Balance#(a + 1) = Balance#(a) + a = a - 1 + WEND + Balance#(CurrRecord + 1) = Balance#(CurrRecord) + MaxRecord = MaxRecord + 1 + LSET IoDate$ = "" + LSET IoRef$ = "" + LSET IoDesc$ = "" + LSET IoFig1$ = MKD$(0) + LSET IoFig2$ = MKD$(0) + PUT #1, CurrRecord + 2 + + LSET valid$ = "THISISVALID" + LSET IoMaxRecord$ = Cvit$(MaxRecord) + PUT #1, 1 + GOSUB EditTransPrintWholeScreen + GOSUB EditTransGetLine + RETURN + +EditTransPrintWholeScreen: + temp = CurrRow + FOR CurrRow = 1 TO 19 + CurrRecord = CurrTopline + CurrRow - 1 + IF CurrRecord <= MaxRecord THEN + GOSUB EditTransGetLine + END IF + GOSUB EditTransPrintLine + NEXT CurrRow + CurrRow = temp + RETURN + +EditTransWriteBalance: + GET #1, 1 + LSET IoBalance$ = MKD$(Balance#(MaxRecord)) + PUT #1, 1 + RETURN + +EditTransPutLine: + CurrRecord = CurrTopline + CurrRow - 1 + LSET IoDate$ = CurrString$(1) + LSET IoRef$ = CurrString$(2) + LSET IoDesc$ = CurrString$(3) + LSET IoFig1$ = MKD$(CurrFig#(4)) + LSET IoFig2$ = MKD$(CurrFig#(5)) + PUT #1, CurrRecord + 1 + RETURN + +EditTransGetLine: + CurrRecord = CurrTopline + CurrRow - 1 + GET #1, CurrRecord + 1 + CurrString$(1) = IoDate$ + CurrString$(2) = IoRef$ + CurrString$(3) = IoDesc$ + CurrFig#(4) = CVD(IoFig1$) + CurrFig#(5) = CVD(IoFig2$) + RETURN +END SUB + +'FancyCls: +' Clears screen in the right color, and draws nice dots. +SUB FancyCls (dots, Background) + + VIEW PRINT 2 TO 24 + COLOR dots, Background + CLS 2 + + FOR a = 95 TO 1820 STEP 45 + row = a / 80 + 1 + col = a MOD 80 + 1 + LOCATE row, col + PRINT CHR$(250); + NEXT a + + VIEW PRINT + +END SUB + +'GetString$: +' Given a row and col, and an initial string, edit a string +' VIS is the length of the visible field of entry +' MAX is the maximum number of characters allowed in the string +FUNCTION GetString$ (row, col, start$, end$, Vis, Max) + curr$ = Trim$(LEFT$(start$, Max)) + IF curr$ = CHR$(8) THEN curr$ = "" + + LOCATE , , 1 + + finished = FALSE + DO + GOSUB GetStringShowText + GOSUB GetStringGetKey + + IF LEN(Kbd$) > 1 THEN + finished = TRUE + GetString$ = Kbd$ + ELSE + SELECT CASE Kbd$ + CASE CHR$(13), CHR$(27), CHR$(9) + finished = TRUE + GetString$ = Kbd$ + + CASE CHR$(8) + IF curr$ <> "" THEN + curr$ = LEFT$(curr$, LEN(curr$) - 1) + END IF + + CASE " " TO "}" + IF LEN(curr$) < Max THEN + curr$ = curr$ + Kbd$ + ELSE + BEEP + END IF + + CASE ELSE + BEEP + END SELECT + END IF + + LOOP UNTIL finished + + end$ = curr$ + LOCATE , , 0 + EXIT FUNCTION + + +GetStringShowText: + LOCATE row, col + IF LEN(curr$) > Vis THEN + PRINT RIGHT$(curr$, Vis); + ELSE + PRINT curr$; SPACE$(Vis - LEN(curr$)); + LOCATE row, col + LEN(curr$) + END IF + RETURN + +GetStringGetKey: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN +END FUNCTION + +'Initialize: +' Read colors in and set up assembly routines +SUB Initialize + + WIDTH , 25 + VIEW PRINT + + FOR ColorSet = 1 TO 4 + FOR X = 1 TO 10 + READ colors(X, ColorSet) + NEXT X + NEXT ColorSet + + LoadState + + P = VARPTR(ScrollUpAsm(1)) + DEF SEG = VARSEG(ScrollUpAsm(1)) + FOR I = 0 TO 13 + READ J + POKE (P + I), J + NEXT I + + P = VARPTR(ScrollDownAsm(1)) + DEF SEG = VARSEG(ScrollDownAsm(1)) + FOR I = 0 TO 13 + READ J + POKE (P + I), J + NEXT I + + DEF SEG + +END SUB + +'Intro: +' Display introduction screen. +SUB Intro + SCREEN 0 + WIDTH 80, 25 + COLOR 7, 0 + CLS + + Center 4, "Q B a s i c" + COLOR 15 + Center 5, "Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ Ü Ü Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜ ÜÜÜÜÜ" + Center 6, "ÛßÜ ÜßÛ Û Û ÛÜ Û Û ÛÜÜÜÛ ÛßÜ ÜßÛ Û Û ÛÜ Û Û Û Û Û Û Û" + Center 7, "Û ß Û Û Û Û ßÜÛ Ûßßß Û Û ß Û ÛßßÛ Û ßÜÛ ÛßßÛ Û ßßÛ Ûßßß ÛßÛßß" + Center 8, "Û Û ÛÜÜÛ Û Û ÛÜÜÜ Û Û Û Û Û Û Û Û Û ÛÜÜÜÛ ÛÜÜÜ Û ßÜ" + COLOR 7 + Center 11, "A Personal Finance Manager written in" + Center 12, "MS-DOS QBasic" + Center 24, "Press any key to continue" + + SparklePause +END SUB + +'LCenter: +' Center TEXT$ on the line printer +SUB LCenter (text$) + LPRINT TAB(41 - LEN(text$) / 2); text$ +END SUB + +'LoadState: +' Load color preferences and account info from MONEY.DAT +SUB LoadState + + OPEN "money.dat" FOR INPUT AS #1 + INPUT #1, ColorPref + + FOR a = 1 TO 19 + LINE INPUT #1, account(a).Title + LINE INPUT #1, account(a).AType + LINE INPUT #1, account(a).Desc + NEXT a + + CLOSE + +END SUB + +'Menu: +' Handles Menu Selection for a single menu (either sub menu, or menu bar) +' currChoiceX : Number of current choice +' maxChoice : Number of choices in the list +' choice$() : Array with the text of the choices +' itemRow() : Array with the row of the choices +' itemCol() : Array with the col of the choices +' help$() : Array with the help text for each choice +' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style +' +' Returns the number of the choice that was made by changing currChoiceX +' and returns the scan code of the key that was pressed to exit +' +FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode) + + currChoice = CurrChoiceX + + 'if in bar mode, color in menu bar, else color box/shadow + 'bar mode means you are currently in the menu bar, not a sub menu + IF BarMode THEN + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE 1, 1 + PRINT SPACE$(80); + ELSE + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1 + + COLOR colors(10, ColorPref), colors(6, ColorPref) + FOR a = 1 TO MaxChoice + 1 + LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2 + PRINT CHR$(178); CHR$(178); + NEXT a + LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2 + PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178); + END IF + + 'print the choices + COLOR colors(7, ColorPref), colors(4, ColorPref) + FOR a = 1 TO MaxChoice + LOCATE ItemRow(a), ItemCol(a) + PRINT choice$(a); + NEXT a + + finished = FALSE + + WHILE NOT finished + + GOSUB MenuShowCursor + GOSUB MenuGetKey + GOSUB MenuHideCursor + + SELECT CASE Kbd$ + CASE CHR$(0) + "H": GOSUB MenuUp + CASE CHR$(0) + "P": GOSUB MenuDown + CASE CHR$(0) + "K": GOSUB MenuLeft + CASE CHR$(0) + "M": GOSUB MenuRight + CASE CHR$(13): GOSUB MenuEnter + CASE CHR$(27): GOSUB MenuEscape + CASE ELSE: BEEP + END SELECT + WEND + + Menu = currChoice + + EXIT FUNCTION + + +MenuEnter: + finished = TRUE + RETURN + +MenuEscape: + currChoice = 0 + finished = TRUE + RETURN + +MenuUp: + IF BarMode THEN + BEEP + ELSE + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + END IF + RETURN + +MenuLeft: + IF BarMode THEN + currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1 + ELSE + currChoice = -2 + finished = TRUE + END IF + RETURN + +MenuRight: + IF BarMode THEN + currChoice = (currChoice) MOD MaxChoice + 1 + ELSE + currChoice = -3 + finished = TRUE + END IF + RETURN + +MenuDown: + IF BarMode THEN + finished = TRUE + ELSE + currChoice = (currChoice) MOD MaxChoice + 1 + END IF + RETURN + +MenuShowCursor: + COLOR colors(8, ColorPref), colors(9, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT choice$(currChoice); + PrintHelpLine help$(currChoice) + RETURN + +MenuGetKey: + Kbd$ = "" + WHILE Kbd$ = "" + Kbd$ = INKEY$ + WEND + RETURN + +MenuHideCursor: + COLOR colors(7, ColorPref), colors(4, ColorPref) + LOCATE ItemRow(currChoice), ItemCol(currChoice) + PRINT choice$(currChoice); + RETURN + + +END FUNCTION + +'MenuSystem: +' Main routine that controls the program. Uses the MENU function +' to implement menu system and calls the appropriate function to handle +' the user's selection +SUB MenuSystem + + DIM choice$(20), menuRow(20), menuCol(20), help$(20) + LOCATE , , 0 + choice = 1 + finished = FALSE + + WHILE NOT finished + GOSUB MenuSystemMain + + subchoice = -1 + WHILE subchoice < 0 + SELECT CASE choice + CASE 1: GOSUB MenuSystemFile + CASE 2: GOSUB MenuSystemEdit + CASE 3: GOSUB MenuSystemAccount + CASE 4: GOSUB MenuSystemReport + CASE 5: GOSUB MenuSystemColors + END SELECT + FancyCls colors(2, ColorPref), colors(1, ColorPref) + + SELECT CASE subchoice + CASE -2: choice = (choice + 3) MOD 5 + 1 + CASE -3: choice = (choice) MOD 5 + 1 + END SELECT + WEND + WEND + EXIT SUB + + +MenuSystemMain: + FancyCls colors(2, ColorPref), colors(1, ColorPref) + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 9, 19, 14, 61 + Center 11, "Use arrow keys to navigate menu system" + Center 12, "Press Enter to select a menu item" + + choice$(1) = " File " + choice$(2) = " Accounts " + choice$(3) = " Transactions " + choice$(4) = " Reports " + choice$(5) = " Colors " + + menuRow(1) = 1: menuCol(1) = 2 + menuRow(2) = 1: menuCol(2) = 8 + menuRow(3) = 1: menuCol(3) = 18 + menuRow(4) = 1: menuCol(4) = 32 + menuRow(5) = 1: menuCol(5) = 41 + + help$(1) = "Exit the Money Manager" + help$(2) = "Add/edit/delete accounts" + help$(3) = "Add/edit/delete account transactions" + help$(4) = "View and print reports" + help$(5) = "Set screen colors" + + DO + NewChoice = Menu((choice), 5, choice$(), menuRow(), menuCol(), help$(), TRUE) + LOOP WHILE NewChoice = 0 + choice = NewChoice + RETURN + +MenuSystemFile: + choice$(1) = " Exit " + + menuRow(1) = 3: menuCol(1) = 2 + + help$(1) = "Exit the Money Manager" + + subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE subchoice + CASE 1: finished = TRUE + CASE ELSE + END SELECT + RETURN + + +MenuSystemEdit: + choice$(1) = " Edit Account Titles " + + menuRow(1) = 3: menuCol(1) = 8 + + help$(1) = "Add/edit/delete accounts" + + subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE subchoice + CASE 1: EditAccounts + CASE ELSE + END SELECT + RETURN + + +MenuSystemAccount: + + FOR a = 1 TO 19 + IF Trim$(account(a).Title) = "" THEN + choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- " + ELSE + choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title + END IF + menuRow(a) = a + 2 + menuCol(a) = 19 + help$(a) = RTRIM$(account(a).Desc) + NEXT a + + subchoice = Menu(1, 19, choice$(), menuRow(), menuCol(), help$(), FALSE) + + IF subchoice > 0 THEN + EditTrans (subchoice) + END IF + RETURN + + +MenuSystemReport: + choice$(1) = " Net Worth Report " + menuRow(1) = 3: menuCol(1) = 32 + help$(1) = "View and print net worth report" + + FOR a = 1 TO 19 + IF Trim$(account(a).Title) = "" THEN + choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- " + ELSE + choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title + END IF + menuRow(a + 1) = a + 3 + menuCol(a + 1) = 32 + help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary" + NEXT a + + subchoice = Menu(1, 20, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE subchoice + CASE 1 + NetWorthReport + CASE 2 TO 20 + TransactionSummary (subchoice - 1) + CASE ELSE + END SELECT + RETURN + +MenuSystemColors: + choice$(1) = " Monochrome Scheme " + choice$(2) = " Cyan/Blue Scheme " + choice$(3) = " Blue/Cyan Scheme " + choice$(4) = " Red/Grey Scheme " + + menuRow(1) = 3: menuCol(1) = 41 + menuRow(2) = 4: menuCol(2) = 41 + menuRow(3) = 5: menuCol(3) = 41 + menuRow(4) = 6: menuCol(4) = 41 + + help$(1) = "Color scheme for monochrome and LCD displays" + help$(2) = "Color scheme featuring cyan" + help$(3) = "Color scheme featuring blue" + help$(4) = "Color scheme featuring red" + + subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE) + + SELECT CASE subchoice + CASE 1 TO 4 + ColorPref = subchoice + SaveState + CASE ELSE + END SELECT + RETURN + + +END SUB + +'NetWorthReport: +' Prints net worth report to screen and printer +SUB NetWorthReport + DIM assetIndex(19), liabilityIndex(19) + + maxAsset = 0 + maxLiability = 0 + + FOR a = 1 TO 19 + IF account(a).AType = "A" THEN + maxAsset = maxAsset + 1 + assetIndex(maxAsset) = a + ELSEIF account(a).AType = "L" THEN + maxLiability = maxLiability + 1 + liabilityIndex(maxLiability) = a + END IF + NEXT a + + 'Loop until is pressed + finished = FALSE + DO + u1$ = "\ \$$###,###,###.##" + u2$ = "\ \+$$#,###,###,###.##" + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 1: PRINT SPACE$(80); + LOCATE 1, 4: PRINT "Net Worth Report: " + DATE$; + PrintHelpLine " " + + COLOR colors(7, ColorPref), colors(4, ColorPref) + Box 2, 1, 24, 40 + Box 2, 41, 24, 80 + + LOCATE 2, 16: PRINT " ASSETS " + assetTotal# = 0 + a = 1 + count1 = 1 + WHILE a <= maxAsset + file$ = "money." + Cvit$(assetIndex(a)) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + GET #1, 1 + IF valid$ = "THISISVALID" THEN + LOCATE 2 + count1, 3: PRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$) + assetTotal# = assetTotal# + CVD(IoBalance$) + count1 = count1 + 1 + END IF + CLOSE + a = a + 1 + WEND + + LOCATE 2, 55: PRINT " LIABILITIES " + liabilityTotal# = 0 + a = 1 + count2 = 1 + WHILE a <= maxLiability + file$ = "money." + Cvit$(liabilityIndex(a)) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + GET #1, 1 + IF valid$ = "THISISVALID" THEN + LOCATE 2 + count2, 43: PRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$) + liabilityTotal# = liabilityTotal# + CVD(IoBalance$) + count2 = count2 + 1 + END IF + CLOSE + a = a + 1 + WEND + IF count2 > count1 THEN count1 = count2 + LOCATE 2 + count1, 25: PRINT "--------------" + LOCATE 2 + count1, 65: PRINT "--------------" + LOCATE 3 + count1, 3: PRINT USING u2$; "Total assets"; assetTotal#; + LOCATE 3 + count1, 43: PRINT USING u2$; "Total liabilities"; liabilityTotal# + + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 1, 43: PRINT USING u2$; " NET WORTH:"; assetTotal# - liabilityTotal# + + DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> "" + + SELECT CASE Kbd$ 'Handle Special keys + CASE CHR$(0) + "<" 'F2 + finished = TRUE + CASE CHR$(0) + "=" 'F3 + GOSUB NetWorthReportPrint + CASE ELSE + BEEP + END SELECT + LOOP UNTIL finished + EXIT SUB + +NetWorthReportPrint: + PrintHelpLine "" + + Box 8, 20, 14, 62 + Center 10, "Prepare printer on LPT1 for report" + Center 12, "Hit to print, or to abort" + + DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27) + + IF Kbd$ = CHR$(13) THEN + Box 8, 20, 14, 62 + Center 11, "Printing report..." + u0$ = " \ \ " + u1$ = " \ \ $$###,###,###.##" + u2$ = " --------------" + u3$ = " =============" + u4$ = " \ \+$$#,###,###,###.##" + PrintErr = FALSE + ON ERROR GOTO ErrorTrap ' test if printer is connected + LPRINT + IF PrintErr = FALSE THEN + LPRINT : LPRINT : LPRINT : LPRINT : LPRINT + LCenter "Q B a s i c" + LCenter "M O N E Y M A N A G E R" + LPRINT : LPRINT + LCenter "NET WORTH REPORT: " + DATE$ + LCenter "-------------------------------------------" + LPRINT USING u0$; "ASSETS:" + assetTotal# = 0 + a = 1 + WHILE a <= maxAsset + file$ = "money." + Cvit$(assetIndex(a)) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + GET #1, 1 + IF valid$ = "THISISVALID" THEN + LPRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$) + assetTotal# = assetTotal# + CVD(IoBalance$) + END IF + CLOSE #1 + a = a + 1 + WEND + LPRINT u2$ + LPRINT USING u4$; "Total assets"; assetTotal# + LPRINT + LPRINT + LPRINT USING u0$; "LIABILITIES:" + liabilityTotal# = 0 + a = 1 + WHILE a <= maxLiability + file$ = "money." + Cvit$(liabilityIndex(a)) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + GET #1, 1 + IF valid$ = "THISISVALID" THEN + LPRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$) + liabilityTotal# = liabilityTotal# + CVD(IoBalance$) + END IF + CLOSE #1 + a = a + 1 + WEND + LPRINT u2$ + LPRINT USING u4$; "Total liabilities"; liabilityTotal# + LPRINT + + LPRINT + LPRINT u3$ + LPRINT USING u4$; "NET WORTH"; assetTotal# - liabilityTotal# + LCenter "-------------------------------------------" + LPRINT : LPRINT : LPRINT + END IF + ON ERROR GOTO 0 + END IF + RETURN +END SUB + +'PrintHelpLine: +' Prints help text on the bottom row in the proper color +SUB PrintHelpLine (help$) + COLOR colors(5, ColorPref), colors(4, ColorPref) + LOCATE 25, 1 + PRINT SPACE$(80); + Center 25, help$ +END SUB + +'SaveState: +' Save color preference and account information to "MONEY.DAT" data file. +SUB SaveState + OPEN "money.dat" FOR OUTPUT AS #2 + PRINT #2, ColorPref + + FOR a = 1 TO 19 + PRINT #2, account(a).Title + PRINT #2, account(a).AType + PRINT #2, account(a).Desc + NEXT a + + CLOSE #2 +END SUB + +'ScrollDown: +' Call the assembly program to scroll the screen down +SUB ScrollDown + DEF SEG = VARSEG(ScrollDownAsm(1)) + CALL Absolute(VARPTR(ScrollDownAsm(1))) + DEF SEG +END SUB + +'ScrollUp: +' Calls the assembly program to scroll the screen up +SUB ScrollUp + DEF SEG = VARSEG(ScrollUpAsm(1)) + CALL Absolute(VARPTR(ScrollUpAsm(1))) + DEF SEG +END SUB + +'SparklePause: +' Creates flashing border for intro screen +SUB SparklePause + + COLOR 4, 0 + a$ = "* * * * * * * * * * * * * * * * * " + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + WHILE INKEY$ = "" + FOR a = 1 TO 5 + LOCATE 1, 1 'print horizontal sparkles + PRINT MID$(a$, a, 80); + LOCATE 22, 1 + PRINT MID$(a$, 6 - a, 80); + + FOR b = 2 TO 21 'Print Vertical sparkles + c = (a + b) MOD 5 + IF c = 1 THEN + LOCATE b, 80 + PRINT "*"; + LOCATE 23 - b, 1 + PRINT "*"; + ELSE + LOCATE b, 80 + PRINT " "; + LOCATE 23 - b, 1 + PRINT " "; + END IF + NEXT b + NEXT a + WEND +END SUB + +'TransactionSummary: +' Print transaction summary to line printer +SUB TransactionSummary (item) + FancyCls colors(2, ColorPref), colors(1, ColorPref) + PrintHelpLine "" + Box 8, 20, 14, 62 + Center 10, "Prepare printer on LPT1 for report" + Center 12, "Hit to print, or to abort" + + DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27) + + IF Kbd$ = CHR$(13) THEN + Box 8, 20, 14, 62 + Center 11, "Printing report..." + PrintErr = FALSE + ON ERROR GOTO ErrorTrap ' test if printer is connected + LPRINT + IF PrintErr = FALSE THEN + PRINT + LPRINT : LPRINT : LPRINT : LPRINT : LPRINT + LCenter "Q B a s i c" + LCenter "M O N E Y M A N A G E R" + LPRINT : LPRINT + LCenter "Transaction summary: " + Trim$(account(item).Title) + LCenter DATE$ + LPRINT + u5$ = "--------|------|------------------------|----------|----------|--------------" + LPRINT u5$ + LPRINT " Date | Ref# | Description | Increase | Decrease | Balance " + LPRINT u5$ + u0$ = "\ \|\ \|\ \|" + u2$ = "###,###.##" + u3$ = "###,###,###.##" + u4$ = " " + + file$ = "money." + Cvit$(item) + OPEN file$ FOR RANDOM AS #1 LEN = 84 + FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$ + FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$ + GET #1, 1 + IF valid$ = "THISISVALID" THEN + Balance# = 0 + MaxRecord = VAL(IoMaxRecord$) + CurrRecord = 1 + WHILE CurrRecord <= MaxRecord + + GET #1, CurrRecord + 1 + Fig1# = CVD(IoFig1$) + Fig2# = CVD(IoFig2$) + + LPRINT USING u0$; IoDate$; IoRef$; IoDesc$; + IF Fig2# = 0 AND Fig1# = 0 THEN + LPRINT USING u4$ + "|" + u4$ + "|" + u3$; Balance# + ELSEIF Fig2# = 0 THEN + Balance# = Balance# + Fig1# + LPRINT USING u2$ + "|" + u4$ + "|" + u3$; Fig1#; Balance# + ELSE + Balance# = Balance# - Fig2# + LPRINT USING u4$ + "|" + u2$ + "|" + u3$; Fig2#; Balance# + END IF + CurrRecord = CurrRecord + 1 + WEND + LPRINT u5$ + LPRINT : LPRINT + END IF + ON ERROR GOTO 0 + END IF + CLOSE + END IF +END SUB + +'Trin$: +' Remove null and spaces from the end of a string. +FUNCTION Trim$ (X$) + + IF X$ = "" THEN + Trim$ = "" + ELSE + lastChar = 0 + FOR a = 1 TO LEN(X$) + y$ = MID$(X$, a, 1) + IF y$ <> CHR$(0) AND y$ <> " " THEN + lastChar = a + END IF + NEXT a + Trim$ = LEFT$(X$, lastChar) + END IF + +END FUNCTION + diff --git a/turbobasic/3RD-PA.RTY/QBASIC/NIBBLES.BAS b/turbobasic/3RD-PA.RTY/QBASIC/NIBBLES.BAS new file mode 100755 index 0000000..e2b571e --- /dev/null +++ b/turbobasic/3RD-PA.RTY/QBASIC/NIBBLES.BAS @@ -0,0 +1,722 @@ +' +' Q B a s i c N i b b l e s +' +' Copyright (C) Microsoft Corporation 1990 +' +' Nibbles is a game for one or two players. Navigate your snakes +' around the game board trying to eat up numbers while avoiding +' running into walls or other snakes. The more numbers you eat up, +' the more points you gain and the longer your snake becomes. +' +' To run this game, press Shift+F5. +' +' To exit QBasic, press Alt, F, X. +' +' To get help on a BASIC keyword, move the cursor to the keyword and press +' F1 or click the right mouse button. +' + +'Set default data type to integer for faster game play +DEFINT A-Z + +'User-defined TYPEs +TYPE snakeBody + row AS INTEGER + col AS INTEGER +END TYPE + +'This type defines the player's snake +TYPE snaketype + head AS INTEGER + length AS INTEGER + row AS INTEGER + col AS INTEGER + direction AS INTEGER + lives AS INTEGER + score AS INTEGER + scolor AS INTEGER + alive AS INTEGER +END TYPE + +'This type is used to represent the playing screen in memory +'It is used to simulate graphics in text mode, and has some interesting, +'and slightly advanced methods to increasing the speed of operation. +'Instead of the normal 80x25 text graphics using chr$(219) "Û", we will be +'using chr$(220)"Ü" and chr$(223) "ß" and chr$(219) "Û" to mimic an 80x50 +'pixel screen. +'Check out sub-programs SET and POINTISTHERE to see how this is implemented +'feel free to copy these (as well as arenaType and the DIM ARENA stmt and the +'initialization code in the DrawScreen subprogram) and use them in your own +'programs +TYPE arenaType + realRow AS INTEGER 'Maps the 80x50 point into the real 80x25 + acolor AS INTEGER 'Stores the current color of the point + sister AS INTEGER 'Each char has 2 points in it. .SISTER is +END TYPE '-1 if sister point is above, +1 if below + +'Sub Declarations +DECLARE SUB SpacePause (text$) +DECLARE SUB PrintScore (NumPlayers%, score1%, score2%, lives1%, lives2%) +DECLARE SUB Intro () +DECLARE SUB GetInputs (NumPlayers, speed, diff$, monitor$) +DECLARE SUB DrawScreen () +DECLARE SUB PlayNibbles (NumPlayers, speed, diff$) +DECLARE SUB Set (row, col, acolor) +DECLARE SUB Center (row, text$) +DECLARE SUB DoIntro () +DECLARE SUB Initialize () +DECLARE SUB SparklePause () +DECLARE SUB Level (WhatToDO, sammy() AS snaketype) +DECLARE SUB InitColors () +DECLARE SUB EraseSnake (snake() AS ANY, snakeBod() AS ANY, snakeNum%) +DECLARE FUNCTION StillWantsToPlay () +DECLARE FUNCTION PointIsThere (row, col, backColor) + +'Constants +CONST TRUE = -1 +CONST FALSE = NOT TRUE +CONST MAXSNAKELENGTH = 1000 +CONST STARTOVER = 1 ' Parameters to 'Level' SUB +CONST SAMELEVEL = 2 +CONST NEXTLEVEL = 3 + +'Global Variables +DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType +DIM SHARED curLevel, colorTable(10) + + RANDOMIZE TIMER + GOSUB ClearKeyLocks + Intro + GetInputs NumPlayers, speed, diff$, monitor$ + GOSUB SetColors + DrawScreen + + DO + PlayNibbles NumPlayers, speed, diff$ + LOOP WHILE StillWantsToPlay + + GOSUB RestoreKeyLocks + COLOR 15, 0 + CLS +END + +ClearKeyLocks: + DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock + KeyFlags = PEEK(1047) + POKE 1047, &H0 + DEF SEG + RETURN + +RestoreKeyLocks: + DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states + POKE 1047, KeyFlags + DEF SEG + RETURN + +SetColors: + IF monitor$ = "M" THEN + RESTORE mono + ELSE + RESTORE normal + END IF + + FOR a = 1 TO 6 + READ colorTable(a) + NEXT a + RETURN + + 'snake1 snake2 Walls Background Dialogs-Fore Back +mono: DATA 15, 7, 7, 0, 15, 0 +normal: DATA 14, 13, 12, 1, 15, 4 +END + +'Center: +' Centers text on given row +SUB Center (row, text$) + LOCATE row, 41 - LEN(text$) / 2 + PRINT text$; +END SUB + +'DrawScreen: +' Draws playing field +SUB DrawScreen + + 'initialize screen + VIEW PRINT + COLOR colorTable(1), colorTable(4) + CLS + + 'Print title & message + Center 1, "Nibbles!" + Center 11, "Initializing Playing Field..." + + 'Initialize arena array + FOR row = 1 TO 50 + FOR col = 1 TO 80 + arena(row, col).realRow = INT((row + 1) / 2) + arena(row, col).sister = (row MOD 2) * 2 - 1 + NEXT col + NEXT row +END SUB + +'EraseSnake: +' Erases snake to facilitate moving through playing field +SUB EraseSnake (snake() AS snaketype, snakeBod() AS snakeBody, snakeNum) + + FOR c = 0 TO 9 + FOR b = snake(snakeNum).length - c TO 0 STEP -10 + tail = (snake(snakeNum).head + MAXSNAKELENGTH - b) MOD MAXSNAKELENGTH + Set snakeBod(tail, snakeNum).row, snakeBod(tail, snakeNum).col, colorTable(4) + NEXT b + NEXT c + +END SUB + +'GetInputs: +' Gets player inputs +SUB GetInputs (NumPlayers, speed, diff$, monitor$) + + COLOR 7, 0 + CLS + + DO + LOCATE 5, 47: PRINT SPACE$(34); + LOCATE 5, 20 + INPUT "How many players (1 or 2)"; num$ + LOOP UNTIL VAL(num$) = 1 OR VAL(num$) = 2 + NumPlayers = VAL(num$) + + LOCATE 8, 21: PRINT "Skill level (1 to 100)" + LOCATE 9, 22: PRINT "1 = Novice" + LOCATE 10, 22: PRINT "90 = Expert" + LOCATE 11, 22: PRINT "100 = Twiddle Fingers" + LOCATE 12, 15: PRINT "(Computer speed may affect your skill level)" + DO + LOCATE 8, 44: PRINT SPACE$(35); + LOCATE 8, 43 + INPUT gamespeed$ + LOOP UNTIL VAL(gamespeed$) >= 1 AND VAL(gamespeed$) <= 100 + speed = VAL(gamespeed$) + + speed = (100 - speed) * 2 + 1 + + DO + LOCATE 15, 56: PRINT SPACE$(25); + LOCATE 15, 15 + INPUT "Increase game speed during play (Y or N)"; diff$ + diff$ = UCASE$(diff$) + LOOP UNTIL diff$ = "Y" OR diff$ = "N" + + DO + LOCATE 17, 46: PRINT SPACE$(34); + LOCATE 17, 17 + INPUT "Monochrome or color monitor (M or C)"; monitor$ + monitor$ = UCASE$(monitor$) + LOOP UNTIL monitor$ = "M" OR monitor$ = "C" + + startTime# = TIMER ' Calculate speed of system + FOR i# = 1 TO 1000: NEXT i# ' and do some compensation + stopTime# = TIMER + speed = speed * .5 / (stopTime# - startTime#) + +END SUB + +'InitColors: +'Initializes playing field colors +SUB InitColors + + FOR row = 1 TO 50 + FOR col = 1 TO 80 + arena(row, col).acolor = colorTable(4) + NEXT col + NEXT row + + CLS + + 'Set (turn on) pixels for screen border + FOR col = 1 TO 80 + Set 3, col, colorTable(3) + Set 50, col, colorTable(3) + NEXT col + + FOR row = 4 TO 49 + Set row, 1, colorTable(3) + Set row, 80, colorTable(3) + NEXT row + +END SUB + +'Intro: +' Displays game introduction +SUB Intro + SCREEN 0 + WIDTH 80, 25 + COLOR 15, 0 + CLS + + Center 4, "Q B a s i c N i b b l e s" + COLOR 7 + Center 6, "Copyright (C) Microsoft Corporation 1990" + Center 8, "Nibbles is a game for one or two players. Navigate your snakes" + Center 9, "around the game board trying to eat up numbers while avoiding" + Center 10, "running into walls or other snakes. The more numbers you eat up," + Center 11, "the more points you gain and the longer your snake becomes." + Center 13, " Game Controls " + Center 15, " General Player 1 Player 2 " + Center 16, " (Up) (Up) " + Center 17, "P - Pause " + CHR$(24) + " W " + Center 18, " (Left) " + CHR$(27) + " " + CHR$(26) + " (Right) (Left) A D (Right) " + Center 19, " " + CHR$(25) + " S " + Center 20, " (Down) (Down) " + Center 24, "Press any key to continue" + + PLAY "MBT160O1L8CDEDCDL4ECC" + SparklePause + +END SUB + +'Level: +'Sets game level +SUB Level (WhatToDO, sammy() AS snaketype) STATIC + + SELECT CASE (WhatToDO) + + CASE STARTOVER + curLevel = 1 + CASE NEXTLEVEL + curLevel = curLevel + 1 + END SELECT + + sammy(1).head = 1 'Initialize Snakes + sammy(1).length = 2 + sammy(1).alive = TRUE + sammy(2).head = 1 + sammy(2).length = 2 + sammy(2).alive = TRUE + + InitColors + + SELECT CASE curLevel + CASE 1 + sammy(1).row = 25: sammy(2).row = 25 + sammy(1).col = 50: sammy(2).col = 30 + sammy(1).direction = 4: sammy(2).direction = 3 + + + CASE 2 + FOR i = 20 TO 60 + Set 25, i, colorTable(3) + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 60: sammy(2).col = 20 + sammy(1).direction = 3: sammy(2).direction = 4 + + CASE 3 + FOR i = 10 TO 40 + Set i, 20, colorTable(3) + Set i, 60, colorTable(3) + NEXT i + sammy(1).row = 25: sammy(2).row = 25 + sammy(1).col = 50: sammy(2).col = 30 + sammy(1).direction = 1: sammy(2).direction = 2 + + CASE 4 + FOR i = 4 TO 30 + Set i, 20, colorTable(3) + Set 53 - i, 60, colorTable(3) + NEXT i + FOR i = 2 TO 40 + Set 38, i, colorTable(3) + Set 15, 81 - i, colorTable(3) + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 60: sammy(2).col = 20 + sammy(1).direction = 3: sammy(2).direction = 4 + + CASE 5 + FOR i = 13 TO 39 + Set i, 21, colorTable(3) + Set i, 59, colorTable(3) + NEXT i + FOR i = 23 TO 57 + Set 11, i, colorTable(3) + Set 41, i, colorTable(3) + NEXT i + sammy(1).row = 25: sammy(2).row = 25 + sammy(1).col = 50: sammy(2).col = 30 + sammy(1).direction = 1: sammy(2).direction = 2 + + CASE 6 + FOR i = 4 TO 49 + IF i > 30 OR i < 23 THEN + Set i, 10, colorTable(3) + Set i, 20, colorTable(3) + Set i, 30, colorTable(3) + Set i, 40, colorTable(3) + Set i, 50, colorTable(3) + Set i, 60, colorTable(3) + Set i, 70, colorTable(3) + END IF + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 65: sammy(2).col = 15 + sammy(1).direction = 2: sammy(2).direction = 1 + + CASE 7 + FOR i = 4 TO 49 STEP 2 + Set i, 40, colorTable(3) + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 65: sammy(2).col = 15 + sammy(1).direction = 2: sammy(2).direction = 1 + + CASE 8 + FOR i = 4 TO 40 + Set i, 10, colorTable(3) + Set 53 - i, 20, colorTable(3) + Set i, 30, colorTable(3) + Set 53 - i, 40, colorTable(3) + Set i, 50, colorTable(3) + Set 53 - i, 60, colorTable(3) + Set i, 70, colorTable(3) + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 65: sammy(2).col = 15 + sammy(1).direction = 2: sammy(2).direction = 1 + + CASE 9 + FOR i = 6 TO 47 + Set i, i, colorTable(3) + Set i, i + 28, colorTable(3) + NEXT i + sammy(1).row = 40: sammy(2).row = 15 + sammy(1).col = 75: sammy(2).col = 5 + sammy(1).direction = 1: sammy(2).direction = 2 + + CASE ELSE + FOR i = 4 TO 49 STEP 2 + Set i, 10, colorTable(3) + Set i + 1, 20, colorTable(3) + Set i, 30, colorTable(3) + Set i + 1, 40, colorTable(3) + Set i, 50, colorTable(3) + Set i + 1, 60, colorTable(3) + Set i, 70, colorTable(3) + NEXT i + sammy(1).row = 7: sammy(2).row = 43 + sammy(1).col = 65: sammy(2).col = 15 + sammy(1).direction = 2: sammy(2).direction = 1 + + END SELECT +END SUB + +'PlayNibbles: +' Main routine that controls game play +SUB PlayNibbles (NumPlayers, speed, diff$) + + 'Initialize Snakes + DIM sammyBody(MAXSNAKELENGTH - 1, 1 TO 2) AS snakeBody + DIM sammy(1 TO 2) AS snaketype + sammy(1).lives = 5 + sammy(1).score = 0 + sammy(1).scolor = colorTable(1) + sammy(2).lives = 5 + sammy(2).score = 0 + sammy(2).scolor = colorTable(2) + + Level STARTOVER, sammy() + startRow1 = sammy(1).row: startCol1 = sammy(1).col + startRow2 = sammy(2).row: startCol2 = sammy(2).col + + curSpeed = speed + + 'play Nibbles until finished + + SpacePause " Level" + STR$(curLevel) + ", Push Space" + gameOver = FALSE + DO + IF NumPlayers = 1 THEN + sammy(2).row = 0 + END IF + + number = 1 'Current number that snakes are trying to run into + nonum = TRUE 'nonum = TRUE if a number is not on the screen + + playerDied = FALSE + PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives + PLAY "T160O1>L20CDEDCDL10ECC" + + DO + 'Print number if no number exists + IF nonum = TRUE THEN + DO + numberRow = INT(RND(1) * 47 + 3) + NumberCol = INT(RND(1) * 78 + 2) + sisterRow = numberRow + arena(numberRow, NumberCol).sister + LOOP UNTIL NOT PointIsThere(numberRow, NumberCol, colorTable(4)) AND NOT PointIsThere(sisterRow, NumberCol, colorTable(4)) + numberRow = arena(numberRow, NumberCol).realRow + nonum = FALSE + COLOR colorTable(1), colorTable(4) + LOCATE numberRow, NumberCol + PRINT RIGHT$(STR$(number), 1); + count = 0 + END IF + + 'Delay game + FOR a# = 1 TO curSpeed: NEXT a# + + 'Get keyboard input & Change direction accordingly + kbd$ = INKEY$ + SELECT CASE kbd$ + CASE "w", "W": IF sammy(2).direction <> 2 THEN sammy(2).direction = 1 + CASE "s", "S": IF sammy(2).direction <> 1 THEN sammy(2).direction = 2 + CASE "a", "A": IF sammy(2).direction <> 4 THEN sammy(2).direction = 3 + CASE "d", "D": IF sammy(2).direction <> 3 THEN sammy(2).direction = 4 + CASE CHR$(0) + "H": IF sammy(1).direction <> 2 THEN sammy(1).direction = 1 + CASE CHR$(0) + "P": IF sammy(1).direction <> 1 THEN sammy(1).direction = 2 + CASE CHR$(0) + "K": IF sammy(1).direction <> 4 THEN sammy(1).direction = 3 + CASE CHR$(0) + "M": IF sammy(1).direction <> 3 THEN sammy(1).direction = 4 + CASE "p", "P": SpacePause " Game Paused ... Push Space " + CASE ELSE + END SELECT + + FOR a = 1 TO NumPlayers + 'Move Snake + SELECT CASE sammy(a).direction + CASE 1: sammy(a).row = sammy(a).row - 1 + CASE 2: sammy(a).row = sammy(a).row + 1 + CASE 3: sammy(a).col = sammy(a).col - 1 + CASE 4: sammy(a).col = sammy(a).col + 1 + END SELECT + + 'If snake hits number, respond accordingly + IF numberRow = INT((sammy(a).row + 1) / 2) AND NumberCol = sammy(a).col THEN + PLAY "MBO0L16>CCCE" + IF sammy(a).length < (MAXSNAKELENGTH - 30) THEN + sammy(a).length = sammy(a).length + number * 4 + END IF + sammy(a).score = sammy(a).score + number + PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives + number = number + 1 + IF number = 10 THEN + EraseSnake sammy(), sammyBody(), 1 + EraseSnake sammy(), sammyBody(), 2 + LOCATE numberRow, NumberCol: PRINT " " + Level NEXTLEVEL, sammy() + PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives + SpacePause " Level" + STR$(curLevel) + ", Push Space" + IF NumPlayers = 1 THEN sammy(2).row = 0 + number = 1 + IF diff$ = "P" THEN speed = speed - 10: curSpeed = speed + END IF + nonum = TRUE + IF curSpeed < 1 THEN curSpeed = 1 + END IF + NEXT a + + FOR a = 1 TO NumPlayers + 'If player runs into any point, or the head of the other snake, it dies. + IF PointIsThere(sammy(a).row, sammy(a).col, colorTable(4)) OR (sammy(1).row = sammy(2).row AND sammy(1).col = sammy(2).col) THEN + PLAY "MBO0L32EFGEFDC" + COLOR , colorTable(4) + LOCATE numberRow, NumberCol + PRINT " " + + playerDied = TRUE + sammy(a).alive = FALSE + sammy(a).lives = sammy(a).lives - 1 + + 'Otherwise, move the snake, and erase the tail + ELSE + sammy(a).head = (sammy(a).head + 1) MOD MAXSNAKELENGTH + sammyBody(sammy(a).head, a).row = sammy(a).row + sammyBody(sammy(a).head, a).col = sammy(a).col + tail = (sammy(a).head + MAXSNAKELENGTH - sammy(a).length) MOD MAXSNAKELENGTH + Set sammyBody(tail, a).row, sammyBody(tail, a).col, colorTable(4) + sammyBody(tail, a).row = 0 + Set sammy(a).row, sammy(a).col, sammy(a).scolor + END IF + NEXT a + + LOOP UNTIL playerDied + + curSpeed = speed ' reset speed to initial value + + FOR a = 1 TO NumPlayers + EraseSnake sammy(), sammyBody(), a + + 'If dead, then erase snake in really cool way + IF sammy(a).alive = FALSE THEN + 'Update score + sammy(a).score = sammy(a).score - 10 + PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives + + IF a = 1 THEN + SpacePause " Sammy Dies! Push Space! --->" + ELSE + SpacePause " <---- Jake Dies! Push Space " + END IF + END IF + NEXT a + + Level SAMELEVEL, sammy() + PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives + + 'Play next round, until either of snake's lives have run out. + LOOP UNTIL sammy(1).lives = 0 OR sammy(2).lives = 0 + +END SUB + +'PointIsThere: +' Checks the global arena array to see if the boolean flag is set +FUNCTION PointIsThere (row, col, acolor) + IF row <> 0 THEN + IF arena(row, col).acolor <> acolor THEN + PointIsThere = TRUE + ELSE + PointIsThere = FALSE + END IF + END IF +END FUNCTION + +'PrintScore: +' Prints players scores and number of lives remaining +SUB PrintScore (NumPlayers, score1, score2, lives1, lives2) + COLOR 15, colorTable(4) + + IF NumPlayers = 2 THEN + LOCATE 1, 1 + PRINT USING "#,###,#00 Lives: # <--JAKE"; score2; lives2 + END IF + + LOCATE 1, 49 + PRINT USING "SAMMY--> Lives: # #,###,#00"; lives1; score1 +END SUB + +'Set: +' Sets row and column on playing field to given color to facilitate moving +' of snakes around the field. +SUB Set (row, col, acolor) + IF row <> 0 THEN + arena(row, col).acolor = acolor 'assign color to arena + realRow = arena(row, col).realRow 'Get real row of pixel + topFlag = arena(row, col).sister + 1 / 2 'Deduce whether pixel + 'is on topß, or bottomÜ + sisterRow = row + arena(row, col).sister 'Get arena row of sister + sisterColor = arena(sisterRow, col).acolor 'Determine sister's color + + LOCATE realRow, col + + IF acolor = sisterColor THEN 'If both points are same + COLOR acolor, acolor 'Print chr$(219) "Û" + PRINT CHR$(219); + ELSE + IF topFlag THEN 'Since you cannot have + IF acolor > 7 THEN 'bright backgrounds + COLOR acolor, sisterColor 'determine best combo + PRINT CHR$(223); 'to use. + ELSE + COLOR sisterColor, acolor + PRINT CHR$(220); + END IF + ELSE + IF acolor > 7 THEN + COLOR acolor, sisterColor + PRINT CHR$(220); + ELSE + COLOR sisterColor, acolor + PRINT CHR$(223); + END IF + END IF + END IF + END IF +END SUB + +'SpacePause: +' Pauses game play and waits for space bar to be pressed before continuing +SUB SpacePause (text$) + + COLOR colorTable(5), colorTable(6) + Center 11, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ" + Center 12, "Û " + LEFT$(text$ + SPACE$(29), 29) + " Û" + Center 13, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ" + WHILE INKEY$ <> "": WEND + WHILE INKEY$ <> " ": WEND + COLOR 15, colorTable(4) + + FOR i = 21 TO 26 ' Restore the screen background + FOR j = 24 TO 56 + Set i, j, arena(i, j).acolor + NEXT j + NEXT i + +END SUB + +'SparklePause: +' Creates flashing border for intro screen +SUB SparklePause + + COLOR 4, 0 + a$ = "* * * * * * * * * * * * * * * * * " + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + WHILE INKEY$ = "" + FOR a = 1 TO 5 + LOCATE 1, 1 'print horizontal sparkles + PRINT MID$(a$, a, 80); + LOCATE 22, 1 + PRINT MID$(a$, 6 - a, 80); + + FOR b = 2 TO 21 'Print Vertical sparkles + c = (a + b) MOD 5 + IF c = 1 THEN + LOCATE b, 80 + PRINT "*"; + LOCATE 23 - b, 1 + PRINT "*"; + ELSE + LOCATE b, 80 + PRINT " "; + LOCATE 23 - b, 1 + PRINT " "; + END IF + NEXT b + NEXT a + WEND + +END SUB + +'StillWantsToPlay: +' Determines if users want to play game again. +FUNCTION StillWantsToPlay + + COLOR colorTable(5), colorTable(6) + Center 10, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ" + Center 11, "Û G A M E O V E R Û" + Center 12, "Û Û" + Center 13, "Û Play Again? (Y/N) Û" + Center 14, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ" + + WHILE INKEY$ <> "": WEND + DO + kbd$ = UCASE$(INKEY$) + LOOP UNTIL kbd$ = "Y" OR kbd$ = "N" + + COLOR 15, colorTable(4) + Center 10, " " + Center 11, " " + Center 12, " " + Center 13, " " + Center 14, " " + + IF kbd$ = "Y" THEN + StillWantsToPlay = TRUE + ELSE + StillWantsToPlay = FALSE + COLOR 7, 0 + CLS + END IF + +END FUNCTION + + \ No newline at end of file diff --git a/turbobasic/3RD-PA.RTY/REMLINE.BAS b/turbobasic/3RD-PA.RTY/REMLINE.BAS new file mode 100755 index 0000000..959604b --- /dev/null +++ b/turbobasic/3RD-PA.RTY/REMLINE.BAS @@ -0,0 +1,395 @@ +' +' Microsoft RemLine - Line Number Removal Utility +' Copyright (C) Microsoft Corporation 1985-1990 +' +' REMLINE.BAS is a program to remove line numbers from Microsoft Basic +' Programs. It removes only those line numbers that are not the object +' of one of the following statements: GOSUB, RETURN, GOTO, THEN, ELSE, +' RESUME, RESTORE, or RUN. +' +' When REMLINE is run, it will ask for the name of the file to be +' processed and the name of the file or device to receive the +' reformatted output. If no extension is given, .BAS is assumed (except +' for output devices). If filenames are not given, REMLINE prompts for +' file names. If both filenames are the same, REMLINE saves the original +' file with the extension .BAK. +' +' REMLINE makes several assumptions about the program: +' +' 1. It must be correct syntactically, and must run in BASICA or +' GW-BASIC interpreter. +' 2. There is a 400 line limit. To process larger files, change +' MaxLines constant. +' 3. The first number encountered on a line is considered a line +' number; thus some continuation lines (in a compiler-specific +' construction) may not be handled correctly. +' 4. REMLINE can handle simple statements that test the ERL function +' using relational operators such as =, <, and >. For example, +' the following statement is handled correctly: +' +' IF ERL = 100 THEN END +' +' Line 100 is not removed from the source code. However, more +' complex expressions that contain the +, -, AND, OR, XOR, EQV, +' MOD, or IMP operators may not be handled correctly. For example, +' in the following statement REMLINE does not recognize line 105 +' as a referenced line number and removes it from the source code: +' +' IF ERL + 5 = 105 THEN END +' +' If you do not like the way REMLINE formats its output, you can modify +' the output lines in SUB GenOutFile. An example is shown in comments. +DEFINT A-Z + +' Function and Subprocedure declarations +DECLARE FUNCTION GetToken$ (Search$, Delim$) +DECLARE FUNCTION StrSpn% (InString$, Separator$) +DECLARE FUNCTION StrBrk% (InString$, Separator$) +DECLARE FUNCTION IsDigit% (Char$) +DECLARE SUB GetFileNames () +DECLARE SUB BuildTable () +DECLARE SUB GenOutFile () +DECLARE SUB InitKeyTable () + +' Global and constant data +CONST TRUE = -1 +CONST false = 0 +CONST MaxLines = 400 + +DIM SHARED LineTable!(MaxLines) +DIM SHARED LineCount +DIM SHARED Seps$, InputFile$, OutputFile$, TmpFile$ + +' Keyword search data +CONST KeyWordCount = 9 +DIM SHARED KeyWordTable$(KeyWordCount) + +KeyData: + DATA THEN, ELSE, GOSUB, GOTO, RESUME, RETURN, RESTORE, RUN, ERL, "" + +' Start of module-level program code + Seps$ = " ,:=<>()" + CHR$(9) + InitKeyTable + GetFileNames + ON ERROR GOTO FileErr1 + OPEN InputFile$ FOR INPUT AS 1 + ON ERROR GOTO 0 + COLOR 7: PRINT "Working"; : COLOR 23: PRINT " . . .": COLOR 7: PRINT + BuildTable + CLOSE #1 + OPEN InputFile$ FOR INPUT AS 1 + ON ERROR GOTO FileErr2 + OPEN OutputFile$ FOR OUTPUT AS 2 + ON ERROR GOTO 0 + GenOutFile + CLOSE #1, #2 + IF OutputFile$ <> "CON" THEN CLS + +END + +FileErr1: + CLS + PRINT " Invalid file name": PRINT + INPUT " New input file name (ENTER to terminate): ", InputFile$ + IF InputFile$ = "" THEN END +FileErr2: + INPUT " Output file name (ENTER to print to screen) :", OutputFile$ + PRINT + IF (OutputFile$ = "") THEN OutputFile$ = "CON" + IF TmpFile$ = "" THEN + RESUME + ELSE + TmpFile$ = "" + RESUME NEXT + END IF + +' +' BuildTable: +' Examines the entire text file looking for line numbers that are +' the object of GOTO, GOSUB, etc. As each is found, it is entered +' into a table of line numbers. The table is used during a second +' pass (see GenOutFile), when all line numbers not in the list +' are removed. +' Input: +' Uses globals KeyWordTable$, KeyWordCount, and Seps$ +' Output: +' Modifies LineTable! and LineCount +' +SUB BuildTable STATIC + + DO WHILE NOT EOF(1) + ' Get line and first token + LINE INPUT #1, InLin$ + Token$ = GetToken$(InLin$, Seps$) + DO WHILE (Token$ <> "") + FOR KeyIndex = 1 TO KeyWordCount + ' See if token is keyword + IF (KeyWordTable$(KeyIndex) = UCASE$(Token$)) THEN + ' Get possible line number after keyword + Token$ = GetToken$("", Seps$) + ' Check each token to see if it is a line number + ' (the LOOP is necessary for the multiple numbers + ' of ON GOSUB or ON GOTO). A non-numeric token will + ' terminate search. + DO WHILE (IsDigit(LEFT$(Token$, 1))) + LineCount = LineCount + 1 + LineTable!(LineCount) = VAL(Token$) + Token$ = GetToken$("", Seps$) + IF Token$ <> "" THEN KeyIndex = 0 + LOOP + END IF + NEXT KeyIndex + ' Get next token + Token$ = GetToken$("", Seps$) + LOOP + LOOP + +END SUB + +' +' GenOutFile: +' Generates an output file with unreferenced line numbers removed. +' Input: +' Uses globals LineTable!, LineCount, and Seps$ +' Output: +' Processed file +' +SUB GenOutFile STATIC + + ' Speed up by eliminating comma and colon (can't separate first token) + Sep$ = " " + CHR$(9) + DO WHILE NOT EOF(1) + LINE INPUT #1, InLin$ + IF (InLin$ <> "") THEN + ' Get first token and process if it is a line number + Token$ = GetToken$(InLin$, Sep$) + IF IsDigit(LEFT$(Token$, 1)) THEN + LineNumber! = VAL(Token$) + FoundNumber = false + ' See if line number is in table of referenced line numbers + FOR index = 1 TO LineCount + IF (LineNumber! = LineTable!(index)) THEN + FoundNumber = TRUE + END IF + NEXT index + ' Modify line strings + IF (NOT FoundNumber) THEN + Token$ = SPACE$(LEN(Token$)) + MID$(InLin$, StrSpn(InLin$, Sep$), LEN(Token$)) = Token$ + END IF + + ' You can replace the previous lines with your own + ' code to reformat output. For example, try these lines: + + 'TmpPos1 = StrSpn(InLin$, Sep$) + LEN(Token$) + 'TmpPos2 = TmpPos1 + StrSpn(MID$(InLin$, TmpPos1), Sep$) + ' + 'IF FoundNumber THEN + ' InLin$ = LEFT$(InLin$, TmpPos1 - 1) + CHR$(9) + MID$(InLin$, TmpPos2) + 'ELSE + ' InLin$ = CHR$(9) + MID$(InLin$, TmpPos2) + 'END IF + + END IF + END IF + ' Print line to file or console (PRINT is faster than console device) + IF OutputFile$ = "CON" THEN + PRINT InLin$ + ELSE + PRINT #2, InLin$ + END IF + LOOP + +END SUB + +' +' GetFileNames: +' Gets a file name by prompting the user. +' Input: +' User input +' Output: +' Defines InputFiles$ and OutputFiles$ +' +SUB GetFileNames STATIC + + CLS + PRINT " Microsoft RemLine: Line Number Removal Utility" + PRINT " (.BAS assumed if no extension given)" + PRINT + INPUT " Input file name (ENTER to terminate): ", InputFile$ + IF InputFile$ = "" THEN END + INPUT " Output file name (ENTER to print to screen): ", OutputFile$ + PRINT + IF (OutputFile$ = "") THEN OutputFile$ = "CON" + + IF INSTR(InputFile$, ".") = 0 THEN + InputFile$ = InputFile$ + ".BAS" + END IF + + IF INSTR(OutputFile$, ".") = 0 THEN + SELECT CASE OutputFile$ + CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3" + EXIT SUB + CASE ELSE + OutputFile$ = OutputFile$ + ".BAS" + END SELECT + END IF + + DO WHILE InputFile$ = OutputFile$ + TmpFile$ = LEFT$(InputFile$, INSTR(InputFile$, ".")) + "BAK" + ON ERROR GOTO FileErr1 + NAME InputFile$ AS TmpFile$ + ON ERROR GOTO 0 + IF TmpFile$ <> "" THEN InputFile$ = TmpFile$ + LOOP + +END SUB + +' +' GetToken$: +' Extracts tokens from a string. A token is a word that is surrounded +' by separators, such as spaces or commas. Tokens are extracted and +' analyzed when parsing sentences or commands. To use the GetToken$ +' function, pass the string to be parsed on the first call, then pass +' a null string on subsequent calls until the function returns a null +' to indicate that the entire string has been parsed. +' Input: +' Search$ = string to search +' Delim$ = String of separators +' Output: +' GetToken$ = next token +' +FUNCTION GetToken$ (Search$, Delim$) STATIC + + ' Note that SaveStr$ and BegPos must be static from call to call + ' (other variables are only static for efficiency). + ' If first call, make a copy of the string + IF (Search$ <> "") THEN + BegPos = 1 + SaveStr$ = Search$ + END IF + + ' Find the start of the next token + NewPos = StrSpn(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$) + IF NewPos THEN + ' Set position to start of token + BegPos = NewPos + BegPos - 1 + ELSE + ' If no new token, quit and return null + GetToken$ = "" + EXIT FUNCTION + END IF + + ' Find end of token + NewPos = StrBrk(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$) + IF NewPos THEN + ' Set position to end of token + NewPos = BegPos + NewPos - 1 + ELSE + ' If no end of token, return set to end a value + NewPos = LEN(SaveStr$) + 1 + END IF + ' Cut token out of search string + GetToken$ = MID$(SaveStr$, BegPos, NewPos - BegPos) + ' Set new starting position + BegPos = NewPos + +END FUNCTION + +' +' InitKeyTable: +' Initializes a keyword table. Keywords must be recognized so that +' line numbers can be distinguished from numeric constants. +' Input: +' Uses KeyData +' Output: +' Modifies global array KeyWordTable$ +' +SUB InitKeyTable STATIC + + RESTORE KeyData + FOR Count = 1 TO KeyWordCount + READ KeyWord$ + KeyWordTable$(Count) = KeyWord$ + NEXT + +END SUB + +' +' IsDigit: +' Returns true if character passed is a decimal digit. Since any +' Basic token starting with a digit is a number, the function only +' needs to check the first digit. Doesn't check for negative numbers, +' but that's not needed here. +' Input: +' Char$ - initial character of string to check +' Output: +' IsDigit - true if within 0 - 9 +' +FUNCTION IsDigit (Char$) STATIC + + IF (Char$ = "") THEN + IsDigit = false + ELSE + CharAsc = ASC(Char$) + IsDigit = (CharAsc >= ASC("0")) AND (CharAsc <= ASC("9")) + END IF + +END FUNCTION + +' +' StrBrk: +' Searches InString$ to find the first character from among those in +' Separator$. Returns the index of that character. This function can +' be used to find the end of a token. +' Input: +' InString$ = string to search +' Separator$ = characters to search for +' Output: +' StrBrk = index to first match in InString$ or 0 if none match +' +FUNCTION StrBrk (InString$, Separator$) STATIC + + Ln = LEN(InString$) + BegPos = 1 + ' Look for end of token (first character that is a delimiter). + DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) = 0 + IF BegPos > Ln THEN + StrBrk = 0 + EXIT FUNCTION + ELSE + BegPos = BegPos + 1 + END IF + LOOP + StrBrk = BegPos + +END FUNCTION + +' +' StrSpn: +' Searches InString$ to find the first character that is not one of +' those in Separator$. Returns the index of that character. This +' function can be used to find the start of a token. +' Input: +' InString$ = string to search +' Separator$ = characters to search for +' Output: +' StrSpn = index to first nonmatch in InString$ or 0 if all match +' +FUNCTION StrSpn% (InString$, Separator$) STATIC + + Ln = LEN(InString$) + BegPos = 1 + ' Look for start of a token (character that isn't a delimiter). + DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) + IF BegPos > Ln THEN + StrSpn = 0 + EXIT FUNCTION + ELSE + BegPos = BegPos + 1 + END IF + LOOP + StrSpn = BegPos + +END FUNCTION + diff --git a/turbobasic/AAAAAAAA.BAS b/turbobasic/AAAAAAAA.BAS new file mode 100755 index 0000000..e84695a --- /dev/null +++ b/turbobasic/AAAAAAAA.BAS @@ -0,0 +1,3 @@ +CLS +SHELL "A:" +END \ No newline at end of file diff --git a/turbobasic/ALARM.BAS b/turbobasic/ALARM.BAS new file mode 100755 index 0000000..5b4449d --- /dev/null +++ b/turbobasic/ALARM.BAS @@ -0,0 +1,16 @@ +cls +screen 1 +COLOR 14,1 +LOCATE 2,2 +INPUT " ZAKàDUJTE ALARM " ;KOD$ +ZPED: +SCREEN 1 +COLOR 14,1 +LOCATE 2,2 +cls +INPUT " ODKàDUJTE ALARM " ;UNKOD$ +IF UNKOD$=KOD$ THEN GOTO NOTALARM +SOUND 1000+12,100 +GOTO ZPED +NOTALARM: +END \ No newline at end of file diff --git a/turbobasic/ASCI2-25.BAS b/turbobasic/ASCI2-25.BAS new file mode 100755 index 0000000..58f896f --- /dev/null +++ b/turbobasic/ASCI2-25.BAS @@ -0,0 +1,16 @@ +CLS +FOR A=0 TO 255 +COLOR 0,15 +SCREEN 1 +LOCATE 2,2 +PRINT A " " CHR$ (A)"" + +locate 5,5 +input "Chcete znat dalsi znak? Jestli ne napiste x a stisknete enter." ;dalsi$ + REM POKR: + REM LOCATE 5,5 + REM PRINT CHR$ (A) + REM FOR I=0 TO 99999 + REM NEXT I + NEXT A +END \ No newline at end of file diff --git a/turbobasic/ASCI255.BAS b/turbobasic/ASCI255.BAS new file mode 100755 index 0000000..a78929c --- /dev/null +++ b/turbobasic/ASCI255.BAS @@ -0,0 +1,16 @@ +CLS +FOR A=0 TO 255 +COLOR 0,15 +SCREEN 0 +LOCATE 2,2 +PRINT A " " CHR$ (A)"" + +locate 5,5 +input "Chcete znat dalsi znak? Jestli ne napiste x a stisknete enter." ;dalsi$ + REM POKR: + REM LOCATE 5,5 + REM PRINT CHR$ (A) + REM FOR I=0 TO 99999 + REM NEXT I + NEXT A +END \ No newline at end of file diff --git a/turbobasic/BARVY.BAS b/turbobasic/BARVY.BAS new file mode 100755 index 0000000..c11c783 --- /dev/null +++ b/turbobasic/BARVY.BAS @@ -0,0 +1,7 @@ +cls +screen 0 +color 0,15 +locate 3,10 +print SPC(32) "AHOJ" +color 2,9 +input "pokus";A \ No newline at end of file diff --git a/turbobasic/BINGO.BAS b/turbobasic/BINGO.BAS new file mode 100755 index 0000000..b73f6fe --- /dev/null +++ b/turbobasic/BINGO.BAS @@ -0,0 +1,8 @@ +CLS +A=0 +COLOR 4,15 +SCREEN 1 +A=INT(RND*15) +LOCATE 2,2 +PRINT A +END \ No newline at end of file diff --git a/turbobasic/BINGO2.BAS b/turbobasic/BINGO2.BAS new file mode 100755 index 0000000..f45a7da --- /dev/null +++ b/turbobasic/BINGO2.BAS @@ -0,0 +1,10 @@ +START: +SCREEN 0 +CLS +COLOR 4,15 +B=INT(RND*(4)*10+1) +LOCATE 5,5 +PRINT B +REM LOCATE 6,6 +REM INPUT " STISKNI ENTER " ;A$ +END \ No newline at end of file diff --git a/turbobasic/BUDIK.BAS b/turbobasic/BUDIK.BAS new file mode 100755 index 0000000..1374a79 --- /dev/null +++ b/turbobasic/BUDIK.BAS @@ -0,0 +1,12 @@ +INPUT "POCET MINUT" ;M +FOR I = 1 TO M STEP 1 +PRINT "MINUTA " I +WAIT(600) +C=M-I +PRINT "ZBYVA " C " MINUT" +NEXT I +FOR J = 1 TO 15 STEP 1 +SOUND RND*200+11,12 +WAIT(15) +NEXT J +END \ No newline at end of file diff --git a/turbobasic/CH b/turbobasic/CH new file mode 100755 index 0000000..6dc15a2 --- /dev/null +++ b/turbobasic/CH @@ -0,0 +1,153 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8,0,8,7,15,15,7,8,0,8,7,15,15,7,8,0,0,8,8,8,8,8,7,7,7,7,7,7,15,15,15,15,15,7,7,7,7,7,8,8,8,8,8,8,8,8,8, +FOR A=1 TO 52 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : +CALL ANYKEY +CALL CLWD +RETURN +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : +FOR R=0 TO 4000 +NEXT R +CLS +COLOR 14,1 +FOR A=0 TO 2000 +Q=RND*55 +T=RND*55 +CIRCLE (Q,T),50 +FOR L=0 TO 5000 +NEXT L +NEXT A +LOCATE 8,23 +PRINT " KONEC " +STOP +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/CH ZABAR.BAS b/turbobasic/CH ZABAR.BAS new file mode 100755 index 0000000..076273c --- /dev/null +++ b/turbobasic/CH ZABAR.BAS @@ -0,0 +1,153 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8,9,6,9,6,2,0,1,3,5,7,9,9,7,5,3,1,0 +FOR A=1 TO 23 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : +CALL ANYKEY +CALL CLWD +RETURN +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : +FOR R=0 TO 4000 +NEXT R +CLS +COLOR 14,1 +FOR A=0 TO 2000 +Q=RND*55 +T=RND*55 +CIRCLE (Q,T),50 +FOR L=0 TO 5000 +NEXT L +NEXT A +LOCATE 8,23 +PRINT " KONEC " +STOP +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/CH.BAS b/turbobasic/CH.BAS new file mode 100755 index 0000000..394c702 --- /dev/null +++ b/turbobasic/CH.BAS @@ -0,0 +1,159 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8,0,8,7,15,15,7,8,0,8,7,15,15,7,8,0,0,8,8,8,8,8,7,7,7,7,7,7,15,15,15,15,15,7,7,7,7,7,8,8,8,8,8,8,8,8,8, +FOR A=1 TO 10 +REM ZAPLNENO 52 +REM 1 CARA 6 NEBO 7 +REM 2 CARY 13 NEBO 14 +REM PUL CARY 3 +REM PUL 2.CARY 10 +REM PUL ZAPLNENI 35 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : +CALL ANYKEY +CALL CLWD +RETURN +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : +FOR R=0 TO 4000 +NEXT R +CLS +COLOR 14,1 +FOR A=0 TO 2000 +Q=RND*55 +T=RND*55 +CIRCLE (Q,T),50 +FOR L=0 TO 5000 +NEXT L +NEXT A +LOCATE 8,23 +PRINT " KONEC " +STOP +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/CHKLIST.MS b/turbobasic/CHKLIST.MS new file mode 100755 index 0000000000000000000000000000000000000000..a4523fc684494776f9e145c1bbcbf2751562066a GIT binary patch literal 81 zcmebE)pLz-We8^QWnf@nR7jfGD|4ZWfx-RX|NkLQo_@h0dd~h3DF%)vK8-mH4E2l* a3?ZRGPX11g!C<|N3Lq&7IcA1tpcw#Bw-Q Enter; NEBO ZAPIS JINOU";S1 +IF S1=0 THEN S1= 8.2 +CLS +LOCATE 10,5 +INPUT "POCET UJETYCH km OD ZACATKU MESICE";K +CLS +LOCATE 10,5 +INPUT "STAV BENZINU - BLOKY NA ZAC. DEKADY";B +CLS +LOCATE 10,5 +INPUT "STAV BENZINU - NADRZ NA ZAC. DEKADY";B4 +CLS +LOCATE 10,5 +INPUT "CERPANE BLOKY OD ZAC. MESICE - SL.9";B1 +CLS +LOCATE 10,5 +INPUT "STAV TACHOMETRU NA ZAC. DEKADY";O +CLS +PRINT SPC(32) "DEKADA" +PRINT "===============================================================================" +PRINT " SLOUPEC 6 ! SLOUPEC 7 ! SLOUPEC 9 ! BENZIN " +PRINT " TACH.KONEC DNE ! KmDen KmCelk! ZAC DOPL CELK ! BLOKY NADRZ " +PRINT "================================================================================" +R=8:K2=0:B6=0 +FOR I =1 TO 9: R=R+1 +LOCATE 20,1 +PRINT +LOCATE 20,1 +INPUT "UDEJ POCET UJETYCH km ZA DEN";K1 +IF K1=0 THEN konec +K=K1+K:B5=B1+B5:A=(K1/100)*S1:A1=A-INT(A) +IF A1< = .7 THEN raz +IF A1> .7 THEN dva + +raz: +B3=INT(A) +GOTO tri + +dva: +B3=INT(A)+1 +GOTO tri + +tri: +LOCATE 20,1:PRINT" " +LOCATE 20,1 +PRINT"SPOTREBA/NADRZ:";B3;"/";B4;"=>DOPLNENI NADRZE?":INPUT B2 +LOCATE 20,1:PRINT " " +LOCATE 21,1:PRINT " " +B4=B4-B3+B2:B=B-B2:B5=B1+B2 +O2=O+K1 +LOCATE R-2,9:PRINT O2 +LOCATE R-2,22:PRINT K1 +LOCATE R-2,30:PRINT K +LOCATE R-2,39:PRINT B1 +LOCATE R-2,44:PRINT B2 +LOCATE R-2,49:PRINT B5 +LOCATE R-2,70:PRINT B4 +LOCATE R-2,62:PRINT B +LOCATE R-2,20:PRINT "!" +LOCATE R-2,36:PRINT "!" +LOCATE R-2,58:PRINT "!" +O=O2 +B1=B1+B2:K2=K2+K1:B6=B6+B3 +NEXT +GOTO konec + +konec: +S=S1*(K2/100) +LOCATE 20,1:PRINT " NORMOVANA SPOTREBA:";S;" " + +LOCATE 20,30:PRINT" " + +LOCATE 21,2:PRINT"SKUTECNA SPOTREBA:";B6;" " +LOCATE 22,2:PRINT"UJETE km V DEKADE:";K2;" " +LOCATE 24,15 +INPUT "KONEC = Enter ; OPAKOVANI = 1 ";A +IF A=1 GOTO pet + END \ No newline at end of file diff --git a/turbobasic/DISC-A.BAS b/turbobasic/DISC-A.BAS new file mode 100755 index 0000000..9d99274 --- /dev/null +++ b/turbobasic/DISC-A.BAS @@ -0,0 +1,2 @@ +SHELL "A:" +SHELL "DIR" \ No newline at end of file diff --git a/turbobasic/DODELAM.BAS b/turbobasic/DODELAM.BAS new file mode 100755 index 0000000..1e758a6 --- /dev/null +++ b/turbobasic/DODELAM.BAS @@ -0,0 +1,373 @@ +' Q B a s i c G o r i l l a s +' +' Copyright (C) Microsoft Corporation 1990 +' +' Your mission is to hit your opponent with the exploding banana +' by varying the angle and power of your throw, taking into account +' wind speed, gravity, and the city skyline. +' +' Speed of this game is determined by the constant SPEEDCONST. If the +' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line +' below. The larger the number the faster the game will go. +' +' To run this game, press Shift+F5. +' +' To exit QBasic, press Alt, F, X. +' +' To get help on a BASIC keyword, move the cursor to the keyword and press +' F1 or click the right mouse button. +' + +'Set default data type to integer for faster game play +DEFINT A-Z + +'Sub Declarations +DECLARE SUB DoSun (Mouth) +DECLARE SUB SetScreen () +DECLARE SUB EndGame () +DECLARE SUB Center (Row, Text$) +DECLARE SUB Intro () +DECLARE SUB SparklePause () +DECLARE SUB GetInputs (Player1$, Player2$, NumGames) +DECLARE SUB PlayGame (Player1$, Player2$, NumGames) +DECLARE SUB DoExplosion (x#, y#) +DECLARE SUB MakeCityScape (BCoor() AS ANY) +DECLARE SUB PlaceGorillas (BCoor() AS ANY) +DECLARE SUB UpdateScores (Record(), PlayerNum, Results) +DECLARE SUB DrawGorilla (x, y, arms) +DECLARE SUB GorillaIntro (Player1$, Player2$) +DECLARE SUB Rest (t#) +DECLARE SUB VictoryDance (Player) +DECLARE SUB ClearGorillas () +DECLARE SUB DrawBan (xc#, yc#, r, bc) +DECLARE FUNCTION Scl (n!) +DECLARE FUNCTION GetNum# (Row, Col) +DECLARE FUNCTION DoShot (PlayerNum, x, y) +DECLARE FUNCTION ExplodeGorilla (x#, y#) +DECLARE FUNCTION Getn# (Row, Col) +DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) +DECLARE FUNCTION CalcDelay! () + +'Make all arrays Dynamic +'$DYNAMIC + +'User-Defined TYPEs +TYPE XYPoint + XCoor AS INTEGER + YCoor AS INTEGER +END TYPE + +'Constants +CONST SPEEDCONST = 500 +CONST TRUE = -1 +CONST FALSE = NOT TRUE +CONST HITSELF = 1 +CONST BACKATTR = 0 +CONST OBJECTCOLOR = 1 +CONST WINDOWCOLOR = 14 +CONST SUNATTR = 3 +CONST SUNHAPPY = FALSE +CONST SUNSHOCK = TRUE +CONST RIGHTUP = 1 +CONST LEFTUP = 2 +CONST ARMSDOWN = 3 +STOP +END + + + + + Player1$, Player2$ - player names +' NumGames - number of games to play +SUB PlayGame (Player1$, Player2$, NumGames) + DIM BCoor(0 TO 30) AS XYPoint + DIM TotalWins(1 TO 2) + + J = 1 + + FOR i = 1 TO NumGames + + CLS + RANDOMIZE (TIMER) + CALL MakeCityScape(BCoor()) + CALL PlaceGorillas(BCoor()) + DoSun SUNHAPPY + Hit = FALSE + DO WHILE Hit = FALSE + J = 1 - J + LOCATE 1, 1 + PRINT Player1$ + LOCATE 1, (MaxCol - 1 - LEN(Player2$)) + PRINT Player2$ + Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2))) + Tosser = J + 1: Tossee = 3 - J + + 'Plot the shot. Hit is true if Gorilla gets hit. + Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser)) + + 'Reset the sun, if it got hit + IF SunHit THEN DoSun SUNHAPPY + + IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit) + LOOP + SLEEP 1 + NEXT i + + SCREEN 0 + WIDTH 80, 25 + COLOR 7, 0 + MaxCol = 80 + CLS + + Center 8, "GAME OVER!" + Center 10, "Score:" + LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1) + LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2) + Center 24, "Press any key to continue" + SparklePause + COLOR 7, 0 + CLS +END SUB + +'PlayGame: +' Plots banana shot across the screen +'Parameters: +' StartX, StartY - starting shot location +' Angle - shot angle +' Velocity - shot velocity +' PlayerNum - the banana thrower +FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) + + Angle# = Angle# / 180 * pi# 'Convert degree angle to radians + Radius = Mode MOD 7 + + InitXVel# = COS(Angle#) * Velocity + InitYVel# = SIN(Angle#) * Velocity + + oldx# = StartX + oldy# = StartY + + 'draw gorilla toss + IF PlayerNum = 1 THEN + PUT (StartX, StartY), GorL&, PSET + ELSE + PUT (StartX, StartY), GorR&, PSET + END IF + + 'throw sound + PLAY "MBo0L32A-L64CL16BL64A+" + Rest .1 + + 'redraw gorilla + PUT (StartX, StartY), GorD&, PSET + + adjust = Scl(4) 'For scaling CGA + + xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check + + Impact = FALSE + ShotInSun = FALSE + OnScreen = TRUE + PlayerHit = 0 + NeedErase = FALSE + + StartXPos = StartX + StartYPos = StartY - adjust - 3 + + IF PlayerNum = 2 THEN + StartXPos = StartXPos + Scl(25) + direction = Scl(4) + ELSE + direction = Scl(-4) + END IF + + IF Velocity < 2 THEN 'Shot too slow - hit self + x# = StartX + y# = StartY + pointval = OBJECTCOLOR + END IF + + DO WHILE (NOT Impact) AND OnScreen + + Rest .02 + + 'Erase old banana, if necessary + IF NeedErase THEN + NeedErase = FALSE + CALL DrawBan(oldx#, oldy#, oldrot, FALSE) + END IF + + x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2) + y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350) + + IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN + OnScreen = FALSE + END IF + + + IF OnScreen AND y# > 0 THEN + + 'check it + LookY = 0 + LookX = Scl(8 * (2 - PlayerNum)) + DO + pointval = POINT(x# + LookX, y# + LookY) + IF pointval = 0 THEN + Impact = FALSE + IF ShotInSun = TRUE THEN + IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE + END IF + ELSEIF pointval = SUNATTR AND y# < SunHt THEN + IF NOT SunHit THEN DoSun SUNSHOCK + SunHit = TRUE + ShotInSun = TRUE + ELSE + Impact = TRUE + END IF + LookX = LookX + direction + LookY = LookY + Scl(6) + LOOP UNTIL Impact OR LookX <> Scl(4) + + IF NOT ShotInSun AND NOT Impact THEN + 'plot it + rot = (t# * 10) MOD 4 + CALL DrawBan(x#, y#, rot, TRUE) + NeedErase = TRUE + END IF + + oldx# = x# + oldy# = y# + oldrot = rot + + END IF + + + t# = t# + .1 + + LOOP + + IF pointval <> OBJECTCOLOR AND Impact THEN + CALL DoExplosion(x# + adjust, y# + adjust) + ELSEIF pointval = OBJECTCOLOR THEN + PlayerHit = ExplodeGorilla(x#, y#) + END IF + + PlotShot = PlayerHit + +END FUNCTION + +'Rest: +' pauses the program +SUB Rest (t#) + s# = TIMER + t2# = MachSpeed * t# / SPEEDCONST + DO + LOOP UNTIL TIMER - s# > t2# +END SUB + +'Scl: +' Pass the number in to scaling for cga. If the number is a decimal, then we +' want to scale down for cga or scale up for ega. This allows a full range +' of numbers to be generated for scaling. +' (i.e. for 3 to get scaled to 1, pass in 2.9) +FUNCTION Scl (n!) + + IF n! <> INT(n!) THEN + IF Mode = 1 THEN n! = n! - 1 + END IF + IF Mode = 1 THEN + Scl = CINT(n! / 2 + .1) + ELSE + Scl = CINT(n!) + END IF + +END FUNCTION + +'SetScreen: +' Sets the appropriate color statements +SUB SetScreen + + IF Mode = 9 THEN + ExplosionColor = 2 + BackColor = 1 + PALETTE 0, 1 + PALETTE 1, 46 + PALETTE 2, 44 + PALETTE 3, 54 + PALETTE 5, 7 + PALETTE 6, 4 + PALETTE 7, 3 + PALETTE 9, 63 'Display Color + ELSE + ExplosionColor = 2 + BackColor = 0 + COLOR BackColor, 2 + + END IF + +END SUB + +'SparklePause: +' Creates flashing border for intro and game over screens +SUB SparklePause + + COLOR 4, 0 + A$ = "* * * * * * * * * * * * * * * * * " + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + WHILE INKEY$ = "" + FOR A = 1 TO 5 + LOCATE 1, 1 'print horizontal sparkles + PRINT MID$(A$, A, 80); + LOCATE 22, 1 + PRINT MID$(A$, 6 - A, 80); + + FOR b = 2 TO 21 'Print Vertical sparkles + c = (A + b) MOD 5 + IF c = 1 THEN + LOCATE b, 80 + PRINT "*"; + LOCATE 23 - b, 1 + PRINT "*"; + ELSE + LOCATE b, 80 + PRINT " "; + LOCATE 23 - b, 1 + PRINT " "; + END IF + NEXT b + NEXT A + WEND +END SUB + +'UpdateScores: +' Updates players' scores +'Parameters: +' Record - players' scores +' PlayerNum - player +' Results - results of player's shot +SUB UpdateScores (Record(), PlayerNum, Results) + IF Results = HITSELF THEN + Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1 + ELSE + Record(PlayerNum) = Record(PlayerNum) + 1 + END IF +END SUB + +'VictoryDance: +' gorilla dances after he has eliminated his opponent +'Parameters: +' Player - which gorilla is dancing +SUB VictoryDance (Player) + + FOR i# = 1 TO 4 + PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + NEXT +END SUB + + \ No newline at end of file diff --git a/turbobasic/DOOM2.BAS b/turbobasic/DOOM2.BAS new file mode 100755 index 0000000..88658e8 --- /dev/null +++ b/turbobasic/DOOM2.BAS @@ -0,0 +1,586 @@ +print "-------------------------------------------------------------------------------" +shell "cd c:\" + print " c************************************************************************************************************* " +shell "cd hry2" + print " hry2*********************************************************************************************************************** " +shell "cd doom2" + print " doom2*********************************************************************************************************************** " +shell "doom2.exe" + print " ********************************************************************************************************************** " + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +end \ No newline at end of file diff --git a/turbobasic/GORILLA.BAS b/turbobasic/GORILLA.BAS new file mode 100755 index 0000000..4948055 --- /dev/null +++ b/turbobasic/GORILLA.BAS @@ -0,0 +1,1135 @@ +' Q B a s i c G o r i l l a s +' +' Copyright (C) Microsoft Corporation 1990 +' +' Your mission is to hit your opponent with the exploding banana +' by varying the angle and power of your throw, taking into account +' wind speed, gravity, and the city skyline. +' +' Speed of this game is determined by the constant SPEEDCONST. If the +' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line +' below. The larger the number the faster the game will go. +' +' To run this game, press Shift+F5. +' +' To exit QBasic, press Alt, F, X. +' +' To get help on a BASIC keyword, move the cursor to the keyword and press +' F1 or click the right mouse button. +' + +'Set default data type to integer for faster game play +DEFINT A-Z + +'Sub Declarations +DECLARE SUB DoSun (Mouth) +DECLARE SUB SetScreen () +DECLARE SUB EndGame () +DECLARE SUB Center (Row, Text$) +DECLARE SUB Intro () +DECLARE SUB SparklePause () +DECLARE SUB GetInputs (Player1$, Player2$, NumGames) +DECLARE SUB PlayGame (Player1$, Player2$, NumGames) +DECLARE SUB DoExplosion (x#, y#) +DECLARE SUB MakeCityScape (BCoor() AS ANY) +DECLARE SUB PlaceGorillas (BCoor() AS ANY) +DECLARE SUB UpdateScores (Record(), PlayerNum, Results) +DECLARE SUB DrawGorilla (x, y, arms) +DECLARE SUB GorillaIntro (Player1$, Player2$) +DECLARE SUB Rest (t#) +DECLARE SUB VictoryDance (Player) +DECLARE SUB ClearGorillas () +DECLARE SUB DrawBan (xc#, yc#, r, bc) +DECLARE FUNCTION Scl (n!) +DECLARE FUNCTION GetNum# (Row, Col) +DECLARE FUNCTION DoShot (PlayerNum, x, y) +DECLARE FUNCTION ExplodeGorilla (x#, y#) +DECLARE FUNCTION Getn# (Row, Col) +DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) +DECLARE FUNCTION CalcDelay! () + +'Make all arrays Dynamic +'$DYNAMIC + +'User-Defined TYPEs +TYPE XYPoint + XCoor AS INTEGER + YCoor AS INTEGER +END TYPE + +'Constants +CONST SPEEDCONST = 500 +CONST TRUE = -1 +CONST FALSE = NOT TRUE +CONST HITSELF = 1 +CONST BACKATTR = 0 +CONST OBJECTCOLOR = 1 +CONST WINDOWCOLOR = 14 +CONST SUNATTR = 3 +CONST SUNHAPPY = FALSE +CONST SUNSHOCK = TRUE +CONST RIGHTUP = 1 +CONST LEFTUP = 2 +CONST ARMSDOWN = 3 + +'Global Variables +DIM SHARED GorillaX(1 TO 2) 'Location of the two gorillas +DIM SHARED GorillaY(1 TO 2) +DIM SHARED LastBuilding + +DIM SHARED pi# +DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana +DIM SHARED GorD&(120) 'Graphical picture of Gorilla arms down +DIM SHARED GorL&(120) 'Gorilla left arm raised +DIM SHARED GorR&(120) 'Gorilla right arm raised + +DIM SHARED gravity# +DIM SHARED Wind + +'Screen Mode Variables +DIM SHARED ScrHeight +DIM SHARED ScrWidth +DIM SHARED Mode +DIM SHARED MaxCol + +'Screen Color Variables +DIM SHARED ExplosionColor +DIM SHARED SunColor +DIM SHARED BackColor +DIM SHARED SunHit + +DIM SHARED SunHt +DIM SHARED GHeight +DIM SHARED MachSpeed AS SINGLE + + DEF FnRan (x) = INT(RND(1) * x) + 1 + DEF SEG = 0 ' Set NumLock to ON + KeyFlags = PEEK(1047) + IF (KeyFlags AND 32) = 0 THEN + POKE 1047, KeyFlags OR 32 + END IF + DEF SEG + + GOSUB InitVars + Intro + GetInputs Name1$, Name2$, NumGames + GorillaIntro Name1$, Name2$ + PlayGame Name1$, Name2$, NumGames + + DEF SEG = 0 ' Restore NumLock state + POKE 1047, KeyFlags + DEF SEG +END + + +CGABanana: + 'BananaLeft + DATA 327686, -252645316, 60 + 'BananaDown + DATA 196618, -1057030081, 49344 + 'BananaUp + DATA 196618, -1056980800, 63 + 'BananaRight + DATA 327686, 1010580720, 240 + +EGABanana: + 'BananaLeft + DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0 + 'BananaDown + DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294 + 'BananaUp + DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239 + 'BananaRight + DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0 + +InitVars: + pi# = 4 * ATN(1#) + + 'This is a clever way to pick the best graphics mode available + ON ERROR GOTO ScreenModeError + Mode = 9 + SCREEN Mode + ON ERROR GOTO PaletteError + IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA + ON ERROR GOTO 0 + + MachSpeed = CalcDelay + + IF Mode = 9 THEN + ScrWidth = 640 + ScrHeight = 350 + GHeight = 25 + RESTORE EGABanana + REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8) + + FOR i = 0 TO 8 + READ LBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ DBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ UBan&(i) + NEXT i + + FOR i = 0 TO 8 + READ RBan&(i) + NEXT i + + SunHt = 39 + + ELSE + + ScrWidth = 320 + ScrHeight = 200 + GHeight = 12 + RESTORE CGABanana + REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2) + REDIM GorL&(20), GorD&(20), GorR&(20) + + FOR i = 0 TO 2 + READ LBan&(i) + NEXT i + FOR i = 0 TO 2 + READ DBan&(i) + NEXT i + FOR i = 0 TO 2 + READ UBan&(i) + NEXT i + FOR i = 0 TO 2 + READ RBan&(i) + NEXT i + + MachSpeed = MachSpeed * 1.3 + SunHt = 20 + END IF +RETURN + +ScreenModeError: + IF Mode = 1 THEN + CLS + LOCATE 10, 5 + PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS" + END + ELSE + Mode = 1 + RESUME + END IF + +PaletteError: + Mode = 1 '64K EGA cards will run in CGA mode. + RESUME NEXT + +REM $STATIC +'CalcDelay: +' Checks speed of the machine. +FUNCTION CalcDelay! + + s! = TIMER + DO + i! = i! + 1 + LOOP UNTIL TIMER - s! >= .5 + CalcDelay! = i! + +END FUNCTION + +' Center: +' Centers and prints a text string on a given row +' Parameters: +' Row - screen row number +' Text$ - text to be printed +' +SUB Center (Row, Text$) + Col = MaxCol \ 2 + LOCATE Row, Col - (LEN(Text$) / 2 + .5) + PRINT Text$; +END SUB + +' DoExplosion: +' Produces explosion when a shot is fired +' Parameters: +' X#, Y# - location of explosion +' +SUB DoExplosion (x#, y#) + + PLAY "MBO0L32EFGEFDC" + Radius = ScrHeight / 50 + IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41 + FOR c# = 0 TO Radius STEP Inc# + CIRCLE (x#, y#), c#, ExplosionColor + NEXT c# + FOR c# = Radius TO 0 STEP (-1 * Inc#) + CIRCLE (x#, y#), c#, BACKATTR + FOR i = 1 TO 100 + NEXT i + Rest .005 + NEXT c# +END SUB + +' DoShot: +' Controls banana shots by accepting player input and plotting +' shot angle +' Parameters: +' PlayerNum - Player +' x, y - Player's gorilla position +' +FUNCTION DoShot (PlayerNum, x, y) + + 'Input shot + IF PlayerNum = 1 THEN + LocateCol = 1 + ELSE + IF Mode = 9 THEN + LocateCol = 66 + ELSE + LocateCol = 26 + END IF + END IF + + LOCATE 2, LocateCol + PRINT "Angle:"; + Angle# = GetNum#(2, LocateCol + 7) + + LOCATE 3, LocateCol + PRINT "Velocity:"; + Velocity = GetNum#(3, LocateCol + 10) + + IF PlayerNum = 2 THEN + Angle# = 180 - Angle# + END IF + + 'Erase input + FOR i = 1 TO 4 + LOCATE i, 1 + PRINT SPACE$(30 \ (80 \ MaxCol)); + LOCATE i, (50 \ (80 \ MaxCol)) + PRINT SPACE$(30 \ (80 \ MaxCol)); + NEXT + + SunHit = FALSE + PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum) + IF PlayerHit = 0 THEN + DoShot = FALSE + ELSE + DoShot = TRUE + IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum + VictoryDance PlayerNum + END IF + +END FUNCTION + +' DoSun: +' Draws the sun at the top of the screen. +' Parameters: +' Mouth - If TRUE draws "O" mouth else draws a smile mouth. +' +SUB DoSun (Mouth) + + 'set position of sun + x = ScrWidth \ 2: y = Scl(25) + + 'clear old sun + LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF + + 'draw new sun: + 'body + CIRCLE (x, y), Scl(12), SUNATTR + PAINT (x, y), SUNATTR + + 'rays + LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR + LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR + + LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR + LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR + + LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR + LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR + + LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR + LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR + + 'mouth + IF Mouth THEN 'draw "o" mouth + CIRCLE (x, y + Scl(5)), Scl(2.9), 0 + PAINT (x, y + Scl(5)), 0, 0 + ELSE 'draw smile + CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180) + END IF + + 'eyes + CIRCLE (x - 3, y - 2), 1, 0 + CIRCLE (x + 3, y - 2), 1, 0 + PSET (x - 3, y - 2), 0 + PSET (x + 3, y - 2), 0 + +END SUB + +'DrawBan: +' Draws the banana +'Parameters: +' xc# - Horizontal Coordinate +' yc# - Vertical Coordinate +' r - rotation position (0-3). ( \_/ ) /-\ +' bc - if TRUE then DrawBan draws the banana ELSE it erases the banana +SUB DrawBan (xc#, yc#, r, bc) + +SELECT CASE r + CASE 0 + IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR + CASE 1 + IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR + CASE 2 + IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR + CASE 3 + IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR +END SELECT + +END SUB + +'DrawGorilla: +' Draws the Gorilla in either CGA or EGA mode +' and saves the graphics data in an array. +'Parameters: +' x - x coordinate of gorilla +' y - y coordinate of the gorilla +' arms - either Left up, Right up, or both down +SUB DrawGorilla (x, y, arms) + DIM i AS SINGLE ' Local index must be single precision + + 'draw head + LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF + LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF + + 'draw eyes/brow + LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0 + + 'draw nose if ega + IF Mode = 9 THEN + FOR i = -2 TO -1 + PSET (x + i, y + 4), 0 + PSET (x + i + 3, y + 4), 0 + NEXT i + END IF + + 'neck + LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR + + 'body + LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF + LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF + + 'legs + FOR i = 0 TO 4 + CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8 + CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4 + NEXT + + 'chest + CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0 + CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2 + + FOR i = -5 TO -1 + SELECT CASE arms + CASE 1 + 'Right arm up + CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR& + CASE 2 + 'Left arm up + CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL& + CASE 3 + 'Both arms down + CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4 + CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4 + GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD& + END SELECT + NEXT i +END SUB + +'ExplodeGorilla: +' Causes gorilla explosion when a direct hit occurs +'Parameters: +' X#, Y# - shot location +FUNCTION ExplodeGorilla (x#, y#) + YAdj = Scl(12) + XAdj = Scl(5) + SclX# = ScrWidth / 320 + SclY# = ScrHeight / 200 + IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2 + PLAY "MBO0L16EFGEFDC" + + FOR i = 1 TO 8 * SclX# + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57 + LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor + NEXT i + + FOR i = 1 TO 16 * SclX# + IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57 + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57 + NEXT i + + FOR i = 24 * SclX# TO 1 STEP -1 + CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57 + FOR Count = 1 TO 200 + NEXT + NEXT i + + ExplodeGorilla = PlayerHit +END FUNCTION + +'GetInputs: +' Gets user inputs at beginning of game +'Parameters: +' Player1$, Player2$ - player names +' NumGames - number of games to play +SUB GetInputs (Player1$, Player2$, NumGames) + COLOR 7, 0 + CLS + + LOCATE 8, 15 + LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$ + IF Player1$ = "" THEN + Player1$ = "Player 1" + ELSE + Player1$ = LEFT$(Player1$, 10) + END IF + + LOCATE 10, 15 + LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$ + IF Player2$ = "" THEN + Player2$ = "Player 2" + ELSE + Player2$ = LEFT$(Player2$, 10) + END IF + + DO + LOCATE 12, 56: PRINT SPACE$(25); + LOCATE 12, 13 + INPUT "Play to how many total points (Default = 3)"; game$ + NumGames = VAL(LEFT$(game$, 2)) + LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0 + IF NumGames = 0 THEN NumGames = 3 + + DO + LOCATE 14, 53: PRINT SPACE$(28); + LOCATE 14, 17 + INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$ + gravity# = VAL(grav$) + LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0 + IF gravity# = 0 THEN gravity# = 9.8 +END SUB + +'GetNum: +' Gets valid numeric input from user +'Parameters: +' Row, Col - location to echo input +FUNCTION GetNum# (Row, Col) + Result$ = "" + Done = FALSE + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + DO WHILE NOT Done + + LOCATE Row, Col + PRINT Result$; CHR$(95); " "; + + Kbd$ = INKEY$ + SELECT CASE Kbd$ + CASE "0" TO "9" + Result$ = Result$ + Kbd$ + CASE "." + IF INSTR(Result$, ".") = 0 THEN + Result$ = Result$ + Kbd$ + END IF + CASE CHR$(13) + IF VAL(Result$) > 360 THEN + Result$ = "" + ELSE + Done = TRUE + END IF + CASE CHR$(8) + IF LEN(Result$) > 0 THEN + Result$ = LEFT$(Result$, LEN(Result$) - 1) + END IF + CASE ELSE + IF LEN(Kbd$) > 0 THEN + BEEP + END IF + END SELECT + LOOP + + LOCATE Row, Col + PRINT Result$; " "; + + GetNum# = VAL(Result$) +END FUNCTION + +'GorillaIntro: +' Displays gorillas on screen for the first time +' allows the graphical data to be put into an array +'Parameters: +' Player1$, Player2$ - The names of the players +' +SUB GorillaIntro (Player1$, Player2$) + LOCATE 16, 34: PRINT "--------------" + LOCATE 18, 34: PRINT "V = View Intro" + LOCATE 19, 34: PRINT "P = Play Game" + LOCATE 21, 35: PRINT "Your Choice?" + + DO WHILE Char$ = "" + Char$ = INKEY$ + LOOP + + IF Mode = 1 THEN + x = 125 + y = 100 + ELSE + x = 278 + y = 175 + END IF + + SCREEN Mode + SetScreen + + IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn." + + VIEW PRINT 9 TO 24 + + IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor + + DrawGorilla x, y, ARMSDOWN + CLS 2 + DrawGorilla x, y, LEFTUP + CLS 2 + DrawGorilla x, y, RIGHTUP + CLS 2 + + VIEW PRINT 1 TO 25 + IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46 + + IF UCASE$(Char$) = "V" THEN + Center 2, "Q B A S I C G O R I L L A S" + Center 5, " STARRING: " + P$ = Player1$ + " AND " + Player2$ + Center 7, P$ + + PUT (x - 13, y), GorD&, PSET + PUT (x + 47, y), GorD&, PSET + Rest 1 + + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b" + Rest .3 + + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-" + Rest .3 + + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-" + Rest .3 + + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b" + Rest .3 + + FOR i = 1 TO 4 + PUT (x - 13, y), GorL&, PSET + PUT (x + 47, y), GorR&, PSET + PLAY "T160O0L32EFGEFDC" + Rest .1 + PUT (x - 13, y), GorR&, PSET + PUT (x + 47, y), GorL&, PSET + PLAY "T160O0L32EFGEFDC" + Rest .1 + NEXT + END IF +END SUB + +'Intro: +' Displays game introduction +SUB Intro + + SCREEN 0 + WIDTH 80, 25 + MaxCol = 80 + COLOR 15, 0 + CLS + + Center 4, "Q B a s i c G O R I L L A S" + COLOR 7 + Center 6, "Copyright (C) Microsoft Corporation 1990" + Center 8, "Your mission is to hit your opponent with the exploding" + Center 9, "banana by varying the angle and power of your throw, taking" + Center 10, "into account wind speed, gravity, and the city skyline." + Center 11, "The wind speed is shown by a directional arrow at the bottom" + Center 12, "of the playing field, its length relative to its strength." + Center 24, "Press any key to continue" + + PLAY "MBT160O1L8CDEDCDL4ECC" + SparklePause + IF Mode = 1 THEN MaxCol = 40 +END SUB + +'MakeCityScape: +' Creates random skyline for game +'Parameters: +' BCoor() - a user-defined type array which stores the coordinates of +' the upper left corner of each building. +SUB MakeCityScape (BCoor() AS XYPoint) + + x = 2 + + 'Set the sloping trend of the city scape. NewHt is new building height + Slope = FnRan(6) + SELECT CASE Slope + CASE 1: NewHt = 15 'Upward slope + CASE 2: NewHt = 130 'Downward slope + CASE 3 TO 5: NewHt = 15 '"V" slope - most common + CASE 6: NewHt = 130 'Inverted "V" slope + END SELECT + + IF Mode = 9 THEN + BottomLine = 335 'Bottom of building + HtInc = 10 'Increase value for new height + DefBWidth = 37 'Default building height + RandomHeight = 120 'Random height difference + WWidth = 3 'Window width + WHeight = 6 'Window height + WDifV = 15 'Counter for window spacing - vertical + WDifh = 10 'Counter for window spacing - horizontal + ELSE + BottomLine = 190 + HtInc = 6 + NewHt = NewHt * 20 \ 35 'Adjust for CGA + DefBWidth = 18 + RandomHeight = 54 + WWidth = 1 + WHeight = 2 + WDifV = 5 + WDifh = 4 + END IF + + CurBuilding = 1 + DO + + SELECT CASE Slope + CASE 1 + NewHt = NewHt + HtInc + CASE 2 + NewHt = NewHt - HtInc + CASE 3 TO 5 + IF x > ScrWidth \ 2 THEN + NewHt = NewHt - 2 * HtInc + ELSE + NewHt = NewHt + 2 * HtInc + END IF + CASE 4 + IF x > ScrWidth \ 2 THEN + NewHt = NewHt + 2 * HtInc + ELSE + NewHt = NewHt - 2 * HtInc + END IF + END SELECT + + 'Set width of building and check to see if it would go off the screen + BWidth = FnRan(DefBWidth) + DefBWidth + IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2 + + 'Set height of building and check to see if it goes below screen + BHeight = FnRan(RandomHeight) + NewHt + IF BHeight < HtInc THEN BHeight = HtInc + + 'Check to see if Building is too high + IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5 + + 'Set the coordinates of the building into the array + BCoor(CurBuilding).XCoor = x + BCoor(CurBuilding).YCoor = BottomLine - BHeight + + IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2 + + 'Draw the building, outline first, then filled + LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B + LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF + + 'Draw the windows + c = x + 3 + DO + FOR i = BHeight - 3 TO 7 STEP -WDifV + IF Mode <> 9 THEN + WinColr = (FnRan(2) - 2) * -3 + ELSEIF FnRan(4) = 1 THEN + WinColr = 8 + ELSE + WinColr = WINDOWCOLOR + END IF + LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF + NEXT + c = c + WDifh + LOOP UNTIL c >= x + BWidth - 3 + + x = x + BWidth + 2 + + CurBuilding = CurBuilding + 1 + + LOOP UNTIL x > ScrWidth - HtInc + + LastBuilding = CurBuilding - 1 + + 'Set Wind speed + Wind = FnRan(10) - 5 + IF FnRan(3) = 1 THEN + IF Wind > 0 THEN + Wind = Wind + FnRan(10) + ELSE + Wind = Wind - FnRan(10) + END IF + END IF + + 'Draw Wind speed arrow + IF Wind <> 0 THEN + WindLine = Wind * 3 * (ScrWidth \ 320) + LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor + IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2 + LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor + LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor + END IF +END SUB + +'PlaceGorillas: +' PUTs the Gorillas on top of the buildings. Must have drawn +' Gorillas first. +'Parameters: +' BCoor() - user-defined TYPE array which stores upper left coordinates +' of each building. +SUB PlaceGorillas (BCoor() AS XYPoint) + + IF Mode = 9 THEN + XAdj = 14 + YAdj = 30 + ELSE + XAdj = 7 + YAdj = 16 + END IF + SclX# = ScrWidth / 320 + SclY# = ScrHeight / 200 + + 'Place gorillas on second or third building from edge + FOR i = 1 TO 2 + IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2) + + BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor + GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj + GorillaY(i) = BCoor(BNum).YCoor - YAdj + PUT (GorillaX(i), GorillaY(i)), GorD&, PSET + NEXT i + +END SUB + +'PlayGame: +' Main game play routine +'Parameters: +' Player1$, Player2$ - player names +' NumGames - number of games to play +SUB PlayGame (Player1$, Player2$, NumGames) + DIM BCoor(0 TO 30) AS XYPoint + DIM TotalWins(1 TO 2) + + J = 1 + + FOR i = 1 TO NumGames + + CLS + RANDOMIZE (TIMER) + CALL MakeCityScape(BCoor()) + CALL PlaceGorillas(BCoor()) + DoSun SUNHAPPY + Hit = FALSE + DO WHILE Hit = FALSE + J = 1 - J + LOCATE 1, 1 + PRINT Player1$ + LOCATE 1, (MaxCol - 1 - LEN(Player2$)) + PRINT Player2$ + Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2))) + Tosser = J + 1: Tossee = 3 - J + + 'Plot the shot. Hit is true if Gorilla gets hit. + Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser)) + + 'Reset the sun, if it got hit + IF SunHit THEN DoSun SUNHAPPY + + IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit) + LOOP + SLEEP 1 + NEXT i + + SCREEN 0 + WIDTH 80, 25 + COLOR 7, 0 + MaxCol = 80 + CLS + + Center 8, "GAME OVER!" + Center 10, "Score:" + LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1) + LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2) + Center 24, "Press any key to continue" + SparklePause + COLOR 7, 0 + CLS +END SUB + +'PlayGame: +' Plots banana shot across the screen +'Parameters: +' StartX, StartY - starting shot location +' Angle - shot angle +' Velocity - shot velocity +' PlayerNum - the banana thrower +FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum) + + Angle# = Angle# / 180 * pi# 'Convert degree angle to radians + Radius = Mode MOD 7 + + InitXVel# = COS(Angle#) * Velocity + InitYVel# = SIN(Angle#) * Velocity + + oldx# = StartX + oldy# = StartY + + 'draw gorilla toss + IF PlayerNum = 1 THEN + PUT (StartX, StartY), GorL&, PSET + ELSE + PUT (StartX, StartY), GorR&, PSET + END IF + + 'throw sound + PLAY "MBo0L32A-L64CL16BL64A+" + Rest .1 + + 'redraw gorilla + PUT (StartX, StartY), GorD&, PSET + + adjust = Scl(4) 'For scaling CGA + + xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check + + Impact = FALSE + ShotInSun = FALSE + OnScreen = TRUE + PlayerHit = 0 + NeedErase = FALSE + + StartXPos = StartX + StartYPos = StartY - adjust - 3 + + IF PlayerNum = 2 THEN + StartXPos = StartXPos + Scl(25) + direction = Scl(4) + ELSE + direction = Scl(-4) + END IF + + IF Velocity < 2 THEN 'Shot too slow - hit self + x# = StartX + y# = StartY + pointval = OBJECTCOLOR + END IF + + DO WHILE (NOT Impact) AND OnScreen + + Rest .02 + + 'Erase old banana, if necessary + IF NeedErase THEN + NeedErase = FALSE + CALL DrawBan(oldx#, oldy#, oldrot, FALSE) + END IF + + x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2) + y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350) + + IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN + OnScreen = FALSE + END IF + + + IF OnScreen AND y# > 0 THEN + + 'check it + LookY = 0 + LookX = Scl(8 * (2 - PlayerNum)) + DO + pointval = POINT(x# + LookX, y# + LookY) + IF pointval = 0 THEN + Impact = FALSE + IF ShotInSun = TRUE THEN + IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE + END IF + ELSEIF pointval = SUNATTR AND y# < SunHt THEN + IF NOT SunHit THEN DoSun SUNSHOCK + SunHit = TRUE + ShotInSun = TRUE + ELSE + Impact = TRUE + END IF + LookX = LookX + direction + LookY = LookY + Scl(6) + LOOP UNTIL Impact OR LookX <> Scl(4) + + IF NOT ShotInSun AND NOT Impact THEN + 'plot it + rot = (t# * 10) MOD 4 + CALL DrawBan(x#, y#, rot, TRUE) + NeedErase = TRUE + END IF + + oldx# = x# + oldy# = y# + oldrot = rot + + END IF + + + t# = t# + .1 + + LOOP + + IF pointval <> OBJECTCOLOR AND Impact THEN + CALL DoExplosion(x# + adjust, y# + adjust) + ELSEIF pointval = OBJECTCOLOR THEN + PlayerHit = ExplodeGorilla(x#, y#) + END IF + + PlotShot = PlayerHit + +END FUNCTION + +'Rest: +' pauses the program +SUB Rest (t#) + s# = TIMER + t2# = MachSpeed * t# / SPEEDCONST + DO + LOOP UNTIL TIMER - s# > t2# +END SUB + +'Scl: +' Pass the number in to scaling for cga. If the number is a decimal, then we +' want to scale down for cga or scale up for ega. This allows a full range +' of numbers to be generated for scaling. +' (i.e. for 3 to get scaled to 1, pass in 2.9) +FUNCTION Scl (n!) + + IF n! <> INT(n!) THEN + IF Mode = 1 THEN n! = n! - 1 + END IF + IF Mode = 1 THEN + Scl = CINT(n! / 2 + .1) + ELSE + Scl = CINT(n!) + END IF + +END FUNCTION + +'SetScreen: +' Sets the appropriate color statements +SUB SetScreen + + IF Mode = 9 THEN + ExplosionColor = 2 + BackColor = 1 + PALETTE 0, 1 + PALETTE 1, 46 + PALETTE 2, 44 + PALETTE 3, 54 + PALETTE 5, 7 + PALETTE 6, 4 + PALETTE 7, 3 + PALETTE 9, 63 'Display Color + ELSE + ExplosionColor = 2 + BackColor = 0 + COLOR BackColor, 2 + + END IF + +END SUB + +'SparklePause: +' Creates flashing border for intro and game over screens +SUB SparklePause + + COLOR 4, 0 + A$ = "* * * * * * * * * * * * * * * * * " + WHILE INKEY$ <> "": WEND 'Clear keyboard buffer + + WHILE INKEY$ = "" + FOR A = 1 TO 5 + LOCATE 1, 1 'print horizontal sparkles + PRINT MID$(A$, A, 80); + LOCATE 22, 1 + PRINT MID$(A$, 6 - A, 80); + + FOR b = 2 TO 21 'Print Vertical sparkles + c = (A + b) MOD 5 + IF c = 1 THEN + LOCATE b, 80 + PRINT "*"; + LOCATE 23 - b, 1 + PRINT "*"; + ELSE + LOCATE b, 80 + PRINT " "; + LOCATE 23 - b, 1 + PRINT " "; + END IF + NEXT b + NEXT A + WEND +END SUB + +'UpdateScores: +' Updates players' scores +'Parameters: +' Record - players' scores +' PlayerNum - player +' Results - results of player's shot +SUB UpdateScores (Record(), PlayerNum, Results) + IF Results = HITSELF THEN + Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1 + ELSE + Record(PlayerNum) = Record(PlayerNum) + 1 + END IF +END SUB + +'VictoryDance: +' gorilla dances after he has eliminated his opponent +'Parameters: +' Player - which gorilla is dancing +SUB VictoryDance (Player) + + FOR i# = 1 TO 4 + PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET + PLAY "MFO0L32EFGEFDC" + Rest .2 + NEXT +END SUB + diff --git a/turbobasic/GRANATOM.BAS b/turbobasic/GRANATOM.BAS new file mode 100755 index 0000000..23a0890 --- /dev/null +++ b/turbobasic/GRANATOM.BAS @@ -0,0 +1,19 @@ +CLS +SCREEN 0 +COLOR 15,0 +LOCATE 2,2 +PRINT "GRAN TOMET M  GRAN TY(viz hvØzdy)JEN NA JEDEN D VKOV¡ VìSTýEL :*****" +LOCATE 3,2 +INPUT " M -LI SE VYSTýELIT STISKNI *ENTER* " ;V +FOR A=2 TO 71 +FOR I=0 TO 600 +NEXT I +CLS +LOCATE 10,A +PRINT "*" +NEXT A +LOCATE 10,69 +PRINT "XO*OX" +FOR K2=0 TO 550 +NEXT K2 +END \ No newline at end of file diff --git a/turbobasic/HESLO.BAS b/turbobasic/HESLO.BAS new file mode 100755 index 0000000..4077caa --- /dev/null +++ b/turbobasic/HESLO.BAS @@ -0,0 +1,11 @@ +cls +open "heslo.dta" For random AS #1 +c$=input$(137,#1) +b$=mid$(C$,129,7) +input "Zadej vstupni heslo"; a$ + if a$=b$ then end + shell "date>>HESLO.TXT" + shell "K>>HESLO.TXT" + shell "KONEC" +end + \ No newline at end of file diff --git a/turbobasic/HESLO.DTA b/turbobasic/HESLO.DTA new file mode 100755 index 0000000..aeb0309 --- /dev/null +++ b/turbobasic/HESLO.DTA @@ -0,0 +1,7 @@ +brave38 + +NA PRVNI RADCE MUSI BYT OD ZACATKU NAPSANO VZDY SLOVO DLOUHE 7 ZNAKU !!! + Dalsi budou ignorovany. + Odpoved musi byt zapsana STEJNOU VELIKOSTI pisma. + + \ No newline at end of file diff --git a/turbobasic/HESLO.TXT b/turbobasic/HESLO.TXT new file mode 100755 index 0000000..57fb43d --- /dev/null +++ b/turbobasic/HESLO.TXT @@ -0,0 +1,9 @@ + + *************************************** + * Hlaseni o pokusu narusit ochranu * + *************************************** +Current date is Wed 30/10/1991 +Enter new date (dd-mm-yy): +Current time is 8:45:28,27 +Enter new time: +****** diff --git a/turbobasic/HMOTNOST.BAS b/turbobasic/HMOTNOST.BAS new file mode 100755 index 0000000..646472b --- /dev/null +++ b/turbobasic/HMOTNOST.BAS @@ -0,0 +1,45 @@ +cls +screen 9 +screen 0 +color 0,15 +cls +locate 2,2 +input "Jaka je hustota telesa (g/cm3) " ;hmotnost +cls +locate 2,2 +input "Jaky je objem telesa (cm3 - ml) " ;objem + +screen 9 +cls +locate 20,20 +print "POCITAM!" +locate 2,2 +print "TENTO PROGRAM NAPROGRMOVAL TOMAS MUDRUNKA." +delay 2 +screen 0 +hustota=hmotnost*objem +cls + +print "hustota....."hmotnost " g/cm3" +print "objem......."objem " cm3" +print "hmotnost.....? g" +print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" +print "hmotnost = hustota . objem" +print "hmotnost = "hmotnost" g . "objem " cm3" +print "hmotnost = "hustota" g/cm3" +print "" +print "Hmotnost daneho telesa je "hustota" g/cm3." +print "" +print "" +print "" +print "" +print "" +print "" +print "" +print "" +print "TENTO PROGRAM NAPSAL.... TOMAS MUDRUNKA" +PRINT "SPOLECNOST.............. X-TOM" +input "Mas uz tabulku opsanou " ;konec$ + + +end \ No newline at end of file diff --git a/turbobasic/HUSTOTA.BAS b/turbobasic/HUSTOTA.BAS new file mode 100755 index 0000000..eba33e6 --- /dev/null +++ b/turbobasic/HUSTOTA.BAS @@ -0,0 +1,45 @@ +cls +screen 9 +screen 0 +color 0,15 +cls +locate 2,2 +input "Jaka je hmotnost telesa (g) " ;hmotnost +cls +locate 2,2 +input "Jaky je objem telesa (cm3 - ml) " ;objem + +screen 9 +cls +locate 20,20 +print "POCITAM!" +locate 2,2 +print "TENTO PROGRAM NAPROGRMOVAL TOMAS MUDRUNKA." +delay 2 +screen 0 +hustota=hmotnost/objem +cls + +print "hmotnost...."hmotnost " g" +print "objem......."objem " cm3" +print "hustota.....? g/cm3" +print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ" +print "hustota = m:V" +print "hustota = "hmotnost" g:"objem " cm3" +print "hustota = "hustota" g/cm3" +print "" +print "Hustota daneho telesa je "hustota" g/cm3." +print "" +print "" +print "" +print "" +print "" +print "" +print "" +print "" +print "TENTO PROGRAM NAPSAL.... TOMAS MUDRUNKA" +PRINT "SPOLECNOST.............. X-TOM" +input "Mas uz tabulku opsanou " ;konec$ + + +end \ No newline at end of file diff --git a/turbobasic/INKEY.BAS b/turbobasic/INKEY.BAS new file mode 100755 index 0000000..c133a19 --- /dev/null +++ b/turbobasic/INKEY.BAS @@ -0,0 +1,16 @@ +cls + +FOR I=1 TO 100 +A$=INKEY$ +IF LEN(A$)<>0 THEN ANO +PRINT A$ +NEXT I + +GOTO NE + +ANO: +PRINT " ANO " +END + +NE: +PRINT " NE " \ No newline at end of file diff --git a/turbobasic/INSTALAC.BAS b/turbobasic/INSTALAC.BAS new file mode 100755 index 0000000..bed965a --- /dev/null +++ b/turbobasic/INSTALAC.BAS @@ -0,0 +1,4 @@ +SHELL "MKDIR C:/ CD MUDPROG" +SHELL "COPY CD A: TO CD C:/CD MUDPROG" +SHELL "DEL CD C:/ CD MUDPROG/INSTALAC.EXE" +END \ No newline at end of file diff --git a/turbobasic/JMENOVKA.BAS b/turbobasic/JMENOVKA.BAS new file mode 100755 index 0000000..876c357 --- /dev/null +++ b/turbobasic/JMENOVKA.BAS @@ -0,0 +1,10 @@ +COLOR 14,1 +LOCATE 5,5 +SCREEN 1 +PRINT " FLOPI DISC " +LOCATE 20,20 +REM SCREEN 1 +PRINT " TOMµæ MUDRUÕKA " +FOR TOMAS=0 TO 1000000 +NEXT TOMAS +END \ No newline at end of file diff --git a/turbobasic/KALK.BAS b/turbobasic/KALK.BAS new file mode 100755 index 0000000..e12565f --- /dev/null +++ b/turbobasic/KALK.BAS @@ -0,0 +1,9 @@ +CLS +SCREEN 9 +COLOR 3,15 +LOCATE 2,2 +INPUT " Pü¡KLAD (BEZ*=*) " ;A +CLS +LOCATE 2,2 +PRINT " = " A +END \ No newline at end of file diff --git a/turbobasic/KALKUL-S.BAS b/turbobasic/KALKUL-S.BAS new file mode 100755 index 0000000..9d6b04e --- /dev/null +++ b/turbobasic/KALKUL-S.BAS @@ -0,0 +1,25 @@ +S1=0 +S2=0 +V=0 +CLS + FOR O=1 TO 20 +COLOR 0,15 +SCREEN 0 +LOCATE 2,2 + INPUT " S¬ÖTANEC= " ;S1 +LOCATE 23,23 + INPUT " " ;K$ +IF K$="X" THEN GOTO KONEC +LOCATE 3,2 + PRINT " + " +LOCATE 4,2 + INPUT " S¬ÖTANEC= " ;S2 +LOCATE 5,2 + PRINT " = " +V=S1+S2 +LOCATE 6,2 +PRINT V + NEXT O +GOTO KONEC +KONEC: +END \ No newline at end of file diff --git a/turbobasic/LINE.BAS b/turbobasic/LINE.BAS new file mode 100755 index 0000000..11ea7d4 --- /dev/null +++ b/turbobasic/LINE.BAS @@ -0,0 +1,232 @@ + GOTO POKR + +POKR : +SCREEN 0 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +REM zadani polozek adresare +DO + A$="NASOB AHOJ POZDR NASO2 KONEC " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC +LOOP + +'----------------------------------------------------------------------------- +TEXT : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +NASOB : +SCREEN 0 +CLS +SOUND RND*1000+20,70 +COLOR 4,15 +N=0 +S=0 +V=0 +SOUND RND*300+12,13 +SOUND RND*10000+12,13 +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +SOUND RND*10000+12,13 +S=S+1 +GOTO VOLBA +SOUND RND*100+12,13 +ANO: +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +REM pise chybu sound rnd*100+12,13 +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlac klavesu Enter" +end +'----------------------------------------------------------------------------- +NIC1 : +A$="Zdravi Vas Tomas Mudrunka" +CALL ECHO (5,16,A$,13) +A$="Jak se mate?" +CALL ECHO (7,17,A$,13) +A$="Jak se Vam libi tento program?" +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +NASOB2 : + +SCREEN 0 +CLS +rem SOUND RND*1000+20,70 +COLOR 4,15 +S=0 +V=0 +rem SOUND RND*300+12,13 +rem SOUND RND*10000+12,13 + +FOR I=1 TO 10 + rem nechat pokud nebude vadit CLS + LOCATE 4,20 + PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU" + + A=INT(RND(5)*10+1) + B=INT(RND(4)*10+1) + LOCATE 10,5 + REM vymaze radek + PRINT " " + PRINT " " + LOCATE 10,5 + PRINT "NAPIS VYSLEDEK" A "x" B "=" + INPUT " STISKNI ENTER";C + D=A*B + + IF D=C THEN ANO2 + PRINT " SPATNY VYSLEDEK" + rem SOUND RND*10000+12,13 + S=S+1 + GOTO VOLBA2 + rem SOUND RND*100+12,13 + ANO2: + PRINT " SPRAVNE" + V=V+1 + VOLBA2: + LOCATE 18,10 + PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + REM zdrzeni programu + FOR G=1 TO 10 + rem SOUND RND*1000+12,13 + NEXT G +NEXT I + +LOCATE 18,10 +PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +LOCATE 20,10 +PRINT "VYSLEDNA ZNAMKA" T + +Input "Ukonci stiskem klavesy ENTER";A +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/LINES.BAS b/turbobasic/LINES.BAS new file mode 100755 index 0000000..4079efc --- /dev/null +++ b/turbobasic/LINES.BAS @@ -0,0 +1,7 @@ +CLS +color 2,3 +SCREEN 8 +LINE (3,3)-(319,119),,B +LINE (55,1)-(1,50) +CIRCLE (200,100),50,3 +CIRCLE (100,100),50, , , , 5/18 \ No newline at end of file diff --git a/turbobasic/LOSO2.BAS b/turbobasic/LOSO2.BAS new file mode 100755 index 0000000..8e5a152 --- /dev/null +++ b/turbobasic/LOSO2.BAS @@ -0,0 +1,23 @@ +CLS +A=0 +M=1000000 +START: +A=A+1 + +COLOR 14,1 +SCREEN 0 +LOCATE 2,2 +PRINT "LOSUJI" +B$=INKEY$ +IF A>M THEN KONEC +IF LEN(B$)=0 THEN GOTO START +IF B$<>"0" THEN GOTO KONEC + +KONEC: +IF A>M THEN PRINT"LOSOVANI JE NEPLATNE !" +PRINT "VYLOSOVANE CISLO JE" A +INPUT;f +FOR I=0 TO 2000 +NEXT I +STOP +END \ No newline at end of file diff --git a/turbobasic/LOSO9.BAS b/turbobasic/LOSO9.BAS new file mode 100755 index 0000000..4f6203c --- /dev/null +++ b/turbobasic/LOSO9.BAS @@ -0,0 +1,10 @@ +CLS +SCREEN 0 +COLOR 14,1 +T=TIMER +T=T*2 +G=RND*30 +D=T+G +PRINT D +STOP +END \ No newline at end of file diff --git a/turbobasic/LOVEC.BAS b/turbobasic/LOVEC.BAS new file mode 100755 index 0000000..1c16671 --- /dev/null +++ b/turbobasic/LOVEC.BAS @@ -0,0 +1,29 @@ +LET N = 5 +LET G = 10 +LET NALEZ = 0 +LET I = 0 +LET A = INT(G * RND) +LET B = INT(G * RND) +OLAL: + +IF NOT ( NALEZ = 0 AND I <= 5) THEN GOTO FEDO +INPUT "X,Y" ;X,Y +IF ABS (X-A)+ABS(Y-B)=0 THEN GOTO FEDOS +GOSUB FEDOE +GOTO OLA +FEDOS: +PRINT "ZVIRE NALEZENO:";A,B +LET NALEZ = 1 +OLA : +LET I = I+1 +GOTO OLAL +END +FEDOE: +PRINT "JDI NA "; +IF X < A +IF X > A +IF X <> A +IF +IF +RETURN + \ No newline at end of file diff --git a/turbobasic/MENU-VZ.BAS b/turbobasic/MENU-VZ.BAS new file mode 100755 index 0000000..b7bd296 --- /dev/null +++ b/turbobasic/MENU-VZ.BAS @@ -0,0 +1,139 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : + +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/MENU.BAS b/turbobasic/MENU.BAS new file mode 100755 index 0000000..b7bd296 --- /dev/null +++ b/turbobasic/MENU.BAS @@ -0,0 +1,139 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFON DIR exit HELP LOAD " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +DIR : + +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stla‡ kl vesu Enter" +end +'----------------------------------------------------------------------------- +HELP : +A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se" +CALL ECHO (5,16,A$,13) +A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat" +CALL ECHO (7,17,A$,13) +A$="spojeni s jinym uzivatelem C&P NETWORK." +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/MM.BAS b/turbobasic/MM.BAS new file mode 100755 index 0000000..f0ca8f0 --- /dev/null +++ b/turbobasic/MM.BAS @@ -0,0 +1,11 @@ +cls +open "c:\util\mm.dta" For random AS #1 +c$=input$(137,#1) +b$=mid$(C$,129,7) +input "Zadej vstupni heslo"; a$ + if a$=b$ then end + shell "rem date>>c:\util\mm.TXT" + shell "rem time>>c:\util\mm.TXT" + shell "blokne PC" +end + \ No newline at end of file diff --git a/turbobasic/NAH-CISL.BAS b/turbobasic/NAH-CISL.BAS new file mode 100755 index 0000000..45730fa --- /dev/null +++ b/turbobasic/NAH-CISL.BAS @@ -0,0 +1,17 @@ +V=TIMER +PRINT V + +V=V-INT(V) +PRINT V +V=V*120 +PRINT V +V=INT(V) + +G=RND*40 +I=G+V +I=INT(V)+(G) +I=I+55 +I=INT(V)+(G)+(I) +I=INT(I) +PRINT I +END \ No newline at end of file diff --git a/turbobasic/NASOBENI.BAS b/turbobasic/NASOBENI.BAS new file mode 100755 index 0000000..fd82e76 --- /dev/null +++ b/turbobasic/NASOBENI.BAS @@ -0,0 +1,43 @@ +SCREEN 0 +COLOR 0,15 +SOUND 700,12 +N=0 +S=0 +V=0 + +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +SOUND 100,10 +S=S+1 +GOTO VOLBA + +ANO: +PRINT " SPRAVNE" +SOUND 900,8 +V=V+1 + +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI ENTER";E +IF E<>1 THEN OPET +SOUND 900,12 +SOUND 100,7 + +END + + \ No newline at end of file diff --git a/turbobasic/NASOBIT.BAS b/turbobasic/NASOBIT.BAS new file mode 100755 index 0000000..ae31bec --- /dev/null +++ b/turbobasic/NASOBIT.BAS @@ -0,0 +1,38 @@ +SCREEN 0 +COLOR 7,9 +N=0 +S=0 +V=0 + +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " A STISKNI ENTER ";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +S=S+1 +GOTO VOLBA + +ANO: +PRINT " SPRAVNE" +V=V+1 + +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET + +END + + \ No newline at end of file diff --git a/turbobasic/NASOBIT2.BAS b/turbobasic/NASOBIT2.BAS new file mode 100755 index 0000000..ef655b2 --- /dev/null +++ b/turbobasic/NASOBIT2.BAS @@ -0,0 +1,41 @@ +SCREEN 0 +CLS +SOUND RND*1000+20,70 +COLOR 4,15 +N=0 +S=0 +V=0 +SOUND RND*300+12,13 +SOUND RND*10000+12,13 +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +SOUND RND*10000+12,13 +S=S+1 +GOTO VOLBA +SOUND RND*100+12,13 +ANO: +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +sound rnd*100+12,13 +END + + \ No newline at end of file diff --git a/turbobasic/NAVOD.BAS b/turbobasic/NAVOD.BAS new file mode 100755 index 0000000..44ddc33 --- /dev/null +++ b/turbobasic/NAVOD.BAS @@ -0,0 +1,8 @@ +shell "1.waw" +shell "2.waw" +shell "3.waw" +end + + + + \ No newline at end of file diff --git a/turbobasic/NONAME.BAS b/turbobasic/NONAME.BAS new file mode 100755 index 0000000..e3a6f43 --- /dev/null +++ b/turbobasic/NONAME.BAS @@ -0,0 +1,9 @@ +T=TIMER +L=INT(T) +COLOR 14,1 +SCREEN 0 +LOCATE 2,2 +L=L-9999 +PRINT L +STOP +END \ No newline at end of file diff --git a/turbobasic/NORMAL.TB b/turbobasic/NORMAL.TB new file mode 100755 index 0000000000000000000000000000000000000000..7cc1d6a31c8d5092d8389cb43459a1796c229969 GIT binary patch literal 886 zcmb``NlU{(6bJDCw6Wt>2Lvg!kmexNgZp;yWUc5$jG#v;)~yu8#tnMwS8!jxj$Yii z&*B1Z^}Sa~?rI?a`DG?=UJ}U6*7|(W8Od!F7Mx6Rb-9q=TF-43imT38VP(mQLq(fo zDh?I!3A>Ct5m3gxta9xG$sM0`fkzV80&gT^Jfpq$9|0e}K7D;vr41?~qxrLQH!6h^ z@sox~#?ad!EaLktlIIy(ZI?Oj*6|~t(^r?T?y9I;kBE2aB~`oiiMU(8ta7&j|Gq(y zM{{#(lq&vyzHUmz_V~KV ljqTHDYKB`5XsoLpZ$4ED>Wt$_@qh9x`6Br$S*e5&$2W4}S2O?s literal 0 HcmV?d00001 diff --git a/turbobasic/NOTY1.BAS b/turbobasic/NOTY1.BAS new file mode 100755 index 0000000..c363680 --- /dev/null +++ b/turbobasic/NOTY1.BAS @@ -0,0 +1,39 @@ +SCREEN 0 +color 0,15 +cls +INPUT " NOTA 1 " ;N1 +CLS +INPUT " NOTA 2 " ;N2 +CLS +INPUT " NOTA 3 " ;N3 +CLS +INPUT " NOTA 4 " ;N4 +CLS +INPUT " NOTA 5 " ;N5 +CLS +INPUT " NOTA 6 " ;N6 +CLS +INPUT " NOTA 7 " ;N7 +CLS +INPUT " NOTA 8 " ;N8 +CLS +INPUT " NOTA 9 " ;N9 +CLS +INPUT " NOTA 10 " ;N10 +CLS +INPUT " STISKNI *ENTER* " ;V +CLS +SOUND N1*12,12 +SOUND N2*12,12 +SOUND N3*12,12 +SOUND N4*12,12 +SOUND N5*12,12 +SOUND N6*12,12 +SOUND N7*12,12 +SOUND N8*12,12 +SOUND N9*12,12 +SOUND N10*12,12 +PRINT " KONEC " +FOR I=0 TO 300 +NEXT I +END \ No newline at end of file diff --git a/turbobasic/OPRAV.BAS b/turbobasic/OPRAV.BAS new file mode 100755 index 0000000..6bb52d5 --- /dev/null +++ b/turbobasic/OPRAV.BAS @@ -0,0 +1,7 @@ +COLOR 14,1 +SCREEN 1 +PRINT CHR$ 200 + + + + \ No newline at end of file diff --git a/turbobasic/OPRAVIT9.BAS b/turbobasic/OPRAVIT9.BAS new file mode 100755 index 0000000..76c7e4a --- /dev/null +++ b/turbobasic/OPRAVIT9.BAS @@ -0,0 +1,32 @@ + + +CLS +SCREEN 0 +COLOR 14,1 + +start: +INPUT ; A$ +IF A$="1" THEN GOTO ANO +IF A$="2" THEN GOTO NE +IF A$="3" THEN GOTO NEVIM +IF A$="4" THEN GOTO KONEC + +ANO: +LOCATE 2,2 +PRINT "ANO " +GOTO START + +NE: +LOCATE 2,2 +PRINT "NE " +GOTO START + +NEVIM: +LOCATE 2,2 +PRINT "NEVIM " +GOTO START + +KONEC: +LOCATE 2,2 +PRINT "STLAC LIBOVOLNOU KLAVESU " +END \ No newline at end of file diff --git a/turbobasic/PARTA.BAS b/turbobasic/PARTA.BAS new file mode 100755 index 0000000..5cf329c --- /dev/null +++ b/turbobasic/PARTA.BAS @@ -0,0 +1,160 @@ +DO +CLS +SCREEN 8 +COLOR 14,1 +LOCATE 2,2 +INPUT " !!! ZADEJ HESLO !!! " ; ALO$ +IF ALO$ = "COBRA 11" THEN GOTO POGR +LOOP +POGR: + GOTO POKR +REM PIN= COBRA 11 +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="TELEFONY CLUB exit! HESLA PAR› CI " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +SOUND RND*150+12,13 +print "MUDRUNKA 56 18 243" +RETURN +'----------------------------------------------------------------------------- +DIR : +SOUND RND*150+12,13 +PRINT "KROTITEL DUCH…" +RETURN +'----------------------------------------------------------------------------- +KONEC : +CLS +SOUND RND*150+12,13 +CALL ANYKEY +CALL CLWD +end +'----------------------------------------------------------------------------- +HELP : + +A$="ZAKLADNI COBRA 11" +CALL ECHO (5,16,A$,13) +A$="DO NASI BEDNY DF45M3" +CALL ECHO (7,17,A$,13) +A$="DO NASEHO UKRITU (BUNKRU,CTYRKOLKY) SD85L6" +SOUND RND*1000+12,13 +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : + +PRINT "MUDRUNKA,COUFAL=VELITELE.VELEBNY,TOMEK,HORNYCH,HAUK." + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + + FOR A=1 TO LEN(A$) + + + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/POZDR-BL.BAS b/turbobasic/POZDR-BL.BAS new file mode 100755 index 0000000..9a9bd0e --- /dev/null +++ b/turbobasic/POZDR-BL.BAS @@ -0,0 +1,26 @@ +SCREEN 0 +INPUT " ZADEJ 1 (çED ) NEBO JEN ENTER(MODR )";L +IF L=1 THEN COLOR 0,15:GOTO RAZ +COLOR 14,1 + +RAZ: +FOR I=2 TO 500 +REM CLS PRI KAZDEM CYKLU VYMAZE OBRAZOVKU, TAKZE NAPIS BLIKA +CLS +SCREEN 0 +LOCATE 9,23 +PRINT " DOBRY DEN! JAK SE MATE ? " + +A$=INKEY$ +IF A$="X" THEN KONEC +KEY (11) STOP + +FOR B=0 TO 300 +NEXT B + +NEXT I +KONEC: +REM CLS +LOCATE 20,15 + +PRINT "UKONCI stiskem enter" \ No newline at end of file diff --git a/turbobasic/POZDR2.BAS b/turbobasic/POZDR2.BAS new file mode 100755 index 0000000..4d7239e --- /dev/null +++ b/turbobasic/POZDR2.BAS @@ -0,0 +1,28 @@ +SCREEN 0 +INPUT " ZADEJ 1 (çED ) NEBO JEN ENTER(MODR )";L +IF L=1 THEN COLOR 0,15:GOTO RAZ +COLOR 14,1 + +RAZ: +FOR I=2 TO 500 +REM CLS PRI KAZDEM CYKLU VYMAZE OBRAZOVKU, TAKZE NAPIS BLIKA +CLS +SCREEN 0 +LOCATE 9,23 +PRINT " DOBRY DEN! JAK SE MATE ? " + +A$=INKEY$ +IF A$="X" THEN KONEC +KEY (11) STOP + +FOR B=0 TO 300 +NEXT B + +NEXT I +KONEC: +LOCATE 20,15 +FOR T=0 TO 2000 +CLS +PRINT "UKONCI LIBOVOLNOU KLAVESOU" +KEY (19) STOP +NEXT T \ No newline at end of file diff --git a/turbobasic/POZDRAV.BAS b/turbobasic/POZDRAV.BAS new file mode 100755 index 0000000..4e6670c --- /dev/null +++ b/turbobasic/POZDRAV.BAS @@ -0,0 +1,16 @@ +FOR I=0 TO 5000 +CLS +SCREEN 0 +COLOR 14,1 +LOCATE 10,5 +PRINT " DOBRY DEN! JAK SE MATE ? " + +A$=INKEY$ +IF A$="X" THEN KONEC + +FOR B=0 TO 300 +NEXT B + +NEXT I +KONEC: +CLS \ No newline at end of file diff --git a/turbobasic/PROGRAM1.BAS b/turbobasic/PROGRAM1.BAS new file mode 100755 index 0000000..eb05613 --- /dev/null +++ b/turbobasic/PROGRAM1.BAS @@ -0,0 +1,236 @@ + GOTO POKR + + + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +REM zadani polozek adresare +DO + A$="NASOB HELP POZDR NASO2 KONEC " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC +LOOP + +'----------------------------------------------------------------------------- +TEXT : +LOCATE 10,5 +print "JESTLI ¦E NEUMÖTE NASOBIT:*KONEC*,!!!POZOR!!! NASOB2 ZNAMKUJE" +RETURN +'----------------------------------------------------------------------------- +NASOB : +SCREEN 0 +CLS + +COLOR 14,1 +N=0 +S=0 +V=0 + +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +SOUND RND*10000+90,90 +PRINT " SPATNY VYSLEDEK" + +S=S+1 +GOTO VOLBA + +ANO: +SOUND RND*100+90,90 +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 + +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +REM pise chybu sound rnd*100+12,13 +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlac klavesu Enter" +end +'----------------------------------------------------------------------------- +NIC1 : +A$="Zdravi Vas Tomas Mudrunka" +CALL ECHO (5,16,A$,13) +A$="Jak se mate?" +CALL ECHO (7,17,A$,13) +A$="Jak se Vam libi tento program?" +CALL ECHO (7,18,A$,13) + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +NASOB2 : + +SCREEN 0 +CLS +COLOR 4,15 +S=0 +V=0 + + +FOR I=1 TO 10 + rem nechat pokud nebude vadit CLS + LOCATE 4,20 + PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU" + + A=INT(RND(5)*10+1) + B=INT(RND(4)*10+1) + LOCATE 10,5 + REM vymaze radek + PRINT " " + PRINT " " + LOCATE 10,5 + PRINT "NAPIS VYSLEDEK" A "x" B "=" + INPUT " STISKNI ENTER";C + D=A*B + + IF D=C THEN ANO2 + SOUND RND*10000+55,55 + PRINT " SPATNY VYSLEDEK" + + S=S+1 + GOTO VOLBA2 + + ANO2: + SOUND RND*100+55,55 + PRINT " SPRAVNE" + V=V+1 + VOLBA2: + LOCATE 18,10 + PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + REM zdrzeni programu + FOR G=1 TO 10 + + NEXT G +NEXT I + +LOCATE 18,10 +PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +LOCATE 20,10 +PRINT "VYSLEDNA ZNAMKA" T + +Input "Ukonci stiskem klavesy ENTER";A +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/PROGRAM2.BAS b/turbobasic/PROGRAM2.BAS new file mode 100755 index 0000000..631a784 --- /dev/null +++ b/turbobasic/PROGRAM2.BAS @@ -0,0 +1,240 @@ + GOTO POKR + + + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +REM zadani polozek adresare +DO + A$="NASOB AHOJ POZDR NASO2 KONEC " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC +LOOP + +'----------------------------------------------------------------------------- +TEXT : +SOUND RND*10000+12,13 +SOUND RND*100+99,80 +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +NASOB : +SCREEN 0 +CLS +SOUND RND*1000+20,70 +COLOR 14,1 +N=0 +S=0 +V=0 +SOUND RND*300+12,13 +SOUND RND*10000+12,13 +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +SOUND RND*10000+90,90 +PRINT " SPATNY VYSLEDEK" +SOUND RND*10000+12,13 +S=S+1 +GOTO VOLBA +SOUND RND*100+12,13 +ANO: +SOUND RND*100+90,90 +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 +SOUND RND* 10000+55,55 +SOUND RND* 100+55,55 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +REM pise chybu sound rnd*100+12,13 +RETURN +'----------------------------------------------------------------------------- +KONEC : +SOUND RND*100+55,100 +print "stlac klavesu Enter" +end +'----------------------------------------------------------------------------- +NIC1 : +SOUND RND*100+55,55 +A$="Zdravi Vas Tomas Mudrunka" +CALL ECHO (5,16,A$,13) +A$="Jak se mate?" +CALL ECHO (7,17,A$,13) +A$="Jak se Vam libi tento program?" +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +NASOB2 : + +SCREEN 0 +CLS +rem SOUND RND*1000+20,70 +COLOR 4,15 +S=0 +V=0 +rem SOUND RND*300+12,13 +rem SOUND RND*10000+12,13 + +FOR I=1 TO 10 + rem nechat pokud nebude vadit CLS + LOCATE 4,20 + PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU" + + A=INT(RND(5)*10+1) + B=INT(RND(4)*10+1) + LOCATE 10,5 + REM vymaze radek + PRINT " " + PRINT " " + LOCATE 10,5 + PRINT "NAPIS VYSLEDEK" A "x" B "=" + INPUT " STISKNI ENTER";C + D=A*B + + IF D=C THEN ANO2 + SOUND RND*10000+55,55 + PRINT " SPATNY VYSLEDEK" + rem SOUND RND*10000+12,13 + S=S+1 + GOTO VOLBA2 + rem SOUND RND*100+12,13 + ANO2: + SOUND RND*100+55,55 + PRINT " SPRAVNE" + V=V+1 + VOLBA2: + LOCATE 18,10 + PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + REM zdrzeni programu + FOR G=1 TO 10 + rem SOUND RND*1000+12,13 + NEXT G +NEXT I + +LOCATE 18,10 +PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +LOCATE 20,10 +PRINT "VYSLEDNA ZNAMKA" T + +Input "Ukonci stiskem klavesy ENTER";A +RETURN +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/ROZVRH b/turbobasic/ROZVRH new file mode 100755 index 0000000..7cf141f --- /dev/null +++ b/turbobasic/ROZVRH @@ -0,0 +1,14 @@ +SCREEN 8 +COLOR 14,1 +LOCATE 2,2 +PRINT " PO- ¬J* M* PR 2.* ¬T/PS " +LOCATE 3,2 +PRINT " éT- M* ¬J* PR 1.* ¬J:SL* PLAVµNÖ* PLAVµNÖ:NµVRAT " +LOCATE 4,2 +PRINT " ST- ¬J* M* Tv* ¬T* Hv " +LOCATE 5,2 +PRINT " ¬T- M* ¬J* PR 2.* P¬* ¬T/PS " +LOCATE 6,2 +PRINT " Pµ- ¬J* M* Vv* ¬T " +SOUND 100+12,150 +END \ No newline at end of file diff --git a/turbobasic/ROZVRH H.BAS b/turbobasic/ROZVRH H.BAS new file mode 100755 index 0000000..8885bd5 --- /dev/null +++ b/turbobasic/ROZVRH H.BAS @@ -0,0 +1,14 @@ +SCREEN 8 +COLOR 14,1 +LOCATE 2,2 +PRINT " PO- ¬J* M* PR 2.* ¬T/PS " +LOCATE 3,2 +PRINT " éT- M* ¬J* PR 1.* ¬J:SL* PLAVµNÖ* PLAVµNÖ:NµVRAT " +LOCATE 4,2 +PRINT " ST- ¬J* M* Tv* ¬T* Hv " +LOCATE 5,2 +PRINT " ¬T- M* ¬J* PR 2.* P¬* ¬T/PS " +LOCATE 6,2 +PRINT " Pµ- ¬J* M* Vv* ¬T " +SOUND 100+12,70 +END \ No newline at end of file diff --git a/turbobasic/SCITANI.BAS b/turbobasic/SCITANI.BAS new file mode 100755 index 0000000..a4b0acd --- /dev/null +++ b/turbobasic/SCITANI.BAS @@ -0,0 +1,77 @@ +SCREEN 0 +CLS +COLOR 4,15 +S=0 +Z=0 + +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI SCITANI" +PRINT " " + +V=TIMER +V=INT(((V-INT(V)+.2)*100)) + +FOR I=1 TO 15 + +A(I)=INT(RND*V+1) +A(I)=A(I)+1 +B(I)=INT(RND*V+1) +B(I)=B(I)+1 + +VYP: +IF A(I)>=B(I) THEN C(I)=A(I)-B(I):D(I)=B(I):GOTO VYSL +REM pokud je B vØtç¡ ne§ A zmenç¡ se +B(I)=INT(B(I)*.9) +B(I)=B(I)+1 +GOTO VYP + +VYSL: +REM aby druhì sŸ¡tanec nebyl 0 +IF C(I)=O THEN A(I)=A(I)+2:GOTO VYP + +REM VYSLEDEK JE V A(x) +LOCATE I+5,1 +PRINT " " +LOCATE I+5,4 +PRINT "NAPIS VYSLEDEK" D(I) "+" C(I) "=":INPUT C + +IF A(I)=C THEN ANO + +LOCATE I+5,30 +PRINT C +LOCATE I+5,34 +PRINT " SPATNY VYSLEDEK" +SOUND 1200,2 +S=S+1 +GOTO VOLBA + +ANO: +LOCATE I+5,30 +PRINT C +LOCATE I+5,34 +PRINT " SPRAVNE" +rem SOUND 600,2 +Z=Z+1 + +VOLBA: +NEXT I + +I=I-1 +PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" Z "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +print " " +PRINT "VYSLEDNA ZNAMKA" T + +REM PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +REM LOCATE 21,10 +REM INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +REM IF E<>1 THEN OPET + +END + + \ No newline at end of file diff --git a/turbobasic/SCITANI2.BAS b/turbobasic/SCITANI2.BAS new file mode 100755 index 0000000..0680b8d --- /dev/null +++ b/turbobasic/SCITANI2.BAS @@ -0,0 +1,73 @@ +SCREEN 0 +CLS +COLOR 4,15 +S=0 +Z=0 + +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI SCITANI" +PRINT " " + +V=TIMER +V=INT(((V-INT(V)+.3)*200)) +REM puvodne bylo + .2 )*100 + +FOR I=1 TO 15 + +A(I)=INT(RND*V+1) +A(I)=A(I)+1 +B(I)=INT(RND*V+1) +B(I)=B(I)+1 + +VYP: +REM pokud je A vetsi ne§ 100 zmençit +IF A(I)>=100 THEN A(I)=INT(A(I)*.9)+1: GOTO VYP +C(I)=A(I)+B(I) +REM pokud je souŸet vØtç¡ ne§ 100 zmençit B +IF C(I)>100 THEN B(I)=INT(B(I)*.9)+1: GOTO VYP + +LOCATE I+5,1 +PRINT " " +LOCATE I+5,4 +PRINT "NAPIS VYSLEDEK" A(I) "+" B(I) "=":INPUT C + +IF C(I)=C THEN ANO + +LOCATE I+5,30 +PRINT C +LOCATE I+5,34 +PRINT " SPATNY VYSLEDEK" +SOUND 1200,2 +S=S+1 +GOTO VOLBA + +ANO: +LOCATE I+5,30 +PRINT C +LOCATE I+5,34 +PRINT " SPRAVNE" +rem SOUND 600,2 +Z=Z+1 + +VOLBA: +NEXT I + +I=I-1 +PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" Z "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +print " " +PRINT "VYSLEDNA ZNAMKA" T + +REM PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +REM LOCATE 21,10 +REM INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +REM IF E<>1 THEN OPET + +END + + \ No newline at end of file diff --git a/turbobasic/SPOLECNI.BAS b/turbobasic/SPOLECNI.BAS new file mode 100755 index 0000000..26f1aab --- /dev/null +++ b/turbobasic/SPOLECNI.BAS @@ -0,0 +1,26 @@ +CLS +COLOR 14,15 +LOCATE 2,2 +SCREEN 0 +INPUT " AHOJ,JAK SE Mµæ. DOBRE/SPATNE " ;AAA$ +IF AAA$= SPATNE THEN GOTO CXY +IF AAA$= DOBRE THEN GOTO ASE + +GOTO SDF +ASE: +CLS +LOCATE 2,2 +PRINT " !!! SUPER !!! " +FOR A=0 TO 2000 +NEXT A +SOUND RND*700+12,13 +GOTO SDF +CXY: +CLS +LOCATE 2,2 +PRINT " TO JE æKODA. " +FOR A=0 TO 2000 +NEXT A +SOUND RND*100+40,40 +SDF: +END \ No newline at end of file diff --git a/turbobasic/STICKS.BAS b/turbobasic/STICKS.BAS new file mode 100755 index 0000000..cfccaa8 --- /dev/null +++ b/turbobasic/STICKS.BAS @@ -0,0 +1,13 @@ +for A=0 TO 6000 +CLS +COLOR 0,15 +SCREEN 0 +X=STICK (0) +Y=STICK (1) +REM LOCATE X,Y +REM PRINT "O" +PRINT X " , " Y +FOR D=0 TO 300 +NEXT D +NEXT A +END \ No newline at end of file diff --git a/turbobasic/SYSTEM.BAS b/turbobasic/SYSTEM.BAS new file mode 100755 index 0000000..6002c6b --- /dev/null +++ b/turbobasic/SYSTEM.BAS @@ -0,0 +1,18 @@ +SKODA: +CLS +SCREEN 1 +COLOR 0,15 +LOCATE 2,2 +INPUT " ZADEJTE VSTUPNI PIN NA TOTO CD " ; No$ + IF No$ = "TTDA" THEN GOTO POKR + GOTO SKODA +POKR: +CLS +LOCATE 2,2 +INPUT " JMENO UZIVATELE " ;N$ +CLS +LOCATE 2,2 +PRINT " CD VITA UZIVATELE " N$ +LOCATE 25,2 +INPUT " ZMACKNETE LIBOVOLNOU KLAVESU " ;X10$ +END \ No newline at end of file diff --git a/turbobasic/T-BASIC.BAS b/turbobasic/T-BASIC.BAS new file mode 100755 index 0000000..228db95 --- /dev/null +++ b/turbobasic/T-BASIC.BAS @@ -0,0 +1,45 @@ + +SOUND RND*10000+20,30 +SCREEN 0 +CLS +COLOR 15,9 +LOCATE 6,24 +PRINT " MEGA ZVUKY UKON¬I ENTER " +LOCATE 7,24 +PRINT " -------------------------------- " + + + +SOUND RND*100+36,21 +SOUND RND*1000+39,36 +SOUND RND*150+33,69 +SOUND RND*10321+34,20 +SOUND RND*1999+99,56 +SOUND RND*9999+99,50 +SOUND RND*300+99,50 +SOUND RND*400+99,50 +SOUND RND*500+99,50 +SOUND RND*600+99,50 +SOUND RND*700+99,50 +SOUND RND*800+99,50 +SOUND RND*900+99,50 +SOUND RND*100+9,20 + + + + + + + + + + + + + + + +SOUND RND*1000+99,36 + +SOUND RND*632+900,60 + \ No newline at end of file diff --git a/turbobasic/TELEFON1.BAS b/turbobasic/TELEFON1.BAS new file mode 100755 index 0000000..b2f5784 --- /dev/null +++ b/turbobasic/TELEFON1.BAS @@ -0,0 +1,155 @@ +start: +CLS +COLOR 14,1 +SCREEN 0 +LOCATE 2,2 +INPUT " ZADEJTE VSTUPNÖ PIN " ;A +IF A<>4545 THEN START + + GOTO POKR + +POKR : +CLS +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +DO + A$="POZDRAV1 POMOC2 TELEFON3 HELP4 ESC Q" + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB TELEFON,DIR,LOAD,HELP,KONEC +LOOP + +'----------------------------------------------------------------------------- +TELEFON : +print "HLAVNE KDYZ POZDRAVITE:DOBRY DEN TADY----- -----." +RETURN +'----------------------------------------------------------------------------- +DIR : +LOCATE 8,23 +PRINT "PRAVE STE SE DOVOLALI NA TEL.¬.:158" +LOCATE 10,10 +print "TADY POLICIE H.L.M.PRAHY" +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlaŸ kl vesu*ENTER*" +END +'----------------------------------------------------------------------------- +HELP : +A$="ZKOUSKA OVLADANI TELEFONU" +CALL ECHO (5,16,A$,13) +A$="STISKN·TE TELEFON1 NEBO POMOC" +CALL ECHO (7,17,A$,13) +A$="VIDITE U¦ TELEFONUJETE PO SITI MUDRUÕKANET" +CALL ECHO (7,18,A$,13) + + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +LOAD : +PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 " +LOCATE 9,23 +PRINT " TADY TOMAS MUDRUNKA " + + +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/TOM b/turbobasic/TOM new file mode 100755 index 0000000..2141aef --- /dev/null +++ b/turbobasic/TOM @@ -0,0 +1,9 @@ +START: +CLS +COLOR 14,1 +SCREEN 1 +LOCATE 2,2 +INPUT " ZADEJTE STARTOVACÖ PIN " ;A +IF A<>007 THEN GOTO START +REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT timto PROGR... +END \ No newline at end of file diff --git a/turbobasic/TOM HESL.BAS b/turbobasic/TOM HESL.BAS new file mode 100755 index 0000000..8e55657 --- /dev/null +++ b/turbobasic/TOM HESL.BAS @@ -0,0 +1,10 @@ +START: +CLS +COLOR 14,1 +SCREEN 8 +LOCATE 2,2 +INPUT " ZADEJTE STARTOVACÖ PIN " ;A +IF A<>007 THEN GOTO START +REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007 +STOP +END \ No newline at end of file diff --git a/turbobasic/TOM.BAS b/turbobasic/TOM.BAS new file mode 100755 index 0000000..7b7a088 --- /dev/null +++ b/turbobasic/TOM.BAS @@ -0,0 +1,10 @@ +START: + CLS + COLOR 14,1 + SCREEN 1 + LOCATE 2,2 + INPUT " ZADEJTE STARTOVACÖ PIN " ;A + IF A<>007 THEN GOTO START + REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007 + STOP + END \ No newline at end of file diff --git a/turbobasic/UZIVATEL.BAS b/turbobasic/UZIVATEL.BAS new file mode 100755 index 0000000..54c806e --- /dev/null +++ b/turbobasic/UZIVATEL.BAS @@ -0,0 +1,12 @@ +CLS +SCREEN 1 +COLOR 14,1 +LOCATE 2,2 +INPUT " JAK JSE JMENUJETE " ;A$ +CLS +LOCATE 2,2 +PRINT " V¡T M U§IVATELE JM‚NEM " +LOCATE 3,2 +PRINT A$ +SOUND 100+12,80 +END \ No newline at end of file diff --git a/turbobasic/VIPIS.BAS b/turbobasic/VIPIS.BAS new file mode 100755 index 0000000..a5b093e --- /dev/null +++ b/turbobasic/VIPIS.BAS @@ -0,0 +1,10 @@ +A=0 +FOR I=0 TO 24 +A=A+1 +REM CLS +COLOR 14,1 +SCREEN 0 +LOCATE A,A +PRINT I +NEXT I +END \ No newline at end of file diff --git a/turbobasic/VO-PSANI.BAS b/turbobasic/VO-PSANI.BAS new file mode 100755 index 0000000..21bd21a --- /dev/null +++ b/turbobasic/VO-PSANI.BAS @@ -0,0 +1,31 @@ +T$="A" +O$="H" +M$="O" +A$="J" +S$="!" +FOR I=1 TO 3000 +CLS +COLOR 14,1 +SCREEN 0 +LOCATE 2,23 +PRINT T$ +LOCATE 3,23 +PRINT O$ +LOCATE 4,23 +PRINT M$ +LOCATE 5,23 +PRINT A$ +LOCATE 6,23 +PRINT S$ + +FOR D=1 TO 300 +NEXT D +NEXT I +END + + + + + + + \ No newline at end of file diff --git a/turbobasic/ZVUKY.BAS b/turbobasic/ZVUKY.BAS new file mode 100755 index 0000000..8081bf0 --- /dev/null +++ b/turbobasic/ZVUKY.BAS @@ -0,0 +1,5 @@ +SOUND 500,1 +SOUND 900,3 +SOUND 100,5 +SOUND 200,2 +END \ No newline at end of file diff --git "a/turbobasic/Z\303\241loha menu1.BAS" "b/turbobasic/Z\303\241loha menu1.BAS" new file mode 100755 index 0000000..98b0edf --- /dev/null +++ "b/turbobasic/Z\303\241loha menu1.BAS" @@ -0,0 +1,232 @@ + GOTO POKR + +POKR : +SCREEN 8 : CLS +COLOR 14,1 +RESTORE BARVY +BARVY : + + DATA 8,7,15,15,7,8 +FOR A=1 TO 6 + READ C + LINE (A,A)-(640-A,A),C + LINE (A,106-A)-(640-A,106-A),C + LINE (A,A)-(A,106-A),C + LINE (640-A,A)-(640-A,106-A),C + LINE (A,110+A)-(640-A,110+A),C + LINE (A,200-A)-(640-A,200-A),C + LINE (A,110+A)-(A,200-A),C + LINE (640-A,110+A)-(640-A,200-A),C +NEXT A + +REM zadani polozek adresare +DO + A$="NASOB AHOJ POZDR NASO2 KONEC " + D=5:X=5:Y=17:C=14 + GOSUB MENU + ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC +LOOP + +'----------------------------------------------------------------------------- +TEXT : +print "ahoj" +RETURN +'----------------------------------------------------------------------------- +NASOB : +SCREEN 0 +CLS +SOUND RND*1000+20,70 +COLOR 4,15 +N=0 +S=0 +V=0 +SOUND RND*300+12,13 +SOUND RND*10000+12,13 +OPET: +N=N+1 +CLS +LOCATE 4,23 +PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY" +A=INT(RND(5)*10+1) +B=INT(RND(4)*10+1) +LOCATE 10,5 +PRINT "NAPIS VYSLEDEK" A "x" B "=" +INPUT " STISKNI ENTER";C +D=A*B +IF D=C THEN ANO +PRINT " SPATNY VYSLEDEK" +SOUND RND*10000+12,13 +S=S+1 +GOTO VOLBA +SOUND RND*100+12,13 +ANO: +PRINT " SPRAVNE" +V=V+1 +VOLBA: +LOCATE 18,10 +PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" +LOCATE 20,10 +PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER" +LOCATE 21,10 +INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E +IF E<>1 THEN OPET +REM pise chybu sound rnd*100+12,13 +RETURN +'----------------------------------------------------------------------------- +KONEC : +print "stlac klavesu Enter" +end +'----------------------------------------------------------------------------- +NIC1 : +A$="Zdravi Vas Tomas Mudrunka" +CALL ECHO (5,16,A$,13) +A$="Jak se mate?" +CALL ECHO (7,17,A$,13) +A$="Jak se Vam libi tento program?" +CALL ECHO (7,18,A$,13) +stop + +CALL ANYKEY +CALL CLWD +RETURN +'----------------------------------------------------------------------------- +NASOB2 : + +SCREEN 0 +CLS +rem SOUND RND*1000+20,70 +COLOR 4,15 +S=0 +V=0 +rem SOUND RND*300+12,13 +rem SOUND RND*10000+12,13 + +FOR I=1 TO 10 + rem nechat pokud nebude vadit CLS + LOCATE 4,20 + PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU" + + A=INT(RND(5)*10+1) + B=INT(RND(4)*10+1) + LOCATE 10,5 + REM vymaze radek + PRINT " " + PRINT " " + LOCATE 10,5 + PRINT "NAPIS VYSLEDEK" A "x" B "=" + INPUT " STISKNI ENTER";C + D=A*B + + IF D=C THEN ANO2 + PRINT " SPATNY VYSLEDEK" + rem SOUND RND*10000+12,13 + S=S+1 + GOTO VOLBA2 + rem SOUND RND*100+12,13 + ANO2: + PRINT " SPRAVNE" + V=V+1 + VOLBA2: + LOCATE 18,10 + PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + REM zdrzeni programu + FOR G=1 TO 10 + rem SOUND RND*1000+12,13 + NEXT G +NEXT I + +LOCATE 18,10 +PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH" + +IF S=>4 THEN T=5 +IF S=3 THEN T=4 +IF S=2 THEN T=3 +IF S=1 THEN T=2 +IF S=0 THEN T=1 +LOCATE 20,10 +PRINT "VYSLEDNA ZNAMKA" T + +Input "Ukonci stiskem klavesy ENTER";A +RETURN +'----------------------------------------------------------------------------- + + +END +'----------------------------------------------------------------------------- +' podprogram ECHO +' postupny tisk textu obsazeneho v retezcove promenne A$ +' na souradnice X a Y +' barvou C + +SUB ECHO(X,Y,A$,C) + COLOR C + LOCATE Y,X + FOR A=1 TO LEN(A$) + PRINT MID$ (A$,A,1); + SOUND 1200,.2 + SOUND 900,.2 + SOUND 600,.2 + FOR I=1 TO 200 + NEXT I + NEXT A +END SUB + +'-------------------------------------------------------------------------- + +MENU : + ' PODPROGRAM 'MENU' + + ' X a Y jsou textove souradnice menu-okna + ' A$ obsahuje text okna + ' D je pocet polozek (radku) v menu + ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu + ' C je barva okna + ' v promenne MENU podprogram vraci cislo zvolene polozky + + L=LEN (A$)/D : MENU = 1 : M = MENU+.0001 + COLOR C,9:LOCATE Y,X + PRINT CHR$(201); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$ (187); + FOR A= 1 TO LEN(A$) STEP L + LOCATE Y+A/L+1,X + PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186); + NEXT A + LOCATE Y+A/L+1,X: PRINT CHR$(200); + FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A + PRINT CHR$(188); + IF W=1 THEN W=0 : RETURN + + DO + I$ = INKEY$ + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1 + IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1 + IF MENU < 1 THEN MENU = D + IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP + IF MENU > D THEN MENU = 0 : EXIT LOOP + IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " "; + IF MENU <> M THEN LOCATE Y+MENU,X+L+2:COLOR 11:PRINT CHR$(174);:LOCATE Y+MENU,X+1:PRINT CHR$(175);:COLOR C + M = MENU + LOOP + I=MENU + W=1:C=0:GOSUB MENU + MENU = I : COLOR 15 +RETURN +'----------------------------------------------------------------------------- +SUB CLWD + 'Clear window + FOR A=120 TO 190 + LINE (8,A)-(632,A),0 + NEXT A +END SUB +'----------------------------------------------------------------------------- +SUB ANYKEY + DO + IF INKEY$<>"" THEN EXIT LOOP + C=C+1:IF C>15 THEN C=1 + COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU"; + LOOP +END SUB +'----------------------------------------------------------------------------- + + \ No newline at end of file diff --git a/turbobasic/noty2.bas b/turbobasic/noty2.bas new file mode 100755 index 0000000..2d2e129 --- /dev/null +++ b/turbobasic/noty2.bas @@ -0,0 +1,143 @@ +SCREEN 0 + +Color 0,15 + +cls + +INPUT " NOTA 1 " ;N1 + +CLS + +INPUT " NOTA 2 " ;N2 + +CLS + +INPUT " NOTA 3 " ;N3 + +CLS + +INPUT " NOTA 4 " ;N4 + +CLS + +INPUT " NOTA 5 " ;N5 + +CLS + +INPUT " NOTA 6 " ;N6 + +CLS + +INPUT " NOTA 7 " ;N7 + +CLS + +INPUT " NOTA 8 " ;N8 + +CLS + +INPUT " NOTA 9 " ;N9 + +CLS + +INPUT " NOTA 10 " ;N10 +SCREEN 0 + +Color 0,15 + +cls + +INPUT " NOTA 11 " ;N11 + +CLS + +INPUT " NOTA 12 " ;N12 + +CLS + +INPUT " NOTA 13 " ;N13 + +CLS + +INPUT " NOTA 14 " ;N14 + +CLS + +INPUT " NOTA 15 " ;N15 + +CLS + +INPUT " NOTA 16 " ;N16 + +CLS + +INPUT " NOTA 17 " ;N17 + +CLS + +INPUT " NOTA 18 " ;N18 + +CLS + +INPUT " NOTA 19 " ;N19 + +CLS + +INPUT " NOTA 20 " ;N10 + +CLS + +INPUT " STISKNI *ENTER* " ;V + +CLS + +SOUND N1*12,12 + +SOUND N2*12,12 + +SOUND N3*12,12 + +SOUND N4*12,12 + +SOUND N5*12,12 + +SOUND N6*12,12 + +SOUND N7*12,12 + +SOUND N8*12,12 + +SOUND N9*12,12 + +SOUND N10*12,12 + + +SOUND N11*12,12 + +SOUND N12*12,12 + +SOUND N13*12,12 + +SOUND N14*12,12 + +SOUND N15*12,12 + +SOUND N16*12,12 + +SOUND N17*12,12 + +SOUND N18*12,12 + +SOUND N19*12,12 + +SOUND N20*12,12 + +PRINT " KONEC " + +FOR I=0 TO 300 + +NEXT I + +END + + \ No newline at end of file diff --git a/turbopascal/MORSE.PAS b/turbopascal/MORSE.PAS new file mode 100755 index 0000000..eb0c269 --- /dev/null +++ b/turbopascal/MORSE.PAS @@ -0,0 +1,21 @@ +program morse; +uses crt; +const +tab: array ['A'..'Z'] of string[6] = ( + '._','_...','_._.','_..','.','.._.','__.','....','____','..', + '.___','_._','._..','__','_.','___','.__.','._.','...','_','.._', + '..._','_.__','__..'); +var +s:string; +i:byte; + +begin +writeln ('***PROGRAM *M*O*R*S*E* ---- PREVEDE TEXT DO MORSEOVY ABECEDY*** '); +write ('ZADEJ TEXT PRO PRýEVOD: '); READLN (s); + +FOR i:= 1 TO LENGTH (s) DO +CASE s[i] OF + 'A'..'Z','a'..'z': WRITE (Tab[Upcase (s[i])],'|'); + ' ' WRITE ('|'); + END; +end. \ No newline at end of file -- 2.30.2