Moved old turbobasic files to directory 1998 and added new directory for new files
[mirrors/Programs.git] / turbobasic / PROGRAM1.BAS
diff --git a/turbobasic/PROGRAM1.BAS b/turbobasic/PROGRAM1.BAS
deleted file mode 100644 (file)
index 7fc0bc4..0000000
+++ /dev/null
@@ -1,236 +0,0 @@
- 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
This page took 0.144691 seconds and 4 git commands to generate.