Added experimental makepkg-update-checksums.sh

[mirrors/Programs.git] / turbobasic / 1998 / 1PROGRAM.BAS

 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