*.old
*.exe
+*.EXE
*.dll
*.com
*.o
--- /dev/null
+CLS\r
+SHELL "A:"\r
+SHELL "FORMAT A:"\r
+INPUT "KONEC" ;A$\r
+END\1a
\ No newline at end of file
--- /dev/null
+START:\r
+CLS\r
+COLOR 14,1\r
+SCREEN 8\r
+LOCATE 2,2\r
+INPUT " ZADEJTE STARTOVACÖ PIN " ;A\r
+IF A<>007 THEN GOTO START\r
+REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007\r
+STOP\r
+END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+COLOR 4,15\r
+SCREEN 1\r
+LOCATE 2,2\r
+INPUT " ZAKàDUJTE " ;A$\r
+CLS\r
+LOCATE 2,2\r
+INPUT " ODKàDUJTE " ;C$\r
+IF A$=C$ THEN GOTO JEDNA\r
+CLS\r
+LOCATE 2,2\r
+PRINT " æPATNí KàD ( !!! ZABLOKOVµNO !!! ) "\r
+DO\r
+SOUND RND*800+12,13\r
+LOOP\r
+JEDNA:\r
+END\r
+\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+SHELL "C:"\r
+SHELL "SYS A:"\r
+END\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 0 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+REM zadani polozek adresare\r
+DO\r
+ A$="NASOB AHOJ POZDR NASO2 KONEC "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TEXT :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB :\r
+SCREEN 0\r
+CLS\r
+SOUND RND*1000+20,70\r
+COLOR 4,15\r
+N=0\r
+S=0\r
+V=0\r
+SOUND RND*300+12,13\r
+SOUND RND*10000+12,13\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND RND*10000+12,13\r
+S=S+1\r
+GOTO VOLBA\r
+SOUND RND*100+12,13\r
+ANO:\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+REM pise chybu sound rnd*100+12,13\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stlac klavesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+NIC1 :\r
+A$="Zdravi Vas Tomas Mudrunka"\r
+CALL ECHO (5,16,A$,13)\r
+A$="Jak se mate?"\r
+CALL ECHO (7,17,A$,13)\r
+A$="Jak se Vam libi tento program?"\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB2 :\r
+\r
+SCREEN 0\r
+CLS\r
+rem SOUND RND*1000+20,70\r
+COLOR 4,15\r
+S=0\r
+V=0\r
+rem SOUND RND*300+12,13\r
+rem SOUND RND*10000+12,13\r
+\r
+FOR I=1 TO 10\r
+ rem nechat pokud nebude vadit CLS\r
+ LOCATE 4,20\r
+ PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"\r
+\r
+ A=INT(RND(5)*10+1)\r
+ B=INT(RND(4)*10+1)\r
+ LOCATE 10,5\r
+ REM vymaze radek\r
+ PRINT " "\r
+ PRINT " "\r
+ LOCATE 10,5\r
+ PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+ INPUT " STISKNI ENTER";C\r
+ D=A*B\r
+\r
+ IF D=C THEN ANO2\r
+ PRINT " SPATNY VYSLEDEK"\r
+ rem SOUND RND*10000+12,13\r
+ S=S+1\r
+ GOTO VOLBA2\r
+ rem SOUND RND*100+12,13\r
+ ANO2:\r
+ PRINT " SPRAVNE"\r
+ V=V+1\r
+ VOLBA2:\r
+ LOCATE 18,10\r
+ PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+ REM zdrzeni programu\r
+ FOR G=1 TO 10\r
+ rem SOUND RND*1000+12,13\r
+ NEXT G\r
+NEXT I\r
+\r
+LOCATE 18,10\r
+PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+LOCATE 20,10\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+Input "Ukonci stiskem klavesy ENTER";A\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+FOR A=0 TO 255\r
+COLOR 0,15\r
+SCREEN 0\r
+LOCATE B,A\r
+PRINT A CHR$ (A)"* "\r
+\r
+\r
+REM POKR:\r
+REM LOCATE 5,5\r
+REM PRINT CHR$ (A)\r
+REM FOR I=0 TO 99999\r
+REM NEXT I\r
+NEXT A\r
+END\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+COLOR 0,15\r
+GOTO pet\r
+\r
+pet:\r
+CLS\r
+LOCATE 10,5\r
+input "NORMA SPOTREBY = 8.2 => Enter; NEBO ZAPIS JINOU";S1\r
+IF S1=0 THEN S1= 8.2\r
+CLS\r
+LOCATE 10,5\r
+INPUT "POCET UJETYCH km OD ZACATKU MESICE";K\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV BENZINU - BLOKY NA ZAC. DEKADY";B\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV BENZINU - NADRZ NA ZAC. DEKADY";B4\r
+CLS\r
+LOCATE 10,5\r
+INPUT "CERPANE BLOKY OD ZAC. MESICE - SL.9";B1\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV TACHOMETRU NA ZAC. DEKADY";O\r
+CLS\r
+PRINT SPC(32) "DEKADA"\r
+PRINT "==============================================================================="\r
+PRINT " SLOUPEC 6 ! SLOUPEC 7 ! SLOUPEC 9 ! BENZIN "\r
+PRINT " TACH.KONEC DNE ! KmDen KmCelk! ZAC DOPL CELK ! BLOKY NADRZ "\r
+PRINT "================================================================================"\r
+R=8:K2=0:B6=0\r
+FOR I =1 TO 9: R=R+1\r
+LOCATE 20,1\r
+PRINT\r
+LOCATE 20,1\r
+INPUT "UDEJ POCET UJETYCH km ZA DEN";K1\r
+IF K1=0 THEN konec\r
+K=K1+K:B5=B1+B5:A=(K1/100)*S1:A1=A-INT(A)\r
+IF A1< = .7 THEN raz\r
+IF A1> .7 THEN dva\r
+\r
+raz:\r
+B3=INT(A)\r
+GOTO tri\r
+\r
+dva:\r
+B3=INT(A)+1\r
+GOTO tri\r
+\r
+tri:\r
+LOCATE 20,1:PRINT" "\r
+LOCATE 20,1\r
+PRINT"SPOTREBA/NADRZ:";B3;"/";B4;"=>DOPLNENI NADRZE?":INPUT B2\r
+LOCATE 20,1:PRINT " "\r
+LOCATE 21,1:PRINT " "\r
+B4=B4-B3+B2:B=B-B2:B5=B1+B2\r
+O2=O+K1\r
+LOCATE R-2,9:PRINT O2\r
+LOCATE R-2,22:PRINT K1\r
+LOCATE R-2,30:PRINT K\r
+LOCATE R-2,39:PRINT B1\r
+LOCATE R-2,44:PRINT B2\r
+LOCATE R-2,49:PRINT B5\r
+LOCATE R-2,70:PRINT B4\r
+LOCATE R-2,62:PRINT B\r
+LOCATE R-2,20:PRINT "!"\r
+LOCATE R-2,36:PRINT "!"\r
+LOCATE R-2,58:PRINT "!"\r
+O=O2\r
+B1=B1+B2:K2=K2+K1:B6=B6+B3\r
+NEXT\r
+GOTO konec\r
+\r
+konec:\r
+S=S1*(K2/100)\r
+LOCATE 20,1:PRINT " NORMOVANA SPOTREBA:";S;" "\r
+\r
+LOCATE 20,30:PRINT" "\r
+\r
+LOCATE 21,2:PRINT"SKUTECNA SPOTREBA:";B6;" "\r
+LOCATE 22,2:PRINT"UJETE km V DEKADE:";K2;" "\r
+LOCATE 24,15\r
+INPUT "KONEC = Enter ; OPAKOVANI = 1 ";A\r
+IF A=1 GOTO pet\r
+ END\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP TELEF "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\9f kl vesu Enter A CEKEJ "\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 "\r
+LOCATE 9,23\r
+PRINT " TADY TOMAS MUDRUNKA "\r
+\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+' Q B a s i c G o r i l l a s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Your mission is to hit your opponent with the exploding banana\r
+' by varying the angle and power of your throw, taking into account\r
+' wind speed, gravity, and the city skyline.\r
+'\r
+' Speed of this game is determined by the constant SPEEDCONST. If the\r
+' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line\r
+' below. The larger the number the faster the game will go.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'Sub Declarations\r
+DECLARE SUB DoSun (Mouth)\r
+DECLARE SUB SetScreen ()\r
+DECLARE SUB EndGame ()\r
+DECLARE SUB Center (Row, Text$)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB GetInputs (Player1$, Player2$, NumGames)\r
+DECLARE SUB PlayGame (Player1$, Player2$, NumGames)\r
+DECLARE SUB DoExplosion (x#, y#)\r
+DECLARE SUB MakeCityScape (BCoor() AS ANY)\r
+DECLARE SUB PlaceGorillas (BCoor() AS ANY)\r
+DECLARE SUB UpdateScores (Record(), PlayerNum, Results)\r
+DECLARE SUB DrawGorilla (x, y, arms)\r
+DECLARE SUB GorillaIntro (Player1$, Player2$)\r
+DECLARE SUB Rest (t#)\r
+DECLARE SUB VictoryDance (Player)\r
+DECLARE SUB ClearGorillas ()\r
+DECLARE SUB DrawBan (xc#, yc#, r, bc)\r
+DECLARE FUNCTION Scl (n!)\r
+DECLARE FUNCTION GetNum# (Row, Col)\r
+DECLARE FUNCTION DoShot (PlayerNum, x, y)\r
+DECLARE FUNCTION ExplodeGorilla (x#, y#)\r
+DECLARE FUNCTION Getn# (Row, Col)\r
+DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+DECLARE FUNCTION CalcDelay! ()\r
+\r
+'Make all arrays Dynamic\r
+'$DYNAMIC\r
+\r
+'User-Defined TYPEs\r
+TYPE XYPoint\r
+ XCoor AS INTEGER\r
+ YCoor AS INTEGER\r
+END TYPE\r
+\r
+'Constants\r
+CONST SPEEDCONST = 500\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST HITSELF = 1\r
+CONST BACKATTR = 0\r
+CONST OBJECTCOLOR = 1\r
+CONST WINDOWCOLOR = 14\r
+CONST SUNATTR = 3\r
+CONST SUNHAPPY = FALSE\r
+CONST SUNSHOCK = TRUE\r
+CONST RIGHTUP = 1\r
+CONST LEFTUP = 2\r
+CONST ARMSDOWN = 3\r
+\r
+'Global Variables\r
+DIM SHARED GorillaX(1 TO 2) 'Location of the two gorillas\r
+DIM SHARED GorillaY(1 TO 2)\r
+DIM SHARED LastBuilding\r
+\r
+DIM SHARED pi#\r
+DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana\r
+DIM SHARED GorD&(120) 'Graphical picture of Gorilla arms down\r
+DIM SHARED GorL&(120) 'Gorilla left arm raised\r
+DIM SHARED GorR&(120) 'Gorilla right arm raised\r
+\r
+DIM SHARED gravity#\r
+DIM SHARED Wind\r
+\r
+'Screen Mode Variables\r
+DIM SHARED ScrHeight\r
+DIM SHARED ScrWidth\r
+DIM SHARED Mode\r
+DIM SHARED MaxCol\r
+\r
+'Screen Color Variables\r
+DIM SHARED ExplosionColor\r
+DIM SHARED SunColor\r
+DIM SHARED BackColor\r
+DIM SHARED SunHit\r
+\r
+DIM SHARED SunHt\r
+DIM SHARED GHeight\r
+DIM SHARED MachSpeed AS SINGLE\r
+\r
+ DEF FnRan (x) = INT(RND(1) * x) + 1\r
+ DEF SEG = 0 ' Set NumLock to ON\r
+ KeyFlags = PEEK(1047)\r
+ IF (KeyFlags AND 32) = 0 THEN\r
+ POKE 1047, KeyFlags OR 32\r
+ END IF\r
+ DEF SEG\r
+\r
+ GOSUB InitVars\r
+ Intro\r
+ GetInputs Name1$, Name2$, NumGames\r
+ GorillaIntro Name1$, Name2$\r
+ PlayGame Name1$, Name2$, NumGames\r
+ \r
+ DEF SEG = 0 ' Restore NumLock state\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+END\r
+\r
+\r
+CGABanana:\r
+ 'BananaLeft\r
+ DATA 327686, -252645316, 60\r
+ 'BananaDown\r
+ DATA 196618, -1057030081, 49344\r
+ 'BananaUp\r
+ DATA 196618, -1056980800, 63\r
+ 'BananaRight\r
+ DATA 327686, 1010580720, 240\r
+\r
+EGABanana:\r
+ 'BananaLeft\r
+ DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0\r
+ 'BananaDown\r
+ DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294\r
+ 'BananaUp\r
+ DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239\r
+ 'BananaRight\r
+ DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0\r
+\r
+InitVars:\r
+ pi# = 4 * ATN(1#)\r
+\r
+ 'This is a clever way to pick the best graphics mode available\r
+ ON ERROR GOTO ScreenModeError\r
+ Mode = 9\r
+ SCREEN Mode\r
+ ON ERROR GOTO PaletteError\r
+ IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA\r
+ ON ERROR GOTO 0\r
+\r
+ MachSpeed = CalcDelay\r
+\r
+ IF Mode = 9 THEN\r
+ ScrWidth = 640\r
+ ScrHeight = 350\r
+ GHeight = 25\r
+ RESTORE EGABanana\r
+ REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)\r
+\r
+ FOR i = 0 TO 8\r
+ READ LBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ DBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ UBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ RBan&(i)\r
+ NEXT i\r
+\r
+ SunHt = 39\r
+\r
+ ELSE\r
+\r
+ ScrWidth = 320\r
+ ScrHeight = 200\r
+ GHeight = 12\r
+ RESTORE CGABanana\r
+ REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)\r
+ REDIM GorL&(20), GorD&(20), GorR&(20)\r
+\r
+ FOR i = 0 TO 2\r
+ READ LBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ DBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ UBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ RBan&(i)\r
+ NEXT i\r
+\r
+ MachSpeed = MachSpeed * 1.3\r
+ SunHt = 20\r
+ END IF\r
+RETURN\r
+\r
+ScreenModeError:\r
+ IF Mode = 1 THEN\r
+ CLS\r
+ LOCATE 10, 5\r
+ PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"\r
+ END\r
+ ELSE\r
+ Mode = 1\r
+ RESUME\r
+ END IF\r
+\r
+PaletteError:\r
+ Mode = 1 '64K EGA cards will run in CGA mode.\r
+ RESUME NEXT\r
+\r
+REM $STATIC\r
+'CalcDelay:\r
+' Checks speed of the machine.\r
+FUNCTION CalcDelay!\r
+\r
+ s! = TIMER\r
+ DO\r
+ i! = i! + 1\r
+ LOOP UNTIL TIMER - s! >= .5\r
+ CalcDelay! = i!\r
+\r
+END FUNCTION\r
+\r
+' Center:\r
+' Centers and prints a text string on a given row\r
+' Parameters:\r
+' Row - screen row number\r
+' Text$ - text to be printed\r
+'\r
+SUB Center (Row, Text$)\r
+ Col = MaxCol \ 2\r
+ LOCATE Row, Col - (LEN(Text$) / 2 + .5)\r
+ PRINT Text$;\r
+END SUB\r
+\r
+' DoExplosion:\r
+' Produces explosion when a shot is fired\r
+' Parameters:\r
+' X#, Y# - location of explosion\r
+'\r
+SUB DoExplosion (x#, y#)\r
+\r
+ PLAY "MBO0L32EFGEFDC"\r
+ Radius = ScrHeight / 50\r
+ IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41\r
+ FOR c# = 0 TO Radius STEP Inc#\r
+ CIRCLE (x#, y#), c#, ExplosionColor\r
+ NEXT c#\r
+ FOR c# = Radius TO 0 STEP (-1 * Inc#)\r
+ CIRCLE (x#, y#), c#, BACKATTR\r
+ FOR i = 1 TO 100\r
+ NEXT i\r
+ Rest .005\r
+ NEXT c#\r
+END SUB\r
+\r
+' DoShot:\r
+' Controls banana shots by accepting player input and plotting\r
+' shot angle\r
+' Parameters:\r
+' PlayerNum - Player\r
+' x, y - Player's gorilla position\r
+'\r
+FUNCTION DoShot (PlayerNum, x, y)\r
+\r
+ 'Input shot\r
+ IF PlayerNum = 1 THEN\r
+ LocateCol = 1\r
+ ELSE\r
+ IF Mode = 9 THEN\r
+ LocateCol = 66\r
+ ELSE\r
+ LocateCol = 26\r
+ END IF\r
+ END IF\r
+\r
+ LOCATE 2, LocateCol\r
+ PRINT "Angle:";\r
+ Angle# = GetNum#(2, LocateCol + 7)\r
+\r
+ LOCATE 3, LocateCol\r
+ PRINT "Velocity:";\r
+ Velocity = GetNum#(3, LocateCol + 10)\r
+\r
+ IF PlayerNum = 2 THEN\r
+ Angle# = 180 - Angle#\r
+ END IF\r
+\r
+ 'Erase input\r
+ FOR i = 1 TO 4\r
+ LOCATE i, 1\r
+ PRINT SPACE$(30 \ (80 \ MaxCol));\r
+ LOCATE i, (50 \ (80 \ MaxCol))\r
+ PRINT SPACE$(30 \ (80 \ MaxCol));\r
+ NEXT\r
+\r
+ SunHit = FALSE\r
+ PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)\r
+ IF PlayerHit = 0 THEN\r
+ DoShot = FALSE\r
+ ELSE\r
+ DoShot = TRUE\r
+ IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum\r
+ VictoryDance PlayerNum\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+' DoSun:\r
+' Draws the sun at the top of the screen.\r
+' Parameters:\r
+' Mouth - If TRUE draws "O" mouth else draws a smile mouth.\r
+'\r
+SUB DoSun (Mouth)\r
+\r
+ 'set position of sun\r
+ x = ScrWidth \ 2: y = Scl(25)\r
+\r
+ 'clear old sun\r
+ LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF\r
+\r
+ 'draw new sun:\r
+ 'body\r
+ CIRCLE (x, y), Scl(12), SUNATTR\r
+ PAINT (x, y), SUNATTR\r
+\r
+ 'rays\r
+ LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR\r
+ LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR\r
+\r
+ LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR\r
+ LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR\r
+\r
+ LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR\r
+ LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR\r
+\r
+ LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR\r
+ LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR\r
+\r
+ 'mouth\r
+ IF Mouth THEN 'draw "o" mouth\r
+ CIRCLE (x, y + Scl(5)), Scl(2.9), 0\r
+ PAINT (x, y + Scl(5)), 0, 0\r
+ ELSE 'draw smile\r
+ CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)\r
+ END IF\r
+\r
+ 'eyes\r
+ CIRCLE (x - 3, y - 2), 1, 0\r
+ CIRCLE (x + 3, y - 2), 1, 0\r
+ PSET (x - 3, y - 2), 0\r
+ PSET (x + 3, y - 2), 0\r
+\r
+END SUB\r
+\r
+'DrawBan:\r
+' Draws the banana\r
+'Parameters:\r
+' xc# - Horizontal Coordinate\r
+' yc# - Vertical Coordinate\r
+' r - rotation position (0-3). ( \_/ ) /-\\r
+' bc - if TRUE then DrawBan draws the banana ELSE it erases the banana\r
+SUB DrawBan (xc#, yc#, r, bc)\r
+\r
+SELECT CASE r\r
+ CASE 0\r
+ IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR\r
+ CASE 1\r
+ IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR\r
+ CASE 2\r
+ IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR\r
+ CASE 3\r
+ IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR\r
+END SELECT\r
+\r
+END SUB\r
+\r
+'DrawGorilla:\r
+' Draws the Gorilla in either CGA or EGA mode\r
+' and saves the graphics data in an array.\r
+'Parameters:\r
+' x - x coordinate of gorilla\r
+' y - y coordinate of the gorilla\r
+' arms - either Left up, Right up, or both down\r
+SUB DrawGorilla (x, y, arms)\r
+ DIM i AS SINGLE ' Local index must be single precision\r
+\r
+ 'draw head\r
+ LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF\r
+ LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF\r
+\r
+ 'draw eyes/brow\r
+ LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0\r
+\r
+ 'draw nose if ega\r
+ IF Mode = 9 THEN\r
+ FOR i = -2 TO -1\r
+ PSET (x + i, y + 4), 0\r
+ PSET (x + i + 3, y + 4), 0\r
+ NEXT i\r
+ END IF\r
+\r
+ 'neck\r
+ LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR\r
+\r
+ 'body\r
+ LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF\r
+ LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF\r
+\r
+ 'legs\r
+ FOR i = 0 TO 4\r
+ CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8\r
+ CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4\r
+ NEXT\r
+\r
+ 'chest\r
+ CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0\r
+ CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2\r
+\r
+ FOR i = -5 TO -1\r
+ SELECT CASE arms\r
+ CASE 1\r
+ 'Right arm up\r
+ CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&\r
+ CASE 2\r
+ 'Left arm up\r
+ CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&\r
+ CASE 3\r
+ 'Both arms down\r
+ CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&\r
+ END SELECT\r
+ NEXT i\r
+END SUB\r
+\r
+'ExplodeGorilla:\r
+' Causes gorilla explosion when a direct hit occurs\r
+'Parameters:\r
+' X#, Y# - shot location\r
+FUNCTION ExplodeGorilla (x#, y#)\r
+ YAdj = Scl(12)\r
+ XAdj = Scl(5)\r
+ SclX# = ScrWidth / 320\r
+ SclY# = ScrHeight / 200\r
+ IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2\r
+ PLAY "MBO0L16EFGEFDC"\r
+\r
+ FOR i = 1 TO 8 * SclX#\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57\r
+ LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor\r
+ NEXT i\r
+\r
+ FOR i = 1 TO 16 * SclX#\r
+ IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57\r
+ NEXT i\r
+\r
+ FOR i = 24 * SclX# TO 1 STEP -1\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57\r
+ FOR Count = 1 TO 200\r
+ NEXT\r
+ NEXT i\r
+\r
+ ExplodeGorilla = PlayerHit\r
+END FUNCTION\r
+\r
+'GetInputs:\r
+' Gets user inputs at beginning of game\r
+'Parameters:\r
+' Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB GetInputs (Player1$, Player2$, NumGames)\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ LOCATE 8, 15\r
+ LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$\r
+ IF Player1$ = "" THEN\r
+ Player1$ = "Player 1"\r
+ ELSE\r
+ Player1$ = LEFT$(Player1$, 10)\r
+ END IF\r
+\r
+ LOCATE 10, 15\r
+ LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$\r
+ IF Player2$ = "" THEN\r
+ Player2$ = "Player 2"\r
+ ELSE\r
+ Player2$ = LEFT$(Player2$, 10)\r
+ END IF\r
+\r
+ DO\r
+ LOCATE 12, 56: PRINT SPACE$(25);\r
+ LOCATE 12, 13\r
+ INPUT "Play to how many total points (Default = 3)"; game$\r
+ NumGames = VAL(LEFT$(game$, 2))\r
+ LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0\r
+ IF NumGames = 0 THEN NumGames = 3\r
+\r
+ DO\r
+ LOCATE 14, 53: PRINT SPACE$(28);\r
+ LOCATE 14, 17\r
+ INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$\r
+ gravity# = VAL(grav$)\r
+ LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0\r
+ IF gravity# = 0 THEN gravity# = 9.8\r
+END SUB\r
+\r
+'GetNum:\r
+' Gets valid numeric input from user\r
+'Parameters:\r
+' Row, Col - location to echo input\r
+FUNCTION GetNum# (Row, Col)\r
+ Result$ = ""\r
+ Done = FALSE\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ DO WHILE NOT Done\r
+\r
+ LOCATE Row, Col\r
+ PRINT Result$; CHR$(95); " ";\r
+\r
+ Kbd$ = INKEY$\r
+ SELECT CASE Kbd$\r
+ CASE "0" TO "9"\r
+ Result$ = Result$ + Kbd$\r
+ CASE "."\r
+ IF INSTR(Result$, ".") = 0 THEN\r
+ Result$ = Result$ + Kbd$\r
+ END IF\r
+ CASE CHR$(13)\r
+ IF VAL(Result$) > 360 THEN\r
+ Result$ = ""\r
+ ELSE\r
+ Done = TRUE\r
+ END IF\r
+ CASE CHR$(8)\r
+ IF LEN(Result$) > 0 THEN\r
+ Result$ = LEFT$(Result$, LEN(Result$) - 1)\r
+ END IF\r
+ CASE ELSE\r
+ IF LEN(Kbd$) > 0 THEN\r
+ BEEP\r
+ END IF\r
+ END SELECT\r
+ LOOP\r
+\r
+ LOCATE Row, Col\r
+ PRINT Result$; " ";\r
+\r
+ GetNum# = VAL(Result$)\r
+END FUNCTION\r
+\r
+'GorillaIntro:\r
+' Displays gorillas on screen for the first time\r
+' allows the graphical data to be put into an array\r
+'Parameters:\r
+' Player1$, Player2$ - The names of the players\r
+'\r
+SUB GorillaIntro (Player1$, Player2$)\r
+ LOCATE 16, 34: PRINT "--------------"\r
+ LOCATE 18, 34: PRINT "V = View Intro"\r
+ LOCATE 19, 34: PRINT "P = Play Game"\r
+ LOCATE 21, 35: PRINT "Your Choice?"\r
+\r
+ DO WHILE Char$ = ""\r
+ Char$ = INKEY$\r
+ LOOP\r
+\r
+ IF Mode = 1 THEN\r
+ x = 125\r
+ y = 100\r
+ ELSE\r
+ x = 278\r
+ y = 175\r
+ END IF\r
+\r
+ SCREEN Mode\r
+ SetScreen\r
+\r
+ IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."\r
+\r
+ VIEW PRINT 9 TO 24\r
+\r
+ IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor\r
+ \r
+ DrawGorilla x, y, ARMSDOWN\r
+ CLS 2\r
+ DrawGorilla x, y, LEFTUP\r
+ CLS 2\r
+ DrawGorilla x, y, RIGHTUP\r
+ CLS 2\r
+ \r
+ VIEW PRINT 1 TO 25\r
+ IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46\r
+ \r
+ IF UCASE$(Char$) = "V" THEN\r
+ Center 2, "Q B A S I C G O R I L L A S"\r
+ Center 5, " STARRING: "\r
+ P$ = Player1$ + " AND " + Player2$\r
+ Center 7, P$\r
+\r
+ PUT (x - 13, y), GorD&, PSET\r
+ PUT (x + 47, y), GorD&, PSET\r
+ Rest 1\r
+\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"\r
+ Rest .3\r
+\r
+ FOR i = 1 TO 4\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "T160O0L32EFGEFDC"\r
+ Rest .1\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "T160O0L32EFGEFDC"\r
+ Rest .1\r
+ NEXT\r
+ END IF\r
+END SUB\r
+\r
+'Intro:\r
+' Displays game introduction\r
+SUB Intro\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ MaxCol = 80\r
+ COLOR 15, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c G O R I L L A S"\r
+ COLOR 7\r
+ Center 6, "Copyright (C) Microsoft Corporation 1990"\r
+ Center 8, "Your mission is to hit your opponent with the exploding"\r
+ Center 9, "banana by varying the angle and power of your throw, taking"\r
+ Center 10, "into account wind speed, gravity, and the city skyline."\r
+ Center 11, "The wind speed is shown by a directional arrow at the bottom"\r
+ Center 12, "of the playing field, its length relative to its strength."\r
+ Center 24, "Press any key to continue"\r
+\r
+ PLAY "MBT160O1L8CDEDCDL4ECC"\r
+ SparklePause\r
+ IF Mode = 1 THEN MaxCol = 40\r
+END SUB\r
+\r
+'MakeCityScape:\r
+' Creates random skyline for game\r
+'Parameters:\r
+' BCoor() - a user-defined type array which stores the coordinates of\r
+' the upper left corner of each building.\r
+SUB MakeCityScape (BCoor() AS XYPoint)\r
+\r
+ x = 2\r
+\r
+ 'Set the sloping trend of the city scape. NewHt is new building height\r
+ Slope = FnRan(6)\r
+ SELECT CASE Slope\r
+ CASE 1: NewHt = 15 'Upward slope\r
+ CASE 2: NewHt = 130 'Downward slope\r
+ CASE 3 TO 5: NewHt = 15 '"V" slope - most common\r
+ CASE 6: NewHt = 130 'Inverted "V" slope\r
+ END SELECT\r
+\r
+ IF Mode = 9 THEN\r
+ BottomLine = 335 'Bottom of building\r
+ HtInc = 10 'Increase value for new height\r
+ DefBWidth = 37 'Default building height\r
+ RandomHeight = 120 'Random height difference\r
+ WWidth = 3 'Window width\r
+ WHeight = 6 'Window height\r
+ WDifV = 15 'Counter for window spacing - vertical\r
+ WDifh = 10 'Counter for window spacing - horizontal\r
+ ELSE\r
+ BottomLine = 190\r
+ HtInc = 6\r
+ NewHt = NewHt * 20 \ 35 'Adjust for CGA\r
+ DefBWidth = 18\r
+ RandomHeight = 54\r
+ WWidth = 1\r
+ WHeight = 2\r
+ WDifV = 5\r
+ WDifh = 4\r
+ END IF\r
+\r
+ CurBuilding = 1\r
+ DO\r
+\r
+ SELECT CASE Slope\r
+ CASE 1\r
+ NewHt = NewHt + HtInc\r
+ CASE 2\r
+ NewHt = NewHt - HtInc\r
+ CASE 3 TO 5\r
+ IF x > ScrWidth \ 2 THEN\r
+ NewHt = NewHt - 2 * HtInc\r
+ ELSE\r
+ NewHt = NewHt + 2 * HtInc\r
+ END IF\r
+ CASE 4\r
+ IF x > ScrWidth \ 2 THEN\r
+ NewHt = NewHt + 2 * HtInc\r
+ ELSE\r
+ NewHt = NewHt - 2 * HtInc\r
+ END IF\r
+ END SELECT\r
+\r
+ 'Set width of building and check to see if it would go off the screen\r
+ BWidth = FnRan(DefBWidth) + DefBWidth\r
+ IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2\r
+\r
+ 'Set height of building and check to see if it goes below screen\r
+ BHeight = FnRan(RandomHeight) + NewHt\r
+ IF BHeight < HtInc THEN BHeight = HtInc\r
+\r
+ 'Check to see if Building is too high\r
+ IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5\r
+\r
+ 'Set the coordinates of the building into the array\r
+ BCoor(CurBuilding).XCoor = x\r
+ BCoor(CurBuilding).YCoor = BottomLine - BHeight\r
+\r
+ IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2\r
+\r
+ 'Draw the building, outline first, then filled\r
+ LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B\r
+ LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF\r
+\r
+ 'Draw the windows\r
+ c = x + 3\r
+ DO\r
+ FOR i = BHeight - 3 TO 7 STEP -WDifV\r
+ IF Mode <> 9 THEN\r
+ WinColr = (FnRan(2) - 2) * -3\r
+ ELSEIF FnRan(4) = 1 THEN\r
+ WinColr = 8\r
+ ELSE\r
+ WinColr = WINDOWCOLOR\r
+ END IF\r
+ LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF\r
+ NEXT\r
+ c = c + WDifh\r
+ LOOP UNTIL c >= x + BWidth - 3\r
+\r
+ x = x + BWidth + 2\r
+\r
+ CurBuilding = CurBuilding + 1\r
+\r
+ LOOP UNTIL x > ScrWidth - HtInc\r
+\r
+ LastBuilding = CurBuilding - 1\r
+\r
+ 'Set Wind speed\r
+ Wind = FnRan(10) - 5\r
+ IF FnRan(3) = 1 THEN\r
+ IF Wind > 0 THEN\r
+ Wind = Wind + FnRan(10)\r
+ ELSE\r
+ Wind = Wind - FnRan(10)\r
+ END IF\r
+ END IF\r
+\r
+ 'Draw Wind speed arrow\r
+ IF Wind <> 0 THEN\r
+ WindLine = Wind * 3 * (ScrWidth \ 320)\r
+ LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor\r
+ IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2\r
+ LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor\r
+ LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor\r
+ END IF\r
+END SUB\r
+\r
+'PlaceGorillas:\r
+' PUTs the Gorillas on top of the buildings. Must have drawn\r
+' Gorillas first.\r
+'Parameters:\r
+' BCoor() - user-defined TYPE array which stores upper left coordinates\r
+' of each building.\r
+SUB PlaceGorillas (BCoor() AS XYPoint)\r
+ \r
+ IF Mode = 9 THEN\r
+ XAdj = 14\r
+ YAdj = 30\r
+ ELSE\r
+ XAdj = 7\r
+ YAdj = 16\r
+ END IF\r
+ SclX# = ScrWidth / 320\r
+ SclY# = ScrHeight / 200\r
+ \r
+ 'Place gorillas on second or third building from edge\r
+ FOR i = 1 TO 2\r
+ IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)\r
+\r
+ BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor\r
+ GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj\r
+ GorillaY(i) = BCoor(BNum).YCoor - YAdj\r
+ PUT (GorillaX(i), GorillaY(i)), GorD&, PSET\r
+ NEXT i\r
+\r
+END SUB\r
+\r
+'PlayGame:\r
+' Main game play routine\r
+'Parameters:\r
+' Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB PlayGame (Player1$, Player2$, NumGames)\r
+ DIM BCoor(0 TO 30) AS XYPoint\r
+ DIM TotalWins(1 TO 2)\r
+\r
+ J = 1\r
+ \r
+ FOR i = 1 TO NumGames\r
+ \r
+ CLS\r
+ RANDOMIZE (TIMER)\r
+ CALL MakeCityScape(BCoor())\r
+ CALL PlaceGorillas(BCoor())\r
+ DoSun SUNHAPPY\r
+ Hit = FALSE\r
+ DO WHILE Hit = FALSE\r
+ J = 1 - J\r
+ LOCATE 1, 1\r
+ PRINT Player1$\r
+ LOCATE 1, (MaxCol - 1 - LEN(Player2$))\r
+ PRINT Player2$\r
+ Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))\r
+ Tosser = J + 1: Tossee = 3 - J\r
+\r
+ 'Plot the shot. Hit is true if Gorilla gets hit.\r
+ Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))\r
+\r
+ 'Reset the sun, if it got hit\r
+ IF SunHit THEN DoSun SUNHAPPY\r
+\r
+ IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)\r
+ LOOP\r
+ SLEEP 1\r
+ NEXT i\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ MaxCol = 80\r
+ CLS\r
+\r
+ Center 8, "GAME OVER!"\r
+ Center 10, "Score:"\r
+ LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)\r
+ LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)\r
+ Center 24, "Press any key to continue"\r
+ SparklePause\r
+ COLOR 7, 0\r
+ CLS\r
+END SUB\r
+\r
+'PlayGame:\r
+' Plots banana shot across the screen\r
+'Parameters:\r
+' StartX, StartY - starting shot location\r
+' Angle - shot angle\r
+' Velocity - shot velocity\r
+' PlayerNum - the banana thrower\r
+FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+\r
+ Angle# = Angle# / 180 * pi# 'Convert degree angle to radians\r
+ Radius = Mode MOD 7\r
+\r
+ InitXVel# = COS(Angle#) * Velocity\r
+ InitYVel# = SIN(Angle#) * Velocity\r
+\r
+ oldx# = StartX\r
+ oldy# = StartY\r
+\r
+ 'draw gorilla toss\r
+ IF PlayerNum = 1 THEN\r
+ PUT (StartX, StartY), GorL&, PSET\r
+ ELSE\r
+ PUT (StartX, StartY), GorR&, PSET\r
+ END IF\r
+ \r
+ 'throw sound\r
+ PLAY "MBo0L32A-L64CL16BL64A+"\r
+ Rest .1\r
+\r
+ 'redraw gorilla\r
+ PUT (StartX, StartY), GorD&, PSET\r
+\r
+ adjust = Scl(4) 'For scaling CGA\r
+\r
+ xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check\r
+\r
+ Impact = FALSE\r
+ ShotInSun = FALSE\r
+ OnScreen = TRUE\r
+ PlayerHit = 0\r
+ NeedErase = FALSE\r
+\r
+ StartXPos = StartX\r
+ StartYPos = StartY - adjust - 3\r
+\r
+ IF PlayerNum = 2 THEN\r
+ StartXPos = StartXPos + Scl(25)\r
+ direction = Scl(4)\r
+ ELSE\r
+ direction = Scl(-4)\r
+ END IF\r
+\r
+ IF Velocity < 2 THEN 'Shot too slow - hit self\r
+ x# = StartX\r
+ y# = StartY\r
+ pointval = OBJECTCOLOR\r
+ END IF\r
+ \r
+ DO WHILE (NOT Impact) AND OnScreen\r
+ \r
+ Rest .02\r
+\r
+ 'Erase old banana, if necessary\r
+ IF NeedErase THEN\r
+ NeedErase = FALSE\r
+ CALL DrawBan(oldx#, oldy#, oldrot, FALSE)\r
+ END IF\r
+\r
+ x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)\r
+ y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)\r
+ \r
+ IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN\r
+ OnScreen = FALSE\r
+ END IF\r
+\r
+ \r
+ IF OnScreen AND y# > 0 THEN\r
+\r
+ 'check it\r
+ LookY = 0\r
+ LookX = Scl(8 * (2 - PlayerNum))\r
+ DO\r
+ pointval = POINT(x# + LookX, y# + LookY)\r
+ IF pointval = 0 THEN\r
+ Impact = FALSE\r
+ IF ShotInSun = TRUE THEN\r
+ IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE\r
+ END IF\r
+ ELSEIF pointval = SUNATTR AND y# < SunHt THEN\r
+ IF NOT SunHit THEN DoSun SUNSHOCK\r
+ SunHit = TRUE\r
+ ShotInSun = TRUE\r
+ ELSE\r
+ Impact = TRUE\r
+ END IF\r
+ LookX = LookX + direction\r
+ LookY = LookY + Scl(6)\r
+ LOOP UNTIL Impact OR LookX <> Scl(4)\r
+ \r
+ IF NOT ShotInSun AND NOT Impact THEN\r
+ 'plot it\r
+ rot = (t# * 10) MOD 4\r
+ CALL DrawBan(x#, y#, rot, TRUE)\r
+ NeedErase = TRUE\r
+ END IF\r
+ \r
+ oldx# = x#\r
+ oldy# = y#\r
+ oldrot = rot\r
+\r
+ END IF\r
+\r
+ \r
+ t# = t# + .1\r
+\r
+ LOOP\r
+\r
+ IF pointval <> OBJECTCOLOR AND Impact THEN\r
+ CALL DoExplosion(x# + adjust, y# + adjust)\r
+ ELSEIF pointval = OBJECTCOLOR THEN\r
+ PlayerHit = ExplodeGorilla(x#, y#)\r
+ END IF\r
+\r
+ PlotShot = PlayerHit\r
+\r
+END FUNCTION\r
+\r
+'Rest:\r
+' pauses the program\r
+SUB Rest (t#)\r
+ s# = TIMER\r
+ t2# = MachSpeed * t# / SPEEDCONST\r
+ DO\r
+ LOOP UNTIL TIMER - s# > t2#\r
+END SUB\r
+\r
+'Scl:\r
+' Pass the number in to scaling for cga. If the number is a decimal, then we\r
+' want to scale down for cga or scale up for ega. This allows a full range\r
+' of numbers to be generated for scaling.\r
+' (i.e. for 3 to get scaled to 1, pass in 2.9)\r
+FUNCTION Scl (n!)\r
+\r
+ IF n! <> INT(n!) THEN\r
+ IF Mode = 1 THEN n! = n! - 1\r
+ END IF\r
+ IF Mode = 1 THEN\r
+ Scl = CINT(n! / 2 + .1)\r
+ ELSE\r
+ Scl = CINT(n!)\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+'SetScreen:\r
+' Sets the appropriate color statements\r
+SUB SetScreen\r
+\r
+ IF Mode = 9 THEN\r
+ ExplosionColor = 2\r
+ BackColor = 1\r
+ PALETTE 0, 1\r
+ PALETTE 1, 46\r
+ PALETTE 2, 44\r
+ PALETTE 3, 54\r
+ PALETTE 5, 7\r
+ PALETTE 6, 4\r
+ PALETTE 7, 3\r
+ PALETTE 9, 63 'Display Color\r
+ ELSE\r
+ ExplosionColor = 2\r
+ BackColor = 0\r
+ COLOR BackColor, 2\r
+\r
+ END IF\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro and game over screens\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ A$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR A = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(A$, A, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(A$, 6 - A, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (A + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT A\r
+ WEND\r
+END SUB\r
+\r
+'UpdateScores:\r
+' Updates players' scores\r
+'Parameters:\r
+' Record - players' scores\r
+' PlayerNum - player\r
+' Results - results of player's shot\r
+SUB UpdateScores (Record(), PlayerNum, Results)\r
+ IF Results = HITSELF THEN\r
+ Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1\r
+ ELSE\r
+ Record(PlayerNum) = Record(PlayerNum) + 1\r
+ END IF\r
+END SUB\r
+\r
+'VictoryDance:\r
+' gorilla dances after he has eliminated his opponent\r
+'Parameters:\r
+' Player - which gorilla is dancing\r
+SUB VictoryDance (Player)\r
+\r
+ FOR i# = 1 TO 4\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ NEXT\r
+END SUB\r
+\r
--- /dev/null
+'\r
+' Q B a s i c M O N E Y M A N A G E R\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' The Money Manager is a personal finance manager that allows you\r
+' to enter account transactions while tracking your account balances\r
+' and net worth.\r
+'\r
+' To run this program, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+\r
+'Set default data type to integer for faster operation\r
+DEFINT A-Z\r
+\r
+'Sub and function declarations\r
+DECLARE SUB TransactionSummary (item%)\r
+DECLARE SUB LCenter (text$)\r
+DECLARE SUB ScrollUp ()\r
+DECLARE SUB ScrollDown ()\r
+DECLARE SUB Initialize ()\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB Center (row%, text$)\r
+DECLARE SUB FancyCls (dots%, Background%)\r
+DECLARE SUB LoadState ()\r
+DECLARE SUB SaveState ()\r
+DECLARE SUB MenuSystem ()\r
+DECLARE SUB MakeBackup ()\r
+DECLARE SUB RestoreBackup ()\r
+DECLARE SUB Box (Row1%, Col1%, Row2%, Col2%)\r
+DECLARE SUB NetWorthReport ()\r
+DECLARE SUB EditAccounts ()\r
+DECLARE SUB PrintHelpLine (help$)\r
+DECLARE SUB EditTrans (item%)\r
+DECLARE FUNCTION Cvdt$ (X#)\r
+DECLARE FUNCTION Cvst$ (X!)\r
+DECLARE FUNCTION Cvit$ (X%)\r
+DECLARE FUNCTION Menu% (CurrChoiceX%, MaxChoice%, choice$(), ItemRow%(), ItemCol%(), help$(), BarMode%)\r
+DECLARE FUNCTION GetString$ (row%, col%, start$, end$, Vis%, Max%)\r
+DECLARE FUNCTION Trim$ (X$)\r
+\r
+'Constants\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+\r
+'User-defined types\r
+TYPE AccountType\r
+ Title AS STRING * 20\r
+ AType AS STRING * 1\r
+ Desc AS STRING * 50\r
+END TYPE\r
+\r
+TYPE Recordtype\r
+ Date AS STRING * 8\r
+ Ref AS STRING * 10\r
+ Desc AS STRING * 50\r
+ Fig1 AS DOUBLE\r
+ Fig2 AS DOUBLE\r
+END TYPE\r
+\r
+'Global variables\r
+DIM SHARED account(1 TO 19) AS AccountType 'Stores the 19 account titles\r
+DIM SHARED ColorPref 'Color Preference\r
+DIM SHARED colors(0 TO 20, 1 TO 4) 'Different Colors\r
+DIM SHARED ScrollUpAsm(1 TO 7) 'Assembly Language Routines\r
+DIM SHARED ScrollDownAsm(1 TO 7)\r
+DIM SHARED PrintErr AS INTEGER 'Printer error flag\r
+\r
+ DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock\r
+ KeyFlags = PEEK(1047)\r
+ POKE 1047, &H0\r
+ DEF SEG\r
+ \r
+ 'Open money manager data file. If it does not exist in current directory,\r
+ ' goto error handler to create and initialize it.\r
+ ON ERROR GOTO ErrorTrap\r
+ OPEN "money.dat" FOR INPUT AS #1\r
+ CLOSE\r
+ ON ERROR GOTO 0 'Reset error handler\r
+\r
+ Initialize 'Initialize program\r
+ Intro 'Display introduction screen\r
+ MenuSystem 'This is the main program\r
+ COLOR 7, 0 'Clear screen and end\r
+ CLS\r
+\r
+ DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+\r
+ END\r
+\r
+' Error handler for program\r
+' If data file not found, create and initialize a new one.\r
+ErrorTrap:\r
+ SELECT CASE ERR\r
+ ' If data file not found, create and initialize a new one.\r
+ CASE 53\r
+ CLOSE\r
+ ColorPref = 1\r
+ FOR a = 1 TO 19\r
+ account(a).Title = ""\r
+ account(a).AType = ""\r
+ account(a).Desc = ""\r
+ NEXT a\r
+ SaveState\r
+ RESUME\r
+ CASE 24, 25\r
+ PrintErr = TRUE\r
+ Box 8, 13, 14, 69\r
+ Center 11, "Printer not responding ... Press Space to continue"\r
+ WHILE INKEY$ <> "": WEND\r
+ WHILE INKEY$ <> " ": WEND\r
+ RESUME NEXT\r
+ CASE ELSE\r
+ END SELECT\r
+ RESUME NEXT\r
+\r
+\r
+'The following data defines the color schemes available via the main menu.\r
+'\r
+' scrn dots bar back title shdow choice curs cursbk shdow\r
+DATA 0, 7, 15, 7, 0, 7, 0, 15, 0, 0\r
+DATA 1, 9, 12, 3, 0, 1, 15, 0, 7, 0\r
+DATA 3, 15, 13, 1, 14, 3, 15, 0, 7, 0\r
+DATA 7, 12, 15, 4, 14, 0, 15, 15, 1, 0\r
+\r
+'The following data is actually a machine language program to\r
+'scroll the screen up or down very fast using a BIOS call.\r
+DATA &HB8,&H01,&H06,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB\r
+DATA &HB8,&H01,&H07,&HB9,&H01,&H04,&HBA,&H4E,&H16,&HB7,&H00,&HCD,&H10,&HCB\r
+\r
+'Box:\r
+' Draw a box on the screen between the given coordinates.\r
+SUB Box (Row1, Col1, Row2, Col2) STATIC\r
+\r
+ BoxWidth = Col2 - Col1 + 1\r
+\r
+ LOCATE Row1, Col1\r
+ PRINT "Ú"; STRING$(BoxWidth - 2, "Ä"); "¿";\r
+\r
+ FOR a = Row1 + 1 TO Row2 - 1\r
+ LOCATE a, Col1\r
+ PRINT "³"; SPACE$(BoxWidth - 2); "³";\r
+ NEXT a\r
+\r
+ LOCATE Row2, Col1\r
+ PRINT "À"; STRING$(BoxWidth - 2, "Ä"); "Ù";\r
+\r
+END SUB\r
+\r
+'Center:\r
+' Center text on the given row.\r
+SUB Center (row, text$)\r
+ LOCATE row, 41 - LEN(text$) / 2\r
+ PRINT text$;\r
+END SUB\r
+\r
+'Cvdt$:\r
+' Convert a double precision number to a string WITHOUT a leading space.\r
+FUNCTION Cvdt$ (X#)\r
+\r
+ Cvdt$ = RIGHT$(STR$(X#), LEN(STR$(X#)) - 1)\r
+\r
+END FUNCTION\r
+\r
+'Cvit$:\r
+' Convert an integer to a string WITHOUT a leading space.\r
+FUNCTION Cvit$ (X)\r
+ Cvit$ = RIGHT$(STR$(X), LEN(STR$(X)) - 1)\r
+END FUNCTION\r
+\r
+'Cvst$:\r
+' Convert a single precision number to a string WITHOUT a leading space\r
+FUNCTION Cvst$ (X!)\r
+ Cvst$ = RIGHT$(STR$(X!), LEN(STR$(X!)) - 1)\r
+END FUNCTION\r
+\r
+'EditAccounts:\r
+' This is the full-screen editor which allows you to change your account\r
+' titles and descriptions\r
+SUB EditAccounts\r
+\r
+ 'Information about each column\r
+ REDIM help$(4), col(4), Vis(4), Max(4), edit$(19, 3)\r
+\r
+ 'Draw the screen\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 80\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80)\r
+ LOCATE 1, 4: PRINT "Account Editor";\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+\r
+ LOCATE 3, 2: PRINT "No³ Account Title ³ Description ³A/L"\r
+ LOCATE 4, 2: PRINT "ÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄ"\r
+ u$ = "##³\ \³\ \³ ! "\r
+ FOR a = 5 TO 23\r
+ LOCATE a, 2\r
+ X = a - 4\r
+ PRINT USING u$; X; account(X).Title; account(X).Desc; account(X).AType;\r
+ NEXT a\r
+\r
+ 'Initialize variables\r
+ help$(1) = " Account name | <F2=Save and Exit> <Escape=Abort>"\r
+ help$(2) = " Account description | <F2=Save and Exit> <Escape=Abort>"\r
+ help$(3) = " Account type (A = Asset, L = Liability) | <F2=Save and Exit> <Escape=Abort>"\r
+ \r
+ col(1) = 5: col(2) = 26: col(3) = 78\r
+ Vis(1) = 20: Vis(2) = 50: Vis(3) = 1\r
+ Max(1) = 20: Max(2) = 50: Max(3) = 1\r
+\r
+ FOR a = 1 TO 19\r
+ edit$(a, 1) = account(a).Title\r
+ edit$(a, 2) = account(a).Desc\r
+ edit$(a, 3) = account(a).AType\r
+ NEXT a\r
+\r
+ finished = FALSE\r
+\r
+ CurrRow = 1\r
+ CurrCol = 1\r
+ PrintHelpLine help$(CurrCol)\r
+\r
+ 'Loop until F2 or <ESC> is pressed\r
+ DO\r
+ GOSUB EditAccountsShowCursor 'Show Cursor\r
+ DO 'Wait for key\r
+ Kbd$ = INKEY$\r
+ LOOP UNTIL Kbd$ <> ""\r
+\r
+ IF Kbd$ >= " " AND Kbd$ < "~" THEN 'If legal, edit item\r
+ GOSUB EditAccountsEditItem\r
+ END IF\r
+ GOSUB EditAccountsHideCursor 'Hide Cursor so it can move\r
+ 'If it needs to\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(0) + "H" 'Up Arrow\r
+ CurrRow = (CurrRow + 17) MOD 19 + 1\r
+ CASE CHR$(0) + "P" 'Down Arrow\r
+ CurrRow = (CurrRow) MOD 19 + 1\r
+ CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left or Shift+Tab\r
+ CurrCol = (CurrCol + 1) MOD 3 + 1\r
+ PrintHelpLine help$(CurrCol)\r
+ CASE CHR$(0) + "M", CHR$(9) 'Right or Tab\r
+ CurrCol = (CurrCol) MOD 3 + 1\r
+ PrintHelpLine help$(CurrCol)\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ Save = TRUE\r
+ CASE CHR$(27) 'Esc\r
+ finished = TRUE\r
+ Save = FALSE\r
+ CASE CHR$(13) 'Return\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+\r
+ IF Save THEN\r
+ GOSUB EditAccountsSaveData\r
+ END IF\r
+\r
+ EXIT SUB\r
+\r
+EditAccountsShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));\r
+ RETURN\r
+\r
+EditAccountsEditItem:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ ok = FALSE\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(CurrCol), start$, end$, Vis(CurrCol), Max(CurrCol))\r
+ edit$(CurrRow, CurrCol) = LEFT$(end$ + SPACE$(Max(CurrCol)), Max(CurrCol))\r
+ start$ = ""\r
+\r
+ IF CurrCol = 3 THEN\r
+ X$ = UCASE$(end$)\r
+ IF X$ = "A" OR X$ = "L" OR X$ = "" OR X$ = " " THEN\r
+ ok = TRUE\r
+ IF X$ = "" THEN X$ = " "\r
+ edit$(CurrRow, CurrCol) = X$\r
+ ELSE\r
+ BEEP\r
+ END IF\r
+ ELSE\r
+ ok = TRUE\r
+ END IF\r
+ \r
+ LOOP UNTIL ok\r
+ RETURN\r
+\r
+EditAccountsHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ PRINT LEFT$(edit$(CurrRow, CurrCol), Vis(CurrCol));\r
+ RETURN\r
+\r
+\r
+EditAccountsSaveData:\r
+ FOR a = 1 TO 19\r
+ account(a).Title = edit$(a, 1)\r
+ account(a).Desc = edit$(a, 2)\r
+ account(a).AType = edit$(a, 3)\r
+ NEXT a\r
+ SaveState\r
+ RETURN\r
+\r
+END SUB\r
+\r
+'EditTrans:\r
+' This is the full-screen editor which allows you to enter and change\r
+' transactions\r
+SUB EditTrans (item)\r
+\r
+ 'Stores info about each column\r
+ REDIM help$(6), col(6), Vis(6), Max(6), CurrString$(3), CurrFig#(5)\r
+ 'Array to keep the current balance at all the transactions\r
+ REDIM Balance#(1000)\r
+\r
+ 'Open random access file\r
+ file$ = "money." + Cvit$(item)\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+\r
+ 'Initialize variables\r
+ CurrString$(1) = ""\r
+ CurrString$(2) = ""\r
+ CurrString$(3) = ""\r
+ CurrFig#(4) = 0\r
+ CurrFig#(5) = 0\r
+\r
+ GET #1, 1\r
+ IF valid$ <> "THISISVALID" THEN\r
+ LSET IoDate$ = ""\r
+ LSET IoRef$ = ""\r
+ LSET IoDesc$ = ""\r
+ LSET IoFig1$ = MKD$(0)\r
+ LSET IoFig2$ = MKD$(0)\r
+ PUT #1, 2\r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = "1"\r
+ LSET IoBalance$ = MKD$(0)\r
+ PUT #1, 1\r
+ END IF\r
+\r
+ MaxRecord = VAL(IoMaxRecord$)\r
+\r
+ Balance#(0) = 0\r
+ a = 1\r
+ WHILE a <= MaxRecord\r
+ GET #1, a + 1\r
+ Balance#(a) = Balance#(a - 1) + CVD(IoFig1$) - CVD(IoFig2$)\r
+ a = a + 1\r
+ WEND\r
+ GOSUB EditTransWriteBalance\r
+\r
+ help$(1) = "Date of transaction (mm/dd/yy) "\r
+ help$(2) = "Transaction reference number "\r
+ help$(3) = "Transaction description "\r
+ help$(4) = "Increase asset or debt value "\r
+ help$(5) = "Decrease asset or debt value "\r
+\r
+ col(1) = 2\r
+ col(2) = 11\r
+ col(3) = 18\r
+ col(4) = 44\r
+ col(5) = 55\r
+\r
+ Vis(1) = 8\r
+ Vis(2) = 6\r
+ Vis(3) = 25\r
+ Vis(4) = 10\r
+ Vis(5) = 10\r
+\r
+ Max(1) = 8\r
+ Max(2) = 6\r
+ Max(3) = 25\r
+ Max(4) = 10\r
+ Max(5) = 10\r
+\r
+\r
+ 'Draw Screen\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 80\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80);\r
+ LOCATE 1, 4: PRINT "Transaction Editor: " + Trim$(account(item).Title);\r
+\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE 3, 2: PRINT " Date ³ Ref# ³ Description ³ Increase ³ Decrease ³ Balance "\r
+ LOCATE 4, 2: PRINT "ÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"\r
+\r
+ u$ = "\ \³\ \³\ \³"\r
+ u1$ = " ³ ³ ³ ³ ³ "\r
+ u1x$ = "ßßßßßßßß³ßßßßßß³ßßßßßßßßßßßßßßßßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßß³ßßßßßßßßßßßßßß"\r
+ u2$ = "###,###.##"\r
+ u3$ = "###,###,###.##"\r
+ u4$ = " "\r
+\r
+ CurrTopline = 1\r
+ GOSUB EditTransPrintWholeScreen\r
+\r
+ CurrRow = 1\r
+ CurrCol = 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+\r
+ GOSUB EditTransGetLine\r
+\r
+ finished = FALSE\r
+\r
+\r
+ 'Loop until <F2> is pressed\r
+ DO\r
+ GOSUB EditTransShowCursor 'Show Cursor, Wait for key\r
+ DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""\r
+ GOSUB EditTransHideCursor\r
+\r
+ IF Kbd$ >= " " AND Kbd$ < "~" OR Kbd$ = CHR$(8) THEN 'If legal key, edit item\r
+ GOSUB EditTransEditItem\r
+ END IF\r
+\r
+ SELECT CASE Kbd$ 'Handle Special keys\r
+ CASE CHR$(0) + "H" 'up arrow\r
+ GOSUB EditTransMoveUp\r
+ CASE CHR$(0) + "P" 'Down arrow\r
+ GOSUB EditTransMoveDown\r
+ CASE CHR$(0) + "K", CHR$(0) + CHR$(15) 'Left Arrow,BackTab\r
+ CurrCol = (CurrCol + 3) MOD 5 + 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+ CASE CHR$(0) + "M", CHR$(9) 'Right Arrow,Tab\r
+ CurrCol = (CurrCol) MOD 5 + 1\r
+ PrintHelpLine help$(CurrCol) + "| <F2=Save and Exit> <F9=Insert> <F10=Delete>"\r
+ CASE CHR$(0) + "G" 'Home\r
+ CurrCol = 1\r
+ CASE CHR$(0) + "O" 'End\r
+ CurrCol = 5\r
+ CASE CHR$(0) + "I" 'Page Up\r
+ CurrRow = 1\r
+ CurrTopline = CurrTopline - 19\r
+ IF CurrTopline < 1 THEN\r
+ CurrTopline = 1\r
+ END IF\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ CASE CHR$(0) + "Q" 'Page Down\r
+ CurrRow = 1\r
+ CurrTopline = CurrTopline + 19\r
+ IF CurrTopline > MaxRecord THEN\r
+ CurrTopline = MaxRecord\r
+ END IF\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ CASE CHR$(0) + "C" 'F9\r
+ GOSUB EditTransAddRecord\r
+ CASE CHR$(0) + "D" 'F10\r
+ GOSUB EditTransDeleteRecord\r
+ CASE CHR$(13) 'Enter\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+\r
+ CLOSE\r
+\r
+ EXIT SUB\r
+\r
+\r
+EditTransShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));\r
+ CASE 4\r
+ IF CurrFig#(4) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(4);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ CASE 5\r
+ IF CurrFig#(5) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(5);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+EditTransHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE CurrRow + 4, col(CurrCol)\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ PRINT LEFT$(CurrString$(CurrCol), Vis(CurrCol));\r
+ CASE 4\r
+ IF CurrFig#(4) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(4);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ CASE 5\r
+ IF CurrFig#(5) <> 0 THEN\r
+ PRINT USING u2$; CurrFig#(5);\r
+ ELSE\r
+ PRINT SPACE$(Vis(CurrCol));\r
+ END IF\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+EditTransEditItem:\r
+\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+\r
+ SELECT CASE CurrCol\r
+ CASE 1, 2, 3\r
+ Kbd$ = GetString$(CurrRow + 4, col(CurrCol), Kbd$, new$, Vis(CurrCol), Max(CurrCol))\r
+ CurrString$(CurrCol) = new$\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ CASE 4\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(4), start$, new$, Vis(4), Max(4))\r
+ new4# = VAL(new$)\r
+ start$ = ""\r
+ LOOP WHILE new4# >= 999999.99# OR new4# < 0\r
+\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ Balance#(a) = Balance#(a) + new4# - CurrFig#(4) + CurrFig#(5)\r
+ a = a + 1\r
+ WEND\r
+ CurrFig#(4) = new4#\r
+ CurrFig#(5) = 0\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintBalances\r
+ GOSUB EditTransWriteBalance\r
+ CASE 5\r
+ start$ = Kbd$\r
+ DO\r
+ Kbd$ = GetString$(CurrRow + 4, col(5), start$, new$, Vis(5), Max(5))\r
+ new5# = VAL(new$)\r
+ start$ = ""\r
+ LOOP WHILE new5# >= 999999.99# OR new5# < 0\r
+\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ Balance#(a) = Balance#(a) - new5# + CurrFig#(5) - CurrFig#(4)\r
+ a = a + 1\r
+ WEND\r
+ CurrFig#(4) = 0\r
+ CurrFig#(5) = new5#\r
+ GOSUB EditTransPutLine\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintBalances\r
+ GOSUB EditTransWriteBalance\r
+ CASE ELSE\r
+ END SELECT\r
+ GOSUB EditTransPrintLine\r
+ RETURN\r
+\r
+EditTransMoveUp:\r
+ IF CurrRow = 1 THEN\r
+ IF CurrTopline = 1 THEN\r
+ BEEP\r
+ ELSE\r
+ ScrollDown\r
+ CurrTopline = CurrTopline - 1\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintLine\r
+ END IF\r
+ ELSE\r
+ CurrRow = CurrRow - 1\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ RETURN\r
+\r
+EditTransMoveDown:\r
+ IF (CurrRow + CurrTopline - 1) >= MaxRecord THEN\r
+ BEEP\r
+ ELSE\r
+ IF CurrRow = 19 THEN\r
+ ScrollUp\r
+ CurrTopline = CurrTopline + 1\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransPrintLine\r
+ ELSE\r
+ CurrRow = CurrRow + 1\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ END IF\r
+ RETURN\r
+\r
+EditTransPrintLine:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ LOCATE CurrRow + 4, 2\r
+ IF CurrRecord = MaxRecord + 1 THEN\r
+ PRINT u1x$;\r
+ ELSEIF CurrRecord > MaxRecord THEN\r
+ PRINT u1$;\r
+ ELSE\r
+ PRINT USING u$; CurrString$(1); CurrString$(2); CurrString$(3);\r
+ IF CurrFig#(4) = 0 AND CurrFig#(5) = 0 THEN\r
+ PRINT USING u4$ + "³" + u4$ + "³" + u3$; Balance#(CurrRecord)\r
+ ELSEIF CurrFig#(5) = 0 THEN\r
+ PRINT USING u2$ + "³" + u4$ + "³" + u3$; CurrFig#(4); Balance#(CurrRecord)\r
+ ELSE\r
+ PRINT USING u4$ + "³" + u2$ + "³" + u3$; CurrFig#(5); Balance#(CurrRecord)\r
+ END IF\r
+ END IF\r
+ RETURN\r
+\r
+EditTransPrintBalances:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ FOR a = 1 TO 19\r
+ CurrRecord = CurrTopline + a - 1\r
+ IF CurrRecord <= MaxRecord THEN\r
+ LOCATE 4 + a, 66\r
+ PRINT USING u3$; Balance#(CurrTopline + a - 1);\r
+ END IF\r
+ NEXT a\r
+ RETURN\r
+\r
+EditTransDeleteRecord:\r
+ IF MaxRecord = 1 THEN\r
+ BEEP\r
+ ELSE\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ MaxRecord = MaxRecord - 1\r
+ a = CurrRecord\r
+ WHILE a <= MaxRecord\r
+ GET #1, a + 2\r
+ PUT #1, a + 1\r
+ Balance#(a) = Balance#(a + 1) - CurrFig#(4) + CurrFig#(5)\r
+ a = a + 1\r
+ WEND\r
+ \r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = Cvit$(MaxRecord)\r
+ PUT #1, 1\r
+ GOSUB EditTransPrintWholeScreen\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ IF CurrRecord > MaxRecord THEN\r
+ GOSUB EditTransMoveUp\r
+ END IF\r
+ GOSUB EditTransGetLine\r
+ GOSUB EditTransWriteBalance\r
+ END IF\r
+ RETURN\r
+\r
+EditTransAddRecord:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ a = MaxRecord\r
+ WHILE a > CurrRecord\r
+ GET #1, a + 1\r
+ PUT #1, a + 2\r
+ Balance#(a + 1) = Balance#(a)\r
+ a = a - 1\r
+ WEND\r
+ Balance#(CurrRecord + 1) = Balance#(CurrRecord)\r
+ MaxRecord = MaxRecord + 1\r
+ LSET IoDate$ = ""\r
+ LSET IoRef$ = ""\r
+ LSET IoDesc$ = ""\r
+ LSET IoFig1$ = MKD$(0)\r
+ LSET IoFig2$ = MKD$(0)\r
+ PUT #1, CurrRecord + 2\r
+\r
+ LSET valid$ = "THISISVALID"\r
+ LSET IoMaxRecord$ = Cvit$(MaxRecord)\r
+ PUT #1, 1\r
+ GOSUB EditTransPrintWholeScreen\r
+ GOSUB EditTransGetLine\r
+ RETURN\r
+\r
+EditTransPrintWholeScreen:\r
+ temp = CurrRow\r
+ FOR CurrRow = 1 TO 19\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ IF CurrRecord <= MaxRecord THEN\r
+ GOSUB EditTransGetLine\r
+ END IF\r
+ GOSUB EditTransPrintLine\r
+ NEXT CurrRow\r
+ CurrRow = temp\r
+ RETURN\r
+\r
+EditTransWriteBalance:\r
+ GET #1, 1\r
+ LSET IoBalance$ = MKD$(Balance#(MaxRecord))\r
+ PUT #1, 1\r
+ RETURN\r
+\r
+EditTransPutLine:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ LSET IoDate$ = CurrString$(1)\r
+ LSET IoRef$ = CurrString$(2)\r
+ LSET IoDesc$ = CurrString$(3)\r
+ LSET IoFig1$ = MKD$(CurrFig#(4))\r
+ LSET IoFig2$ = MKD$(CurrFig#(5))\r
+ PUT #1, CurrRecord + 1\r
+ RETURN\r
+\r
+EditTransGetLine:\r
+ CurrRecord = CurrTopline + CurrRow - 1\r
+ GET #1, CurrRecord + 1\r
+ CurrString$(1) = IoDate$\r
+ CurrString$(2) = IoRef$\r
+ CurrString$(3) = IoDesc$\r
+ CurrFig#(4) = CVD(IoFig1$)\r
+ CurrFig#(5) = CVD(IoFig2$)\r
+ RETURN\r
+END SUB\r
+\r
+'FancyCls:\r
+' Clears screen in the right color, and draws nice dots.\r
+SUB FancyCls (dots, Background)\r
+\r
+ VIEW PRINT 2 TO 24\r
+ COLOR dots, Background\r
+ CLS 2\r
+\r
+ FOR a = 95 TO 1820 STEP 45\r
+ row = a / 80 + 1\r
+ col = a MOD 80 + 1\r
+ LOCATE row, col\r
+ PRINT CHR$(250);\r
+ NEXT a\r
+\r
+ VIEW PRINT\r
+\r
+END SUB\r
+\r
+'GetString$:\r
+' Given a row and col, and an initial string, edit a string\r
+' VIS is the length of the visible field of entry\r
+' MAX is the maximum number of characters allowed in the string\r
+FUNCTION GetString$ (row, col, start$, end$, Vis, Max)\r
+ curr$ = Trim$(LEFT$(start$, Max))\r
+ IF curr$ = CHR$(8) THEN curr$ = ""\r
+\r
+ LOCATE , , 1\r
+\r
+ finished = FALSE\r
+ DO\r
+ GOSUB GetStringShowText\r
+ GOSUB GetStringGetKey\r
+\r
+ IF LEN(Kbd$) > 1 THEN\r
+ finished = TRUE\r
+ GetString$ = Kbd$\r
+ ELSE\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(13), CHR$(27), CHR$(9)\r
+ finished = TRUE\r
+ GetString$ = Kbd$\r
+ \r
+ CASE CHR$(8)\r
+ IF curr$ <> "" THEN\r
+ curr$ = LEFT$(curr$, LEN(curr$) - 1)\r
+ END IF\r
+\r
+ CASE " " TO "}"\r
+ IF LEN(curr$) < Max THEN\r
+ curr$ = curr$ + Kbd$\r
+ ELSE\r
+ BEEP\r
+ END IF\r
+\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ END IF\r
+\r
+ LOOP UNTIL finished\r
+\r
+ end$ = curr$\r
+ LOCATE , , 0\r
+ EXIT FUNCTION\r
+ \r
+\r
+GetStringShowText:\r
+ LOCATE row, col\r
+ IF LEN(curr$) > Vis THEN\r
+ PRINT RIGHT$(curr$, Vis);\r
+ ELSE\r
+ PRINT curr$; SPACE$(Vis - LEN(curr$));\r
+ LOCATE row, col + LEN(curr$)\r
+ END IF\r
+ RETURN\r
+\r
+GetStringGetKey:\r
+ Kbd$ = ""\r
+ WHILE Kbd$ = ""\r
+ Kbd$ = INKEY$\r
+ WEND\r
+ RETURN\r
+END FUNCTION\r
+\r
+'Initialize:\r
+' Read colors in and set up assembly routines\r
+SUB Initialize\r
+\r
+ WIDTH , 25\r
+ VIEW PRINT\r
+\r
+ FOR ColorSet = 1 TO 4\r
+ FOR X = 1 TO 10\r
+ READ colors(X, ColorSet)\r
+ NEXT X\r
+ NEXT ColorSet\r
+\r
+ LoadState\r
+\r
+ P = VARPTR(ScrollUpAsm(1))\r
+ DEF SEG = VARSEG(ScrollUpAsm(1))\r
+ FOR I = 0 TO 13\r
+ READ J\r
+ POKE (P + I), J\r
+ NEXT I\r
+\r
+ P = VARPTR(ScrollDownAsm(1))\r
+ DEF SEG = VARSEG(ScrollDownAsm(1))\r
+ FOR I = 0 TO 13\r
+ READ J\r
+ POKE (P + I), J\r
+ NEXT I\r
+\r
+ DEF SEG\r
+\r
+END SUB\r
+\r
+'Intro:\r
+' Display introduction screen.\r
+SUB Intro\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c"\r
+ COLOR 15\r
+ Center 5, "Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ Ü Ü Ü Ü ÜÜÜÜ Ü Ü ÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜ ÜÜÜÜÜ"\r
+ Center 6, "ÛßÜ ÜßÛ Û Û ÛÜ Û Û ÛÜÜÜÛ ÛßÜ ÜßÛ Û Û ÛÜ Û Û Û Û Û Û Û"\r
+ Center 7, "Û ß Û Û Û Û ßÜÛ Ûßßß Û Û ß Û ÛßßÛ Û ßÜÛ ÛßßÛ Û ßßÛ Ûßßß ÛßÛßß"\r
+ Center 8, "Û Û ÛÜÜÛ Û Û ÛÜÜÜ Û Û Û Û Û Û Û Û Û ÛÜÜÜÛ ÛÜÜÜ Û ßÜ"\r
+ COLOR 7\r
+ Center 11, "A Personal Finance Manager written in"\r
+ Center 12, "MS-DOS QBasic"\r
+ Center 24, "Press any key to continue"\r
+\r
+ SparklePause\r
+END SUB\r
+\r
+'LCenter:\r
+' Center TEXT$ on the line printer\r
+SUB LCenter (text$)\r
+ LPRINT TAB(41 - LEN(text$) / 2); text$\r
+END SUB\r
+\r
+'LoadState:\r
+' Load color preferences and account info from MONEY.DAT\r
+SUB LoadState\r
+\r
+ OPEN "money.dat" FOR INPUT AS #1\r
+ INPUT #1, ColorPref\r
+\r
+ FOR a = 1 TO 19\r
+ LINE INPUT #1, account(a).Title\r
+ LINE INPUT #1, account(a).AType\r
+ LINE INPUT #1, account(a).Desc\r
+ NEXT a\r
+ \r
+ CLOSE\r
+\r
+END SUB\r
+\r
+'Menu:\r
+' Handles Menu Selection for a single menu (either sub menu, or menu bar)\r
+' currChoiceX : Number of current choice\r
+' maxChoice : Number of choices in the list\r
+' choice$() : Array with the text of the choices\r
+' itemRow() : Array with the row of the choices\r
+' itemCol() : Array with the col of the choices\r
+' help$() : Array with the help text for each choice\r
+' barMode : Boolean: TRUE = menu bar style, FALSE = drop down style\r
+'\r
+' Returns the number of the choice that was made by changing currChoiceX\r
+' and returns the scan code of the key that was pressed to exit\r
+'\r
+FUNCTION Menu (CurrChoiceX, MaxChoice, choice$(), ItemRow(), ItemCol(), help$(), BarMode)\r
+ \r
+ currChoice = CurrChoiceX\r
+\r
+ 'if in bar mode, color in menu bar, else color box/shadow\r
+ 'bar mode means you are currently in the menu bar, not a sub menu\r
+ IF BarMode THEN\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1\r
+ PRINT SPACE$(80);\r
+ ELSE\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box ItemRow(1) - 1, ItemCol(1) - 1, ItemRow(MaxChoice) + 1, ItemCol(1) + LEN(choice$(1)) + 1\r
+ \r
+ COLOR colors(10, ColorPref), colors(6, ColorPref)\r
+ FOR a = 1 TO MaxChoice + 1\r
+ LOCATE ItemRow(1) + a - 1, ItemCol(1) + LEN(choice$(1)) + 2\r
+ PRINT CHR$(178); CHR$(178);\r
+ NEXT a\r
+ LOCATE ItemRow(MaxChoice) + 2, ItemCol(MaxChoice) + 2\r
+ PRINT STRING$(LEN(choice$(MaxChoice)) + 2, 178);\r
+ END IF\r
+ \r
+ 'print the choices\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ FOR a = 1 TO MaxChoice\r
+ LOCATE ItemRow(a), ItemCol(a)\r
+ PRINT choice$(a);\r
+ NEXT a\r
+\r
+ finished = FALSE\r
+\r
+ WHILE NOT finished\r
+ \r
+ GOSUB MenuShowCursor\r
+ GOSUB MenuGetKey\r
+ GOSUB MenuHideCursor\r
+\r
+ SELECT CASE Kbd$\r
+ CASE CHR$(0) + "H": GOSUB MenuUp\r
+ CASE CHR$(0) + "P": GOSUB MenuDown\r
+ CASE CHR$(0) + "K": GOSUB MenuLeft\r
+ CASE CHR$(0) + "M": GOSUB MenuRight\r
+ CASE CHR$(13): GOSUB MenuEnter\r
+ CASE CHR$(27): GOSUB MenuEscape\r
+ CASE ELSE: BEEP\r
+ END SELECT\r
+ WEND\r
+\r
+ Menu = currChoice\r
+\r
+ EXIT FUNCTION\r
+\r
+\r
+MenuEnter:\r
+ finished = TRUE\r
+ RETURN\r
+\r
+MenuEscape:\r
+ currChoice = 0\r
+ finished = TRUE\r
+ RETURN\r
+\r
+MenuUp:\r
+ IF BarMode THEN\r
+ BEEP\r
+ ELSE\r
+ currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1\r
+ END IF\r
+ RETURN\r
+\r
+MenuLeft:\r
+ IF BarMode THEN\r
+ currChoice = (currChoice + MaxChoice - 2) MOD MaxChoice + 1\r
+ ELSE\r
+ currChoice = -2\r
+ finished = TRUE\r
+ END IF\r
+ RETURN\r
+\r
+MenuRight:\r
+ IF BarMode THEN\r
+ currChoice = (currChoice) MOD MaxChoice + 1\r
+ ELSE\r
+ currChoice = -3\r
+ finished = TRUE\r
+ END IF\r
+ RETURN\r
+\r
+MenuDown:\r
+ IF BarMode THEN\r
+ finished = TRUE\r
+ ELSE\r
+ currChoice = (currChoice) MOD MaxChoice + 1\r
+ END IF\r
+ RETURN\r
+\r
+MenuShowCursor:\r
+ COLOR colors(8, ColorPref), colors(9, ColorPref)\r
+ LOCATE ItemRow(currChoice), ItemCol(currChoice)\r
+ PRINT choice$(currChoice);\r
+ PrintHelpLine help$(currChoice)\r
+ RETURN\r
+\r
+MenuGetKey:\r
+ Kbd$ = ""\r
+ WHILE Kbd$ = ""\r
+ Kbd$ = INKEY$\r
+ WEND\r
+ RETURN\r
+\r
+MenuHideCursor:\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ LOCATE ItemRow(currChoice), ItemCol(currChoice)\r
+ PRINT choice$(currChoice);\r
+ RETURN\r
+\r
+\r
+END FUNCTION\r
+\r
+'MenuSystem:\r
+' Main routine that controls the program. Uses the MENU function\r
+' to implement menu system and calls the appropriate function to handle\r
+' the user's selection\r
+SUB MenuSystem\r
+\r
+ DIM choice$(20), menuRow(20), menuCol(20), help$(20)\r
+ LOCATE , , 0\r
+ choice = 1\r
+ finished = FALSE\r
+\r
+ WHILE NOT finished\r
+ GOSUB MenuSystemMain\r
+\r
+ subchoice = -1\r
+ WHILE subchoice < 0\r
+ SELECT CASE choice\r
+ CASE 1: GOSUB MenuSystemFile\r
+ CASE 2: GOSUB MenuSystemEdit\r
+ CASE 3: GOSUB MenuSystemAccount\r
+ CASE 4: GOSUB MenuSystemReport\r
+ CASE 5: GOSUB MenuSystemColors\r
+ END SELECT\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+\r
+ SELECT CASE subchoice\r
+ CASE -2: choice = (choice + 3) MOD 5 + 1\r
+ CASE -3: choice = (choice) MOD 5 + 1\r
+ END SELECT\r
+ WEND\r
+ WEND\r
+ EXIT SUB\r
+\r
+\r
+MenuSystemMain:\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 9, 19, 14, 61\r
+ Center 11, "Use arrow keys to navigate menu system"\r
+ Center 12, "Press Enter to select a menu item"\r
+\r
+ choice$(1) = " File "\r
+ choice$(2) = " Accounts "\r
+ choice$(3) = " Transactions "\r
+ choice$(4) = " Reports "\r
+ choice$(5) = " Colors "\r
+\r
+ menuRow(1) = 1: menuCol(1) = 2\r
+ menuRow(2) = 1: menuCol(2) = 8\r
+ menuRow(3) = 1: menuCol(3) = 18\r
+ menuRow(4) = 1: menuCol(4) = 32\r
+ menuRow(5) = 1: menuCol(5) = 41\r
+ \r
+ help$(1) = "Exit the Money Manager"\r
+ help$(2) = "Add/edit/delete accounts"\r
+ help$(3) = "Add/edit/delete account transactions"\r
+ help$(4) = "View and print reports"\r
+ help$(5) = "Set screen colors"\r
+ \r
+ DO\r
+ NewChoice = Menu((choice), 5, choice$(), menuRow(), menuCol(), help$(), TRUE)\r
+ LOOP WHILE NewChoice = 0\r
+ choice = NewChoice\r
+ RETURN\r
+\r
+MenuSystemFile:\r
+ choice$(1) = " Exit "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 2\r
+\r
+ help$(1) = "Exit the Money Manager"\r
+\r
+ subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1: finished = TRUE\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+MenuSystemEdit:\r
+ choice$(1) = " Edit Account Titles "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 8\r
+ \r
+ help$(1) = "Add/edit/delete accounts"\r
+\r
+ subchoice = Menu(1, 1, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1: EditAccounts\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+MenuSystemAccount:\r
+\r
+ FOR a = 1 TO 19\r
+ IF Trim$(account(a).Title) = "" THEN\r
+ choice$(a) = RIGHT$(STR$(a), 2) + ". ------------------- "\r
+ ELSE\r
+ choice$(a) = RIGHT$(STR$(a), 2) + ". " + account(a).Title\r
+ END IF\r
+ menuRow(a) = a + 2\r
+ menuCol(a) = 19\r
+ help$(a) = RTRIM$(account(a).Desc)\r
+ NEXT a\r
+\r
+ subchoice = Menu(1, 19, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ IF subchoice > 0 THEN\r
+ EditTrans (subchoice)\r
+ END IF\r
+ RETURN\r
+\r
+\r
+MenuSystemReport:\r
+ choice$(1) = " Net Worth Report "\r
+ menuRow(1) = 3: menuCol(1) = 32\r
+ help$(1) = "View and print net worth report"\r
+\r
+ FOR a = 1 TO 19\r
+ IF Trim$(account(a).Title) = "" THEN\r
+ choice$(a + 1) = RIGHT$(STR$(a), 2) + ". ------------------- "\r
+ ELSE\r
+ choice$(a + 1) = RIGHT$(STR$(a), 2) + ". " + account(a).Title\r
+ END IF\r
+ menuRow(a + 1) = a + 3\r
+ menuCol(a + 1) = 32\r
+ help$(a + 1) = "Print " + RTRIM$(account(a).Title) + " transaction summary"\r
+ NEXT a\r
+\r
+ subchoice = Menu(1, 20, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1\r
+ NetWorthReport\r
+ CASE 2 TO 20\r
+ TransactionSummary (subchoice - 1)\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+MenuSystemColors:\r
+ choice$(1) = " Monochrome Scheme "\r
+ choice$(2) = " Cyan/Blue Scheme "\r
+ choice$(3) = " Blue/Cyan Scheme "\r
+ choice$(4) = " Red/Grey Scheme "\r
+\r
+ menuRow(1) = 3: menuCol(1) = 41\r
+ menuRow(2) = 4: menuCol(2) = 41\r
+ menuRow(3) = 5: menuCol(3) = 41\r
+ menuRow(4) = 6: menuCol(4) = 41\r
+\r
+ help$(1) = "Color scheme for monochrome and LCD displays"\r
+ help$(2) = "Color scheme featuring cyan"\r
+ help$(3) = "Color scheme featuring blue"\r
+ help$(4) = "Color scheme featuring red"\r
+\r
+ subchoice = Menu(1, 4, choice$(), menuRow(), menuCol(), help$(), FALSE)\r
+\r
+ SELECT CASE subchoice\r
+ CASE 1 TO 4\r
+ ColorPref = subchoice\r
+ SaveState\r
+ CASE ELSE\r
+ END SELECT\r
+ RETURN\r
+\r
+\r
+END SUB\r
+\r
+'NetWorthReport:\r
+' Prints net worth report to screen and printer\r
+SUB NetWorthReport\r
+ DIM assetIndex(19), liabilityIndex(19)\r
+\r
+ maxAsset = 0\r
+ maxLiability = 0\r
+\r
+ FOR a = 1 TO 19\r
+ IF account(a).AType = "A" THEN\r
+ maxAsset = maxAsset + 1\r
+ assetIndex(maxAsset) = a\r
+ ELSEIF account(a).AType = "L" THEN\r
+ maxLiability = maxLiability + 1\r
+ liabilityIndex(maxLiability) = a\r
+ END IF\r
+ NEXT a\r
+\r
+ 'Loop until <F2> is pressed\r
+ finished = FALSE\r
+ DO\r
+ u1$ = "\ \$$###,###,###.##"\r
+ u2$ = "\ \+$$#,###,###,###.##"\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 1: PRINT SPACE$(80);\r
+ LOCATE 1, 4: PRINT "Net Worth Report: " + DATE$;\r
+ PrintHelpLine "<F2=Exit> <F3=Print Report>"\r
+\r
+ COLOR colors(7, ColorPref), colors(4, ColorPref)\r
+ Box 2, 1, 24, 40\r
+ Box 2, 41, 24, 80\r
+\r
+ LOCATE 2, 16: PRINT " ASSETS "\r
+ assetTotal# = 0\r
+ a = 1\r
+ count1 = 1\r
+ WHILE a <= maxAsset\r
+ file$ = "money." + Cvit$(assetIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LOCATE 2 + count1, 3: PRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)\r
+ assetTotal# = assetTotal# + CVD(IoBalance$)\r
+ count1 = count1 + 1\r
+ END IF\r
+ CLOSE\r
+ a = a + 1\r
+ WEND\r
+\r
+ LOCATE 2, 55: PRINT " LIABILITIES "\r
+ liabilityTotal# = 0\r
+ a = 1\r
+ count2 = 1\r
+ WHILE a <= maxLiability\r
+ file$ = "money." + Cvit$(liabilityIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LOCATE 2 + count2, 43: PRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)\r
+ liabilityTotal# = liabilityTotal# + CVD(IoBalance$)\r
+ count2 = count2 + 1\r
+ END IF\r
+ CLOSE\r
+ a = a + 1\r
+ WEND\r
+ IF count2 > count1 THEN count1 = count2\r
+ LOCATE 2 + count1, 25: PRINT "--------------"\r
+ LOCATE 2 + count1, 65: PRINT "--------------"\r
+ LOCATE 3 + count1, 3: PRINT USING u2$; "Total assets"; assetTotal#;\r
+ LOCATE 3 + count1, 43: PRINT USING u2$; "Total liabilities"; liabilityTotal#\r
+\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 1, 43: PRINT USING u2$; " NET WORTH:"; assetTotal# - liabilityTotal#\r
+\r
+ DO: Kbd$ = INKEY$: LOOP UNTIL Kbd$ <> ""\r
+\r
+ SELECT CASE Kbd$ 'Handle Special keys\r
+ CASE CHR$(0) + "<" 'F2\r
+ finished = TRUE\r
+ CASE CHR$(0) + "=" 'F3\r
+ GOSUB NetWorthReportPrint\r
+ CASE ELSE\r
+ BEEP\r
+ END SELECT\r
+ LOOP UNTIL finished\r
+ EXIT SUB\r
+\r
+NetWorthReportPrint:\r
+ PrintHelpLine ""\r
+ \r
+ Box 8, 20, 14, 62\r
+ Center 10, "Prepare printer on LPT1 for report"\r
+ Center 12, "Hit <Enter> to print, or <Esc> to abort"\r
+\r
+ DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)\r
+\r
+ IF Kbd$ = CHR$(13) THEN\r
+ Box 8, 20, 14, 62\r
+ Center 11, "Printing report..."\r
+ u0$ = " \ \ "\r
+ u1$ = " \ \ $$###,###,###.##"\r
+ u2$ = " --------------"\r
+ u3$ = " ============="\r
+ u4$ = " \ \+$$#,###,###,###.##"\r
+ PrintErr = FALSE\r
+ ON ERROR GOTO ErrorTrap ' test if printer is connected\r
+ LPRINT\r
+ IF PrintErr = FALSE THEN\r
+ LPRINT : LPRINT : LPRINT : LPRINT : LPRINT\r
+ LCenter "Q B a s i c"\r
+ LCenter "M O N E Y M A N A G E R"\r
+ LPRINT : LPRINT\r
+ LCenter "NET WORTH REPORT: " + DATE$\r
+ LCenter "-------------------------------------------"\r
+ LPRINT USING u0$; "ASSETS:"\r
+ assetTotal# = 0\r
+ a = 1\r
+ WHILE a <= maxAsset\r
+ file$ = "money." + Cvit$(assetIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LPRINT USING u1$; account(assetIndex(a)).Title; CVD(IoBalance$)\r
+ assetTotal# = assetTotal# + CVD(IoBalance$)\r
+ END IF\r
+ CLOSE #1\r
+ a = a + 1\r
+ WEND\r
+ LPRINT u2$\r
+ LPRINT USING u4$; "Total assets"; assetTotal#\r
+ LPRINT\r
+ LPRINT\r
+ LPRINT USING u0$; "LIABILITIES:"\r
+ liabilityTotal# = 0\r
+ a = 1\r
+ WHILE a <= maxLiability\r
+ file$ = "money." + Cvit$(liabilityIndex(a))\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ LPRINT USING u1$; account(liabilityIndex(a)).Title; CVD(IoBalance$)\r
+ liabilityTotal# = liabilityTotal# + CVD(IoBalance$)\r
+ END IF\r
+ CLOSE #1\r
+ a = a + 1\r
+ WEND\r
+ LPRINT u2$\r
+ LPRINT USING u4$; "Total liabilities"; liabilityTotal#\r
+ LPRINT\r
+\r
+ LPRINT\r
+ LPRINT u3$\r
+ LPRINT USING u4$; "NET WORTH"; assetTotal# - liabilityTotal#\r
+ LCenter "-------------------------------------------"\r
+ LPRINT : LPRINT : LPRINT\r
+ END IF\r
+ ON ERROR GOTO 0\r
+ END IF\r
+ RETURN\r
+END SUB\r
+\r
+'PrintHelpLine:\r
+' Prints help text on the bottom row in the proper color\r
+SUB PrintHelpLine (help$)\r
+ COLOR colors(5, ColorPref), colors(4, ColorPref)\r
+ LOCATE 25, 1\r
+ PRINT SPACE$(80);\r
+ Center 25, help$\r
+END SUB\r
+\r
+'SaveState:\r
+' Save color preference and account information to "MONEY.DAT" data file.\r
+SUB SaveState\r
+ OPEN "money.dat" FOR OUTPUT AS #2\r
+ PRINT #2, ColorPref\r
+ \r
+ FOR a = 1 TO 19\r
+ PRINT #2, account(a).Title\r
+ PRINT #2, account(a).AType\r
+ PRINT #2, account(a).Desc\r
+ NEXT a\r
+ \r
+ CLOSE #2\r
+END SUB\r
+\r
+'ScrollDown:\r
+' Call the assembly program to scroll the screen down\r
+SUB ScrollDown\r
+ DEF SEG = VARSEG(ScrollDownAsm(1))\r
+ CALL Absolute(VARPTR(ScrollDownAsm(1)))\r
+ DEF SEG\r
+END SUB\r
+\r
+'ScrollUp:\r
+' Calls the assembly program to scroll the screen up\r
+SUB ScrollUp\r
+ DEF SEG = VARSEG(ScrollUpAsm(1))\r
+ CALL Absolute(VARPTR(ScrollUpAsm(1)))\r
+ DEF SEG\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro screen\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ a$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR a = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(a$, a, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(a$, 6 - a, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (a + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT a\r
+ WEND\r
+END SUB\r
+\r
+'TransactionSummary:\r
+' Print transaction summary to line printer\r
+SUB TransactionSummary (item)\r
+ FancyCls colors(2, ColorPref), colors(1, ColorPref)\r
+ PrintHelpLine ""\r
+ Box 8, 20, 14, 62\r
+ Center 10, "Prepare printer on LPT1 for report"\r
+ Center 12, "Hit <Enter> to print, or <Esc> to abort"\r
+\r
+ DO: Kbd$ = INKEY$: LOOP WHILE Kbd$ <> CHR$(13) AND Kbd$ <> CHR$(27)\r
+\r
+ IF Kbd$ = CHR$(13) THEN\r
+ Box 8, 20, 14, 62\r
+ Center 11, "Printing report..."\r
+ PrintErr = FALSE\r
+ ON ERROR GOTO ErrorTrap ' test if printer is connected\r
+ LPRINT\r
+ IF PrintErr = FALSE THEN\r
+ PRINT\r
+ LPRINT : LPRINT : LPRINT : LPRINT : LPRINT\r
+ LCenter "Q B a s i c"\r
+ LCenter "M O N E Y M A N A G E R"\r
+ LPRINT : LPRINT\r
+ LCenter "Transaction summary: " + Trim$(account(item).Title)\r
+ LCenter DATE$\r
+ LPRINT\r
+ u5$ = "--------|------|------------------------|----------|----------|--------------"\r
+ LPRINT u5$\r
+ LPRINT " Date | Ref# | Description | Increase | Decrease | Balance "\r
+ LPRINT u5$\r
+ u0$ = "\ \|\ \|\ \|"\r
+ u2$ = "###,###.##"\r
+ u3$ = "###,###,###.##"\r
+ u4$ = " "\r
+\r
+ file$ = "money." + Cvit$(item)\r
+ OPEN file$ FOR RANDOM AS #1 LEN = 84\r
+ FIELD #1, 8 AS IoDate$, 10 AS IoRef$, 50 AS IoDesc$, 8 AS IoFig1$, 8 AS IoFig2$\r
+ FIELD #1, 11 AS valid$, 5 AS IoMaxRecord$, 8 AS IoBalance$\r
+ GET #1, 1\r
+ IF valid$ = "THISISVALID" THEN\r
+ Balance# = 0\r
+ MaxRecord = VAL(IoMaxRecord$)\r
+ CurrRecord = 1\r
+ WHILE CurrRecord <= MaxRecord\r
+\r
+ GET #1, CurrRecord + 1\r
+ Fig1# = CVD(IoFig1$)\r
+ Fig2# = CVD(IoFig2$)\r
+\r
+ LPRINT USING u0$; IoDate$; IoRef$; IoDesc$;\r
+ IF Fig2# = 0 AND Fig1# = 0 THEN\r
+ LPRINT USING u4$ + "|" + u4$ + "|" + u3$; Balance#\r
+ ELSEIF Fig2# = 0 THEN\r
+ Balance# = Balance# + Fig1#\r
+ LPRINT USING u2$ + "|" + u4$ + "|" + u3$; Fig1#; Balance#\r
+ ELSE\r
+ Balance# = Balance# - Fig2#\r
+ LPRINT USING u4$ + "|" + u2$ + "|" + u3$; Fig2#; Balance#\r
+ END IF\r
+ CurrRecord = CurrRecord + 1\r
+ WEND\r
+ LPRINT u5$\r
+ LPRINT : LPRINT\r
+ END IF\r
+ ON ERROR GOTO 0\r
+ END IF\r
+ CLOSE\r
+ END IF\r
+END SUB\r
+\r
+'Trin$:\r
+' Remove null and spaces from the end of a string.\r
+FUNCTION Trim$ (X$)\r
+\r
+ IF X$ = "" THEN\r
+ Trim$ = ""\r
+ ELSE\r
+ lastChar = 0\r
+ FOR a = 1 TO LEN(X$)\r
+ y$ = MID$(X$, a, 1)\r
+ IF y$ <> CHR$(0) AND y$ <> " " THEN\r
+ lastChar = a\r
+ END IF\r
+ NEXT a\r
+ Trim$ = LEFT$(X$, lastChar)\r
+ END IF\r
+ \r
+END FUNCTION\r
+\r
--- /dev/null
+'\r
+' Q B a s i c N i b b l e s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Nibbles is a game for one or two players. Navigate your snakes\r
+' around the game board trying to eat up numbers while avoiding\r
+' running into walls or other snakes. The more numbers you eat up,\r
+' the more points you gain and the longer your snake becomes.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'User-defined TYPEs\r
+TYPE snakeBody\r
+ row AS INTEGER\r
+ col AS INTEGER\r
+END TYPE\r
+\r
+'This type defines the player's snake\r
+TYPE snaketype\r
+ head AS INTEGER\r
+ length AS INTEGER\r
+ row AS INTEGER\r
+ col AS INTEGER\r
+ direction AS INTEGER\r
+ lives AS INTEGER\r
+ score AS INTEGER\r
+ scolor AS INTEGER\r
+ alive AS INTEGER\r
+END TYPE\r
+\r
+'This type is used to represent the playing screen in memory\r
+'It is used to simulate graphics in text mode, and has some interesting,\r
+'and slightly advanced methods to increasing the speed of operation.\r
+'Instead of the normal 80x25 text graphics using chr$(219) "Û", we will be\r
+'using chr$(220)"Ü" and chr$(223) "ß" and chr$(219) "Û" to mimic an 80x50\r
+'pixel screen.\r
+'Check out sub-programs SET and POINTISTHERE to see how this is implemented\r
+'feel free to copy these (as well as arenaType and the DIM ARENA stmt and the\r
+'initialization code in the DrawScreen subprogram) and use them in your own\r
+'programs\r
+TYPE arenaType\r
+ realRow AS INTEGER 'Maps the 80x50 point into the real 80x25\r
+ acolor AS INTEGER 'Stores the current color of the point\r
+ sister AS INTEGER 'Each char has 2 points in it. .SISTER is\r
+END TYPE '-1 if sister point is above, +1 if below\r
+\r
+'Sub Declarations\r
+DECLARE SUB SpacePause (text$)\r
+DECLARE SUB PrintScore (NumPlayers%, score1%, score2%, lives1%, lives2%)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB GetInputs (NumPlayers, speed, diff$, monitor$)\r
+DECLARE SUB DrawScreen ()\r
+DECLARE SUB PlayNibbles (NumPlayers, speed, diff$)\r
+DECLARE SUB Set (row, col, acolor)\r
+DECLARE SUB Center (row, text$)\r
+DECLARE SUB DoIntro ()\r
+DECLARE SUB Initialize ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB Level (WhatToDO, sammy() AS snaketype)\r
+DECLARE SUB InitColors ()\r
+DECLARE SUB EraseSnake (snake() AS ANY, snakeBod() AS ANY, snakeNum%)\r
+DECLARE FUNCTION StillWantsToPlay ()\r
+DECLARE FUNCTION PointIsThere (row, col, backColor)\r
+\r
+'Constants\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST MAXSNAKELENGTH = 1000\r
+CONST STARTOVER = 1 ' Parameters to 'Level' SUB\r
+CONST SAMELEVEL = 2\r
+CONST NEXTLEVEL = 3\r
+\r
+'Global Variables\r
+DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType\r
+DIM SHARED curLevel, colorTable(10)\r
+\r
+ RANDOMIZE TIMER\r
+ GOSUB ClearKeyLocks\r
+ Intro\r
+ GetInputs NumPlayers, speed, diff$, monitor$\r
+ GOSUB SetColors\r
+ DrawScreen\r
+\r
+ DO\r
+ PlayNibbles NumPlayers, speed, diff$\r
+ LOOP WHILE StillWantsToPlay\r
+\r
+ GOSUB RestoreKeyLocks\r
+ COLOR 15, 0\r
+ CLS\r
+END\r
+\r
+ClearKeyLocks:\r
+ DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock\r
+ KeyFlags = PEEK(1047)\r
+ POKE 1047, &H0\r
+ DEF SEG\r
+ RETURN\r
+\r
+RestoreKeyLocks:\r
+ DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+ RETURN\r
+\r
+SetColors:\r
+ IF monitor$ = "M" THEN\r
+ RESTORE mono\r
+ ELSE\r
+ RESTORE normal\r
+ END IF\r
+\r
+ FOR a = 1 TO 6\r
+ READ colorTable(a)\r
+ NEXT a\r
+ RETURN\r
+\r
+ 'snake1 snake2 Walls Background Dialogs-Fore Back\r
+mono: DATA 15, 7, 7, 0, 15, 0\r
+normal: DATA 14, 13, 12, 1, 15, 4\r
+END\r
+\r
+'Center:\r
+' Centers text on given row\r
+SUB Center (row, text$)\r
+ LOCATE row, 41 - LEN(text$) / 2\r
+ PRINT text$;\r
+END SUB\r
+\r
+'DrawScreen:\r
+' Draws playing field\r
+SUB DrawScreen\r
+\r
+ 'initialize screen\r
+ VIEW PRINT\r
+ COLOR colorTable(1), colorTable(4)\r
+ CLS\r
+\r
+ 'Print title & message\r
+ Center 1, "Nibbles!"\r
+ Center 11, "Initializing Playing Field..."\r
+ \r
+ 'Initialize arena array\r
+ FOR row = 1 TO 50\r
+ FOR col = 1 TO 80\r
+ arena(row, col).realRow = INT((row + 1) / 2)\r
+ arena(row, col).sister = (row MOD 2) * 2 - 1\r
+ NEXT col\r
+ NEXT row\r
+END SUB\r
+\r
+'EraseSnake:\r
+' Erases snake to facilitate moving through playing field\r
+SUB EraseSnake (snake() AS snaketype, snakeBod() AS snakeBody, snakeNum)\r
+\r
+ FOR c = 0 TO 9\r
+ FOR b = snake(snakeNum).length - c TO 0 STEP -10\r
+ tail = (snake(snakeNum).head + MAXSNAKELENGTH - b) MOD MAXSNAKELENGTH\r
+ Set snakeBod(tail, snakeNum).row, snakeBod(tail, snakeNum).col, colorTable(4)\r
+ NEXT b\r
+ NEXT c\r
+ \r
+END SUB\r
+\r
+'GetInputs:\r
+' Gets player inputs\r
+SUB GetInputs (NumPlayers, speed, diff$, monitor$)\r
+\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ DO\r
+ LOCATE 5, 47: PRINT SPACE$(34);\r
+ LOCATE 5, 20\r
+ INPUT "How many players (1 or 2)"; num$\r
+ LOOP UNTIL VAL(num$) = 1 OR VAL(num$) = 2\r
+ NumPlayers = VAL(num$)\r
+\r
+ LOCATE 8, 21: PRINT "Skill level (1 to 100)"\r
+ LOCATE 9, 22: PRINT "1 = Novice"\r
+ LOCATE 10, 22: PRINT "90 = Expert"\r
+ LOCATE 11, 22: PRINT "100 = Twiddle Fingers"\r
+ LOCATE 12, 15: PRINT "(Computer speed may affect your skill level)"\r
+ DO\r
+ LOCATE 8, 44: PRINT SPACE$(35);\r
+ LOCATE 8, 43\r
+ INPUT gamespeed$\r
+ LOOP UNTIL VAL(gamespeed$) >= 1 AND VAL(gamespeed$) <= 100\r
+ speed = VAL(gamespeed$)\r
+ \r
+ speed = (100 - speed) * 2 + 1\r
+\r
+ DO\r
+ LOCATE 15, 56: PRINT SPACE$(25);\r
+ LOCATE 15, 15\r
+ INPUT "Increase game speed during play (Y or N)"; diff$\r
+ diff$ = UCASE$(diff$)\r
+ LOOP UNTIL diff$ = "Y" OR diff$ = "N"\r
+\r
+ DO\r
+ LOCATE 17, 46: PRINT SPACE$(34);\r
+ LOCATE 17, 17\r
+ INPUT "Monochrome or color monitor (M or C)"; monitor$\r
+ monitor$ = UCASE$(monitor$)\r
+ LOOP UNTIL monitor$ = "M" OR monitor$ = "C"\r
+\r
+ startTime# = TIMER ' Calculate speed of system\r
+ FOR i# = 1 TO 1000: NEXT i# ' and do some compensation\r
+ stopTime# = TIMER\r
+ speed = speed * .5 / (stopTime# - startTime#)\r
+\r
+END SUB\r
+\r
+'InitColors:\r
+'Initializes playing field colors\r
+SUB InitColors\r
+ \r
+ FOR row = 1 TO 50\r
+ FOR col = 1 TO 80\r
+ arena(row, col).acolor = colorTable(4)\r
+ NEXT col\r
+ NEXT row\r
+\r
+ CLS\r
+ \r
+ 'Set (turn on) pixels for screen border\r
+ FOR col = 1 TO 80\r
+ Set 3, col, colorTable(3)\r
+ Set 50, col, colorTable(3)\r
+ NEXT col\r
+\r
+ FOR row = 4 TO 49\r
+ Set row, 1, colorTable(3)\r
+ Set row, 80, colorTable(3)\r
+ NEXT row\r
+\r
+END SUB\r
+\r
+'Intro:\r
+' Displays game introduction\r
+SUB Intro\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 15, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c N i b b l e s"\r
+ COLOR 7\r
+ Center 6, "Copyright (C) Microsoft Corporation 1990"\r
+ Center 8, "Nibbles is a game for one or two players. Navigate your snakes"\r
+ Center 9, "around the game board trying to eat up numbers while avoiding"\r
+ Center 10, "running into walls or other snakes. The more numbers you eat up,"\r
+ Center 11, "the more points you gain and the longer your snake becomes."\r
+ Center 13, " Game Controls "\r
+ Center 15, " General Player 1 Player 2 "\r
+ Center 16, " (Up) (Up) "\r
+ Center 17, "P - Pause " + CHR$(24) + " W "\r
+ Center 18, " (Left) " + CHR$(27) + " " + CHR$(26) + " (Right) (Left) A D (Right) "\r
+ Center 19, " " + CHR$(25) + " S "\r
+ Center 20, " (Down) (Down) "\r
+ Center 24, "Press any key to continue"\r
+\r
+ PLAY "MBT160O1L8CDEDCDL4ECC"\r
+ SparklePause\r
+\r
+END SUB\r
+\r
+'Level:\r
+'Sets game level\r
+SUB Level (WhatToDO, sammy() AS snaketype) STATIC\r
+ \r
+ SELECT CASE (WhatToDO)\r
+\r
+ CASE STARTOVER\r
+ curLevel = 1\r
+ CASE NEXTLEVEL\r
+ curLevel = curLevel + 1\r
+ END SELECT\r
+\r
+ sammy(1).head = 1 'Initialize Snakes\r
+ sammy(1).length = 2\r
+ sammy(1).alive = TRUE\r
+ sammy(2).head = 1\r
+ sammy(2).length = 2\r
+ sammy(2).alive = TRUE\r
+\r
+ InitColors\r
+ \r
+ SELECT CASE curLevel\r
+ CASE 1\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 4: sammy(2).direction = 3\r
+\r
+\r
+ CASE 2\r
+ FOR i = 20 TO 60\r
+ Set 25, i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 60: sammy(2).col = 20\r
+ sammy(1).direction = 3: sammy(2).direction = 4\r
+\r
+ CASE 3\r
+ FOR i = 10 TO 40\r
+ Set i, 20, colorTable(3)\r
+ Set i, 60, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+\r
+ CASE 4\r
+ FOR i = 4 TO 30\r
+ Set i, 20, colorTable(3)\r
+ Set 53 - i, 60, colorTable(3)\r
+ NEXT i\r
+ FOR i = 2 TO 40\r
+ Set 38, i, colorTable(3)\r
+ Set 15, 81 - i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 60: sammy(2).col = 20\r
+ sammy(1).direction = 3: sammy(2).direction = 4\r
+ \r
+ CASE 5\r
+ FOR i = 13 TO 39\r
+ Set i, 21, colorTable(3)\r
+ Set i, 59, colorTable(3)\r
+ NEXT i\r
+ FOR i = 23 TO 57\r
+ Set 11, i, colorTable(3)\r
+ Set 41, i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+\r
+ CASE 6\r
+ FOR i = 4 TO 49\r
+ IF i > 30 OR i < 23 THEN\r
+ Set i, 10, colorTable(3)\r
+ Set i, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set i, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set i, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ END IF\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 7\r
+ FOR i = 4 TO 49 STEP 2\r
+ Set i, 40, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 8\r
+ FOR i = 4 TO 40\r
+ Set i, 10, colorTable(3)\r
+ Set 53 - i, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set 53 - i, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set 53 - i, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 9\r
+ FOR i = 6 TO 47\r
+ Set i, i, colorTable(3)\r
+ Set i, i + 28, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 40: sammy(2).row = 15\r
+ sammy(1).col = 75: sammy(2).col = 5\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+ \r
+ CASE ELSE\r
+ FOR i = 4 TO 49 STEP 2\r
+ Set i, 10, colorTable(3)\r
+ Set i + 1, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set i + 1, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set i + 1, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ END SELECT\r
+END SUB\r
+\r
+'PlayNibbles:\r
+' Main routine that controls game play\r
+SUB PlayNibbles (NumPlayers, speed, diff$)\r
+\r
+ 'Initialize Snakes\r
+ DIM sammyBody(MAXSNAKELENGTH - 1, 1 TO 2) AS snakeBody\r
+ DIM sammy(1 TO 2) AS snaketype\r
+ sammy(1).lives = 5\r
+ sammy(1).score = 0\r
+ sammy(1).scolor = colorTable(1)\r
+ sammy(2).lives = 5\r
+ sammy(2).score = 0\r
+ sammy(2).scolor = colorTable(2)\r
+ \r
+ Level STARTOVER, sammy()\r
+ startRow1 = sammy(1).row: startCol1 = sammy(1).col\r
+ startRow2 = sammy(2).row: startCol2 = sammy(2).col\r
+\r
+ curSpeed = speed\r
+\r
+ 'play Nibbles until finished\r
+\r
+ SpacePause " Level" + STR$(curLevel) + ", Push Space"\r
+ gameOver = FALSE\r
+ DO\r
+ IF NumPlayers = 1 THEN\r
+ sammy(2).row = 0\r
+ END IF\r
+\r
+ number = 1 'Current number that snakes are trying to run into\r
+ nonum = TRUE 'nonum = TRUE if a number is not on the screen\r
+\r
+ playerDied = FALSE\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ PLAY "T160O1>L20CDEDCDL10ECC"\r
+\r
+ DO\r
+ 'Print number if no number exists\r
+ IF nonum = TRUE THEN\r
+ DO\r
+ numberRow = INT(RND(1) * 47 + 3)\r
+ NumberCol = INT(RND(1) * 78 + 2)\r
+ sisterRow = numberRow + arena(numberRow, NumberCol).sister\r
+ LOOP UNTIL NOT PointIsThere(numberRow, NumberCol, colorTable(4)) AND NOT PointIsThere(sisterRow, NumberCol, colorTable(4))\r
+ numberRow = arena(numberRow, NumberCol).realRow\r
+ nonum = FALSE\r
+ COLOR colorTable(1), colorTable(4)\r
+ LOCATE numberRow, NumberCol\r
+ PRINT RIGHT$(STR$(number), 1);\r
+ count = 0\r
+ END IF\r
+\r
+ 'Delay game\r
+ FOR a# = 1 TO curSpeed: NEXT a#\r
+\r
+ 'Get keyboard input & Change direction accordingly\r
+ kbd$ = INKEY$\r
+ SELECT CASE kbd$\r
+ CASE "w", "W": IF sammy(2).direction <> 2 THEN sammy(2).direction = 1\r
+ CASE "s", "S": IF sammy(2).direction <> 1 THEN sammy(2).direction = 2\r
+ CASE "a", "A": IF sammy(2).direction <> 4 THEN sammy(2).direction = 3\r
+ CASE "d", "D": IF sammy(2).direction <> 3 THEN sammy(2).direction = 4\r
+ CASE CHR$(0) + "H": IF sammy(1).direction <> 2 THEN sammy(1).direction = 1\r
+ CASE CHR$(0) + "P": IF sammy(1).direction <> 1 THEN sammy(1).direction = 2\r
+ CASE CHR$(0) + "K": IF sammy(1).direction <> 4 THEN sammy(1).direction = 3\r
+ CASE CHR$(0) + "M": IF sammy(1).direction <> 3 THEN sammy(1).direction = 4\r
+ CASE "p", "P": SpacePause " Game Paused ... Push Space "\r
+ CASE ELSE\r
+ END SELECT\r
+\r
+ FOR a = 1 TO NumPlayers\r
+ 'Move Snake\r
+ SELECT CASE sammy(a).direction\r
+ CASE 1: sammy(a).row = sammy(a).row - 1\r
+ CASE 2: sammy(a).row = sammy(a).row + 1\r
+ CASE 3: sammy(a).col = sammy(a).col - 1\r
+ CASE 4: sammy(a).col = sammy(a).col + 1\r
+ END SELECT\r
+\r
+ 'If snake hits number, respond accordingly\r
+ IF numberRow = INT((sammy(a).row + 1) / 2) AND NumberCol = sammy(a).col THEN\r
+ PLAY "MBO0L16>CCCE"\r
+ IF sammy(a).length < (MAXSNAKELENGTH - 30) THEN\r
+ sammy(a).length = sammy(a).length + number * 4\r
+ END IF\r
+ sammy(a).score = sammy(a).score + number\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ number = number + 1\r
+ IF number = 10 THEN\r
+ EraseSnake sammy(), sammyBody(), 1\r
+ EraseSnake sammy(), sammyBody(), 2\r
+ LOCATE numberRow, NumberCol: PRINT " "\r
+ Level NEXTLEVEL, sammy()\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ SpacePause " Level" + STR$(curLevel) + ", Push Space"\r
+ IF NumPlayers = 1 THEN sammy(2).row = 0\r
+ number = 1\r
+ IF diff$ = "P" THEN speed = speed - 10: curSpeed = speed\r
+ END IF\r
+ nonum = TRUE\r
+ IF curSpeed < 1 THEN curSpeed = 1\r
+ END IF\r
+ NEXT a\r
+\r
+ FOR a = 1 TO NumPlayers\r
+ 'If player runs into any point, or the head of the other snake, it dies.\r
+ 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\r
+ PLAY "MBO0L32EFGEFDC"\r
+ COLOR , colorTable(4)\r
+ LOCATE numberRow, NumberCol\r
+ PRINT " "\r
+ \r
+ playerDied = TRUE\r
+ sammy(a).alive = FALSE\r
+ sammy(a).lives = sammy(a).lives - 1\r
+\r
+ 'Otherwise, move the snake, and erase the tail\r
+ ELSE\r
+ sammy(a).head = (sammy(a).head + 1) MOD MAXSNAKELENGTH\r
+ sammyBody(sammy(a).head, a).row = sammy(a).row\r
+ sammyBody(sammy(a).head, a).col = sammy(a).col\r
+ tail = (sammy(a).head + MAXSNAKELENGTH - sammy(a).length) MOD MAXSNAKELENGTH\r
+ Set sammyBody(tail, a).row, sammyBody(tail, a).col, colorTable(4)\r
+ sammyBody(tail, a).row = 0\r
+ Set sammy(a).row, sammy(a).col, sammy(a).scolor\r
+ END IF\r
+ NEXT a\r
+\r
+ LOOP UNTIL playerDied\r
+\r
+ curSpeed = speed ' reset speed to initial value\r
+ \r
+ FOR a = 1 TO NumPlayers\r
+ EraseSnake sammy(), sammyBody(), a\r
+\r
+ 'If dead, then erase snake in really cool way\r
+ IF sammy(a).alive = FALSE THEN\r
+ 'Update score\r
+ sammy(a).score = sammy(a).score - 10\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ \r
+ IF a = 1 THEN\r
+ SpacePause " Sammy Dies! Push Space! --->"\r
+ ELSE\r
+ SpacePause " <---- Jake Dies! Push Space "\r
+ END IF\r
+ END IF\r
+ NEXT a\r
+\r
+ Level SAMELEVEL, sammy()\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ \r
+ 'Play next round, until either of snake's lives have run out.\r
+ LOOP UNTIL sammy(1).lives = 0 OR sammy(2).lives = 0\r
+\r
+END SUB\r
+\r
+'PointIsThere:\r
+' Checks the global arena array to see if the boolean flag is set\r
+FUNCTION PointIsThere (row, col, acolor)\r
+ IF row <> 0 THEN\r
+ IF arena(row, col).acolor <> acolor THEN\r
+ PointIsThere = TRUE\r
+ ELSE\r
+ PointIsThere = FALSE\r
+ END IF\r
+ END IF\r
+END FUNCTION\r
+\r
+'PrintScore:\r
+' Prints players scores and number of lives remaining\r
+SUB PrintScore (NumPlayers, score1, score2, lives1, lives2)\r
+ COLOR 15, colorTable(4)\r
+\r
+ IF NumPlayers = 2 THEN\r
+ LOCATE 1, 1\r
+ PRINT USING "#,###,#00 Lives: # <--JAKE"; score2; lives2\r
+ END IF\r
+\r
+ LOCATE 1, 49\r
+ PRINT USING "SAMMY--> Lives: # #,###,#00"; lives1; score1\r
+END SUB\r
+\r
+'Set:\r
+' Sets row and column on playing field to given color to facilitate moving\r
+' of snakes around the field.\r
+SUB Set (row, col, acolor)\r
+ IF row <> 0 THEN\r
+ arena(row, col).acolor = acolor 'assign color to arena\r
+ realRow = arena(row, col).realRow 'Get real row of pixel\r
+ topFlag = arena(row, col).sister + 1 / 2 'Deduce whether pixel\r
+ 'is on topß, or bottomÜ\r
+ sisterRow = row + arena(row, col).sister 'Get arena row of sister\r
+ sisterColor = arena(sisterRow, col).acolor 'Determine sister's color\r
+\r
+ LOCATE realRow, col\r
+\r
+ IF acolor = sisterColor THEN 'If both points are same\r
+ COLOR acolor, acolor 'Print chr$(219) "Û"\r
+ PRINT CHR$(219);\r
+ ELSE\r
+ IF topFlag THEN 'Since you cannot have\r
+ IF acolor > 7 THEN 'bright backgrounds\r
+ COLOR acolor, sisterColor 'determine best combo\r
+ PRINT CHR$(223); 'to use.\r
+ ELSE\r
+ COLOR sisterColor, acolor\r
+ PRINT CHR$(220);\r
+ END IF\r
+ ELSE\r
+ IF acolor > 7 THEN\r
+ COLOR acolor, sisterColor\r
+ PRINT CHR$(220);\r
+ ELSE\r
+ COLOR sisterColor, acolor\r
+ PRINT CHR$(223);\r
+ END IF\r
+ END IF\r
+ END IF\r
+ END IF\r
+END SUB\r
+\r
+'SpacePause:\r
+' Pauses game play and waits for space bar to be pressed before continuing\r
+SUB SpacePause (text$)\r
+\r
+ COLOR colorTable(5), colorTable(6)\r
+ Center 11, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"\r
+ Center 12, "Û " + LEFT$(text$ + SPACE$(29), 29) + " Û"\r
+ Center 13, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"\r
+ WHILE INKEY$ <> "": WEND\r
+ WHILE INKEY$ <> " ": WEND\r
+ COLOR 15, colorTable(4)\r
+\r
+ FOR i = 21 TO 26 ' Restore the screen background\r
+ FOR j = 24 TO 56\r
+ Set i, j, arena(i, j).acolor\r
+ NEXT j\r
+ NEXT i\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro screen\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ a$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR a = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(a$, a, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(a$, 6 - a, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (a + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT a\r
+ WEND\r
+\r
+END SUB\r
+\r
+'StillWantsToPlay:\r
+' Determines if users want to play game again.\r
+FUNCTION StillWantsToPlay\r
+\r
+ COLOR colorTable(5), colorTable(6)\r
+ Center 10, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"\r
+ Center 11, "Û G A M E O V E R Û"\r
+ Center 12, "Û Û"\r
+ Center 13, "Û Play Again? (Y/N) Û"\r
+ Center 14, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"\r
+\r
+ WHILE INKEY$ <> "": WEND\r
+ DO\r
+ kbd$ = UCASE$(INKEY$)\r
+ LOOP UNTIL kbd$ = "Y" OR kbd$ = "N"\r
+\r
+ COLOR 15, colorTable(4)\r
+ Center 10, " "\r
+ Center 11, " "\r
+ Center 12, " "\r
+ Center 13, " "\r
+ Center 14, " "\r
+\r
+ IF kbd$ = "Y" THEN\r
+ StillWantsToPlay = TRUE\r
+ ELSE\r
+ StillWantsToPlay = FALSE\r
+ COLOR 7, 0\r
+ CLS\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+'\r
+' Microsoft RemLine - Line Number Removal Utility\r
+' Copyright (C) Microsoft Corporation 1985-1990\r
+'\r
+' REMLINE.BAS is a program to remove line numbers from Microsoft Basic\r
+' Programs. It removes only those line numbers that are not the object\r
+' of one of the following statements: GOSUB, RETURN, GOTO, THEN, ELSE,\r
+' RESUME, RESTORE, or RUN.\r
+'\r
+' When REMLINE is run, it will ask for the name of the file to be\r
+' processed and the name of the file or device to receive the\r
+' reformatted output. If no extension is given, .BAS is assumed (except\r
+' for output devices). If filenames are not given, REMLINE prompts for\r
+' file names. If both filenames are the same, REMLINE saves the original\r
+' file with the extension .BAK.\r
+'\r
+' REMLINE makes several assumptions about the program:\r
+'\r
+' 1. It must be correct syntactically, and must run in BASICA or\r
+' GW-BASIC interpreter.\r
+' 2. There is a 400 line limit. To process larger files, change\r
+' MaxLines constant.\r
+' 3. The first number encountered on a line is considered a line\r
+' number; thus some continuation lines (in a compiler-specific\r
+' construction) may not be handled correctly.\r
+' 4. REMLINE can handle simple statements that test the ERL function\r
+' using relational operators such as =, <, and >. For example,\r
+' the following statement is handled correctly:\r
+'\r
+' IF ERL = 100 THEN END\r
+'\r
+' Line 100 is not removed from the source code. However, more\r
+' complex expressions that contain the +, -, AND, OR, XOR, EQV,\r
+' MOD, or IMP operators may not be handled correctly. For example,\r
+' in the following statement REMLINE does not recognize line 105\r
+' as a referenced line number and removes it from the source code:\r
+'\r
+' IF ERL + 5 = 105 THEN END\r
+'\r
+' If you do not like the way REMLINE formats its output, you can modify\r
+' the output lines in SUB GenOutFile. An example is shown in comments.\r
+DEFINT A-Z\r
+\r
+' Function and Subprocedure declarations\r
+DECLARE FUNCTION GetToken$ (Search$, Delim$)\r
+DECLARE FUNCTION StrSpn% (InString$, Separator$)\r
+DECLARE FUNCTION StrBrk% (InString$, Separator$)\r
+DECLARE FUNCTION IsDigit% (Char$)\r
+DECLARE SUB GetFileNames ()\r
+DECLARE SUB BuildTable ()\r
+DECLARE SUB GenOutFile ()\r
+DECLARE SUB InitKeyTable ()\r
+\r
+' Global and constant data\r
+CONST TRUE = -1\r
+CONST false = 0\r
+CONST MaxLines = 400\r
+\r
+DIM SHARED LineTable!(MaxLines)\r
+DIM SHARED LineCount\r
+DIM SHARED Seps$, InputFile$, OutputFile$, TmpFile$\r
+\r
+' Keyword search data\r
+CONST KeyWordCount = 9\r
+DIM SHARED KeyWordTable$(KeyWordCount)\r
+\r
+KeyData:\r
+ DATA THEN, ELSE, GOSUB, GOTO, RESUME, RETURN, RESTORE, RUN, ERL, ""\r
+\r
+' Start of module-level program code\r
+ Seps$ = " ,:=<>()" + CHR$(9)\r
+ InitKeyTable\r
+ GetFileNames\r
+ ON ERROR GOTO FileErr1\r
+ OPEN InputFile$ FOR INPUT AS 1\r
+ ON ERROR GOTO 0\r
+ COLOR 7: PRINT "Working"; : COLOR 23: PRINT " . . .": COLOR 7: PRINT\r
+ BuildTable\r
+ CLOSE #1\r
+ OPEN InputFile$ FOR INPUT AS 1\r
+ ON ERROR GOTO FileErr2\r
+ OPEN OutputFile$ FOR OUTPUT AS 2\r
+ ON ERROR GOTO 0\r
+ GenOutFile\r
+ CLOSE #1, #2\r
+ IF OutputFile$ <> "CON" THEN CLS\r
+\r
+END\r
+\r
+FileErr1:\r
+ CLS\r
+ PRINT " Invalid file name": PRINT\r
+ INPUT " New input file name (ENTER to terminate): ", InputFile$\r
+ IF InputFile$ = "" THEN END\r
+FileErr2:\r
+ INPUT " Output file name (ENTER to print to screen) :", OutputFile$\r
+ PRINT\r
+ IF (OutputFile$ = "") THEN OutputFile$ = "CON"\r
+ IF TmpFile$ = "" THEN\r
+ RESUME\r
+ ELSE\r
+ TmpFile$ = ""\r
+ RESUME NEXT\r
+ END IF\r
+\r
+'\r
+' BuildTable:\r
+' Examines the entire text file looking for line numbers that are\r
+' the object of GOTO, GOSUB, etc. As each is found, it is entered\r
+' into a table of line numbers. The table is used during a second\r
+' pass (see GenOutFile), when all line numbers not in the list\r
+' are removed.\r
+' Input:\r
+' Uses globals KeyWordTable$, KeyWordCount, and Seps$\r
+' Output:\r
+' Modifies LineTable! and LineCount\r
+'\r
+SUB BuildTable STATIC\r
+\r
+ DO WHILE NOT EOF(1)\r
+ ' Get line and first token\r
+ LINE INPUT #1, InLin$\r
+ Token$ = GetToken$(InLin$, Seps$)\r
+ DO WHILE (Token$ <> "")\r
+ FOR KeyIndex = 1 TO KeyWordCount\r
+ ' See if token is keyword\r
+ IF (KeyWordTable$(KeyIndex) = UCASE$(Token$)) THEN\r
+ ' Get possible line number after keyword\r
+ Token$ = GetToken$("", Seps$)\r
+ ' Check each token to see if it is a line number\r
+ ' (the LOOP is necessary for the multiple numbers\r
+ ' of ON GOSUB or ON GOTO). A non-numeric token will\r
+ ' terminate search.\r
+ DO WHILE (IsDigit(LEFT$(Token$, 1)))\r
+ LineCount = LineCount + 1\r
+ LineTable!(LineCount) = VAL(Token$)\r
+ Token$ = GetToken$("", Seps$)\r
+ IF Token$ <> "" THEN KeyIndex = 0\r
+ LOOP\r
+ END IF\r
+ NEXT KeyIndex\r
+ ' Get next token\r
+ Token$ = GetToken$("", Seps$)\r
+ LOOP\r
+ LOOP\r
+\r
+END SUB\r
+\r
+'\r
+' GenOutFile:\r
+' Generates an output file with unreferenced line numbers removed.\r
+' Input:\r
+' Uses globals LineTable!, LineCount, and Seps$\r
+' Output:\r
+' Processed file\r
+'\r
+SUB GenOutFile STATIC\r
+\r
+ ' Speed up by eliminating comma and colon (can't separate first token)\r
+ Sep$ = " " + CHR$(9)\r
+ DO WHILE NOT EOF(1)\r
+ LINE INPUT #1, InLin$\r
+ IF (InLin$ <> "") THEN\r
+ ' Get first token and process if it is a line number\r
+ Token$ = GetToken$(InLin$, Sep$)\r
+ IF IsDigit(LEFT$(Token$, 1)) THEN\r
+ LineNumber! = VAL(Token$)\r
+ FoundNumber = false\r
+ ' See if line number is in table of referenced line numbers\r
+ FOR index = 1 TO LineCount\r
+ IF (LineNumber! = LineTable!(index)) THEN\r
+ FoundNumber = TRUE\r
+ END IF\r
+ NEXT index\r
+ ' Modify line strings\r
+ IF (NOT FoundNumber) THEN\r
+ Token$ = SPACE$(LEN(Token$))\r
+ MID$(InLin$, StrSpn(InLin$, Sep$), LEN(Token$)) = Token$\r
+ END IF\r
+ \r
+ ' You can replace the previous lines with your own\r
+ ' code to reformat output. For example, try these lines:\r
+ \r
+ 'TmpPos1 = StrSpn(InLin$, Sep$) + LEN(Token$)\r
+ 'TmpPos2 = TmpPos1 + StrSpn(MID$(InLin$, TmpPos1), Sep$)\r
+ '\r
+ 'IF FoundNumber THEN\r
+ ' InLin$ = LEFT$(InLin$, TmpPos1 - 1) + CHR$(9) + MID$(InLin$, TmpPos2)\r
+ 'ELSE\r
+ ' InLin$ = CHR$(9) + MID$(InLin$, TmpPos2)\r
+ 'END IF\r
+\r
+ END IF\r
+ END IF\r
+ ' Print line to file or console (PRINT is faster than console device)\r
+ IF OutputFile$ = "CON" THEN\r
+ PRINT InLin$\r
+ ELSE\r
+ PRINT #2, InLin$\r
+ END IF\r
+ LOOP\r
+\r
+END SUB\r
+\r
+'\r
+' GetFileNames:\r
+' Gets a file name by prompting the user.\r
+' Input:\r
+' User input\r
+' Output:\r
+' Defines InputFiles$ and OutputFiles$\r
+'\r
+SUB GetFileNames STATIC\r
+\r
+ CLS\r
+ PRINT " Microsoft RemLine: Line Number Removal Utility"\r
+ PRINT " (.BAS assumed if no extension given)"\r
+ PRINT\r
+ INPUT " Input file name (ENTER to terminate): ", InputFile$\r
+ IF InputFile$ = "" THEN END\r
+ INPUT " Output file name (ENTER to print to screen): ", OutputFile$\r
+ PRINT\r
+ IF (OutputFile$ = "") THEN OutputFile$ = "CON"\r
+\r
+ IF INSTR(InputFile$, ".") = 0 THEN\r
+ InputFile$ = InputFile$ + ".BAS"\r
+ END IF\r
+\r
+ IF INSTR(OutputFile$, ".") = 0 THEN\r
+ SELECT CASE OutputFile$\r
+ CASE "CON", "SCRN", "PRN", "COM1", "COM2", "LPT1", "LPT2", "LPT3"\r
+ EXIT SUB\r
+ CASE ELSE\r
+ OutputFile$ = OutputFile$ + ".BAS"\r
+ END SELECT\r
+ END IF\r
+\r
+ DO WHILE InputFile$ = OutputFile$\r
+ TmpFile$ = LEFT$(InputFile$, INSTR(InputFile$, ".")) + "BAK"\r
+ ON ERROR GOTO FileErr1\r
+ NAME InputFile$ AS TmpFile$\r
+ ON ERROR GOTO 0\r
+ IF TmpFile$ <> "" THEN InputFile$ = TmpFile$\r
+ LOOP\r
+\r
+END SUB\r
+\r
+'\r
+' GetToken$:\r
+' Extracts tokens from a string. A token is a word that is surrounded\r
+' by separators, such as spaces or commas. Tokens are extracted and\r
+' analyzed when parsing sentences or commands. To use the GetToken$\r
+' function, pass the string to be parsed on the first call, then pass\r
+' a null string on subsequent calls until the function returns a null\r
+' to indicate that the entire string has been parsed.\r
+' Input:\r
+' Search$ = string to search\r
+' Delim$ = String of separators\r
+' Output:\r
+' GetToken$ = next token\r
+'\r
+FUNCTION GetToken$ (Search$, Delim$) STATIC\r
+\r
+ ' Note that SaveStr$ and BegPos must be static from call to call\r
+ ' (other variables are only static for efficiency).\r
+ ' If first call, make a copy of the string\r
+ IF (Search$ <> "") THEN\r
+ BegPos = 1\r
+ SaveStr$ = Search$\r
+ END IF\r
+ \r
+ ' Find the start of the next token\r
+ NewPos = StrSpn(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)\r
+ IF NewPos THEN\r
+ ' Set position to start of token\r
+ BegPos = NewPos + BegPos - 1\r
+ ELSE\r
+ ' If no new token, quit and return null\r
+ GetToken$ = ""\r
+ EXIT FUNCTION\r
+ END IF\r
+\r
+ ' Find end of token\r
+ NewPos = StrBrk(MID$(SaveStr$, BegPos, LEN(SaveStr$)), Delim$)\r
+ IF NewPos THEN\r
+ ' Set position to end of token\r
+ NewPos = BegPos + NewPos - 1\r
+ ELSE\r
+ ' If no end of token, return set to end a value\r
+ NewPos = LEN(SaveStr$) + 1\r
+ END IF\r
+ ' Cut token out of search string\r
+ GetToken$ = MID$(SaveStr$, BegPos, NewPos - BegPos)\r
+ ' Set new starting position\r
+ BegPos = NewPos\r
+\r
+END FUNCTION\r
+\r
+'\r
+' InitKeyTable:\r
+' Initializes a keyword table. Keywords must be recognized so that\r
+' line numbers can be distinguished from numeric constants.\r
+' Input:\r
+' Uses KeyData\r
+' Output:\r
+' Modifies global array KeyWordTable$\r
+'\r
+SUB InitKeyTable STATIC\r
+\r
+ RESTORE KeyData\r
+ FOR Count = 1 TO KeyWordCount\r
+ READ KeyWord$\r
+ KeyWordTable$(Count) = KeyWord$\r
+ NEXT\r
+\r
+END SUB\r
+\r
+'\r
+' IsDigit:\r
+' Returns true if character passed is a decimal digit. Since any\r
+' Basic token starting with a digit is a number, the function only\r
+' needs to check the first digit. Doesn't check for negative numbers,\r
+' but that's not needed here.\r
+' Input:\r
+' Char$ - initial character of string to check\r
+' Output:\r
+' IsDigit - true if within 0 - 9\r
+'\r
+FUNCTION IsDigit (Char$) STATIC\r
+\r
+ IF (Char$ = "") THEN\r
+ IsDigit = false\r
+ ELSE\r
+ CharAsc = ASC(Char$)\r
+ IsDigit = (CharAsc >= ASC("0")) AND (CharAsc <= ASC("9"))\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+'\r
+' StrBrk:\r
+' Searches InString$ to find the first character from among those in\r
+' Separator$. Returns the index of that character. This function can\r
+' be used to find the end of a token.\r
+' Input:\r
+' InString$ = string to search\r
+' Separator$ = characters to search for\r
+' Output:\r
+' StrBrk = index to first match in InString$ or 0 if none match\r
+'\r
+FUNCTION StrBrk (InString$, Separator$) STATIC\r
+\r
+ Ln = LEN(InString$)\r
+ BegPos = 1\r
+ ' Look for end of token (first character that is a delimiter).\r
+ DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1)) = 0\r
+ IF BegPos > Ln THEN\r
+ StrBrk = 0\r
+ EXIT FUNCTION\r
+ ELSE\r
+ BegPos = BegPos + 1\r
+ END IF\r
+ LOOP\r
+ StrBrk = BegPos\r
+ \r
+END FUNCTION\r
+\r
+'\r
+' StrSpn:\r
+' Searches InString$ to find the first character that is not one of\r
+' those in Separator$. Returns the index of that character. This\r
+' function can be used to find the start of a token.\r
+' Input:\r
+' InString$ = string to search\r
+' Separator$ = characters to search for\r
+' Output:\r
+' StrSpn = index to first nonmatch in InString$ or 0 if all match\r
+'\r
+FUNCTION StrSpn% (InString$, Separator$) STATIC\r
+\r
+ Ln = LEN(InString$)\r
+ BegPos = 1\r
+ ' Look for start of a token (character that isn't a delimiter).\r
+ DO WHILE INSTR(Separator$, MID$(InString$, BegPos, 1))\r
+ IF BegPos > Ln THEN\r
+ StrSpn = 0\r
+ EXIT FUNCTION\r
+ ELSE\r
+ BegPos = BegPos + 1\r
+ END IF\r
+ LOOP\r
+ StrSpn = BegPos\r
+\r
+END FUNCTION\r
+\r
--- /dev/null
+CLS\r
+SHELL "A:"\r
+END\1a
\ No newline at end of file
--- /dev/null
+cls\r
+screen 1\r
+COLOR 14,1\r
+LOCATE 2,2\r
+INPUT " ZAKàDUJTE ALARM " ;KOD$\r
+ZPED:\r
+SCREEN 1\r
+COLOR 14,1\r
+LOCATE 2,2\r
+cls\r
+INPUT " ODKàDUJTE ALARM " ;UNKOD$\r
+IF UNKOD$=KOD$ THEN GOTO NOTALARM\r
+SOUND 1000+12,100\r
+GOTO ZPED\r
+NOTALARM:\r
+END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+FOR A=0 TO 255\r
+COLOR 0,15\r
+SCREEN 1\r
+LOCATE 2,2\r
+PRINT A " " CHR$ (A)""\r
+\r
+locate 5,5\r
+input "Chcete znat dalsi znak? Jestli ne napiste x a stisknete enter." ;dalsi$\r
+ REM POKR:\r
+ REM LOCATE 5,5\r
+ REM PRINT CHR$ (A)\r
+ REM FOR I=0 TO 99999\r
+ REM NEXT I\r
+ NEXT A\r
+END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+FOR A=0 TO 255\r
+COLOR 0,15\r
+SCREEN 0\r
+LOCATE 2,2\r
+PRINT A " " CHR$ (A)""\r
+\r
+locate 5,5\r
+input "Chcete znat dalsi znak? Jestli ne napiste x a stisknete enter." ;dalsi$\r
+ REM POKR:\r
+ REM LOCATE 5,5\r
+ REM PRINT CHR$ (A)\r
+ REM FOR I=0 TO 99999\r
+ REM NEXT I\r
+ NEXT A\r
+END\1a
\ No newline at end of file
--- /dev/null
+cls\r
+screen 0\r
+color 0,15\r
+locate 3,10\r
+print SPC(32) "AHOJ"\r
+color 2,9\r
+input "pokus";A\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+A=0\r
+COLOR 4,15\r
+SCREEN 1\r
+A=INT(RND*15)\r
+LOCATE 2,2\r
+PRINT A\r
+END\1a
\ No newline at end of file
--- /dev/null
+START:\r
+SCREEN 0\r
+CLS\r
+COLOR 4,15\r
+B=INT(RND*(4)*10+1)\r
+LOCATE 5,5\r
+PRINT B\r
+REM LOCATE 6,6\r
+REM INPUT " STISKNI ENTER " ;A$\r
+END\1a
\ No newline at end of file
--- /dev/null
+INPUT "POCET MINUT" ;M\r
+FOR I = 1 TO M STEP 1\r
+PRINT "MINUTA " I\r
+WAIT(600)\r
+C=M-I\r
+PRINT "ZBYVA " C " MINUT"\r
+NEXT I\r
+FOR J = 1 TO 15 STEP 1\r
+SOUND RND*200+11,12\r
+WAIT(15)\r
+NEXT J\r
+END\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ 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,\r
+FOR A=1 TO 52\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+FOR R=0 TO 4000\r
+NEXT R\r
+CLS\r
+COLOR 14,1\r
+FOR A=0 TO 2000\r
+Q=RND*55\r
+T=RND*55\r
+CIRCLE (Q,T),50\r
+FOR L=0 TO 5000\r
+NEXT L\r
+NEXT A\r
+LOCATE 8,23\r
+PRINT " KONEC "\r
+STOP\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8,9,6,9,6,2,0,1,3,5,7,9,9,7,5,3,1,0\r
+FOR A=1 TO 23\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+FOR R=0 TO 4000\r
+NEXT R\r
+CLS\r
+COLOR 14,1\r
+FOR A=0 TO 2000\r
+Q=RND*55\r
+T=RND*55\r
+CIRCLE (Q,T),50\r
+FOR L=0 TO 5000\r
+NEXT L\r
+NEXT A\r
+LOCATE 8,23\r
+PRINT " KONEC "\r
+STOP\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ 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,\r
+FOR A=1 TO 10\r
+REM ZAPLNENO 52\r
+REM 1 CARA 6 NEBO 7\r
+REM 2 CARY 13 NEBO 14\r
+REM PUL CARY 3\r
+REM PUL 2.CARY 10\r
+REM PUL ZAPLNENI 35\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+FOR R=0 TO 4000\r
+NEXT R\r
+CLS\r
+COLOR 14,1\r
+FOR A=0 TO 2000\r
+Q=RND*55\r
+T=RND*55\r
+CIRCLE (Q,T),50\r
+FOR L=0 TO 5000\r
+NEXT L\r
+NEXT A\r
+LOCATE 8,23\r
+PRINT " KONEC "\r
+STOP\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 1\r
+V=TIMER\r
+PRINT "CAS" V\r
+V=INT(((V-INT(V))+.2)*10)\r
+PRINT "DALE" V\r
+FOR I=1 TO 19\r
+A=INT(RND*V+1)\r
+IF A=11 THEN A=A-V+1\r
+PRINT A\r
+NEXT I\r
+SOUND 1200,2\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+LOCATE 2,2\r
+INPUT " CO CHCES SCOPIROVAT " ;COPY$\r
+LOCATE 12,2\r
+PRINT COPY$\r
+FOR SPOMAL=1 TO 15555\r
+NEXT SPOMAL\r
+END\1a
\ No newline at end of file
--- /dev/null
+cls\r
+color 5,7\r
+screen 1\r
+for a=1 to 319\r
+\r
+cls\r
+line (1,1)-(319,199),5,b\r
+wait (10)\r
+line (a,1)-(150,199)\r
+next a\r
+end\1a
\ No newline at end of file
--- /dev/null
+cls\r
+color 5,7\r
+screen 1\r
+cls\r
+line (1,1)-(319,199),5,b\r
+end\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+COLOR 0,15\r
+GOTO pet\r
+\r
+pet:\r
+CLS\r
+LOCATE 10,5\r
+input "NORMA SPOTREBY = 8.2 => Enter; NEBO ZAPIS JINOU";S1\r
+IF S1=0 THEN S1= 8.2\r
+CLS\r
+LOCATE 10,5\r
+INPUT "POCET UJETYCH km OD ZACATKU MESICE";K\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV BENZINU - BLOKY NA ZAC. DEKADY";B\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV BENZINU - NADRZ NA ZAC. DEKADY";B4\r
+CLS\r
+LOCATE 10,5\r
+INPUT "CERPANE BLOKY OD ZAC. MESICE - SL.9";B1\r
+CLS\r
+LOCATE 10,5\r
+INPUT "STAV TACHOMETRU NA ZAC. DEKADY";O\r
+CLS\r
+PRINT SPC(32) "DEKADA"\r
+PRINT "==============================================================================="\r
+PRINT " SLOUPEC 6 ! SLOUPEC 7 ! SLOUPEC 9 ! BENZIN "\r
+PRINT " TACH.KONEC DNE ! KmDen KmCelk! ZAC DOPL CELK ! BLOKY NADRZ "\r
+PRINT "================================================================================"\r
+R=8:K2=0:B6=0\r
+FOR I =1 TO 9: R=R+1\r
+LOCATE 20,1\r
+PRINT\r
+LOCATE 20,1\r
+INPUT "UDEJ POCET UJETYCH km ZA DEN";K1\r
+IF K1=0 THEN konec\r
+K=K1+K:B5=B1+B5:A=(K1/100)*S1:A1=A-INT(A)\r
+IF A1< = .7 THEN raz\r
+IF A1> .7 THEN dva\r
+\r
+raz:\r
+B3=INT(A)\r
+GOTO tri\r
+\r
+dva:\r
+B3=INT(A)+1\r
+GOTO tri\r
+\r
+tri:\r
+LOCATE 20,1:PRINT" "\r
+LOCATE 20,1\r
+PRINT"SPOTREBA/NADRZ:";B3;"/";B4;"=>DOPLNENI NADRZE?":INPUT B2\r
+LOCATE 20,1:PRINT " "\r
+LOCATE 21,1:PRINT " "\r
+B4=B4-B3+B2:B=B-B2:B5=B1+B2\r
+O2=O+K1\r
+LOCATE R-2,9:PRINT O2\r
+LOCATE R-2,22:PRINT K1\r
+LOCATE R-2,30:PRINT K\r
+LOCATE R-2,39:PRINT B1\r
+LOCATE R-2,44:PRINT B2\r
+LOCATE R-2,49:PRINT B5\r
+LOCATE R-2,70:PRINT B4\r
+LOCATE R-2,62:PRINT B\r
+LOCATE R-2,20:PRINT "!"\r
+LOCATE R-2,36:PRINT "!"\r
+LOCATE R-2,58:PRINT "!"\r
+O=O2\r
+B1=B1+B2:K2=K2+K1:B6=B6+B3\r
+NEXT\r
+GOTO konec\r
+\r
+konec:\r
+S=S1*(K2/100)\r
+LOCATE 20,1:PRINT " NORMOVANA SPOTREBA:";S;" "\r
+\r
+LOCATE 20,30:PRINT" "\r
+\r
+LOCATE 21,2:PRINT"SKUTECNA SPOTREBA:";B6;" "\r
+LOCATE 22,2:PRINT"UJETE km V DEKADE:";K2;" "\r
+LOCATE 24,15\r
+INPUT "KONEC = Enter ; OPAKOVANI = 1 ";A\r
+IF A=1 GOTO pet\r
+ END\1a
\ No newline at end of file
--- /dev/null
+SHELL "A:"\r
+SHELL "DIR"\1a
\ No newline at end of file
--- /dev/null
+' Q B a s i c G o r i l l a s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Your mission is to hit your opponent with the exploding banana\r
+' by varying the angle and power of your throw, taking into account\r
+' wind speed, gravity, and the city skyline.\r
+'\r
+' Speed of this game is determined by the constant SPEEDCONST. If the\r
+' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line\r
+' below. The larger the number the faster the game will go.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'Sub Declarations\r
+DECLARE SUB DoSun (Mouth)\r
+DECLARE SUB SetScreen ()\r
+DECLARE SUB EndGame ()\r
+DECLARE SUB Center (Row, Text$)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB GetInputs (Player1$, Player2$, NumGames)\r
+DECLARE SUB PlayGame (Player1$, Player2$, NumGames)\r
+DECLARE SUB DoExplosion (x#, y#)\r
+DECLARE SUB MakeCityScape (BCoor() AS ANY)\r
+DECLARE SUB PlaceGorillas (BCoor() AS ANY)\r
+DECLARE SUB UpdateScores (Record(), PlayerNum, Results)\r
+DECLARE SUB DrawGorilla (x, y, arms)\r
+DECLARE SUB GorillaIntro (Player1$, Player2$)\r
+DECLARE SUB Rest (t#)\r
+DECLARE SUB VictoryDance (Player)\r
+DECLARE SUB ClearGorillas ()\r
+DECLARE SUB DrawBan (xc#, yc#, r, bc)\r
+DECLARE FUNCTION Scl (n!)\r
+DECLARE FUNCTION GetNum# (Row, Col)\r
+DECLARE FUNCTION DoShot (PlayerNum, x, y)\r
+DECLARE FUNCTION ExplodeGorilla (x#, y#)\r
+DECLARE FUNCTION Getn# (Row, Col)\r
+DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+DECLARE FUNCTION CalcDelay! ()\r
+\r
+'Make all arrays Dynamic\r
+'$DYNAMIC\r
+\r
+'User-Defined TYPEs\r
+TYPE XYPoint\r
+ XCoor AS INTEGER\r
+ YCoor AS INTEGER\r
+END TYPE\r
+\r
+'Constants\r
+CONST SPEEDCONST = 500\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST HITSELF = 1\r
+CONST BACKATTR = 0\r
+CONST OBJECTCOLOR = 1\r
+CONST WINDOWCOLOR = 14\r
+CONST SUNATTR = 3\r
+CONST SUNHAPPY = FALSE\r
+CONST SUNSHOCK = TRUE\r
+CONST RIGHTUP = 1\r
+CONST LEFTUP = 2\r
+CONST ARMSDOWN = 3\r
+STOP\r
+END\r
+\r
+\r
+\r
+\r
+ Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB PlayGame (Player1$, Player2$, NumGames)\r
+ DIM BCoor(0 TO 30) AS XYPoint\r
+ DIM TotalWins(1 TO 2)\r
+\r
+ J = 1\r
+\r
+ FOR i = 1 TO NumGames\r
+\r
+ CLS\r
+ RANDOMIZE (TIMER)\r
+ CALL MakeCityScape(BCoor())\r
+ CALL PlaceGorillas(BCoor())\r
+ DoSun SUNHAPPY\r
+ Hit = FALSE\r
+ DO WHILE Hit = FALSE\r
+ J = 1 - J\r
+ LOCATE 1, 1\r
+ PRINT Player1$\r
+ LOCATE 1, (MaxCol - 1 - LEN(Player2$))\r
+ PRINT Player2$\r
+ Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))\r
+ Tosser = J + 1: Tossee = 3 - J\r
+\r
+ 'Plot the shot. Hit is true if Gorilla gets hit.\r
+ Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))\r
+\r
+ 'Reset the sun, if it got hit\r
+ IF SunHit THEN DoSun SUNHAPPY\r
+\r
+ IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)\r
+ LOOP\r
+ SLEEP 1\r
+ NEXT i\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ MaxCol = 80\r
+ CLS\r
+\r
+ Center 8, "GAME OVER!"\r
+ Center 10, "Score:"\r
+ LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)\r
+ LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)\r
+ Center 24, "Press any key to continue"\r
+ SparklePause\r
+ COLOR 7, 0\r
+ CLS\r
+END SUB\r
+\r
+'PlayGame:\r
+' Plots banana shot across the screen\r
+'Parameters:\r
+' StartX, StartY - starting shot location\r
+' Angle - shot angle\r
+' Velocity - shot velocity\r
+' PlayerNum - the banana thrower\r
+FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+\r
+ Angle# = Angle# / 180 * pi# 'Convert degree angle to radians\r
+ Radius = Mode MOD 7\r
+\r
+ InitXVel# = COS(Angle#) * Velocity\r
+ InitYVel# = SIN(Angle#) * Velocity\r
+\r
+ oldx# = StartX\r
+ oldy# = StartY\r
+\r
+ 'draw gorilla toss\r
+ IF PlayerNum = 1 THEN\r
+ PUT (StartX, StartY), GorL&, PSET\r
+ ELSE\r
+ PUT (StartX, StartY), GorR&, PSET\r
+ END IF\r
+\r
+ 'throw sound\r
+ PLAY "MBo0L32A-L64CL16BL64A+"\r
+ Rest .1\r
+\r
+ 'redraw gorilla\r
+ PUT (StartX, StartY), GorD&, PSET\r
+\r
+ adjust = Scl(4) 'For scaling CGA\r
+\r
+ xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check\r
+\r
+ Impact = FALSE\r
+ ShotInSun = FALSE\r
+ OnScreen = TRUE\r
+ PlayerHit = 0\r
+ NeedErase = FALSE\r
+\r
+ StartXPos = StartX\r
+ StartYPos = StartY - adjust - 3\r
+\r
+ IF PlayerNum = 2 THEN\r
+ StartXPos = StartXPos + Scl(25)\r
+ direction = Scl(4)\r
+ ELSE\r
+ direction = Scl(-4)\r
+ END IF\r
+\r
+ IF Velocity < 2 THEN 'Shot too slow - hit self\r
+ x# = StartX\r
+ y# = StartY\r
+ pointval = OBJECTCOLOR\r
+ END IF\r
+\r
+ DO WHILE (NOT Impact) AND OnScreen\r
+\r
+ Rest .02\r
+\r
+ 'Erase old banana, if necessary\r
+ IF NeedErase THEN\r
+ NeedErase = FALSE\r
+ CALL DrawBan(oldx#, oldy#, oldrot, FALSE)\r
+ END IF\r
+\r
+ x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)\r
+ y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)\r
+\r
+ IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN\r
+ OnScreen = FALSE\r
+ END IF\r
+\r
+\r
+ IF OnScreen AND y# > 0 THEN\r
+\r
+ 'check it\r
+ LookY = 0\r
+ LookX = Scl(8 * (2 - PlayerNum))\r
+ DO\r
+ pointval = POINT(x# + LookX, y# + LookY)\r
+ IF pointval = 0 THEN\r
+ Impact = FALSE\r
+ IF ShotInSun = TRUE THEN\r
+ IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE\r
+ END IF\r
+ ELSEIF pointval = SUNATTR AND y# < SunHt THEN\r
+ IF NOT SunHit THEN DoSun SUNSHOCK\r
+ SunHit = TRUE\r
+ ShotInSun = TRUE\r
+ ELSE\r
+ Impact = TRUE\r
+ END IF\r
+ LookX = LookX + direction\r
+ LookY = LookY + Scl(6)\r
+ LOOP UNTIL Impact OR LookX <> Scl(4)\r
+\r
+ IF NOT ShotInSun AND NOT Impact THEN\r
+ 'plot it\r
+ rot = (t# * 10) MOD 4\r
+ CALL DrawBan(x#, y#, rot, TRUE)\r
+ NeedErase = TRUE\r
+ END IF\r
+\r
+ oldx# = x#\r
+ oldy# = y#\r
+ oldrot = rot\r
+\r
+ END IF\r
+\r
+\r
+ t# = t# + .1\r
+\r
+ LOOP\r
+\r
+ IF pointval <> OBJECTCOLOR AND Impact THEN\r
+ CALL DoExplosion(x# + adjust, y# + adjust)\r
+ ELSEIF pointval = OBJECTCOLOR THEN\r
+ PlayerHit = ExplodeGorilla(x#, y#)\r
+ END IF\r
+\r
+ PlotShot = PlayerHit\r
+\r
+END FUNCTION\r
+\r
+'Rest:\r
+' pauses the program\r
+SUB Rest (t#)\r
+ s# = TIMER\r
+ t2# = MachSpeed * t# / SPEEDCONST\r
+ DO\r
+ LOOP UNTIL TIMER - s# > t2#\r
+END SUB\r
+\r
+'Scl:\r
+' Pass the number in to scaling for cga. If the number is a decimal, then we\r
+' want to scale down for cga or scale up for ega. This allows a full range\r
+' of numbers to be generated for scaling.\r
+' (i.e. for 3 to get scaled to 1, pass in 2.9)\r
+FUNCTION Scl (n!)\r
+\r
+ IF n! <> INT(n!) THEN\r
+ IF Mode = 1 THEN n! = n! - 1\r
+ END IF\r
+ IF Mode = 1 THEN\r
+ Scl = CINT(n! / 2 + .1)\r
+ ELSE\r
+ Scl = CINT(n!)\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+'SetScreen:\r
+' Sets the appropriate color statements\r
+SUB SetScreen\r
+\r
+ IF Mode = 9 THEN\r
+ ExplosionColor = 2\r
+ BackColor = 1\r
+ PALETTE 0, 1\r
+ PALETTE 1, 46\r
+ PALETTE 2, 44\r
+ PALETTE 3, 54\r
+ PALETTE 5, 7\r
+ PALETTE 6, 4\r
+ PALETTE 7, 3\r
+ PALETTE 9, 63 'Display Color\r
+ ELSE\r
+ ExplosionColor = 2\r
+ BackColor = 0\r
+ COLOR BackColor, 2\r
+\r
+ END IF\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro and game over screens\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ A$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR A = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(A$, A, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(A$, 6 - A, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (A + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT A\r
+ WEND\r
+END SUB\r
+\r
+'UpdateScores:\r
+' Updates players' scores\r
+'Parameters:\r
+' Record - players' scores\r
+' PlayerNum - player\r
+' Results - results of player's shot\r
+SUB UpdateScores (Record(), PlayerNum, Results)\r
+ IF Results = HITSELF THEN\r
+ Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1\r
+ ELSE\r
+ Record(PlayerNum) = Record(PlayerNum) + 1\r
+ END IF\r
+END SUB\r
+\r
+'VictoryDance:\r
+' gorilla dances after he has eliminated his opponent\r
+'Parameters:\r
+' Player - which gorilla is dancing\r
+SUB VictoryDance (Player)\r
+\r
+ FOR i# = 1 TO 4\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ NEXT\r
+END SUB\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+print "-------------------------------------------------------------------------------"\r
+shell "cd c:\"\r
+ print " c************************************************************************************************************* "\r
+shell "cd hry2"\r
+ print " hry2*********************************************************************************************************************** "\r
+shell "cd doom2"\r
+ print " doom2*********************************************************************************************************************** "\r
+shell "doom2.exe"\r
+ print " ********************************************************************************************************************** "\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+end\1a
\ No newline at end of file
--- /dev/null
+' Q B a s i c G o r i l l a s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Your mission is to hit your opponent with the exploding banana\r
+' by varying the angle and power of your throw, taking into account\r
+' wind speed, gravity, and the city skyline.\r
+'\r
+' Speed of this game is determined by the constant SPEEDCONST. If the\r
+' program is too slow or too fast adjust the "CONST SPEEDCONST = 500" line\r
+' below. The larger the number the faster the game will go.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'Sub Declarations\r
+DECLARE SUB DoSun (Mouth)\r
+DECLARE SUB SetScreen ()\r
+DECLARE SUB EndGame ()\r
+DECLARE SUB Center (Row, Text$)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB GetInputs (Player1$, Player2$, NumGames)\r
+DECLARE SUB PlayGame (Player1$, Player2$, NumGames)\r
+DECLARE SUB DoExplosion (x#, y#)\r
+DECLARE SUB MakeCityScape (BCoor() AS ANY)\r
+DECLARE SUB PlaceGorillas (BCoor() AS ANY)\r
+DECLARE SUB UpdateScores (Record(), PlayerNum, Results)\r
+DECLARE SUB DrawGorilla (x, y, arms)\r
+DECLARE SUB GorillaIntro (Player1$, Player2$)\r
+DECLARE SUB Rest (t#)\r
+DECLARE SUB VictoryDance (Player)\r
+DECLARE SUB ClearGorillas ()\r
+DECLARE SUB DrawBan (xc#, yc#, r, bc)\r
+DECLARE FUNCTION Scl (n!)\r
+DECLARE FUNCTION GetNum# (Row, Col)\r
+DECLARE FUNCTION DoShot (PlayerNum, x, y)\r
+DECLARE FUNCTION ExplodeGorilla (x#, y#)\r
+DECLARE FUNCTION Getn# (Row, Col)\r
+DECLARE FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+DECLARE FUNCTION CalcDelay! ()\r
+\r
+'Make all arrays Dynamic\r
+'$DYNAMIC\r
+\r
+'User-Defined TYPEs\r
+TYPE XYPoint\r
+ XCoor AS INTEGER\r
+ YCoor AS INTEGER\r
+END TYPE\r
+\r
+'Constants\r
+CONST SPEEDCONST = 500\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST HITSELF = 1\r
+CONST BACKATTR = 0\r
+CONST OBJECTCOLOR = 1\r
+CONST WINDOWCOLOR = 14\r
+CONST SUNATTR = 3\r
+CONST SUNHAPPY = FALSE\r
+CONST SUNSHOCK = TRUE\r
+CONST RIGHTUP = 1\r
+CONST LEFTUP = 2\r
+CONST ARMSDOWN = 3\r
+\r
+'Global Variables\r
+DIM SHARED GorillaX(1 TO 2) 'Location of the two gorillas\r
+DIM SHARED GorillaY(1 TO 2)\r
+DIM SHARED LastBuilding\r
+\r
+DIM SHARED pi#\r
+DIM SHARED LBan&(x), RBan&(x), UBan&(x), DBan&(x) 'Graphical picture of banana\r
+DIM SHARED GorD&(120) 'Graphical picture of Gorilla arms down\r
+DIM SHARED GorL&(120) 'Gorilla left arm raised\r
+DIM SHARED GorR&(120) 'Gorilla right arm raised\r
+\r
+DIM SHARED gravity#\r
+DIM SHARED Wind\r
+\r
+'Screen Mode Variables\r
+DIM SHARED ScrHeight\r
+DIM SHARED ScrWidth\r
+DIM SHARED Mode\r
+DIM SHARED MaxCol\r
+\r
+'Screen Color Variables\r
+DIM SHARED ExplosionColor\r
+DIM SHARED SunColor\r
+DIM SHARED BackColor\r
+DIM SHARED SunHit\r
+\r
+DIM SHARED SunHt\r
+DIM SHARED GHeight\r
+DIM SHARED MachSpeed AS SINGLE\r
+\r
+ DEF FnRan (x) = INT(RND(1) * x) + 1\r
+ DEF SEG = 0 ' Set NumLock to ON\r
+ KeyFlags = PEEK(1047)\r
+ IF (KeyFlags AND 32) = 0 THEN\r
+ POKE 1047, KeyFlags OR 32\r
+ END IF\r
+ DEF SEG\r
+\r
+ GOSUB InitVars\r
+ Intro\r
+ GetInputs Name1$, Name2$, NumGames\r
+ GorillaIntro Name1$, Name2$\r
+ PlayGame Name1$, Name2$, NumGames\r
+ \r
+ DEF SEG = 0 ' Restore NumLock state\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+END\r
+\r
+\r
+CGABanana:\r
+ 'BananaLeft\r
+ DATA 327686, -252645316, 60\r
+ 'BananaDown\r
+ DATA 196618, -1057030081, 49344\r
+ 'BananaUp\r
+ DATA 196618, -1056980800, 63\r
+ 'BananaRight\r
+ DATA 327686, 1010580720, 240\r
+\r
+EGABanana:\r
+ 'BananaLeft\r
+ DATA 458758,202116096,471604224,943208448,943208448,943208448,471604224,202116096,0\r
+ 'BananaDown\r
+ DATA 262153, -2134835200, -2134802239, -2130771968, -2130738945,8323072, 8323199, 4063232, 4063294\r
+ 'BananaUp\r
+ DATA 262153, 4063232, 4063294, 8323072, 8323199, -2130771968, -2130738945, -2134835200,-2134802239\r
+ 'BananaRight\r
+ DATA 458758, -1061109760, -522133504, 1886416896, 1886416896, 1886416896,-522133504,-1061109760,0\r
+\r
+InitVars:\r
+ pi# = 4 * ATN(1#)\r
+\r
+ 'This is a clever way to pick the best graphics mode available\r
+ ON ERROR GOTO ScreenModeError\r
+ Mode = 9\r
+ SCREEN Mode\r
+ ON ERROR GOTO PaletteError\r
+ IF Mode = 9 THEN PALETTE 4, 0 'Check for 64K EGA\r
+ ON ERROR GOTO 0\r
+\r
+ MachSpeed = CalcDelay\r
+\r
+ IF Mode = 9 THEN\r
+ ScrWidth = 640\r
+ ScrHeight = 350\r
+ GHeight = 25\r
+ RESTORE EGABanana\r
+ REDIM LBan&(8), RBan&(8), UBan&(8), DBan&(8)\r
+\r
+ FOR i = 0 TO 8\r
+ READ LBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ DBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ UBan&(i)\r
+ NEXT i\r
+\r
+ FOR i = 0 TO 8\r
+ READ RBan&(i)\r
+ NEXT i\r
+\r
+ SunHt = 39\r
+\r
+ ELSE\r
+\r
+ ScrWidth = 320\r
+ ScrHeight = 200\r
+ GHeight = 12\r
+ RESTORE CGABanana\r
+ REDIM LBan&(2), RBan&(2), UBan&(2), DBan&(2)\r
+ REDIM GorL&(20), GorD&(20), GorR&(20)\r
+\r
+ FOR i = 0 TO 2\r
+ READ LBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ DBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ UBan&(i)\r
+ NEXT i\r
+ FOR i = 0 TO 2\r
+ READ RBan&(i)\r
+ NEXT i\r
+\r
+ MachSpeed = MachSpeed * 1.3\r
+ SunHt = 20\r
+ END IF\r
+RETURN\r
+\r
+ScreenModeError:\r
+ IF Mode = 1 THEN\r
+ CLS\r
+ LOCATE 10, 5\r
+ PRINT "Sorry, you must have CGA, EGA color, or VGA graphics to play GORILLA.BAS"\r
+ END\r
+ ELSE\r
+ Mode = 1\r
+ RESUME\r
+ END IF\r
+\r
+PaletteError:\r
+ Mode = 1 '64K EGA cards will run in CGA mode.\r
+ RESUME NEXT\r
+\r
+REM $STATIC\r
+'CalcDelay:\r
+' Checks speed of the machine.\r
+FUNCTION CalcDelay!\r
+\r
+ s! = TIMER\r
+ DO\r
+ i! = i! + 1\r
+ LOOP UNTIL TIMER - s! >= .5\r
+ CalcDelay! = i!\r
+\r
+END FUNCTION\r
+\r
+' Center:\r
+' Centers and prints a text string on a given row\r
+' Parameters:\r
+' Row - screen row number\r
+' Text$ - text to be printed\r
+'\r
+SUB Center (Row, Text$)\r
+ Col = MaxCol \ 2\r
+ LOCATE Row, Col - (LEN(Text$) / 2 + .5)\r
+ PRINT Text$;\r
+END SUB\r
+\r
+' DoExplosion:\r
+' Produces explosion when a shot is fired\r
+' Parameters:\r
+' X#, Y# - location of explosion\r
+'\r
+SUB DoExplosion (x#, y#)\r
+\r
+ PLAY "MBO0L32EFGEFDC"\r
+ Radius = ScrHeight / 50\r
+ IF Mode = 9 THEN Inc# = .5 ELSE Inc# = .41\r
+ FOR c# = 0 TO Radius STEP Inc#\r
+ CIRCLE (x#, y#), c#, ExplosionColor\r
+ NEXT c#\r
+ FOR c# = Radius TO 0 STEP (-1 * Inc#)\r
+ CIRCLE (x#, y#), c#, BACKATTR\r
+ FOR i = 1 TO 100\r
+ NEXT i\r
+ Rest .005\r
+ NEXT c#\r
+END SUB\r
+\r
+' DoShot:\r
+' Controls banana shots by accepting player input and plotting\r
+' shot angle\r
+' Parameters:\r
+' PlayerNum - Player\r
+' x, y - Player's gorilla position\r
+'\r
+FUNCTION DoShot (PlayerNum, x, y)\r
+\r
+ 'Input shot\r
+ IF PlayerNum = 1 THEN\r
+ LocateCol = 1\r
+ ELSE\r
+ IF Mode = 9 THEN\r
+ LocateCol = 66\r
+ ELSE\r
+ LocateCol = 26\r
+ END IF\r
+ END IF\r
+\r
+ LOCATE 2, LocateCol\r
+ PRINT "Angle:";\r
+ Angle# = GetNum#(2, LocateCol + 7)\r
+\r
+ LOCATE 3, LocateCol\r
+ PRINT "Velocity:";\r
+ Velocity = GetNum#(3, LocateCol + 10)\r
+\r
+ IF PlayerNum = 2 THEN\r
+ Angle# = 180 - Angle#\r
+ END IF\r
+\r
+ 'Erase input\r
+ FOR i = 1 TO 4\r
+ LOCATE i, 1\r
+ PRINT SPACE$(30 \ (80 \ MaxCol));\r
+ LOCATE i, (50 \ (80 \ MaxCol))\r
+ PRINT SPACE$(30 \ (80 \ MaxCol));\r
+ NEXT\r
+\r
+ SunHit = FALSE\r
+ PlayerHit = PlotShot(x, y, Angle#, Velocity, PlayerNum)\r
+ IF PlayerHit = 0 THEN\r
+ DoShot = FALSE\r
+ ELSE\r
+ DoShot = TRUE\r
+ IF PlayerHit = PlayerNum THEN PlayerNum = 3 - PlayerNum\r
+ VictoryDance PlayerNum\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+' DoSun:\r
+' Draws the sun at the top of the screen.\r
+' Parameters:\r
+' Mouth - If TRUE draws "O" mouth else draws a smile mouth.\r
+'\r
+SUB DoSun (Mouth)\r
+\r
+ 'set position of sun\r
+ x = ScrWidth \ 2: y = Scl(25)\r
+\r
+ 'clear old sun\r
+ LINE (x - Scl(22), y - Scl(18))-(x + Scl(22), y + Scl(18)), BACKATTR, BF\r
+\r
+ 'draw new sun:\r
+ 'body\r
+ CIRCLE (x, y), Scl(12), SUNATTR\r
+ PAINT (x, y), SUNATTR\r
+\r
+ 'rays\r
+ LINE (x - Scl(20), y)-(x + Scl(20), y), SUNATTR\r
+ LINE (x, y - Scl(15))-(x, y + Scl(15)), SUNATTR\r
+\r
+ LINE (x - Scl(15), y - Scl(10))-(x + Scl(15), y + Scl(10)), SUNATTR\r
+ LINE (x - Scl(15), y + Scl(10))-(x + Scl(15), y - Scl(10)), SUNATTR\r
+\r
+ LINE (x - Scl(8), y - Scl(13))-(x + Scl(8), y + Scl(13)), SUNATTR\r
+ LINE (x - Scl(8), y + Scl(13))-(x + Scl(8), y - Scl(13)), SUNATTR\r
+\r
+ LINE (x - Scl(18), y - Scl(5))-(x + Scl(18), y + Scl(5)), SUNATTR\r
+ LINE (x - Scl(18), y + Scl(5))-(x + Scl(18), y - Scl(5)), SUNATTR\r
+\r
+ 'mouth\r
+ IF Mouth THEN 'draw "o" mouth\r
+ CIRCLE (x, y + Scl(5)), Scl(2.9), 0\r
+ PAINT (x, y + Scl(5)), 0, 0\r
+ ELSE 'draw smile\r
+ CIRCLE (x, y), Scl(8), 0, (210 * pi# / 180), (330 * pi# / 180)\r
+ END IF\r
+\r
+ 'eyes\r
+ CIRCLE (x - 3, y - 2), 1, 0\r
+ CIRCLE (x + 3, y - 2), 1, 0\r
+ PSET (x - 3, y - 2), 0\r
+ PSET (x + 3, y - 2), 0\r
+\r
+END SUB\r
+\r
+'DrawBan:\r
+' Draws the banana\r
+'Parameters:\r
+' xc# - Horizontal Coordinate\r
+' yc# - Vertical Coordinate\r
+' r - rotation position (0-3). ( \_/ ) /-\\r
+' bc - if TRUE then DrawBan draws the banana ELSE it erases the banana\r
+SUB DrawBan (xc#, yc#, r, bc)\r
+\r
+SELECT CASE r\r
+ CASE 0\r
+ IF bc THEN PUT (xc#, yc#), LBan&, PSET ELSE PUT (xc#, yc#), LBan&, XOR\r
+ CASE 1\r
+ IF bc THEN PUT (xc#, yc#), UBan&, PSET ELSE PUT (xc#, yc#), UBan&, XOR\r
+ CASE 2\r
+ IF bc THEN PUT (xc#, yc#), DBan&, PSET ELSE PUT (xc#, yc#), DBan&, XOR\r
+ CASE 3\r
+ IF bc THEN PUT (xc#, yc#), RBan&, PSET ELSE PUT (xc#, yc#), RBan&, XOR\r
+END SELECT\r
+\r
+END SUB\r
+\r
+'DrawGorilla:\r
+' Draws the Gorilla in either CGA or EGA mode\r
+' and saves the graphics data in an array.\r
+'Parameters:\r
+' x - x coordinate of gorilla\r
+' y - y coordinate of the gorilla\r
+' arms - either Left up, Right up, or both down\r
+SUB DrawGorilla (x, y, arms)\r
+ DIM i AS SINGLE ' Local index must be single precision\r
+\r
+ 'draw head\r
+ LINE (x - Scl(4), y)-(x + Scl(2.9), y + Scl(6)), OBJECTCOLOR, BF\r
+ LINE (x - Scl(5), y + Scl(2))-(x + Scl(4), y + Scl(4)), OBJECTCOLOR, BF\r
+\r
+ 'draw eyes/brow\r
+ LINE (x - Scl(3), y + Scl(2))-(x + Scl(2), y + Scl(2)), 0\r
+\r
+ 'draw nose if ega\r
+ IF Mode = 9 THEN\r
+ FOR i = -2 TO -1\r
+ PSET (x + i, y + 4), 0\r
+ PSET (x + i + 3, y + 4), 0\r
+ NEXT i\r
+ END IF\r
+\r
+ 'neck\r
+ LINE (x - Scl(3), y + Scl(7))-(x + Scl(2), y + Scl(7)), OBJECTCOLOR\r
+\r
+ 'body\r
+ LINE (x - Scl(8), y + Scl(8))-(x + Scl(6.9), y + Scl(14)), OBJECTCOLOR, BF\r
+ LINE (x - Scl(6), y + Scl(15))-(x + Scl(4.9), y + Scl(20)), OBJECTCOLOR, BF\r
+\r
+ 'legs\r
+ FOR i = 0 TO 4\r
+ CIRCLE (x + Scl(i), y + Scl(25)), Scl(10), OBJECTCOLOR, 3 * pi# / 4, 9 * pi# / 8\r
+ CIRCLE (x + Scl(-6) + Scl(i - .1), y + Scl(25)), Scl(10), OBJECTCOLOR, 15 * pi# / 8, pi# / 4\r
+ NEXT\r
+\r
+ 'chest\r
+ CIRCLE (x - Scl(4.9), y + Scl(10)), Scl(4.9), 0, 3 * pi# / 2, 0\r
+ CIRCLE (x + Scl(4.9), y + Scl(10)), Scl(4.9), 0, pi#, 3 * pi# / 2\r
+\r
+ FOR i = -5 TO -1\r
+ SELECT CASE arms\r
+ CASE 1\r
+ 'Right arm up\r
+ CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(4)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorR&\r
+ CASE 2\r
+ 'Left arm up\r
+ CIRCLE (x + Scl(i - .1), y + Scl(4)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorL&\r
+ CASE 3\r
+ 'Both arms down\r
+ CIRCLE (x + Scl(i - .1), y + Scl(14)), Scl(9), OBJECTCOLOR, 3 * pi# / 4, 5 * pi# / 4\r
+ CIRCLE (x + Scl(4.9) + Scl(i), y + Scl(14)), Scl(9), OBJECTCOLOR, 7 * pi# / 4, pi# / 4\r
+ GET (x - Scl(15), y - Scl(1))-(x + Scl(14), y + Scl(28)), GorD&\r
+ END SELECT\r
+ NEXT i\r
+END SUB\r
+\r
+'ExplodeGorilla:\r
+' Causes gorilla explosion when a direct hit occurs\r
+'Parameters:\r
+' X#, Y# - shot location\r
+FUNCTION ExplodeGorilla (x#, y#)\r
+ YAdj = Scl(12)\r
+ XAdj = Scl(5)\r
+ SclX# = ScrWidth / 320\r
+ SclY# = ScrHeight / 200\r
+ IF x# < ScrWidth / 2 THEN PlayerHit = 1 ELSE PlayerHit = 2\r
+ PLAY "MBO0L16EFGEFDC"\r
+\r
+ FOR i = 1 TO 8 * SclX#\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), i, ExplosionColor, , , -1.57\r
+ LINE (GorillaX(PlayerHit) + 7 * SclX#, GorillaY(PlayerHit) + 9 * SclY# - i)-(GorillaX(PlayerHit), GorillaY(PlayerHit) + 9 * SclY# - i), ExplosionColor\r
+ NEXT i\r
+\r
+ FOR i = 1 TO 16 * SclX#\r
+ IF i < (8 * SclX#) THEN CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + 7 * SclY# + YAdj), (8 * SclX# + 1) - i, BACKATTR, , , -1.57\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, i MOD 2 + 1, , , -1.57\r
+ NEXT i\r
+\r
+ FOR i = 24 * SclX# TO 1 STEP -1\r
+ CIRCLE (GorillaX(PlayerHit) + 3.5 * SclX# + XAdj, GorillaY(PlayerHit) + YAdj), i, BACKATTR, , , -1.57\r
+ FOR Count = 1 TO 200\r
+ NEXT\r
+ NEXT i\r
+\r
+ ExplodeGorilla = PlayerHit\r
+END FUNCTION\r
+\r
+'GetInputs:\r
+' Gets user inputs at beginning of game\r
+'Parameters:\r
+' Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB GetInputs (Player1$, Player2$, NumGames)\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ LOCATE 8, 15\r
+ LINE INPUT "Name of Player 1 (Default = 'Player 1'): "; Player1$\r
+ IF Player1$ = "" THEN\r
+ Player1$ = "Player 1"\r
+ ELSE\r
+ Player1$ = LEFT$(Player1$, 10)\r
+ END IF\r
+\r
+ LOCATE 10, 15\r
+ LINE INPUT "Name of Player 2 (Default = 'Player 2'): "; Player2$\r
+ IF Player2$ = "" THEN\r
+ Player2$ = "Player 2"\r
+ ELSE\r
+ Player2$ = LEFT$(Player2$, 10)\r
+ END IF\r
+\r
+ DO\r
+ LOCATE 12, 56: PRINT SPACE$(25);\r
+ LOCATE 12, 13\r
+ INPUT "Play to how many total points (Default = 3)"; game$\r
+ NumGames = VAL(LEFT$(game$, 2))\r
+ LOOP UNTIL NumGames > 0 AND LEN(game$) < 3 OR LEN(game$) = 0\r
+ IF NumGames = 0 THEN NumGames = 3\r
+\r
+ DO\r
+ LOCATE 14, 53: PRINT SPACE$(28);\r
+ LOCATE 14, 17\r
+ INPUT "Gravity in Meters/Sec (Earth = 9.8)"; grav$\r
+ gravity# = VAL(grav$)\r
+ LOOP UNTIL gravity# > 0 OR LEN(grav$) = 0\r
+ IF gravity# = 0 THEN gravity# = 9.8\r
+END SUB\r
+\r
+'GetNum:\r
+' Gets valid numeric input from user\r
+'Parameters:\r
+' Row, Col - location to echo input\r
+FUNCTION GetNum# (Row, Col)\r
+ Result$ = ""\r
+ Done = FALSE\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ DO WHILE NOT Done\r
+\r
+ LOCATE Row, Col\r
+ PRINT Result$; CHR$(95); " ";\r
+\r
+ Kbd$ = INKEY$\r
+ SELECT CASE Kbd$\r
+ CASE "0" TO "9"\r
+ Result$ = Result$ + Kbd$\r
+ CASE "."\r
+ IF INSTR(Result$, ".") = 0 THEN\r
+ Result$ = Result$ + Kbd$\r
+ END IF\r
+ CASE CHR$(13)\r
+ IF VAL(Result$) > 360 THEN\r
+ Result$ = ""\r
+ ELSE\r
+ Done = TRUE\r
+ END IF\r
+ CASE CHR$(8)\r
+ IF LEN(Result$) > 0 THEN\r
+ Result$ = LEFT$(Result$, LEN(Result$) - 1)\r
+ END IF\r
+ CASE ELSE\r
+ IF LEN(Kbd$) > 0 THEN\r
+ BEEP\r
+ END IF\r
+ END SELECT\r
+ LOOP\r
+\r
+ LOCATE Row, Col\r
+ PRINT Result$; " ";\r
+\r
+ GetNum# = VAL(Result$)\r
+END FUNCTION\r
+\r
+'GorillaIntro:\r
+' Displays gorillas on screen for the first time\r
+' allows the graphical data to be put into an array\r
+'Parameters:\r
+' Player1$, Player2$ - The names of the players\r
+'\r
+SUB GorillaIntro (Player1$, Player2$)\r
+ LOCATE 16, 34: PRINT "--------------"\r
+ LOCATE 18, 34: PRINT "V = View Intro"\r
+ LOCATE 19, 34: PRINT "P = Play Game"\r
+ LOCATE 21, 35: PRINT "Your Choice?"\r
+\r
+ DO WHILE Char$ = ""\r
+ Char$ = INKEY$\r
+ LOOP\r
+\r
+ IF Mode = 1 THEN\r
+ x = 125\r
+ y = 100\r
+ ELSE\r
+ x = 278\r
+ y = 175\r
+ END IF\r
+\r
+ SCREEN Mode\r
+ SetScreen\r
+\r
+ IF Mode = 1 THEN Center 5, "Please wait while gorillas are drawn."\r
+\r
+ VIEW PRINT 9 TO 24\r
+\r
+ IF Mode = 9 THEN PALETTE OBJECTCOLOR, BackColor\r
+ \r
+ DrawGorilla x, y, ARMSDOWN\r
+ CLS 2\r
+ DrawGorilla x, y, LEFTUP\r
+ CLS 2\r
+ DrawGorilla x, y, RIGHTUP\r
+ CLS 2\r
+ \r
+ VIEW PRINT 1 TO 25\r
+ IF Mode = 9 THEN PALETTE OBJECTCOLOR, 46\r
+ \r
+ IF UCASE$(Char$) = "V" THEN\r
+ Center 2, "Q B A S I C G O R I L L A S"\r
+ Center 5, " STARRING: "\r
+ P$ = Player1$ + " AND " + Player2$\r
+ Center 7, P$\r
+\r
+ PUT (x - 13, y), GorD&, PSET\r
+ PUT (x + 47, y), GorD&, PSET\r
+ Rest 1\r
+\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"\r
+ Rest .3\r
+\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"\r
+ Rest .3\r
+\r
+ FOR i = 1 TO 4\r
+ PUT (x - 13, y), GorL&, PSET\r
+ PUT (x + 47, y), GorR&, PSET\r
+ PLAY "T160O0L32EFGEFDC"\r
+ Rest .1\r
+ PUT (x - 13, y), GorR&, PSET\r
+ PUT (x + 47, y), GorL&, PSET\r
+ PLAY "T160O0L32EFGEFDC"\r
+ Rest .1\r
+ NEXT\r
+ END IF\r
+END SUB\r
+\r
+'Intro:\r
+' Displays game introduction\r
+SUB Intro\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ MaxCol = 80\r
+ COLOR 15, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c G O R I L L A S"\r
+ COLOR 7\r
+ Center 6, "Copyright (C) Microsoft Corporation 1990"\r
+ Center 8, "Your mission is to hit your opponent with the exploding"\r
+ Center 9, "banana by varying the angle and power of your throw, taking"\r
+ Center 10, "into account wind speed, gravity, and the city skyline."\r
+ Center 11, "The wind speed is shown by a directional arrow at the bottom"\r
+ Center 12, "of the playing field, its length relative to its strength."\r
+ Center 24, "Press any key to continue"\r
+\r
+ PLAY "MBT160O1L8CDEDCDL4ECC"\r
+ SparklePause\r
+ IF Mode = 1 THEN MaxCol = 40\r
+END SUB\r
+\r
+'MakeCityScape:\r
+' Creates random skyline for game\r
+'Parameters:\r
+' BCoor() - a user-defined type array which stores the coordinates of\r
+' the upper left corner of each building.\r
+SUB MakeCityScape (BCoor() AS XYPoint)\r
+\r
+ x = 2\r
+\r
+ 'Set the sloping trend of the city scape. NewHt is new building height\r
+ Slope = FnRan(6)\r
+ SELECT CASE Slope\r
+ CASE 1: NewHt = 15 'Upward slope\r
+ CASE 2: NewHt = 130 'Downward slope\r
+ CASE 3 TO 5: NewHt = 15 '"V" slope - most common\r
+ CASE 6: NewHt = 130 'Inverted "V" slope\r
+ END SELECT\r
+\r
+ IF Mode = 9 THEN\r
+ BottomLine = 335 'Bottom of building\r
+ HtInc = 10 'Increase value for new height\r
+ DefBWidth = 37 'Default building height\r
+ RandomHeight = 120 'Random height difference\r
+ WWidth = 3 'Window width\r
+ WHeight = 6 'Window height\r
+ WDifV = 15 'Counter for window spacing - vertical\r
+ WDifh = 10 'Counter for window spacing - horizontal\r
+ ELSE\r
+ BottomLine = 190\r
+ HtInc = 6\r
+ NewHt = NewHt * 20 \ 35 'Adjust for CGA\r
+ DefBWidth = 18\r
+ RandomHeight = 54\r
+ WWidth = 1\r
+ WHeight = 2\r
+ WDifV = 5\r
+ WDifh = 4\r
+ END IF\r
+\r
+ CurBuilding = 1\r
+ DO\r
+\r
+ SELECT CASE Slope\r
+ CASE 1\r
+ NewHt = NewHt + HtInc\r
+ CASE 2\r
+ NewHt = NewHt - HtInc\r
+ CASE 3 TO 5\r
+ IF x > ScrWidth \ 2 THEN\r
+ NewHt = NewHt - 2 * HtInc\r
+ ELSE\r
+ NewHt = NewHt + 2 * HtInc\r
+ END IF\r
+ CASE 4\r
+ IF x > ScrWidth \ 2 THEN\r
+ NewHt = NewHt + 2 * HtInc\r
+ ELSE\r
+ NewHt = NewHt - 2 * HtInc\r
+ END IF\r
+ END SELECT\r
+\r
+ 'Set width of building and check to see if it would go off the screen\r
+ BWidth = FnRan(DefBWidth) + DefBWidth\r
+ IF x + BWidth > ScrWidth THEN BWidth = ScrWidth - x - 2\r
+\r
+ 'Set height of building and check to see if it goes below screen\r
+ BHeight = FnRan(RandomHeight) + NewHt\r
+ IF BHeight < HtInc THEN BHeight = HtInc\r
+\r
+ 'Check to see if Building is too high\r
+ IF BottomLine - BHeight <= MaxHeight + GHeight THEN BHeight = MaxHeight + GHeight - 5\r
+\r
+ 'Set the coordinates of the building into the array\r
+ BCoor(CurBuilding).XCoor = x\r
+ BCoor(CurBuilding).YCoor = BottomLine - BHeight\r
+\r
+ IF Mode = 9 THEN BuildingColor = FnRan(3) + 4 ELSE BuildingColor = 2\r
+\r
+ 'Draw the building, outline first, then filled\r
+ LINE (x - 1, BottomLine + 1)-(x + BWidth + 1, BottomLine - BHeight - 1), BACKGROUND, B\r
+ LINE (x, BottomLine)-(x + BWidth, BottomLine - BHeight), BuildingColor, BF\r
+\r
+ 'Draw the windows\r
+ c = x + 3\r
+ DO\r
+ FOR i = BHeight - 3 TO 7 STEP -WDifV\r
+ IF Mode <> 9 THEN\r
+ WinColr = (FnRan(2) - 2) * -3\r
+ ELSEIF FnRan(4) = 1 THEN\r
+ WinColr = 8\r
+ ELSE\r
+ WinColr = WINDOWCOLOR\r
+ END IF\r
+ LINE (c, BottomLine - i)-(c + WWidth, BottomLine - i + WHeight), WinColr, BF\r
+ NEXT\r
+ c = c + WDifh\r
+ LOOP UNTIL c >= x + BWidth - 3\r
+\r
+ x = x + BWidth + 2\r
+\r
+ CurBuilding = CurBuilding + 1\r
+\r
+ LOOP UNTIL x > ScrWidth - HtInc\r
+\r
+ LastBuilding = CurBuilding - 1\r
+\r
+ 'Set Wind speed\r
+ Wind = FnRan(10) - 5\r
+ IF FnRan(3) = 1 THEN\r
+ IF Wind > 0 THEN\r
+ Wind = Wind + FnRan(10)\r
+ ELSE\r
+ Wind = Wind - FnRan(10)\r
+ END IF\r
+ END IF\r
+\r
+ 'Draw Wind speed arrow\r
+ IF Wind <> 0 THEN\r
+ WindLine = Wind * 3 * (ScrWidth \ 320)\r
+ LINE (ScrWidth \ 2, ScrHeight - 5)-(ScrWidth \ 2 + WindLine, ScrHeight - 5), ExplosionColor\r
+ IF Wind > 0 THEN ArrowDir = -2 ELSE ArrowDir = 2\r
+ LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 - 2), ExplosionColor\r
+ LINE (ScrWidth / 2 + WindLine, ScrHeight - 5)-(ScrWidth / 2 + WindLine + ArrowDir, ScrHeight - 5 + 2), ExplosionColor\r
+ END IF\r
+END SUB\r
+\r
+'PlaceGorillas:\r
+' PUTs the Gorillas on top of the buildings. Must have drawn\r
+' Gorillas first.\r
+'Parameters:\r
+' BCoor() - user-defined TYPE array which stores upper left coordinates\r
+' of each building.\r
+SUB PlaceGorillas (BCoor() AS XYPoint)\r
+ \r
+ IF Mode = 9 THEN\r
+ XAdj = 14\r
+ YAdj = 30\r
+ ELSE\r
+ XAdj = 7\r
+ YAdj = 16\r
+ END IF\r
+ SclX# = ScrWidth / 320\r
+ SclY# = ScrHeight / 200\r
+ \r
+ 'Place gorillas on second or third building from edge\r
+ FOR i = 1 TO 2\r
+ IF i = 1 THEN BNum = FnRan(2) + 1 ELSE BNum = LastBuilding - FnRan(2)\r
+\r
+ BWidth = BCoor(BNum + 1).XCoor - BCoor(BNum).XCoor\r
+ GorillaX(i) = BCoor(BNum).XCoor + BWidth / 2 - XAdj\r
+ GorillaY(i) = BCoor(BNum).YCoor - YAdj\r
+ PUT (GorillaX(i), GorillaY(i)), GorD&, PSET\r
+ NEXT i\r
+\r
+END SUB\r
+\r
+'PlayGame:\r
+' Main game play routine\r
+'Parameters:\r
+' Player1$, Player2$ - player names\r
+' NumGames - number of games to play\r
+SUB PlayGame (Player1$, Player2$, NumGames)\r
+ DIM BCoor(0 TO 30) AS XYPoint\r
+ DIM TotalWins(1 TO 2)\r
+\r
+ J = 1\r
+ \r
+ FOR i = 1 TO NumGames\r
+ \r
+ CLS\r
+ RANDOMIZE (TIMER)\r
+ CALL MakeCityScape(BCoor())\r
+ CALL PlaceGorillas(BCoor())\r
+ DoSun SUNHAPPY\r
+ Hit = FALSE\r
+ DO WHILE Hit = FALSE\r
+ J = 1 - J\r
+ LOCATE 1, 1\r
+ PRINT Player1$\r
+ LOCATE 1, (MaxCol - 1 - LEN(Player2$))\r
+ PRINT Player2$\r
+ Center 23, LTRIM$(STR$(TotalWins(1))) + ">Score<" + LTRIM$(STR$(TotalWins(2)))\r
+ Tosser = J + 1: Tossee = 3 - J\r
+\r
+ 'Plot the shot. Hit is true if Gorilla gets hit.\r
+ Hit = DoShot(Tosser, GorillaX(Tosser), GorillaY(Tosser))\r
+\r
+ 'Reset the sun, if it got hit\r
+ IF SunHit THEN DoSun SUNHAPPY\r
+\r
+ IF Hit = TRUE THEN CALL UpdateScores(TotalWins(), Tosser, Hit)\r
+ LOOP\r
+ SLEEP 1\r
+ NEXT i\r
+\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 7, 0\r
+ MaxCol = 80\r
+ CLS\r
+\r
+ Center 8, "GAME OVER!"\r
+ Center 10, "Score:"\r
+ LOCATE 11, 30: PRINT Player1$; TAB(50); TotalWins(1)\r
+ LOCATE 12, 30: PRINT Player2$; TAB(50); TotalWins(2)\r
+ Center 24, "Press any key to continue"\r
+ SparklePause\r
+ COLOR 7, 0\r
+ CLS\r
+END SUB\r
+\r
+'PlayGame:\r
+' Plots banana shot across the screen\r
+'Parameters:\r
+' StartX, StartY - starting shot location\r
+' Angle - shot angle\r
+' Velocity - shot velocity\r
+' PlayerNum - the banana thrower\r
+FUNCTION PlotShot (StartX, StartY, Angle#, Velocity, PlayerNum)\r
+\r
+ Angle# = Angle# / 180 * pi# 'Convert degree angle to radians\r
+ Radius = Mode MOD 7\r
+\r
+ InitXVel# = COS(Angle#) * Velocity\r
+ InitYVel# = SIN(Angle#) * Velocity\r
+\r
+ oldx# = StartX\r
+ oldy# = StartY\r
+\r
+ 'draw gorilla toss\r
+ IF PlayerNum = 1 THEN\r
+ PUT (StartX, StartY), GorL&, PSET\r
+ ELSE\r
+ PUT (StartX, StartY), GorR&, PSET\r
+ END IF\r
+ \r
+ 'throw sound\r
+ PLAY "MBo0L32A-L64CL16BL64A+"\r
+ Rest .1\r
+\r
+ 'redraw gorilla\r
+ PUT (StartX, StartY), GorD&, PSET\r
+\r
+ adjust = Scl(4) 'For scaling CGA\r
+\r
+ xedge = Scl(9) * (2 - PlayerNum) 'Find leading edge of banana for check\r
+\r
+ Impact = FALSE\r
+ ShotInSun = FALSE\r
+ OnScreen = TRUE\r
+ PlayerHit = 0\r
+ NeedErase = FALSE\r
+\r
+ StartXPos = StartX\r
+ StartYPos = StartY - adjust - 3\r
+\r
+ IF PlayerNum = 2 THEN\r
+ StartXPos = StartXPos + Scl(25)\r
+ direction = Scl(4)\r
+ ELSE\r
+ direction = Scl(-4)\r
+ END IF\r
+\r
+ IF Velocity < 2 THEN 'Shot too slow - hit self\r
+ x# = StartX\r
+ y# = StartY\r
+ pointval = OBJECTCOLOR\r
+ END IF\r
+ \r
+ DO WHILE (NOT Impact) AND OnScreen\r
+ \r
+ Rest .02\r
+\r
+ 'Erase old banana, if necessary\r
+ IF NeedErase THEN\r
+ NeedErase = FALSE\r
+ CALL DrawBan(oldx#, oldy#, oldrot, FALSE)\r
+ END IF\r
+\r
+ x# = StartXPos + (InitXVel# * t#) + (.5 * (Wind / 5) * t# ^ 2)\r
+ y# = StartYPos + ((-1 * (InitYVel# * t#)) + (.5 * gravity# * t# ^ 2)) * (ScrHeight / 350)\r
+ \r
+ IF (x# >= ScrWidth - Scl(10)) OR (x# <= 3) OR (y# >= ScrHeight - 3) THEN\r
+ OnScreen = FALSE\r
+ END IF\r
+\r
+ \r
+ IF OnScreen AND y# > 0 THEN\r
+\r
+ 'check it\r
+ LookY = 0\r
+ LookX = Scl(8 * (2 - PlayerNum))\r
+ DO\r
+ pointval = POINT(x# + LookX, y# + LookY)\r
+ IF pointval = 0 THEN\r
+ Impact = FALSE\r
+ IF ShotInSun = TRUE THEN\r
+ IF ABS(ScrWidth \ 2 - x#) > Scl(20) OR y# > SunHt THEN ShotInSun = FALSE\r
+ END IF\r
+ ELSEIF pointval = SUNATTR AND y# < SunHt THEN\r
+ IF NOT SunHit THEN DoSun SUNSHOCK\r
+ SunHit = TRUE\r
+ ShotInSun = TRUE\r
+ ELSE\r
+ Impact = TRUE\r
+ END IF\r
+ LookX = LookX + direction\r
+ LookY = LookY + Scl(6)\r
+ LOOP UNTIL Impact OR LookX <> Scl(4)\r
+ \r
+ IF NOT ShotInSun AND NOT Impact THEN\r
+ 'plot it\r
+ rot = (t# * 10) MOD 4\r
+ CALL DrawBan(x#, y#, rot, TRUE)\r
+ NeedErase = TRUE\r
+ END IF\r
+ \r
+ oldx# = x#\r
+ oldy# = y#\r
+ oldrot = rot\r
+\r
+ END IF\r
+\r
+ \r
+ t# = t# + .1\r
+\r
+ LOOP\r
+\r
+ IF pointval <> OBJECTCOLOR AND Impact THEN\r
+ CALL DoExplosion(x# + adjust, y# + adjust)\r
+ ELSEIF pointval = OBJECTCOLOR THEN\r
+ PlayerHit = ExplodeGorilla(x#, y#)\r
+ END IF\r
+\r
+ PlotShot = PlayerHit\r
+\r
+END FUNCTION\r
+\r
+'Rest:\r
+' pauses the program\r
+SUB Rest (t#)\r
+ s# = TIMER\r
+ t2# = MachSpeed * t# / SPEEDCONST\r
+ DO\r
+ LOOP UNTIL TIMER - s# > t2#\r
+END SUB\r
+\r
+'Scl:\r
+' Pass the number in to scaling for cga. If the number is a decimal, then we\r
+' want to scale down for cga or scale up for ega. This allows a full range\r
+' of numbers to be generated for scaling.\r
+' (i.e. for 3 to get scaled to 1, pass in 2.9)\r
+FUNCTION Scl (n!)\r
+\r
+ IF n! <> INT(n!) THEN\r
+ IF Mode = 1 THEN n! = n! - 1\r
+ END IF\r
+ IF Mode = 1 THEN\r
+ Scl = CINT(n! / 2 + .1)\r
+ ELSE\r
+ Scl = CINT(n!)\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+'SetScreen:\r
+' Sets the appropriate color statements\r
+SUB SetScreen\r
+\r
+ IF Mode = 9 THEN\r
+ ExplosionColor = 2\r
+ BackColor = 1\r
+ PALETTE 0, 1\r
+ PALETTE 1, 46\r
+ PALETTE 2, 44\r
+ PALETTE 3, 54\r
+ PALETTE 5, 7\r
+ PALETTE 6, 4\r
+ PALETTE 7, 3\r
+ PALETTE 9, 63 'Display Color\r
+ ELSE\r
+ ExplosionColor = 2\r
+ BackColor = 0\r
+ COLOR BackColor, 2\r
+\r
+ END IF\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro and game over screens\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ A$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR A = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(A$, A, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(A$, 6 - A, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (A + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT A\r
+ WEND\r
+END SUB\r
+\r
+'UpdateScores:\r
+' Updates players' scores\r
+'Parameters:\r
+' Record - players' scores\r
+' PlayerNum - player\r
+' Results - results of player's shot\r
+SUB UpdateScores (Record(), PlayerNum, Results)\r
+ IF Results = HITSELF THEN\r
+ Record(ABS(PlayerNum - 3)) = Record(ABS(PlayerNum - 3)) + 1\r
+ ELSE\r
+ Record(PlayerNum) = Record(PlayerNum) + 1\r
+ END IF\r
+END SUB\r
+\r
+'VictoryDance:\r
+' gorilla dances after he has eliminated his opponent\r
+'Parameters:\r
+' Player - which gorilla is dancing\r
+SUB VictoryDance (Player)\r
+\r
+ FOR i# = 1 TO 4\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorL&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ PUT (GorillaX(Player), GorillaY(Player)), GorR&, PSET\r
+ PLAY "MFO0L32EFGEFDC"\r
+ Rest .2\r
+ NEXT\r
+END SUB\r
+\r
--- /dev/null
+CLS\r
+SCREEN 0\r
+COLOR 15,0\r
+LOCATE 2,2\r
+PRINT "GRAN TOMET M GRAN TY(viz hvØzdy)JEN NA JEDEN D VKOV¡ VìSTýEL :*****"\r
+LOCATE 3,2\r
+INPUT " M -LI SE VYSTýELIT STISKNI *ENTER* " ;V\r
+FOR A=2 TO 71\r
+FOR I=0 TO 600\r
+NEXT I\r
+CLS\r
+LOCATE 10,A\r
+PRINT "*"\r
+NEXT A\r
+LOCATE 10,69\r
+PRINT "XO*OX"\r
+FOR K2=0 TO 550\r
+NEXT K2\r
+END\1a
\ No newline at end of file
--- /dev/null
+cls\r
+open "heslo.dta" For random AS #1\r
+c$=input$(137,#1)\r
+b$=mid$(C$,129,7)\r
+input "Zadej vstupni heslo"; a$\r
+ if a$=b$ then end\r
+ shell "date>>HESLO.TXT"\r
+ shell "K>>HESLO.TXT"\r
+ shell "KONEC"\r
+end\r
+\1a
\ No newline at end of file
--- /dev/null
+brave38\r
+\r
+NA PRVNI RADCE MUSI BYT OD ZACATKU NAPSANO VZDY SLOVO DLOUHE 7 ZNAKU !!!\r
+ Dalsi budou ignorovany.\r
+ Odpoved musi byt zapsana STEJNOU VELIKOSTI pisma.\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+\r
+ ***************************************\r
+ * Hlaseni o pokusu narusit ochranu *\r
+ ***************************************\r
+Current date is Wed 30/10/1991\r
+Enter new date (dd-mm-yy): \r\r
+Current time is 8:45:28,27\r
+Enter new time: \r\r
+******\r
--- /dev/null
+cls\r
+screen 9\r
+screen 0\r
+color 0,15\r
+cls\r
+locate 2,2\r
+input "Jaka je hustota telesa (g/cm3) " ;hmotnost\r
+cls\r
+locate 2,2\r
+input "Jaky je objem telesa (cm3 - ml) " ;objem\r
+\r
+screen 9\r
+cls\r
+locate 20,20\r
+print "POCITAM!"\r
+locate 2,2\r
+print "TENTO PROGRAM NAPROGRMOVAL TOMAS MUDRUNKA."\r
+delay 2\r
+screen 0\r
+hustota=hmotnost*objem\r
+cls\r
+\r
+print "hustota....."hmotnost " g/cm3"\r
+print "objem......."objem " cm3"\r
+print "hmotnost.....? g"\r
+print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"\r
+print "hmotnost = hustota . objem"\r
+print "hmotnost = "hmotnost" g . "objem " cm3"\r
+print "hmotnost = "hustota" g/cm3"\r
+print ""\r
+print "Hmotnost daneho telesa je "hustota" g/cm3."\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print "TENTO PROGRAM NAPSAL.... TOMAS MUDRUNKA"\r
+PRINT "SPOLECNOST.............. X-TOM"\r
+input "Mas uz tabulku opsanou " ;konec$\r
+\r
+\r
+end\1a
\ No newline at end of file
--- /dev/null
+cls\r
+screen 9\r
+screen 0\r
+color 0,15\r
+cls\r
+locate 2,2\r
+input "Jaka je hmotnost telesa (g) " ;hmotnost\r
+cls\r
+locate 2,2\r
+input "Jaky je objem telesa (cm3 - ml) " ;objem\r
+\r
+screen 9\r
+cls\r
+locate 20,20\r
+print "POCITAM!"\r
+locate 2,2\r
+print "TENTO PROGRAM NAPROGRMOVAL TOMAS MUDRUNKA."\r
+delay 2\r
+screen 0\r
+hustota=hmotnost/objem\r
+cls\r
+\r
+print "hmotnost...."hmotnost " g"\r
+print "objem......."objem " cm3"\r
+print "hustota.....? g/cm3"\r
+print "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"\r
+print "hustota = m:V"\r
+print "hustota = "hmotnost" g:"objem " cm3"\r
+print "hustota = "hustota" g/cm3"\r
+print ""\r
+print "Hustota daneho telesa je "hustota" g/cm3."\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print ""\r
+print "TENTO PROGRAM NAPSAL.... TOMAS MUDRUNKA"\r
+PRINT "SPOLECNOST.............. X-TOM"\r
+input "Mas uz tabulku opsanou " ;konec$\r
+\r
+\r
+end\1a
\ No newline at end of file
--- /dev/null
+cls\r
+\r
+FOR I=1 TO 100\r
+A$=INKEY$\r
+IF LEN(A$)<>0 THEN ANO\r
+PRINT A$\r
+NEXT I\r
+\r
+GOTO NE\r
+\r
+ANO:\r
+PRINT " ANO "\r
+END\r
+\r
+NE:\r
+PRINT " NE "\1a
\ No newline at end of file
--- /dev/null
+SHELL "MKDIR C:/ CD MUDPROG"\r
+SHELL "COPY CD A: TO CD C:/CD MUDPROG"\r
+SHELL "DEL CD C:/ CD MUDPROG/INSTALAC.EXE"\r
+END\1a
\ No newline at end of file
--- /dev/null
+COLOR 14,1\r
+LOCATE 5,5\r
+SCREEN 1\r
+PRINT " FLOPI DISC "\r
+LOCATE 20,20\r
+REM SCREEN 1\r
+PRINT " TOMµæ MUDRUÕKA "\r
+FOR TOMAS=0 TO 1000000\r
+NEXT TOMAS\r
+END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+SCREEN 9\r
+COLOR 3,15\r
+LOCATE 2,2\r
+INPUT " Pü¡KLAD (BEZ*=*) " ;A\r
+CLS\r
+LOCATE 2,2\r
+PRINT " = " A\r
+END\1a
\ No newline at end of file
--- /dev/null
+S1=0\r
+S2=0\r
+V=0\r
+CLS\r
+ FOR O=1 TO 20\r
+COLOR 0,15\r
+SCREEN 0\r
+LOCATE 2,2\r
+ INPUT " S¬ÖTANEC= " ;S1\r
+LOCATE 23,23\r
+ INPUT " " ;K$\r
+IF K$="X" THEN GOTO KONEC\r
+LOCATE 3,2\r
+ PRINT " + "\r
+LOCATE 4,2\r
+ INPUT " S¬ÖTANEC= " ;S2\r
+LOCATE 5,2\r
+ PRINT " = "\r
+V=S1+S2\r
+LOCATE 6,2\r
+PRINT V\r
+ NEXT O\r
+GOTO KONEC\r
+KONEC:\r
+END\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 0 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+REM zadani polozek adresare\r
+DO\r
+ A$="NASOB AHOJ POZDR NASO2 KONEC "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TEXT :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB :\r
+SCREEN 0\r
+CLS\r
+SOUND RND*1000+20,70\r
+COLOR 4,15\r
+N=0\r
+S=0\r
+V=0\r
+SOUND RND*300+12,13\r
+SOUND RND*10000+12,13\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND RND*10000+12,13\r
+S=S+1\r
+GOTO VOLBA\r
+SOUND RND*100+12,13\r
+ANO:\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+REM pise chybu sound rnd*100+12,13\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stlac klavesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+NIC1 :\r
+A$="Zdravi Vas Tomas Mudrunka"\r
+CALL ECHO (5,16,A$,13)\r
+A$="Jak se mate?"\r
+CALL ECHO (7,17,A$,13)\r
+A$="Jak se Vam libi tento program?"\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB2 :\r
+\r
+SCREEN 0\r
+CLS\r
+rem SOUND RND*1000+20,70\r
+COLOR 4,15\r
+S=0\r
+V=0\r
+rem SOUND RND*300+12,13\r
+rem SOUND RND*10000+12,13\r
+\r
+FOR I=1 TO 10\r
+ rem nechat pokud nebude vadit CLS\r
+ LOCATE 4,20\r
+ PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"\r
+\r
+ A=INT(RND(5)*10+1)\r
+ B=INT(RND(4)*10+1)\r
+ LOCATE 10,5\r
+ REM vymaze radek\r
+ PRINT " "\r
+ PRINT " "\r
+ LOCATE 10,5\r
+ PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+ INPUT " STISKNI ENTER";C\r
+ D=A*B\r
+\r
+ IF D=C THEN ANO2\r
+ PRINT " SPATNY VYSLEDEK"\r
+ rem SOUND RND*10000+12,13\r
+ S=S+1\r
+ GOTO VOLBA2\r
+ rem SOUND RND*100+12,13\r
+ ANO2:\r
+ PRINT " SPRAVNE"\r
+ V=V+1\r
+ VOLBA2:\r
+ LOCATE 18,10\r
+ PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+ REM zdrzeni programu\r
+ FOR G=1 TO 10\r
+ rem SOUND RND*1000+12,13\r
+ NEXT G\r
+NEXT I\r
+\r
+LOCATE 18,10\r
+PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+LOCATE 20,10\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+Input "Ukonci stiskem klavesy ENTER";A\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+color 2,3\r
+SCREEN 8\r
+LINE (3,3)-(319,119),,B\r
+LINE (55,1)-(1,50)\r
+CIRCLE (200,100),50,3\r
+CIRCLE (100,100),50, , , , 5/18\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+A=0\r
+M=1000000\r
+START:\r
+A=A+1\r
+\r
+COLOR 14,1\r
+SCREEN 0\r
+LOCATE 2,2\r
+PRINT "LOSUJI"\r
+B$=INKEY$\r
+IF A>M THEN KONEC\r
+IF LEN(B$)=0 THEN GOTO START\r
+IF B$<>"0" THEN GOTO KONEC\r
+\r
+KONEC:\r
+IF A>M THEN PRINT"LOSOVANI JE NEPLATNE !"\r
+PRINT "VYLOSOVANE CISLO JE" A\r
+INPUT;f\r
+FOR I=0 TO 2000\r
+NEXT I\r
+STOP\r
+END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+SCREEN 0\r
+COLOR 14,1\r
+T=TIMER\r
+T=T*2\r
+G=RND*30\r
+D=T+G\r
+PRINT D\r
+STOP\r
+END\1a
\ No newline at end of file
--- /dev/null
+LET N = 5\r
+LET G = 10\r
+LET NALEZ = 0\r
+LET I = 0\r
+LET A = INT(G * RND)\r
+LET B = INT(G * RND)\r
+OLAL:\r
+\r
+IF NOT ( NALEZ = 0 AND I <= 5) THEN GOTO FEDO\r
+INPUT "X,Y" ;X,Y\r
+IF ABS (X-A)+ABS(Y-B)=0 THEN GOTO FEDOS\r
+GOSUB FEDOE\r
+GOTO OLA\r
+FEDOS:\r
+PRINT "ZVIRE NALEZENO:";A,B\r
+LET NALEZ = 1\r
+OLA :\r
+LET I = I+1\r
+GOTO OLAL\r
+END\r
+FEDOE:\r
+PRINT "JDI NA ";\r
+IF X < A\r
+IF X > A\r
+IF X <> A\r
+IF\r
+IF\r
+RETURN\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFON DIR exit HELP LOAD "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\87 kl vesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="Jste uzivatelem pocitacove site C&P NETWORK. Jste vybaven harddiskem se"\r
+CALL ECHO (5,16,A$,13)\r
+A$="softwarovym vybavenim. Mate k dispozici modem, takze muzete navazat"\r
+CALL ECHO (7,17,A$,13)\r
+A$="spojeni s jinym uzivatelem C&P NETWORK."\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+cls\r
+open "c:\util\mm.dta" For random AS #1\r
+c$=input$(137,#1)\r
+b$=mid$(C$,129,7)\r
+input "Zadej vstupni heslo"; a$\r
+ if a$=b$ then end\r
+ shell "rem date>>c:\util\mm.TXT"\r
+ shell "rem time>>c:\util\mm.TXT"\r
+ shell "blokne PC"\r
+end\r
+\1a
\ No newline at end of file
--- /dev/null
+V=TIMER\r
+PRINT V\r
+\r
+V=V-INT(V)\r
+PRINT V\r
+V=V*120\r
+PRINT V\r
+V=INT(V)\r
+\r
+G=RND*40\r
+I=G+V\r
+I=INT(V)+(G)\r
+I=I+55\r
+I=INT(V)+(G)+(I)\r
+I=INT(I)\r
+PRINT I\r
+END\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+COLOR 0,15\r
+SOUND 700,12\r
+N=0\r
+S=0\r
+V=0\r
+\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND 100,10\r
+S=S+1\r
+GOTO VOLBA\r
+\r
+ANO:\r
+PRINT " SPRAVNE"\r
+SOUND 900,8\r
+V=V+1\r
+\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI ENTER";E\r
+IF E<>1 THEN OPET\r
+SOUND 900,12\r
+SOUND 100,7\r
+\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+COLOR 7,9\r
+N=0\r
+S=0\r
+V=0\r
+\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " A STISKNI ENTER ";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+S=S+1\r
+GOTO VOLBA\r
+\r
+ANO:\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+CLS\r
+SOUND RND*1000+20,70\r
+COLOR 4,15\r
+N=0\r
+S=0\r
+V=0\r
+SOUND RND*300+12,13\r
+SOUND RND*10000+12,13\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND RND*10000+12,13\r
+S=S+1\r
+GOTO VOLBA\r
+SOUND RND*100+12,13\r
+ANO:\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+sound rnd*100+12,13\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+shell "1.waw"\r
+shell "2.waw"\r
+shell "3.waw"\r
+end\r
+\r
+\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+T=TIMER\r
+L=INT(T)\r
+COLOR 14,1\r
+SCREEN 0\r
+LOCATE 2,2\r
+L=L-9999\r
+PRINT L\r
+STOP\r
+END\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+color 0,15\r
+cls\r
+INPUT " NOTA 1 " ;N1\r
+CLS\r
+INPUT " NOTA 2 " ;N2\r
+CLS\r
+INPUT " NOTA 3 " ;N3\r
+CLS\r
+INPUT " NOTA 4 " ;N4\r
+CLS\r
+INPUT " NOTA 5 " ;N5\r
+CLS\r
+INPUT " NOTA 6 " ;N6\r
+CLS\r
+INPUT " NOTA 7 " ;N7\r
+CLS\r
+INPUT " NOTA 8 " ;N8\r
+CLS\r
+INPUT " NOTA 9 " ;N9\r
+CLS\r
+INPUT " NOTA 10 " ;N10\r
+CLS\r
+INPUT " STISKNI *ENTER* " ;V\r
+CLS\r
+SOUND N1*12,12\r
+SOUND N2*12,12\r
+SOUND N3*12,12\r
+SOUND N4*12,12\r
+SOUND N5*12,12\r
+SOUND N6*12,12\r
+SOUND N7*12,12\r
+SOUND N8*12,12\r
+SOUND N9*12,12\r
+SOUND N10*12,12\r
+PRINT " KONEC "\r
+FOR I=0 TO 300\r
+NEXT I\r
+END\1a
\ No newline at end of file
--- /dev/null
+COLOR 14,1\r
+SCREEN 1\r
+PRINT CHR$ 200\r
+\r
+\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+\r
+\r
+CLS\r
+SCREEN 0\r
+COLOR 14,1\r
+\r
+start:\r
+INPUT ; A$\r
+IF A$="1" THEN GOTO ANO\r
+IF A$="2" THEN GOTO NE\r
+IF A$="3" THEN GOTO NEVIM\r
+IF A$="4" THEN GOTO KONEC\r
+\r
+ANO:\r
+LOCATE 2,2\r
+PRINT "ANO "\r
+GOTO START\r
+\r
+NE:\r
+LOCATE 2,2\r
+PRINT "NE "\r
+GOTO START\r
+\r
+NEVIM:\r
+LOCATE 2,2\r
+PRINT "NEVIM "\r
+GOTO START\r
+\r
+KONEC:\r
+LOCATE 2,2\r
+PRINT "STLAC LIBOVOLNOU KLAVESU "\r
+END\1a
\ No newline at end of file
--- /dev/null
+DO\r
+CLS\r
+SCREEN 8\r
+COLOR 14,1\r
+LOCATE 2,2\r
+INPUT " !!! ZADEJ HESLO !!! " ; ALO$\r
+IF ALO$ = "COBRA 11" THEN GOTO POGR\r
+LOOP\r
+POGR:\r
+ GOTO POKR\r
+REM PIN= COBRA 11\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="TELEFONY CLUB exit! HESLA PAR\9b CI "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+SOUND RND*150+12,13\r
+print "MUDRUNKA 56 18 243"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+SOUND RND*150+12,13\r
+PRINT "KROTITEL\90 DUCH\85"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+CLS\r
+SOUND RND*150+12,13\r
+CALL ANYKEY\r
+CALL CLWD\r
+end\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+\r
+A$="ZAKLADNI COBRA 11"\r
+CALL ECHO (5,16,A$,13)\r
+A$="DO NASI BEDNY DF45M3"\r
+CALL ECHO (7,17,A$,13)\r
+A$="DO NASEHO UKRITU (BUNKRU,CTYRKOLKY) SD85L6"\r
+SOUND RND*1000+12,13\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+\r
+PRINT "MUDRUNKA,COUFAL=VELITELE.VELEBNY,TOMEK,HORNYCH,HAUK."\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+\r
+ FOR A=1 TO LEN(A$)\r
+\r
+\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+INPUT " ZADEJ 1 (çED ) NEBO JEN ENTER(MODR )";L\r
+IF L=1 THEN COLOR 0,15:GOTO RAZ\r
+COLOR 14,1\r
+\r
+RAZ:\r
+FOR I=2 TO 500\r
+REM CLS PRI KAZDEM CYKLU VYMAZE OBRAZOVKU, TAKZE NAPIS BLIKA\r
+CLS\r
+SCREEN 0\r
+LOCATE 9,23\r
+PRINT " DOBRY DEN! JAK SE MATE ? "\r
+\r
+A$=INKEY$\r
+IF A$="X" THEN KONEC\r
+KEY (11) STOP\r
+\r
+FOR B=0 TO 300\r
+NEXT B\r
+\r
+NEXT I\r
+KONEC:\r
+REM CLS\r
+LOCATE 20,15\r
+\r
+PRINT "UKONCI stiskem enter"\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+INPUT " ZADEJ 1 (çED ) NEBO JEN ENTER(MODR )";L\r
+IF L=1 THEN COLOR 0,15:GOTO RAZ\r
+COLOR 14,1\r
+\r
+RAZ:\r
+FOR I=2 TO 500\r
+REM CLS PRI KAZDEM CYKLU VYMAZE OBRAZOVKU, TAKZE NAPIS BLIKA\r
+CLS\r
+SCREEN 0\r
+LOCATE 9,23\r
+PRINT " DOBRY DEN! JAK SE MATE ? "\r
+\r
+A$=INKEY$\r
+IF A$="X" THEN KONEC\r
+KEY (11) STOP\r
+\r
+FOR B=0 TO 300\r
+NEXT B\r
+\r
+NEXT I\r
+KONEC:\r
+LOCATE 20,15\r
+FOR T=0 TO 2000\r
+CLS\r
+PRINT "UKONCI LIBOVOLNOU KLAVESOU"\r
+KEY (19) STOP\r
+NEXT T\1a
\ No newline at end of file
--- /dev/null
+FOR I=0 TO 5000\r
+CLS\r
+SCREEN 0\r
+COLOR 14,1\r
+LOCATE 10,5\r
+PRINT " DOBRY DEN! JAK SE MATE ? "\r
+\r
+A$=INKEY$\r
+IF A$="X" THEN KONEC\r
+\r
+FOR B=0 TO 300\r
+NEXT B\r
+\r
+NEXT I\r
+KONEC:\r
+CLS\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+REM zadani polozek adresare\r
+DO\r
+ A$="NASOB HELP POZDR NASO2 KONEC "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TEXT :\r
+LOCATE 10,5\r
+print "JESTLI ¦E NEUMÖTE NASOBIT:*KONEC*,!!!POZOR!!! NASOB2 ZNAMKUJE"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB :\r
+SCREEN 0\r
+CLS\r
+\r
+COLOR 14,1\r
+N=0\r
+S=0\r
+V=0\r
+\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+SOUND RND*10000+90,90\r
+PRINT " SPATNY VYSLEDEK"\r
+\r
+S=S+1\r
+GOTO VOLBA\r
+\r
+ANO:\r
+SOUND RND*100+90,90\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+REM pise chybu sound rnd*100+12,13\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stlac klavesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+NIC1 :\r
+A$="Zdravi Vas Tomas Mudrunka"\r
+CALL ECHO (5,16,A$,13)\r
+A$="Jak se mate?"\r
+CALL ECHO (7,17,A$,13)\r
+A$="Jak se Vam libi tento program?"\r
+CALL ECHO (7,18,A$,13)\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB2 :\r
+\r
+SCREEN 0\r
+CLS\r
+COLOR 4,15\r
+S=0\r
+V=0\r
+\r
+\r
+FOR I=1 TO 10\r
+ rem nechat pokud nebude vadit CLS\r
+ LOCATE 4,20\r
+ PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"\r
+\r
+ A=INT(RND(5)*10+1)\r
+ B=INT(RND(4)*10+1)\r
+ LOCATE 10,5\r
+ REM vymaze radek\r
+ PRINT " "\r
+ PRINT " "\r
+ LOCATE 10,5\r
+ PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+ INPUT " STISKNI ENTER";C\r
+ D=A*B\r
+\r
+ IF D=C THEN ANO2\r
+ SOUND RND*10000+55,55\r
+ PRINT " SPATNY VYSLEDEK"\r
+ \r
+ S=S+1\r
+ GOTO VOLBA2\r
+ \r
+ ANO2:\r
+ SOUND RND*100+55,55\r
+ PRINT " SPRAVNE"\r
+ V=V+1\r
+ VOLBA2:\r
+ LOCATE 18,10\r
+ PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+ REM zdrzeni programu\r
+ FOR G=1 TO 10\r
+\r
+ NEXT G\r
+NEXT I\r
+\r
+LOCATE 18,10\r
+PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+LOCATE 20,10\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+Input "Ukonci stiskem klavesy ENTER";A\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+REM zadani polozek adresare\r
+DO\r
+ A$="NASOB AHOJ POZDR NASO2 KONEC "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TEXT :\r
+SOUND RND*10000+12,13\r
+SOUND RND*100+99,80\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB :\r
+SCREEN 0\r
+CLS\r
+SOUND RND*1000+20,70\r
+COLOR 14,1\r
+N=0\r
+S=0\r
+V=0\r
+SOUND RND*300+12,13\r
+SOUND RND*10000+12,13\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+SOUND RND*10000+90,90\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND RND*10000+12,13\r
+S=S+1\r
+GOTO VOLBA\r
+SOUND RND*100+12,13\r
+ANO:\r
+SOUND RND*100+90,90\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+SOUND RND* 10000+55,55\r
+SOUND RND* 100+55,55\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+REM pise chybu sound rnd*100+12,13\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+SOUND RND*100+55,100\r
+print "stlac klavesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+NIC1 :\r
+SOUND RND*100+55,55\r
+A$="Zdravi Vas Tomas Mudrunka"\r
+CALL ECHO (5,16,A$,13)\r
+A$="Jak se mate?"\r
+CALL ECHO (7,17,A$,13)\r
+A$="Jak se Vam libi tento program?"\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB2 :\r
+\r
+SCREEN 0\r
+CLS\r
+rem SOUND RND*1000+20,70\r
+COLOR 4,15\r
+S=0\r
+V=0\r
+rem SOUND RND*300+12,13\r
+rem SOUND RND*10000+12,13\r
+\r
+FOR I=1 TO 10\r
+ rem nechat pokud nebude vadit CLS\r
+ LOCATE 4,20\r
+ PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"\r
+\r
+ A=INT(RND(5)*10+1)\r
+ B=INT(RND(4)*10+1)\r
+ LOCATE 10,5\r
+ REM vymaze radek\r
+ PRINT " "\r
+ PRINT " "\r
+ LOCATE 10,5\r
+ PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+ INPUT " STISKNI ENTER";C\r
+ D=A*B\r
+\r
+ IF D=C THEN ANO2\r
+ SOUND RND*10000+55,55\r
+ PRINT " SPATNY VYSLEDEK"\r
+ rem SOUND RND*10000+12,13\r
+ S=S+1\r
+ GOTO VOLBA2\r
+ rem SOUND RND*100+12,13\r
+ ANO2:\r
+ SOUND RND*100+55,55\r
+ PRINT " SPRAVNE"\r
+ V=V+1\r
+ VOLBA2:\r
+ LOCATE 18,10\r
+ PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+ REM zdrzeni programu\r
+ FOR G=1 TO 10\r
+ rem SOUND RND*1000+12,13\r
+ NEXT G\r
+NEXT I\r
+\r
+LOCATE 18,10\r
+PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+LOCATE 20,10\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+Input "Ukonci stiskem klavesy ENTER";A\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 8\r
+COLOR 14,1\r
+LOCATE 2,2\r
+PRINT " PO- ¬J* M* PR 2.* ¬T/PS "\r
+LOCATE 3,2\r
+PRINT " éT- M* ¬J* PR 1.* ¬J:SL* PLAVµNÖ* PLAVµNÖ:NµVRAT "\r
+LOCATE 4,2\r
+PRINT " ST- ¬J* M* Tv* ¬T* Hv "\r
+LOCATE 5,2\r
+PRINT " ¬T- M* ¬J* PR 2.* P¬* ¬T/PS "\r
+LOCATE 6,2\r
+PRINT " Pµ- ¬J* M* Vv* ¬T "\r
+SOUND 100+12,150\r
+END\1a
\ No newline at end of file
--- /dev/null
+SCREEN 8\r
+COLOR 14,1\r
+LOCATE 2,2\r
+PRINT " PO- ¬J* M* PR 2.* ¬T/PS "\r
+LOCATE 3,2\r
+PRINT " éT- M* ¬J* PR 1.* ¬J:SL* PLAVµNÖ* PLAVµNÖ:NµVRAT "\r
+LOCATE 4,2\r
+PRINT " ST- ¬J* M* Tv* ¬T* Hv "\r
+LOCATE 5,2\r
+PRINT " ¬T- M* ¬J* PR 2.* P¬* ¬T/PS "\r
+LOCATE 6,2\r
+PRINT " Pµ- ¬J* M* Vv* ¬T "\r
+SOUND 100+12,70\r
+END\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+CLS\r
+COLOR 4,15\r
+S=0\r
+Z=0\r
+\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI SCITANI"\r
+PRINT " "\r
+\r
+V=TIMER\r
+V=INT(((V-INT(V)+.2)*100))\r
+\r
+FOR I=1 TO 15\r
+\r
+A(I)=INT(RND*V+1)\r
+A(I)=A(I)+1\r
+B(I)=INT(RND*V+1)\r
+B(I)=B(I)+1\r
+\r
+VYP:\r
+IF A(I)>=B(I) THEN C(I)=A(I)-B(I):D(I)=B(I):GOTO VYSL\r
+REM pokud je B vØtç¡ ne§ A zmenç¡ se\r
+B(I)=INT(B(I)*.9)\r
+B(I)=B(I)+1\r
+GOTO VYP\r
+\r
+VYSL:\r
+REM aby druhì s\9f¡tanec nebyl 0\r
+IF C(I)=O THEN A(I)=A(I)+2:GOTO VYP\r
+\r
+REM VYSLEDEK JE V A(x)\r
+LOCATE I+5,1\r
+PRINT " "\r
+LOCATE I+5,4\r
+PRINT "NAPIS VYSLEDEK" D(I) "+" C(I) "=":INPUT C\r
+\r
+IF A(I)=C THEN ANO\r
+\r
+LOCATE I+5,30\r
+PRINT C\r
+LOCATE I+5,34\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND 1200,2\r
+S=S+1\r
+GOTO VOLBA\r
+\r
+ANO:\r
+LOCATE I+5,30\r
+PRINT C\r
+LOCATE I+5,34\r
+PRINT " SPRAVNE"\r
+rem SOUND 600,2\r
+Z=Z+1\r
+\r
+VOLBA:\r
+NEXT I\r
+\r
+I=I-1\r
+PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" Z "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+print " "\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+REM PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+REM LOCATE 21,10\r
+REM INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+REM IF E<>1 THEN OPET\r
+\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+CLS\r
+COLOR 4,15\r
+S=0\r
+Z=0\r
+\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI SCITANI"\r
+PRINT " "\r
+\r
+V=TIMER\r
+V=INT(((V-INT(V)+.3)*200))\r
+REM puvodne bylo + .2 )*100\r
+\r
+FOR I=1 TO 15\r
+\r
+A(I)=INT(RND*V+1)\r
+A(I)=A(I)+1\r
+B(I)=INT(RND*V+1)\r
+B(I)=B(I)+1\r
+\r
+VYP:\r
+REM pokud je A vetsi ne§ 100 zmençit\r
+IF A(I)>=100 THEN A(I)=INT(A(I)*.9)+1: GOTO VYP\r
+C(I)=A(I)+B(I)\r
+REM pokud je sou\9fet vØtç¡ ne§ 100 zmençit B\r
+IF C(I)>100 THEN B(I)=INT(B(I)*.9)+1: GOTO VYP\r
+\r
+LOCATE I+5,1\r
+PRINT " "\r
+LOCATE I+5,4\r
+PRINT "NAPIS VYSLEDEK" A(I) "+" B(I) "=":INPUT C\r
+\r
+IF C(I)=C THEN ANO\r
+\r
+LOCATE I+5,30\r
+PRINT C\r
+LOCATE I+5,34\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND 1200,2\r
+S=S+1\r
+GOTO VOLBA\r
+\r
+ANO:\r
+LOCATE I+5,30\r
+PRINT C\r
+LOCATE I+5,34\r
+PRINT " SPRAVNE"\r
+rem SOUND 600,2\r
+Z=Z+1\r
+\r
+VOLBA:\r
+NEXT I\r
+\r
+I=I-1\r
+PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" Z "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+print " "\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+REM PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+REM LOCATE 21,10\r
+REM INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+REM IF E<>1 THEN OPET\r
+\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+COLOR 14,15\r
+LOCATE 2,2\r
+SCREEN 0\r
+INPUT " AHOJ,JAK SE Mµæ. DOBRE/SPATNE " ;AAA$\r
+IF AAA$= SPATNE THEN GOTO CXY\r
+IF AAA$= DOBRE THEN GOTO ASE\r
+\r
+GOTO SDF\r
+ASE:\r
+CLS\r
+LOCATE 2,2\r
+PRINT " !!! SUPER !!! "\r
+FOR A=0 TO 2000\r
+NEXT A\r
+SOUND RND*700+12,13\r
+GOTO SDF\r
+CXY:\r
+CLS\r
+LOCATE 2,2\r
+PRINT " TO JE æKODA. "\r
+FOR A=0 TO 2000\r
+NEXT A\r
+SOUND RND*100+40,40\r
+SDF:\r
+END\1a
\ No newline at end of file
--- /dev/null
+for A=0 TO 6000\r
+CLS\r
+COLOR 0,15\r
+SCREEN 0\r
+X=STICK (0)\r
+Y=STICK (1)\r
+REM LOCATE X,Y\r
+REM PRINT "O"\r
+PRINT X " , " Y\r
+FOR D=0 TO 300\r
+NEXT D\r
+NEXT A\r
+END\1a
\ No newline at end of file
--- /dev/null
+SKODA:\r
+CLS\r
+SCREEN 1\r
+COLOR 0,15\r
+LOCATE 2,2\r
+INPUT " ZADEJTE VSTUPNI PIN NA TOTO CD " ; No$\r
+ IF No$ = "TTDA" THEN GOTO POKR\r
+ GOTO SKODA\r
+POKR:\r
+CLS\r
+LOCATE 2,2\r
+INPUT " JMENO UZIVATELE " ;N$\r
+CLS\r
+LOCATE 2,2\r
+PRINT " CD VITA UZIVATELE " N$\r
+LOCATE 25,2\r
+INPUT " ZMACKNETE LIBOVOLNOU KLAVESU " ;X10$\r
+END\1a
\ No newline at end of file
--- /dev/null
+\r
+SOUND RND*10000+20,30\r
+SCREEN 0\r
+CLS\r
+COLOR 15,9\r
+LOCATE 6,24\r
+PRINT " MEGA ZVUKY UKON¬I ENTER "\r
+LOCATE 7,24\r
+PRINT " -------------------------------- "\r
+\r
+\r
+\r
+SOUND RND*100+36,21\r
+SOUND RND*1000+39,36\r
+SOUND RND*150+33,69\r
+SOUND RND*10321+34,20\r
+SOUND RND*1999+99,56\r
+SOUND RND*9999+99,50\r
+SOUND RND*300+99,50\r
+SOUND RND*400+99,50\r
+SOUND RND*500+99,50\r
+SOUND RND*600+99,50\r
+SOUND RND*700+99,50\r
+SOUND RND*800+99,50\r
+SOUND RND*900+99,50\r
+SOUND RND*100+9,20\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+\r
+SOUND RND*1000+99,36\r
+\r
+SOUND RND*632+900,60\r
+\1a
\ No newline at end of file
--- /dev/null
+start:\r
+CLS\r
+COLOR 14,1\r
+SCREEN 0\r
+LOCATE 2,2\r
+INPUT " ZADEJTE VSTUPNÖ PIN " ;A\r
+IF A<>4545 THEN START\r
+\r
+ GOTO POKR\r
+\r
+POKR :\r
+CLS\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+DO\r
+ A$="POZDRAV1 POMOC2 TELEFON3 HELP4 ESC Q"\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB TELEFON,DIR,LOAD,HELP,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TELEFON :\r
+print "HLAVNE KDYZ POZDRAVITE:DOBRY DEN TADY----- -----."\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+DIR :\r
+LOCATE 8,23\r
+PRINT "PRAVE STE SE DOVOLALI NA TEL.¬.:158"\r
+LOCATE 10,10\r
+print "TADY POLICIE H.L.M.PRAHY"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stla\9f kl vesu*ENTER*"\r
+END\r
+'-----------------------------------------------------------------------------\r
+HELP :\r
+A$="ZKOUSKA OVLADANI TELEFONU"\r
+CALL ECHO (5,16,A$,13)\r
+A$="STISKN·TE TELEFON1 NEBO POMOC"\r
+CALL ECHO (7,17,A$,13)\r
+A$="VIDITE U¦ TELEFONUJETE PO SITI MUDRUÕKANET"\r
+CALL ECHO (7,18,A$,13)\r
+\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+LOAD :\r
+PRINT " DOBRY DEN DOVOLALI JSTE SE NA TEL.:56 18 243 "\r
+LOCATE 9,23\r
+PRINT " TADY TOMAS MUDRUNKA "\r
+\r
+\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+START:\r
+CLS\r
+COLOR 14,1\r
+SCREEN 1\r
+LOCATE 2,2\r
+INPUT " ZADEJTE STARTOVACÖ PIN " ;A\r
+IF A<>007 THEN GOTO START\r
+REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT timto PROGR...\r
+END\1a
\ No newline at end of file
--- /dev/null
+START:\r
+CLS\r
+COLOR 14,1\r
+SCREEN 8\r
+LOCATE 2,2\r
+INPUT " ZADEJTE STARTOVACÖ PIN " ;A\r
+IF A<>007 THEN GOTO START\r
+REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007\r
+STOP\r
+END\1a
\ No newline at end of file
--- /dev/null
+START:\r
+ CLS\r
+ COLOR 14,1\r
+ SCREEN 1\r
+ LOCATE 2,2\r
+ INPUT " ZADEJTE STARTOVACÖ PIN " ;A\r
+ IF A<>007 THEN GOTO START\r
+ REM ZDE LZE DOPLNIT PROGRAM DO KTEREHO LZE VSTOUPIT PINEM 007\r
+ STOP\r
+ END\1a
\ No newline at end of file
--- /dev/null
+CLS\r
+SCREEN 1\r
+COLOR 14,1\r
+LOCATE 2,2\r
+INPUT " JAK JSE JMENUJETE " ;A$\r
+CLS\r
+LOCATE 2,2\r
+PRINT " V¡T M U§IVATELE JM\82NEM "\r
+LOCATE 3,2\r
+PRINT A$\r
+SOUND 100+12,80\r
+END\1a
\ No newline at end of file
--- /dev/null
+A=0\r
+FOR I=0 TO 24\r
+A=A+1\r
+REM CLS\r
+COLOR 14,1\r
+SCREEN 0\r
+LOCATE A,A\r
+PRINT I\r
+NEXT I\r
+END\1a
\ No newline at end of file
--- /dev/null
+T$="A"\r
+O$="H"\r
+M$="O"\r
+A$="J"\r
+S$="!"\r
+FOR I=1 TO 3000\r
+CLS\r
+COLOR 14,1\r
+SCREEN 0\r
+LOCATE 2,23\r
+PRINT T$\r
+LOCATE 3,23\r
+PRINT O$\r
+LOCATE 4,23\r
+PRINT M$\r
+LOCATE 5,23\r
+PRINT A$\r
+LOCATE 6,23\r
+PRINT S$\r
+\r
+FOR D=1 TO 300\r
+NEXT D\r
+NEXT I\r
+END\r
+\r
+\r
+\r
+\r
+\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SOUND 500,1\r
+SOUND 900,3\r
+SOUND 100,5\r
+SOUND 200,2\r
+END\1a
\ No newline at end of file
--- /dev/null
+ GOTO POKR\r
+\r
+POKR :\r
+SCREEN 8 : CLS\r
+COLOR 14,1\r
+RESTORE BARVY\r
+BARVY :\r
+\r
+ DATA 8,7,15,15,7,8\r
+FOR A=1 TO 6\r
+ READ C\r
+ LINE (A,A)-(640-A,A),C\r
+ LINE (A,106-A)-(640-A,106-A),C\r
+ LINE (A,A)-(A,106-A),C\r
+ LINE (640-A,A)-(640-A,106-A),C\r
+ LINE (A,110+A)-(640-A,110+A),C\r
+ LINE (A,200-A)-(640-A,200-A),C\r
+ LINE (A,110+A)-(A,200-A),C\r
+ LINE (640-A,110+A)-(640-A,200-A),C\r
+NEXT A\r
+\r
+REM zadani polozek adresare\r
+DO\r
+ A$="NASOB AHOJ POZDR NASO2 KONEC "\r
+ D=5:X=5:Y=17:C=14\r
+ GOSUB MENU\r
+ ON MENU GOSUB NASOB,TEXT,NIC1,NASOB2,KONEC\r
+LOOP\r
+\r
+'-----------------------------------------------------------------------------\r
+TEXT :\r
+print "ahoj"\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB :\r
+SCREEN 0\r
+CLS\r
+SOUND RND*1000+20,70\r
+COLOR 4,15\r
+N=0\r
+S=0\r
+V=0\r
+SOUND RND*300+12,13\r
+SOUND RND*10000+12,13\r
+OPET:\r
+N=N+1\r
+CLS\r
+LOCATE 4,23\r
+PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY"\r
+A=INT(RND(5)*10+1)\r
+B=INT(RND(4)*10+1)\r
+LOCATE 10,5\r
+PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+INPUT " STISKNI ENTER";C\r
+D=A*B\r
+IF D=C THEN ANO\r
+PRINT " SPATNY VYSLEDEK"\r
+SOUND RND*10000+12,13\r
+S=S+1\r
+GOTO VOLBA\r
+SOUND RND*100+12,13\r
+ANO:\r
+PRINT " SPRAVNE"\r
+V=V+1\r
+VOLBA:\r
+LOCATE 18,10\r
+PRINT "Z" N "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+LOCATE 20,10\r
+PRINT "POKUD CHCES POKRACOVAT ZMACKNI ENTER"\r
+LOCATE 21,10\r
+INPUT "POKUD CHCES SKONCIT NAPIS 1 A ZMACKNI 2 x ENTER";E\r
+IF E<>1 THEN OPET\r
+REM pise chybu sound rnd*100+12,13\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+KONEC :\r
+print "stlac klavesu Enter"\r
+end\r
+'-----------------------------------------------------------------------------\r
+NIC1 :\r
+A$="Zdravi Vas Tomas Mudrunka"\r
+CALL ECHO (5,16,A$,13)\r
+A$="Jak se mate?"\r
+CALL ECHO (7,17,A$,13)\r
+A$="Jak se Vam libi tento program?"\r
+CALL ECHO (7,18,A$,13)\r
+stop\r
+\r
+CALL ANYKEY\r
+CALL CLWD\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+NASOB2 :\r
+\r
+SCREEN 0\r
+CLS\r
+rem SOUND RND*1000+20,70\r
+COLOR 4,15\r
+S=0\r
+V=0\r
+rem SOUND RND*300+12,13\r
+rem SOUND RND*10000+12,13\r
+\r
+FOR I=1 TO 10\r
+ rem nechat pokud nebude vadit CLS\r
+ LOCATE 4,20\r
+ PRINT "PROGRAM PRO ZKOUSENI MALE NASOBILKY - 10 PRIKLADU"\r
+\r
+ A=INT(RND(5)*10+1)\r
+ B=INT(RND(4)*10+1)\r
+ LOCATE 10,5\r
+ REM vymaze radek\r
+ PRINT " "\r
+ PRINT " "\r
+ LOCATE 10,5\r
+ PRINT "NAPIS VYSLEDEK" A "x" B "="\r
+ INPUT " STISKNI ENTER";C\r
+ D=A*B\r
+\r
+ IF D=C THEN ANO2\r
+ PRINT " SPATNY VYSLEDEK"\r
+ rem SOUND RND*10000+12,13\r
+ S=S+1\r
+ GOTO VOLBA2\r
+ rem SOUND RND*100+12,13\r
+ ANO2:\r
+ PRINT " SPRAVNE"\r
+ V=V+1\r
+ VOLBA2:\r
+ LOCATE 18,10\r
+ PRINT "Z" I "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+ REM zdrzeni programu\r
+ FOR G=1 TO 10\r
+ rem SOUND RND*1000+12,13\r
+ NEXT G\r
+NEXT I\r
+\r
+LOCATE 18,10\r
+PRINT "Z" S+V "POKUSU MAS" S "SPATNYCH A" V "DOBRYCH"\r
+\r
+IF S=>4 THEN T=5\r
+IF S=3 THEN T=4\r
+IF S=2 THEN T=3\r
+IF S=1 THEN T=2\r
+IF S=0 THEN T=1\r
+LOCATE 20,10\r
+PRINT "VYSLEDNA ZNAMKA" T\r
+\r
+Input "Ukonci stiskem klavesy ENTER";A\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+\r
+\r
+END\r
+'-----------------------------------------------------------------------------\r
+' podprogram ECHO\r
+' postupny tisk textu obsazeneho v retezcove promenne A$\r
+' na souradnice X a Y\r
+' barvou C\r
+\r
+SUB ECHO(X,Y,A$,C)\r
+ COLOR C\r
+ LOCATE Y,X\r
+ FOR A=1 TO LEN(A$)\r
+ PRINT MID$ (A$,A,1);\r
+ SOUND 1200,.2\r
+ SOUND 900,.2\r
+ SOUND 600,.2\r
+ FOR I=1 TO 200\r
+ NEXT I\r
+ NEXT A\r
+END SUB\r
+\r
+'--------------------------------------------------------------------------\r
+\r
+MENU :\r
+ ' PODPROGRAM 'MENU'\r
+\r
+ ' X a Y jsou textove souradnice menu-okna\r
+ ' A$ obsahuje text okna\r
+ ' D je pocet polozek (radku) v menu\r
+ ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu\r
+ ' C je barva okna\r
+ ' v promenne MENU podprogram vraci cislo zvolene polozky\r
+\r
+ L=LEN (A$)/D : MENU = 1 : M = MENU+.0001\r
+ COLOR C,9:LOCATE Y,X\r
+ PRINT CHR$(201);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$ (187);\r
+ FOR A= 1 TO LEN(A$) STEP L\r
+ LOCATE Y+A/L+1,X\r
+ PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);\r
+ NEXT A\r
+ LOCATE Y+A/L+1,X: PRINT CHR$(200);\r
+ FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A\r
+ PRINT CHR$(188);\r
+ IF W=1 THEN W=0 : RETURN\r
+\r
+ DO\r
+ I$ = INKEY$\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1\r
+ IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1\r
+ IF MENU < 1 THEN MENU = D\r
+ IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP\r
+ IF MENU > D THEN MENU = 0 : EXIT LOOP \r
+ IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";\r
+ 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\r
+ M = MENU\r
+ LOOP\r
+ I=MENU\r
+ W=1:C=0:GOSUB MENU\r
+ MENU = I : COLOR 15\r
+RETURN\r
+'-----------------------------------------------------------------------------\r
+SUB CLWD\r
+ 'Clear window\r
+ FOR A=120 TO 190\r
+ LINE (8,A)-(632,A),0\r
+ NEXT A\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+SUB ANYKEY\r
+ DO\r
+ IF INKEY$<>"" THEN EXIT LOOP\r
+ C=C+1:IF C>15 THEN C=1\r
+ COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";\r
+ LOOP\r
+END SUB\r
+'-----------------------------------------------------------------------------\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+SCREEN 0\r
+\r
+Color 0,15\r
+\r
+cls\r
+\r
+INPUT " NOTA 1 " ;N1\r
+\r
+CLS\r
+\r
+INPUT " NOTA 2 " ;N2\r
+\r
+CLS\r
+\r
+INPUT " NOTA 3 " ;N3\r
+\r
+CLS\r
+\r
+INPUT " NOTA 4 " ;N4\r
+\r
+CLS\r
+\r
+INPUT " NOTA 5 " ;N5\r
+\r
+CLS\r
+\r
+INPUT " NOTA 6 " ;N6\r
+\r
+CLS\r
+\r
+INPUT " NOTA 7 " ;N7\r
+\r
+CLS\r
+\r
+INPUT " NOTA 8 " ;N8\r
+\r
+CLS\r
+\r
+INPUT " NOTA 9 " ;N9\r
+\r
+CLS\r
+\r
+INPUT " NOTA 10 " ;N10\r
+SCREEN 0\r
+\r
+Color 0,15\r
+\r
+cls\r
+\r
+INPUT " NOTA 11 " ;N11\r
+\r
+CLS\r
+\r
+INPUT " NOTA 12 " ;N12\r
+\r
+CLS\r
+\r
+INPUT " NOTA 13 " ;N13\r
+\r
+CLS\r
+\r
+INPUT " NOTA 14 " ;N14\r
+\r
+CLS\r
+\r
+INPUT " NOTA 15 " ;N15\r
+\r
+CLS\r
+\r
+INPUT " NOTA 16 " ;N16\r
+\r
+CLS\r
+\r
+INPUT " NOTA 17 " ;N17\r
+\r
+CLS\r
+\r
+INPUT " NOTA 18 " ;N18\r
+\r
+CLS\r
+\r
+INPUT " NOTA 19 " ;N19\r
+\r
+CLS\r
+\r
+INPUT " NOTA 20 " ;N10\r
+\r
+CLS\r
+\r
+INPUT " STISKNI *ENTER* " ;V\r
+\r
+CLS\r
+\r
+SOUND N1*12,12\r
+\r
+SOUND N2*12,12\r
+\r
+SOUND N3*12,12\r
+\r
+SOUND N4*12,12\r
+\r
+SOUND N5*12,12\r
+\r
+SOUND N6*12,12\r
+\r
+SOUND N7*12,12\r
+\r
+SOUND N8*12,12\r
+\r
+SOUND N9*12,12\r
+\r
+SOUND N10*12,12\r
+\r
+\r
+SOUND N11*12,12\r
+\r
+SOUND N12*12,12\r
+\r
+SOUND N13*12,12\r
+\r
+SOUND N14*12,12\r
+\r
+SOUND N15*12,12\r
+\r
+SOUND N16*12,12\r
+\r
+SOUND N17*12,12\r
+\r
+SOUND N18*12,12\r
+\r
+SOUND N19*12,12\r
+\r
+SOUND N20*12,12\r
+\r
+PRINT " KONEC "\r
+\r
+FOR I=0 TO 300\r
+\r
+NEXT I\r
+\r
+END\r
+\r
+\1a
\ No newline at end of file
--- /dev/null
+program morse;\r
+uses crt;\r
+const\r
+tab: array ['A'..'Z'] of string[6] = (\r
+ '._','_...','_._.','_..','.','.._.','__.','....','____','..',\r
+ '.___','_._','._..','__','_.','___','.__.','._.','...','_','.._',\r
+ '..._','_.__','__..');\r
+var\r
+s:string;\r
+i:byte;\r
+\r
+begin\r
+writeln ('***PROGRAM *M*O*R*S*E* ---- PREVEDE TEXT DO MORSEOVY ABECEDY*** ');\r
+write ('ZADEJ TEXT PRO PRýEVOD: '); READLN (s);\r
+\r
+FOR i:= 1 TO LENGTH (s) DO\r
+CASE s[i] OF\r
+ 'A'..'Z','a'..'z': WRITE (Tab[Upcase (s[i])],'|');\r
+ ' ' WRITE ('|');\r
+ END;\r
+end.
\ No newline at end of file
GIT.Harvie.CZ / mirrors / Programs.git / commitdiff
