turbobasic/1998/PARTA.BAS

   1 DO
   2 CLS
   3 SCREEN 8
   4 COLOR 14,1
   5 LOCATE 2,2
   6 INPUT " !!! ZADEJ HESLO !!! " ; ALO$
   7 IF ALO$ = "COBRA 11" THEN GOTO POGR
   8 LOOP
   9 POGR:
  10  GOTO POKR
  11 REM PIN= COBRA 11
  12 POKR :
  13 SCREEN 8 : CLS
  14 COLOR 14,1
  15 RESTORE BARVY
  16 BARVY :
  17
  18     DATA 8,7,15,15,7,8
  19 FOR A=1 TO 6
  20    READ C
  21    LINE (A,A)-(640-A,A),C
  22    LINE (A,106-A)-(640-A,106-A),C
  23    LINE (A,A)-(A,106-A),C
  24    LINE (640-A,A)-(640-A,106-A),C
  25    LINE (A,110+A)-(640-A,110+A),C
  26    LINE (A,200-A)-(640-A,200-A),C
  27    LINE (A,110+A)-(A,200-A),C
  28    LINE (640-A,110+A)-(640-A,200-A),C
  29 NEXT A
  30
  31 DO
  32    A$="TELEFONY CLUB   exit!  HESLA  PARŤáCI "
  33    D=5:X=5:Y=17:C=14
  34    GOSUB MENU
  35    ON MENU GOSUB TELEFON,DIR,KONEC,HELP,LOAD
  36 LOOP
  37
  38 '-----------------------------------------------------------------------------
  39 TELEFON :
  40 SOUND RND*150+12,13
  41 print "MUDRUNKA 56 18 243"
  42 RETURN
  43 '-----------------------------------------------------------------------------
  44 DIR :
  45 SOUND RND*150+12,13
  46 PRINT "KROTITELÉ DUCHů"
  47 RETURN
  48 '-----------------------------------------------------------------------------
  49 KONEC :
  50 CLS
  51 SOUND RND*150+12,13
  52 CALL ANYKEY
  53 CALL CLWD
  54 end
  55 '-----------------------------------------------------------------------------
  56 HELP :
  57
  58 A$="ZAKLADNI COBRA 11"
  59 CALL ECHO (5,16,A$,13)
  60 A$="DO NASI BEDNY DF45M3"
  61 CALL ECHO (7,17,A$,13)
  62 A$="DO NASEHO UKRITU (BUNKRU,CTYRKOLKY) SD85L6"
  63 SOUND RND*1000+12,13
  64 CALL ECHO (7,18,A$,13)
  65
  66
  67 CALL ANYKEY
  68 CALL CLWD
  69 RETURN
  70 '-----------------------------------------------------------------------------
  71 LOAD :
  72
  73 PRINT "MUDRUNKA,COUFAL=VELITELE.VELEBNY,TOMEK,HORNYCH,HAUK."
  74
  75 RETURN
  76 '-----------------------------------------------------------------------------
  77
  78
  79 END
  80 '-----------------------------------------------------------------------------
  81 '                    podprogram ECHO
  82 ' postupny tisk textu obsazeneho v retezcove promenne A$
  83 ' na souradnice X a Y
  84 ' barvou C
  85
  86 SUB ECHO(X,Y,A$,C)
  87    COLOR C
  88    LOCATE Y,X
  89
  90    FOR A=1 TO LEN(A$)
  91
  92
  93       PRINT MID$ (A$,A,1);
  94       SOUND 1200,.2
  95       SOUND 900,.2
  96       SOUND 600,.2
  97       FOR I=1 TO 200
  98       NEXT I
  99    NEXT A
 100 END SUB
 101
 102 '--------------------------------------------------------------------------
 103
 104 MENU :
 105    ' PODPROGRAM 'MENU'
 106
 107    ' X a Y jsou textove souradnice menu-okna
 108    ' A$ obsahuje text okna
 109    ' D je pocet polozek (radku) v menu
 110    ' W=1 - pouze vypis okna , W=0 - vypis i vyber z menu
 111    ' C je barva okna
 112    ' v promenne MENU podprogram vraci cislo zvolene polozky
 113
 114    L=LEN (A$)/D : MENU = 1 : M = MENU+.0001
 115    COLOR C,9:LOCATE Y,X
 116    PRINT CHR$(201);
 117    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 118    PRINT CHR$ (187);
 119    FOR A= 1 TO LEN(A$) STEP L
 120       LOCATE Y+A/L+1,X
 121       PRINT CHR$(186);" ";MID$(A$,A,L);" ";CHR$(186);
 122    NEXT A
 123    LOCATE Y+A/L+1,X: PRINT CHR$(200);
 124    FOR A=1 TO L+2 : PRINT CHR$(205); : NEXT A
 125    PRINT CHR$(188);
 126    IF W=1 THEN W=0 : RETURN
 127
 128   DO
 129    I$ = INKEY$
 130    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=72 THEN MENU = MENU - 1
 131    IF LEN(I$)=2 THEN IF ASC(MID$(I$,2,1))=80 THEN MENU = MENU + 1
 132    IF MENU < 1     THEN MENU = D
 133    IF LEN(I$)=1 THEN IF ASC(I$)=13 THEN EXIT LOOP
 134    IF MENU > D THEN MENU = 0 : EXIT LOOP
 135    IF MENU <> M THEN LOCATE Y+M,X+L+2 : PRINT " ";:LOCATE Y+M,X+1 : PRINT " ";
 136    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
 137    M = MENU
 138   LOOP
 139    I=MENU
 140    W=1:C=0:GOSUB MENU
 141    MENU = I : COLOR 15
 142 RETURN
 143 '-----------------------------------------------------------------------------
 144 SUB CLWD
 145    'Clear window
 146    FOR A=120 TO 190
 147       LINE (8,A)-(632,A),0
 148    NEXT A
 149 END SUB
 150 '-----------------------------------------------------------------------------
 151 SUB ANYKEY
 152    DO
 153       IF INKEY$<>"" THEN EXIT LOOP
 154       C=C+1:IF C>15 THEN C=1
 155       COLOR C : LOCATE 24,55:PRINT "STLAC LIBOVOLNOU KLAVESU";
 156    LOOP
 157 END SUB
 158 '-----------------------------------------------------------------------------
 159
 160 \1a