Графика на бейсике

DEFSNG F-G, X-Y
DEFLNG I-K
CLS
 
SCREEN 12
WINDOW (-2.8, 2.1)-(2.8, -2.1)
 
f = .5236
j = 800000
k = 8000
g = 0
DO WHILE INKEY$ = ""
   g = g + .1
   CIRCLE (0, 0), 1, 11
   FOR i = 1 TO 12
      x = COS(f * i + g)
      y = SIN(f * i + g)
      LINE (x, y)-(0, 0), 11
   NEXT i
   FOR i = 1 TO j: NEXT i
   FOR i = 1 TO 12
      x = COS(f * i + g)
      y = SIN(f * i + g)
      LINE (x, y)-(0, 0), 0
   NEXT i
   IF j > k THEN j = j - k ELSE k = -k / 8
   IF j > 0 THEN j = j - k
   IF j > 400000 AND k < 0 THEN EXIT DO
LOOP
 
FOR i = 1 TO 12
   x = COS(f * i)
   y = SIN(f * i)
   LINE (x, y)-(0, 0), 11
NEXT i
 
END

DEFINT I-N
SCREEN 12
WINDOW (0, 479)-(639, 0)
 
LINE (270, 350)-(250, 250), 11
LINE (250, 250)-(300, 250), 11
LINE (300, 300)-(280, 150), 11
 
FOR i = 250 TO 300
   FOR j = 150 TO 350
      k = POINT(i, j)
      IF k = 11 THEN
         IF POINT(i - 8, j - 8) <> 11 THEN PSET (i - 8, j - 8), 11
      END IF
   NEXT j
NEXT i
END

DIM i AS INTEGER
DIM j AS INTEGER
DIM c AS INTEGER
CLS
SCREEN 12
WINDOW (0, 300)-(400, 0)
 
FOR i = 1 TO 19
   FOR j = 1 TO 14
      c = 16 * RND
      LINE (20 * i, 20 * j)-(20 * i + 10, 20 * j + 10), c, B
   NEXT j
NEXT i
END

940 REM The IBM Personal Computer Donkey
950 REM Version 1.10 (C)Copyright IBM Corp 1981, 1982
960 REM Licensed Material - Program Property of IBM
975 DEF SEG : POKE 106, 0
980 SAMPLES$ = "NO"
990 GOTO 1010
1000 SAMPLES$ = "YES"
1010 KEY OFF: SCREEN 0, 1: COLOR 15, 0, 0: WIDTH 40: CLS : LOCATE 5, 19: PRINT "IBM"
1020 LOCATE 7, 12, 0: PRINT "Personal Computer"
1030 COLOR 10, 0: LOCATE 10, 9, 0: PRINT CHR$(213) + STRING$(21, 205) + CHR$(184)
1040 LOCATE 11, 9, 0: PRINT CHR$(179) + "       DONKEY        " + CHR$(179)
1050 LOCATE 12, 9, 0: PRINT CHR$(179) + STRING$(21, 32) + CHR$(179)
1060 LOCATE 13, 9, 0: PRINT CHR$(179) + "    Version 1.1O     " + CHR$(179)
1070 LOCATE 14, 9, 0: PRINT CHR$(212) + STRING$(21, 205) + CHR$(190)
1080 COLOR 15, 0: LOCATE 17, 4, 0: PRINT "(C) Copyright IBM Corp 1981, 1982"
1090 COLOR 14, 0: LOCATE 23, 7, 0: PRINT "Press space bar to continue"
1100 IF INKEY$ <> "" THEN GOTO 1100
1110 CMD$ = INKEY$
1120 IF CMD$ = "" THEN GOTO 1110
1130 IF CMD$ = CHR$(27) THEN GOTO 1298
1140 IF CMD$ = " " THEN GOTO 1160
1150 GOTO 1110
1160 DEF SEG = 0
1170 IF (PEEK(&H410) AND &H30) <> &H30 THEN DEF SEG : GOTO 1291
1180 WIDTH 80: CLS : LOCATE 3, 1
1190 PRINT "HOLD IT!"
1200 PRINT "YOU'RE NOT USING THE COLOR/GRAPHICS MONITOR ADAPTER!"
1210 PRINT "THIS PROGRAM USES GRAPHICS AND REQUIRES THAT ADAPTER."
1220 PRINT "PRESS THE SPACE BAR TO CONTINUE."
1230 DEF SEG
1240 IF INKEY$ <> "" THEN GOTO 1240
1250 CMD$ = INKEY$
1260 IF CMD$ = "" THEN GOTO 1250
1270 IF CMD$ = CHR$(27) THEN GOTO 1298
1280 IF CMD$ = " " THEN GOTO 1298
1290 GOTO 1250
1291 KEY OFF
1292 ON ERROR GOTO 1295
1293 PLAY "p16"
1294 GOTO 1300
1295 COLOR 31, 0, 0
1296 PRINT "THIS PROGRAM REQUIRES ADVANCED BASIC -- USE COMMAND 'BASICA'": COLOR 15, 0, 0: FOR I = 1 TO 9000: NEXT: RESUME 1298
1298 ON ERROR GOTO 0
1299 SCREEN 0, 1: 'IF SAMPLES$ = "YES" THEN CHAIN "samples",1000 ELSE COLOR 7,0,0:CLS:END
1300 REM
1410 COLOR 0
1420 DEFINT A-Y
1440 SCREEN 1, 0: COLOR 8, 1
1450 DIM Q%(500)
1460 DIM D1%(150), D2%(150), C1%(200), C2%(200)
1470 DIM DNK%(300)
1480 GOSUB 1940
1490 GOSUB 1780
1500 CLS
1510 DIM B%(300): DIM CAR%(900)
1520 FOR I = 2 TO 300: B%(I) = -16384 + 192: NEXT
1530 B%(0) = 2: B%(1) = 193
1540 REM
1550 CX = 110: CLS
1590 LINE (0, 0)-(305, 199), , B
1600 LINE (6, 6)-(97, 195), 1, BF
1610 LINE (183, 6)-(305, 195), 1, BF
1620 LOCATE 3, 5: PRINT "Donkey"
1630 LOCATE 3, 29: PRINT "Driver"
1631 LOCATE 19, 25: PRINT "Press Space  ";
1632 LOCATE 20, 25: PRINT "Bar to switch";
1633 LOCATE 21, 25: PRINT "lanes        ";
1635 LOCATE 23, 25: PRINT "Press ESC    ";
1636 LOCATE 24, 25: PRINT "to exit      ";
1640 FOR Y = 4 TO 199 STEP 20: LINE (140, Y)-(140, Y + 10): NEXT
1650 CY = 105: CX = 105
1660 LINE (100, 0)-(100, 199): LINE (180, 0)-(180, 199)
1670 LOCATE 5, 6: PRINT SD: LOCATE 5, 31: PRINT SM
1680 CY = CY - 4: IF CY < 60 THEN 2230
1690 PUT (CX, CY), CAR%, PRESET
1700 DX = 105 + 42 * INT(RND * 2)
1710 FOR Y = (RND * -4) * 8 TO 124 STEP 6
1720 SOUND 20000, 1
1730 A$ = INKEY$: IF A$ = CHR$(27) THEN 1298 ELSE POKE 106, 0: IF LEN(A$) > 0 THEN LINE (CX, CY)-(CX + 28, CY + 44), 0, BF: CX = 252 - CX: PUT (CX, CY), CAR%, PRESET: SOUND 200, 1
1740 IF Y >= 3 THEN PUT (DX, Y), DNK%, PSET
1750 IF CX = DX AND Y + 25 >= CY THEN 2060
1760 IF Y AND 3 THEN PUT (140, 6), B%
1770 NEXT: LINE (DX, 124)-(DX + 32, 149), 0, BF: GOTO 1670
1780 CLS
1790 DRAW "S8C3"
1800 DRAW "BM12,1r3m+1,3d2R1ND2u1r2d4l2u1l1"
1810 DRAW "d7R1nd2u2r3d6l3u2l1d3m-1,1l3"
1820 DRAW "m-1,-1u3l1d2l3u6r3d2nd2r1u7l1d1l2"
1830 DRAW "u4r2d1nd2R1U2"
1840 DRAW "M+1,-3"
1850 DRAW "BD10D2R3U2M-1,-1L1M-1,1"
1860 DRAW "BD3D1R1U1L1BR2R1D1L1U1"
1870 DRAW "BD2BL2D1R1U1L1BR2R1D1L1U1"
1880 DRAW "BD2BL2D1R1U1L1BR2R1D1L1U1"
1890 LINE (0, 0)-(40, 60), , B
1900 PAINT (1, 1)
'1910 DIM CAR%(900)
1920 GET (1, 1)-(29, 45), CAR%
1930 RETURN
1940 CLS
1950 DRAW "S08"
1960 DRAW "BM14,18"
1970 DRAW "M+2,-4R8M+1,-1U1M+1,+1M+2,-1"
1980 DRAW "M-1,1M+1,3M-1,1M-1,-2M-1,2"
1990 DRAW "D3L1U3M-1,1D2L1U2L3D2L1U2M-1,-1"
2000 DRAW "D3L1U5M-2,3U1"
2010 PAINT (21, 14), 3
2020 PRESET (37, 10): PRESET (40, 10)
2030 PRESET (37, 11): PRESET (40, 11)
2040 GET (13, 0)-(45, 25), DNK%
2050 RETURN
2060 SD = SD + 1: LOCATE 14, 6: PRINT "BOOM!"
2070 GET (DX, Y)-(DX + 16, Y + 25), D1%
2080 D1X = DX: D1Y = Y: D2X = DX + 17
2090 GET (DX + 17, Y)-(DX + 31, Y + 25), D2%
2100 GET (CX, CY)-(CX + 14, CY + 44), C1%
2110 GET (CX + 15, CY)-(CX + 28, CY + 44), C2%
2120 C1X = CX: C1Y = CY: C2X = CX + 15
2130 FOR P = 6 TO 0 STEP -1: Z = 1 / (2 ^ P): Z1 = 1 - Z
2140 PUT (C1X, C1Y), C1%: PUT (C2X, C1Y), C2%
2150 PUT (D1X, D1Y), D1%: PUT (D2X, D1Y), D2%
2160 C1X = CX * Z1: D1Y = Y * Z1: C2X = C2X + (291 - C2X) * Z
2170 D1X = DX * Z1: C1Y = C1Y + (155 - C1Y) * Z: D2X = D2X + (294 - D2X) * Z
2180 PUT (C1X, C1Y), C1%: PUT (C2X, C1Y), C2%
2190 PUT (D1X, D1Y), D1%: PUT (D2X, D1Y), D2%
2200 SOUND 37 + RND * 200, 4: NEXT
2210 FOR Y = 1 TO 2000: NEXT
2220 CLS : GOTO 1540
2230 SM = SM + 1: LOCATE 7, 25: PRINT "Donkey loses!"
2240 FOR Y = 1 TO 1000: NEXT
2250 CLS : GOTO 1540

DECLARE SUB f(x, y, r, p)
 
CLS
CLEAR, , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 4)
 
END
 
SUB f(x, y, r, p)
   IF p>0 THEN
      CIRCLE (x, y), r
      FOR i=1 TO 50000: NEXT i
      CALL f(x + r, y, r/2, p - 1)
      CALL f(x, y - r, r/2, p - 1)
      CALL f(x - r, y, r/2, p - 1)
      CALL f(x, y + r, r/2, p - 1)
   END IF
END SUB

DECLARE SUB DRE(x!, y!, r!, n!)
 
CLS
DIM SHARED S, C
C = .866
S = .5
x0 = 0: y0 = 0
 
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL DRE(0, 0, 100, 4)
END
 
SUB DRE(x0, y0, r, n)
   IF n > 0 THEN
      x1 = x0 - r*C
      y1 = y0 - r*S
      x2 = x0 + r*C
      y2 = y0 - r*S
      x3 = x0
      y3 = y0 + r
 
      LINE (x1, y1)-(x2, y2)
      LINE (x2, y2)-(x3, y3)
      LINE (x3, y3)-(x1, y1)
 
      FOR I = 1 TO 100000: NEXT I
 
      CALL DRE(x1, y1, r/2, n - 1)
      CALL DRE(x2, y2, r/2, n - 1)
      CALL DRE(x3, y3, r/2, n - 1)
   END IF
END SUB

DECLARE SUB PYR(SD AS STRING, ND%)
DECLARE SUB REC(N%, o1%, o2%, o3%)
DECLARE SUB GRF(p1%, p2%)
 
DIM SHARED N AS INTEGER
DIM SHARED S(1 TO 3) AS STRING
 
CLS
CLEAR, , 26000
INPUT "N = "; NS$
IF NS$ = "" THEN N = 4 ELSE N = VAL(NS$)
 
FOR i = 1 TO N
   S(1) = S(1) + LTRIM$(STR$(i))
NEXT i
 
SCREEN 12
WINDOW (0, 480)-(640, 0)
 
CALL PYR(S(1), 160)
CALL PYR(S(2), 320)
CALL PYR(S(3), 480)
SLEEP 2
CLS
CALL REC(N, 1, 2, 3)
END
 
SUB GRF(p1 AS INTEGER, p2 AS INTEGER)
DIM t1 AS STRING
   t1 = LEFT$(S(p1), 1)
   S(p1) = RIGHT$(S(p1), LEN(S(p1)) - 1)
   S(p2) = t1 + S(p2)
 
   CALL PYR(S(1), 160)
   CALL PYR(S(2), 320)
   CALL PYR(S(3), 480)
   SLEEP 1
   IF LEN(S(3)) < N THEN CLS
END SUB
 
SUB PYR(SD AS STRING, ND AS INTEGER)
DIM S1 AS STRING
DIM S2 AS STRING
   H = 20
   S2 = SD
   LINE (ND, 240)-(ND, 400)
   IF LEN(SD) = 0 THEN EXIT SUB
   
   FOR i = 1 TO LEN(S2)
      S1 = RIGHT$(S2, 1)
      S2 = LEFT$(S2, LEN(S2) - 1)
      n1 = VAL(S1)
      X1 = ND - 10*n1
      X2 = ND + 10*n1
      Y1 = 240 + 20*i
      Y2 = Y1 - 20
      LINE (X1, Y1)-(X2, Y2), , B
   NEXT i
END SUB
 
SUB REC(N AS INTEGER, o1 AS INTEGER, o2 AS INTEGER, o3 AS INTEGER)
   IF N > 0 THEN
      CALL REC(N - 1, o1, o3, o2)
      CALL GRF(o1, o3)
      CALL REC(N - 1, o2, o1, o3)
   END IF
END SUB

REM      Curve of Gilbert
 
DECLARE SUB ABC (x2!, y2!)
DECLARE SUB A (i!)
DECLARE SUB B (i!)
DECLARE SUB C (i!)
DECLARE SUB D (i!)
 
DIM SHARED p
DIM SHARED n
CLS
CLEAR , , 2900
 
p = 5
n = 10
SCREEN 12
DRAW "BM 450,50"
CALL A(p)
INPUT "Enter"; z$
SCREEN 0
END
 
SUB A (i)
   IF i > 0 THEN
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
   END IF
END SUB
 
SUB ABC (x2, y2)
   x1 = POINT(0)
   y1 = POINT(1)
   IF x1 <> x2 THEN
      LINE (x1, y1)-(x2, y2)
      FOR j = 1 TO 10000: NEXT
   ELSE
      LINE (x1, y1)-(x2, y2)
      FOR j = 1 TO 10000: NEXT
   END IF
END SUB
 
SUB B (i)
   IF i > 0 THEN
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
   END IF
END SUB
 
SUB C (i)
   IF i > 0 THEN
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
   END IF
END SUB
 
SUB D (i)
   IF i > 0 THEN
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
   END IF
END SUB

DECLARE SUB f (x!, y!, r!, p!)
 
CLS
CLEAR , , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
 
END
 
SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 100000: NEXT
      CALL f(x + r, y, r / 3, p - 1)
      CALL f(x, y - r, r / 3, p - 1)
      CALL f(x - r, y, r / 3, p - 1)
      CALL f(x, y + r, r / 3, p - 1)
   END IF
END SUB

DECLARE SUB f (x!, y!, r!, p!)
DIM SHARED c
 
CLS
CLEAR , , 20000
c = 2.4
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 4)
 
END
 
SUB f (x, y, r, p)
 
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y - r)-(x + r, y + r), , B
      LINE (x - s, y - s)-(x + s, y + s), 0, BF
      FOR i = 1 TO 50000: NEXT
      CALL f(x + r, y - r, r / c, p - 1)
      CALL f(x - r, y - r, r / c, p - 1)
      CALL f(x - r, y + r, r / c, p - 1)
      CALL f(x + r, y + r, r / c, p - 1)
   END IF
END SUB

DECLARE SUB f (x!, y!, r!, p!)
 
CLS
CLEAR , , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
 
END
 
SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 30000: NEXT
      CALL f(x, y, r / 4, p - 1)
      CALL f(x + r, y, r / 4, p - 1)
      CALL f(x + r, y + r, r / 4, p - 1)
      CALL f(x, y + r, r / 4, p - 1)
      CALL f(x - r, y + r, r / 4, p - 1)
      CALL f(x - r, y, r / 4, p - 1)
      CALL f(x - r, y - r, r / 4, p - 1)
      CALL f(x, y - r, r / 4, p - 1)
      CALL f(x + r, y - r, r / 4, p - 1)
   END IF
END SUB

CHDIR ".\game"
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'
'        ±±    ±± ±±±±±± ±±±±±± ±± ±±±±±  ±±±±±± ±±±   ±±  ±±±±±±±±±±
'        ±±    ±± ±±  ±± ±±  ±± ±±    ±±  ±±  ±± ±± ±± ±±      ±±
'        ±±±±±±±± ±±  ±± ±±±±±± ±±   ±±   ±±  ±± ±±  ±±±±      ±±
'        ±±    ±± ±±  ±± ±± ±±  ±±  ±±    ±±  ±± ±±   ±±±      ±±
'        ±±    ±± ±±±±±± ±±  ±± ±± ±±±±±± ±±±±±± ±±    ±±      ±±
'
'         M I R I D I N    E N T E R T A I N M E N T  -  2 0 1 5
'
'
'               Game Name:  Miridin TANK COMMANDER Horizont version 1.3 ALPHA
'                   Programmer:  Petrov Mihail Denisovech
'                     Completed:  Sentember 22, 2015
'
'
'                               * * * *
'
'Are as follows:
'
'BLUE TANK  - up:  8
'             down:  2
'             left:  4
'             right:  6
'             brakes:  5
'             shoot:  0
'
'GREEN TANK - up:  W
'             down:  S
'             left:  A
'             right:  D
'             brakes:  Q
'             shoot:  SPACE BAR
'File list for Qbasic TANK COMMANDER v2:
'
'*  TCV2.BAS....................Game code file.
'*  ARENA.BSV...................BSAVEd graphics file for game arena.
'*  SPRITES.BSV.................BSAVEd graphics file for sprites.
'
'**************************** PRESS <ENTER> TO PLAY!! *************************
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
'Define variables A-Z as integers.
DEFINT A-Z
 
'Define the data TYPE, PaletteType.
TYPE PaletteType
    Red AS INTEGER
    Green AS INTEGER
    Blue AS INTEGER
END TYPE
 
'SHAREing of certain variables.
DIM SHARED Pal AS PaletteType
DIM SHARED pData(0 TO 255, 1 TO 3)
 
'Declaration of various SUBs.
DECLARE SUB PALETTE.Set (nColor%, pInfo AS PaletteType)
DECLARE SUB PALETTE.GET (nColor%, pInfo AS PaletteType)
DECLARE SUB PALETTE.FadeOut ()
DECLARE SUB PALETTE.FadeIn ()
 
'Change the default directory to the one being used for TANK COMMANDER. When
'setting this, remember to uncomment it.
'CHDIR ""
 
'Initial values of various variables.
D1 = 2: D2 = 4: T1H = 6: T1V = 87: T2H = 300: T2V = 102: Speed = 550
 
'Customise the VGA color palette for the introductory text.
SCREEN 13
C = 16: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * 0) + 0: C = C + 1: NEXT
C = 32: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * A) + 0: C = C + 1: NEXT
C = 48: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * 0) + A: C = C + 1: NEXT
C = 64: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * A) + 0: C = C + 1: NEXT
C = 80: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * 0) + A: C = C + 1: NEXT
C = 96: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * A) + A: C = C + 1: NEXT
C = 112: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * B) + 0: B = B + 3: C = C + 1: NEXT
C = 128: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * 0) + A: B = B + 3: C = C + 1: NEXT
C = 144: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * A) + 0: B = B + 3: C = C + 1: NEXT
C = 160: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * A) + A: B = B + 3: C = C + 1: NEXT
C = 176: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * A) + A: C = C + 1: NEXT
C = 192: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * B) + (256 * AA) + A: B = B + 2: C = C + 1: NEXT
C = 208: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * B) + (256 * B) + A: B = B + 2: C = C + 1: NEXT
C = 224: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * AA) + (256 * B) + A: B = B + 2: C = C + 1: NEXT
 
'Do presentation text.
PALETTE.FadeOut
COLOR 1
LOCATE 11, 14: PRINT  "M I R I D I N"
LOCATE 13, 13: PRINT "P R E S E N T S"
COLOR 9
LOCATE 20, 16: PRINT "*********"
LOCATE 17, 16: PRINT "*********"
LOCATE 18, 16: PRINT "*"
LOCATE 19, 16: PRINT "*"
LOCATE 19, 24: PRINT "*"
LOCATE 18, 24: PRINT "*"
COLOR 2
LOCATE 18, 18: PRINT "ALPHA "
COLOR 6
LOCATE 19, 17: PRINT " v 1.3 "
COLOR 1
'Color in "M I R I D I N" with various shades of blue.
Y = 72: C = 32
DO
    FOR X = 1 TO 300
        IF POINT(X, Y) > 0 THEN PSET (X, Y), C + RND * 17
    NEXT
    Y = Y + 1
LOOP UNTIL Y = 79
 
'Color in "PRESENTS" with various shades of red. Once this has been done,
'fade in the screen, melt it, and then fade out.
Y = 96: C = 49
DO
    FOR X = 1 TO 300
        IF POINT(X, Y) > 0 THEN PSET (X, Y), C + RND * 17
    NEXT
    Y = Y + 1
LOOP UNTIL Y = 103
PALETTE.FadeIn
NOW! = TIMER: WHILE (TIMER - 3) < NOW!: WEND
DIM Melt%(1700)
FOR R = 1 TO 1700
    RANDOMIZE TIMER
    X = INT(RND * 271)
    RANDOMIZE TIMER
    Y = INT(RND * 170)
    GET (X, Y)-(X + 48, Y + 18), Melt%
    PUT (X, Y + 1), Melt%, PSET
    IF INKEY$ = CHR$(27) THEN END
NEXT
PALETTE.FadeOut
CLS : PALETTE: PALETTE.FadeOut
 
'GET the sprite data.
DEF SEG = 40960: BLOAD "sprites.bsv"
DIM Tank1(150): GET (1, 1)-(15, 10), Tank1
DIM Tank2(150): GET (1, 14)-(15, 23), Tank2
DIM Tank3(150): GET (1, 27)-(15, 36), Tank3
DIM Tank4(150): GET (1, 40)-(15, 49), Tank4
DIM Tank5(150): GET (20, 1)-(34, 10), Tank5
DIM Tank6(150): GET (20, 14)-(34, 23), Tank6
DIM Tank7(150): GET (20, 27)-(34, 36), Tank7
DIM Tank8(150): GET (20, 40)-(34, 49), Tank8
 
'Load the file ARENA.BSV, which is the graphics data for the arena, into the
'video memory segment (segment 40960).
BLOAD "arena.bsv"
 
'Place both tanks in their initial positions and fade in the completed arena.
PUT (T1H, T1V), Tank1, PSET
PUT (T2H, T2V), Tank6, PSET
PALETTE.FadeIn
 
'Main program loop.
DO
 
    'IF Count < Speed THEN Count = Count + 1 ELSE Count = 0
    WAIT &H3DA, 8: WAIT &H3DA, 8, 8
 
    IF Go1 = 1 AND Count = 0 THEN
        IF D1 = 1 AND T1V > 26 THEN T1V = T1V - 1: PUT (T1H, T1V), Tank3, PSET
        IF D1 = 2 AND T1H < 305 THEN T1H = T1H + 1: PUT (T1H, T1V), Tank1, PSET
        IF D1 = 3 AND T1V < 190 THEN T1V = T1V + 1: PUT (T1H, T1V), Tank4, PSET
        IF D1 = 4 AND T1H > 0 THEN T1H = T1H - 1: PUT (T1H, T1V), Tank2, PSET
    END IF
    IF Go2 = 1 AND Count = 0 THEN
        IF D2 = 1 AND T2V > 26 THEN T2V = T2V - 1: PUT (T2H, T2V), Tank7, PSET
        IF D2 = 2 AND T2H < 305 THEN T2H = T2H + 1: PUT (T2H, T2V), Tank5, PSET
        IF D2 = 3 AND T2V < 190 THEN T2V = T2V + 1: PUT (T2H, T2V), Tank8, PSET
        IF D2 = 4 AND T2H > 0 THEN T2H = T2H - 1: PUT (T2H, T2V), Tank6, PSET
    END IF
    IF St1 = 30 THEN St1 = 0: Fire1 = 0: PSET (B1H, B1V), Col
    IF St2 = 30 THEN St2 = 0: Fire2 = 0: PSET (B2H, B2V), Col2
    IF Fire1 = 1 AND St1 < 30 AND Count = 0 THEN
        PSET (B1H, B1V), Col
        IF BD1 = 1 THEN B1V = B1V - 2
        IF BD1 = 2 THEN B1H = B1H + 2
        IF BD1 = 3 THEN B1V = B1V + 2
        IF BD1 = 4 THEN B1H = B1H - 2
        Col = POINT(B1H, B1V)
        PSET (B1H, B1V), 14
        St1 = St1 + 1
        GOSUB CheckBullet1
    END IF
    IF Fire2 = 1 AND St2 < 30 AND Count = 0 THEN
        PSET (B2H, B2V), Col2
        IF BD2 = 1 THEN B2V = B2V - 2
        IF BD2 = 2 THEN B2H = B2H + 2
        IF BD2 = 3 THEN B2V = B2V + 2
        IF BD2 = 4 THEN B2H = B2H - 2
        Col2 = POINT(B2H, B2V)
        PSET (B2H, B2V), 14
        St2 = St2 + 1
        GOSUB CheckBullet2
    END IF
    KEY$ = INKEY$
    IF KEY$ = CHR$(27) THEN PALETTE.FadeOut: GOTO Results
    IF KEY$ = "4" THEN Go1 = 1: D1 = 4
    IF KEY$ = "6" THEN Go1 = 1: D1 = 2
    IF KEY$ = "8" THEN Go1 = 1: D1 = 1
    IF KEY$ = "2" THEN Go1 = 1: D1 = 3
    IF KEY$ = "0" THEN IF Fire1 = 0 THEN GOSUB Shoot1
    IF KEY$ = "5" THEN Go1 = 0
    IF KEY$ = "A" OR KEY$ = "a" THEN Go2 = 1: D2 = 4
    IF KEY$ = "D" OR KEY$ = "d" THEN Go2 = 1: D2 = 2
    IF KEY$ = "W" OR KEY$ = "w" THEN Go2 = 1: D2 = 1
    IF KEY$ = "S" OR KEY$ = "s" THEN Go2 = 1: D2 = 3
    IF KEY$ = "Q" OR KEY$ = "q" THEN Go2 = 0
    IF KEY$ = CHR$(32) THEN IF Fire2 = 0 THEN GOSUB Shoot2
LOOP
 
Shoot1:  'Initiates the shooting from Tank 1.
BD1 = D1
IF BD1 = 0 THEN RETURN
IF BD1 = 1 THEN B1H = (T1H + 7): B1V = (T1V - 1)
IF BD1 = 2 THEN B1H = (T1H + 14): B1V = (T1V + 5)
IF BD1 = 3 THEN B1H = (T1H + 7): B1V = (T1V + 11)
IF BD1 = 4 THEN B1H = (T1H - 1): B1V = (T1V + 5)
St1 = 1: Fire1 = 1: Col = POINT(B1H, B1V)
RETURN
 
Shoot2:  'Initiates the shooting from Tank 2.
BD2 = D2
IF BD2 = 0 THEN RETURN
IF BD2 = 1 THEN B2H = (T2H + 7): B2V = (T2V - 1)
IF BD2 = 2 THEN B2H = (T2H + 14): B2V = (T2V + 5)
IF BD2 = 3 THEN B2H = (T2H + 7): B2V = (T2V + 11)
IF BD2 = 4 THEN B2H = (T2H - 1): B2V = (T2V + 5)
St2 = 1: Fire2 = 1: Col2 = POINT(B2H, B2V)
RETURN
 
CheckBullet1:  'Hit detection from Tank 1 bullet.
T2V = T2V + 2: T2H = T2H + 3
FOR ScanTank2 = 1 TO 7
    FOR Scan = 1 TO 9
        IF B1H = T2H AND B1V = T2V THEN Crash = 2: GOTO Explode
        T2H = T2H + 1
    NEXT
    T2H = T2H - 9: T2V = T2V + 1
NEXT
T2V = T2V - 9: T2H = T2H - 3
RETURN
 
CheckBullet2:  'Hit detection from Tank 2 bullet.
T1V = T1V + 2: T1H = T1H + 3
FOR ScanTank1 = 1 TO 7
    FOR Scan = 1 TO 9
        IF B2H = T1H AND B2V = T1V THEN Crash = 1: GOTO Explode
        T1H = T1H + 1
    NEXT
    T1H = T1H - 9: T1V = T1V + 1
NEXT
T1V = T1V - 9: T1H = T1H - 3
RETURN
 
Explode:  'Create very cheap graphic explosion.
IF Crash = 1 THEN ExplodeH = T1H: ExplodeV = T1V: T2Wins = 1
IF Crash = 2 THEN ExplodeH = T2H: ExplodeV = T2V: T1Wins = 1
FOR Explode = 1 TO 9
    IF Explode = 1 THEN Col = 14
    IF Explode = 5 THEN Col = 12
    IF Explode = 7 THEN Col = 4
    CIRCLE (ExplodeH, ExplodeV), Explode, Col
    NOW! = TIMER: WHILE (TIMER - .02) < NOW!: WEND
NEXT
NOW! = TIMER: WHILE (TIMER - 1.2) < NOW!: WEND
PALETTE.FadeOut
 
Results:  'Announce the winning tank and display credits.
SCREEN 0: WIDTH 66, 27
COLOR 12, 4
PRINT " G A M E   R E S U L T S "
PRINT
COLOR 9, 0
PRINT "Blue tank wins:"
COLOR 4
LOCATE 3, 17: PRINT T1Wins
COLOR 2
PRINT "Green tank wins:"
COLOR 4
LOCATE 4, 18: PRINT T2Wins
PRINT
COLOR 12, 4
PRINT " C R E D I T S "
PRINT
COLOR 3, 0
PRINT "Concept:"
PRINT "Programming:"
PRINT "Game art:"
PRINT "Fade effect:"
PRINT "Testing:"
PRINT "Debugging:"
COLOR 2
LOCATE 8, 11: PRINT "Miridin"
LOCATE 9, 15: PRINT "Misha Petrov"
LOCATE 10, 12: PRINT "Misha Petrov"
LOCATE 11, 15: PRINT "Misha Petrov"
COLOR 12
LOCATE 12, 11: PRINT "ALPHA"
COLOR 2
LOCATE 13, 13: PRINT "MIsha Petrov"
PRINT
COLOR 9
PRINT "All programmed by Mihail Petrov."
PRINT
COLOR 4,9
PRINT "Thank you for playing TANK COMMANDER Horizont v1.3 ALPHA !!!"
PRINT "Everything is made in QBASIC"
COLOR 2,0
PRINT ""
PRINT ""
LOCATE 25, 15 :PRINT "Made in POCTOB-HA-DOHY!"
COLOR 9,0
 
 
SUB PALETTE.FadeIn
DIM tT(1 TO 3)
FOR I = 1 TO 64
    WAIT &H3DA, 8, 8
    FOR O = 0 TO 255
        PALETTE.GET O, Pal
        tT(1) = Pal.Red
        tT(2) = Pal.Green
        tT(3) = Pal.Blue
        IF tT(1) < pData(O, 1) THEN tT(1) = tT(1) + 1
        IF tT(2) < pData(O, 2) THEN tT(2) = tT(2) + 1
        IF tT(3) < pData(O, 3) THEN tT(3) = tT(3) + 1
        Pal.Red = tT(1)
        Pal.Green = tT(2)
        Pal.Blue = tT(3)
        PALETTE.Set O, Pal
    NEXT
NEXT
END SUB
 
SUB PALETTE.FadeOut
DIM tT(1 TO 3)
FOR I = 0 TO 255
    PALETTE.GET I, Pal
    pData(I, 1) = Pal.Red
    pData(I, 2) = Pal.Green
    pData(I, 3) = Pal.Blue
NEXT
FOR I = 1 TO 64
    WAIT &H3DA, 8, 8
    FOR O = 0 TO 255
        PALETTE.GET O, Pal
        tT(1) = Pal.Red
        tT(2) = Pal.Green
        tT(3) = Pal.Blue
        IF tT(1) > 0 THEN tT(1) = tT(1) - 1
        IF tT(2) > 0 THEN tT(2) = tT(2) - 1
        IF tT(3) > 0 THEN tT(3) = tT(3) - 1
        Pal.Red = tT(1)
        Pal.Green = tT(2)
        Pal.Blue = tT(3)
        PALETTE.Set O, Pal
    NEXT
NEXT
END SUB
 
SUB PALETTE.GET (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C7, nColor%
pInfo.Red = INP(&H3C9)
pInfo.Green = INP(&H3C9)
pInfo.Blue = INP(&H3C9)
END SUB
 
SUB PALETTE.Set (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C8, nColor%
OUT &H3C9, pInfo.Red
OUT &H3C9, pInfo.Green
OUT &H3C9, pInfo.Blue
END SUB

CONST Punkts = 2
DIM PuName(Punkts) AS STRING
DIM i AS INTEGER, RDr AS INTEGER
Vib = 0: RDr = -1
PuName(0) = "Variant 1"
PuName(1) = "Variant 2"
PuName(2) = "Exit"
 
DO: Kb$ = INKEY$
  IF Kb$ = CHR$(0) + "H" AND Vib > 0 THEN Vib = Vib - 1: RDr = -1
  IF Kb$ = CHR$(0) + "P" AND Vib < Punkts THEN Vib = Vib + 1: RDr = -1
  IF RDr THEN
    CLS 2
    FOR i = 0 TO Punkts
       IF Vib = i THEN COLOR 11 ELSE COLOR 8
       PRINT PuName(i)
    NEXT
    RDr = 0
  END IF
  IF Kb$ = CHR$(13) THEN
    SELECT CASE Vib
      CASE 0:  '  Делаем первое, например, вызов процедуры
               '  В процедуре может быть точно такое же ещё одно меню,
               '  либо толстый движок, вызывающий десятки других процедур
               '  и всё, что вам только в голову взбредёт.
      CASE 1:  '  Делаем второе, например, вызов процедуры  --||--
      CASE 2:  EXIT DO
      CASE ELSE
    END SELECT
  END IF
LOOP UNTIL Kb$ = CHR$(27)

DIM CX AS INTEGER, CY AS INTEGER
DIM SHARED A(1 TO 10, 1 TO 10)
DIM SHARED YOU(1 TO 10, 1 TO 10) AS INTEGER
DIM SHARED SHIP(1 TO 4) AS INTEGER
DIM SHARED ENEMY(1 TO 10, 1 TO 10) AS INTEGER
DIM SHARED ENDGAME AS INTEGER, LMAX AS INTEGER
 
DECLARE SUB SHOWCUR (X AS INTEGER, Y AS INTEGER, L AS INTEGER, R AS INTEGER)
DECLARE SUB BOX (L AS INTEGER, T AS INTEGER, W AS INTEGER, H AS INTEGER)
DECLARE SUB SHOWINDEX (X1 AS INTEGER, Y1 AS INTEGER, MAX AS INTEGER)
DECLARE SUB SHOWCURSOR (X AS INTEGER, Y AS INTEGER)
DECLARE SUB GETLENGHT (X AS INTEGER, Y AS INTEGER)
DECLARE SUB SETSHIPAI (L AS INTEGER, N AS INTEGER)
DECLARE SUB PAUSE (N AS INTEGER)
DECLARE SUB EDITSHIP ()
DECLARE SUB ATOENEMY ()
DECLARE SUB AUTOSET ()
DECLARE SUB RESTART ()
DECLARE SUB ANALIZ1 ()
DECLARE SUB ANALIZ ()
DECLARE SUB REDRAW ()
DECLARE SUB YOUTOA ()
 
DECLARE FUNCTION SETSHIP% (CX AS INTEGER, CY AS INTEGER, L AS INTEGER, R AS INTEGER)
DECLARE FUNCTION VALIDATE% (X AS INTEGER, Y AS INTEGER, L AS INTEGER, R AS INTEGER)
DECLARE FUNCTION FIREAI% (X AS INTEGER, Y AS INTEGER)
DECLARE FUNCTION FIRE% (X AS INTEGER, Y AS INTEGER)
DECLARE FUNCTION GETINDEX% ()
DECLARE FUNCTION AI% ()
 
SCREEN 7
COLOR 15, 1
CLS
RANDOMIZE TIMER
LOCATE 2, 16: PRINT "SEA BATTLE"
RESTART
CX = 5: CY = 5:
DO
  K$ = INKEY$
  IF LEN(K$) > 0 THEN
    K = ASC(RIGHT$(K$, 1))
  ELSE
    K = 0
  END IF
  SELECT CASE K
    CASE 72 'UP
      CY = CY - 1
      IF CY < 1 THEN CY = 1
    CASE 75  'LEFT
      CX = CX - 1
      IF CX < 1 THEN CX = 1
    CASE 77  'RIGHT
      CX = CX + 1
      IF CX > 10 THEN CX = 10
    CASE 80  'DOWN
      CY = CY + 1
      IF CY > 10 THEN CY = 10
    CASE 32 'SPACE
      R = FIRE(CX, CY)
      REDRAW
      IF ENDGAME = 0 THEN
        IF R = 0 THEN
          AIR = 1
          DO WHILE AIR = 1
            AIR = AI
            REDRAW
          LOOP
        END IF
      END IF
    CASE 79 'END
      RESTART
      CX = 5: CY = 5:
  END SELECT
  IF ENDGAME THEN
      CALL BOX(7, 18, 26, 3)
      LOCATE 19, 8: PRINT "                          ";
      IF ENDGAME > 0 THEN
        LOCATE 20, 8: PRINT "         YOU  WIN!        ";
      ELSE
        LOCATE 20, 8: PRINT "         YOU LOSS!        ";
      END IF
      LOCATE 21, 8: PRINT "                          ";
      LOCATE 23, 7: PRINT "                            ";
  ELSE
      CALL SHOWCURSOR(CX, CY)
  END IF
LOOP UNTIL K = 27
END
 
FUNCTION AI%
  DIM X AS INTEGER, Y AS INTEGER, MAX AS INTEGER, I AS INTEGER
  MAX = GETINDEX
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      IF A(X, Y) = MAX THEN
        I = I + 1
      END IF
    NEXT X
  NEXT Y
  I = INT(RND * I) + 1
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      IF A(X, Y) = MAX THEN
        I = I - 1
        IF I = 0 THEN
          AI = FIREAI(X, Y)
          EXIT FUNCTION
        END IF
      END IF
    NEXT X
  NEXT Y
END FUNCTION
 
SUB ANALIZ
  DIM X AS INTEGER, Y AS INTEGER, L AS INTEGER, T AS INTEGER
  YOUTOA
  ANALIZ1
  FOR Y = 1 TO 10
    L = 0: T = 0
    FOR X = 1 TO 10
      IF YOU(X, Y) = 3 THEN
        IF T = 0 THEN T = X
        L = L + 1
      ELSE
        IF L >= LMAX THEN
          IF YOU(X, Y) = 0 THEN YOU(X, Y) = -1
          IF T > 1 THEN
            IF YOU(T - 1, Y) = 0 THEN YOU(T - 1, Y) = -1
          END IF
        END IF
        L = 0: T = 0
      END IF
    NEXT X
  NEXT Y
  FOR X = 1 TO 10
    L = 0: T = 0
    FOR Y = 1 TO 10
      IF YOU(X, Y) = 3 THEN
        IF T = 0 THEN T = Y
        L = L + 1
      ELSE
        IF L >= LMAX THEN
          IF YOU(X, Y) = 0 THEN YOU(X, Y) = -1
          IF T > 1 THEN
            IF YOU(X, T - 1) = 0 THEN YOU(X, T - 1) = -1
          END IF
        END IF
        L = 0: T = 0
      END IF
    NEXT Y
  NEXT X
END SUB
 
SUB ANALIZ1
  ERASE SHIP
  FOR L = 1 TO 4
    FOR Y = 1 TO 10
      FOR X = 1 TO 10
        IF A(X, Y) = 3 THEN
          '===============================
          T = X: I = 0
          DO WHILE A(T, Y) = 3
            I = I + 1
            T = T + 1
            IF T > 10 THEN EXIT DO
          LOOP
          IF I = 5 - L THEN
            SHIP(5 - L) = SHIP(5 - L) + 1
            FOR N = 1 TO 5 - L
              A(T - N, Y) = 0
            NEXT N
          END IF
          '==============================
          T = Y: I = 0
          DO WHILE A(X, T) = 3
            I = I + 1
            T = T + 1
            IF T > 10 THEN EXIT DO
          LOOP
          IF I = 5 - L THEN
            SHIP(5 - L) = SHIP(5 - L) + 1
            FOR N = 1 TO 5 - L
              A(X, T - N) = 0
            NEXT N
          END IF
        END IF
      NEXT X
    NEXT Y
  NEXT L
  IF SHIP(4) = 1 THEN
    LMAX = 3
    IF SHIP(3) = 2 THEN
      LMAX = 2
      IF SHIP(2) = 3 THEN
        LMAX = 1
        IF SHIP(1) = 4 THEN
          LMAX = 0
        END IF
      END IF
    END IF
  END IF
END SUB
 
SUB ATOENEMY
  DIM X AS INTEGER, Y AS INTEGER
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      ENEMY(X, Y) = A(X, Y)
    NEXT X
  NEXT Y
END SUB
 
SUB ATOYOU
  DIM X AS INTEGER, Y AS INTEGER
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      YOU(X, Y) = A(X, Y)
    NEXT X
  NEXT Y
END SUB
 
SUB AUTOSET
  ERASE A
  ERASE YOU
  CALL SETSHIPAI(4, 1)
  CALL SETSHIPAI(3, 2)
  CALL SETSHIPAI(2, 3)
  CALL SETSHIPAI(1, 4)
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      IF A(X, Y) = 2 THEN
        YOU(X, Y) = 2
      ELSE
        YOU(X, Y) = 0
      END IF
    NEXT X
  NEXT Y
  REDRAW
END SUB
 
SUB BOX (L AS INTEGER, T AS INTEGER, W AS INTEGER, H AS INTEGER)
  LOCATE T, L: PRINT "Й";
  FOR X = L + 1 TO L + W
    LOCATE T, X: PRINT "Н";
  NEXT X
  LOCATE T, L + W + 1: PRINT "»";
  FOR Y = T + 1 TO T + H
    LOCATE Y, L: PRINT "є";
    LOCATE Y, L + W + 1: PRINT "є";
  NEXT Y
  LOCATE T + H + 1, L: PRINT "И";
  FOR X = L + 1 TO L + W
    LOCATE T + H + 1, X: PRINT "Н";
  NEXT X
  LOCATE T + H + 1, L + W + 1: PRINT "ј";
END SUB
 
SUB EDITSHIP
  DIM CX AS INTEGER, CY AS INTEGER, L AS INTEGER, R AS INTEGER
  CALL BOX(7, 18, 26, 4)
  LOCATE 19, 8: PRINT "[ARROWS] - Move cursor    ";
  LOCATE 20, 8: PRINT " [ENTER] - Rotate ship    ";
  LOCATE 21, 8: PRINT " [SPACE] - Set ship       ";
  LOCATE 22, 8: PRINT "   [END] - Random set ship";
  CX = 5: CY = 5: L = 3: R = 0
  YOUTOA
  DO
    K$ = INKEY$
    IF LEN(K$) > 0 THEN
      K = ASC(RIGHT$(K$, 1))
    ELSE
      K = 0
    END IF
    SELECT CASE K
      CASE 72 'UP
        CY = CY - 1
        IF CY < 1 THEN CY = 1
      CASE 75  'LEFT
        CX = CX - 1
        IF CX < 1 THEN CX = 1
      CASE 77  'RIGHT
        CX = CX + 1
        IF R THEN
          IF CX > 10 - L THEN CX = 10 - L
        ELSE
          IF CX > 10 THEN CX = 10
        END IF
      CASE 80  'DOWN
        CY = CY + 1
        IF R THEN
          IF CY > 10 THEN CY = 10
        ELSE
          IF CY > 10 - L THEN CY = 10 - L
        END IF
      CASE 13 'ENTER
        R = NOT R
        LOCATE 3, 2
        IF R THEN
          IF CX > 10 - L THEN CX = 10 - L
        ELSE
          IF CY > 10 - L THEN CY = 10 - L
        END IF
      CASE 32 'SPACE
        L = SETSHIP(CX, CY, L, R)
        IF L = 0 THEN
          EXIT DO
        END IF
        L = L - 1
      CASE 79 'END
        AUTOSET
        EXIT DO
    END SELECT
    CALL SHOWCUR(CX, CY, L, R)
  LOOP
  LMAX = 4
END SUB
 
SUB ENEMYTOA
  DIM X AS INTEGER, Y AS INTEGER
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      A(X, Y) = ENEMY(X, Y)
    NEXT X
  NEXT Y
END SUB
 
FUNCTION FIRE% (X AS INTEGER, Y AS INTEGER)
  DIM R AS INTEGER
  SELECT CASE ENEMY(X, Y)
  CASE 0
    COLOR , 9
    ENEMY(X, Y) = 1
    R = 0
  CASE 2
    FOR I = 1 TO 3
      COLOR , 12
      PAUSE 3
      COLOR , 14
      PAUSE 3
    NEXT I
    ENEMY(X, Y) = 3
    R = 1
  CASE ELSE
    R = -1
  END SELECT
  PAUSE 3
  COLOR , 1
  FIRE = R
END FUNCTION
 
FUNCTION FIREAI% (X AS INTEGER, Y AS INTEGER)
  DIM R AS INTEGER
  SELECT CASE YOU(X, Y)
  CASE 0
    COLOR , 9
    YOU(X, Y) = 1
    R = 0
  CASE 2
    FOR I = 1 TO 3
      COLOR , 12
      PAUSE 3
      COLOR , 14
      PAUSE 3
    NEXT I
    YOU(X, Y) = 3
    IF X > 1 AND Y > 1 THEN
      IF YOU(X - 1, Y - 1) = 0 THEN YOU(X - 1, Y - 1) = -1
    END IF
    IF X > 1 AND Y < 10 THEN
      IF YOU(X - 1, Y + 1) = 0 THEN YOU(X - 1, Y + 1) = -1
    END IF
    IF X < 10 AND Y > 1 THEN
      IF YOU(X + 1, Y - 1) = 0 THEN YOU(X + 1, Y - 1) = -1
    END IF
    IF X < 10 AND Y < 10 THEN
      IF YOU(X + 1, Y + 1) = 0 THEN YOU(X + 1, Y + 1) = -1
    END IF
    CALL GETLENGHT(X, Y)
    R = 1
  END SELECT
  PAUSE 3
  COLOR , 1
  FIREAI = R
END FUNCTION
 
FUNCTION GETINDEX%
  DIM T AS INTEGER, U AS INTEGER, D AS INTEGER, L AS INTEGER, R AS INTEGER
  DIM K AS INTEGER, X AS INTEGER, Y AS INTEGER, MAX AS INTEGER
  ANALIZ
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      IF YOU(X, Y) MOD 2 = 0 THEN
'======================================
        U = 0: D = 0: L = 0: R = 0: K = 0
        IF X > 1 THEN
          IF YOU(X - 1, Y) = 3 THEN K = 60
        END IF
        IF X < 10 THEN
          IF YOU(X + 1, Y) = 3 THEN K = 60
        END IF
        IF Y > 1 THEN
          IF YOU(X, Y - 1) = 3 THEN K = 60
        END IF
        IF Y < 10 THEN
          IF YOU(X, Y + 1) = 3 THEN K = 60
        END IF
        T = Y
        DO WHILE T > 0
          IF YOU(X, T) MOD 2 = 0 THEN
            U = U + 1
          ELSE
            EXIT DO
          END IF
          T = T - 1
        LOOP
        T = Y
        DO WHILE T < 11
          IF YOU(X, T) MOD 2 = 0 THEN
            D = D + 1
          ELSE
            EXIT DO
          END IF
          T = T + 1
        LOOP
        T = X
        DO WHILE T > 0
          IF YOU(T, Y) MOD 2 = 0 THEN
            L = L + 1
          ELSE
            EXIT DO
          END IF
          T = T - 1
        LOOP
        T = X
        DO WHILE T < 11
          IF YOU(T, Y) MOD 2 = 0 THEN
            R = R + 1
          ELSE
            EXIT DO
          END IF
          T = T + 1
        LOOP
'======================================
        A(X, Y) = U * D + L * R + K
        IF MAX < A(X, Y) THEN
          MAX = A(X, Y)
        END IF
      ELSE
        A(X, Y) = 0
      END IF
    NEXT X
  NEXT Y
  GETINDEX = MAX
END FUNCTION
 
SUB GETLENGHT (X AS INTEGER, Y AS INTEGER)
  DIM L AS INTEGER, S AS INTEGER, E AS INTEGER
  L = 1
  S = X - 1
  IF X > 1 THEN
    DO WHILE YOU(S, Y) = 3
      L = L + 1
      S = S - 1
      IF S < 1 THEN EXIT DO
    LOOP
  END IF
  E = X + 1
  IF X < 10 THEN
    DO WHILE YOU(E, Y) = 3
      L = L + 1
      E = E + 1
      IF E > 10 THEN EXIT DO
    LOOP
  END IF
  IF L = LMAX THEN
    IF X > 1 AND YOU(S + 1, Y) = 0 THEN YOU(S, Y) = -1
    IF X < 10 AND YOU(E - 1, Y) = 0 THEN YOU(E, Y) = -1
  END IF
  L = 1
  S = Y - 1
  IF Y > 1 THEN
    DO WHILE YOU(X, S) = 3
      L = L + 1
      S = S - 1
      IF S < 1 THEN EXIT DO
    LOOP
  END IF
  E = Y + 1
  IF Y < 10 THEN
    DO WHILE YOU(X, E) = 3
      L = L + 1
      E = E + 1
      IF E > 10 THEN EXIT DO
    LOOP
  END IF
  IF L = LMAX THEN
    IF Y > 1 AND YOU(X, S + 1) = 0 THEN YOU(X, S) = -1
    IF Y < 10 AND YOU(X, E - 1) = 0 THEN YOU(X, E) = -1
  END IF
END SUB
 
SUB PAUSE (N AS INTEGER)
  FOR J = 1 TO N
    FOR I = 1 TO 50
      A = SQR(PI / I)
    NEXT I
  NEXT J
END SUB
 
SUB REDRAW
  DIM X AS INTEGER, Y AS INTEGER, H AS INTEGER, C AS INTEGER
  DIM H1 AS INTEGER, C1 AS INTEGER
  H = 0: C = 0
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      LOCATE Y + 4, X + 8:
      SELECT CASE YOU(X, Y)
        CASE 1
          PRINT "ъ";
        CASE 2
          PRINT "Ы";
          H = H + 1
        CASE 3
          PRINT "X";
          H1 = H1 + 1
        CASE ELSE
          PRINT " ";
      END SELECT
      LOCATE Y + 4, X + 22:
      SELECT CASE ENEMY(X, Y)
        CASE 1
          PRINT "ъ";
        CASE 2
          IF ENDGAME <> 0 THEN
            PRINT "Ы";
          END IF
          C = C + 1
        CASE 3
          PRINT "X";
          C1 = C1 + 1
        CASE ELSE
          PRINT " ";
      END SELECT
    NEXT X
  NEXT Y
  LOCATE 3, 12: PRINT USING "###"; H1
  LOCATE 3, 26: PRINT USING "###"; C1
  IF H = 0 THEN ENDGAME = -1
  IF C = 0 THEN ENDGAME = 1
END SUB
 
SUB RESTART
  ERASE A
  ERASE YOU
  ERASE SHIP
  ERASE ENEMY
  REDRAW
  FOR Y = 1 TO 10
    LOCATE Y + 4, 19: PRINT USING "###"; Y;
  NEXT Y
  LOCATE 16, 9: PRINT "ABCDEFGHIJ"
  LOCATE 16, 23: PRINT "ABCDEFGHIJ"
  CALL BOX(8, 4, 10, 10)
  CALL BOX(22, 4, 10, 10)
  EDITSHIP
  ERASE A
  ERASE SHIP
  CALL SETSHIPAI(4, 1)
  CALL SETSHIPAI(3, 2)
  CALL SETSHIPAI(2, 3)
  CALL SETSHIPAI(1, 4)
  ATOENEMY
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      IF YOU(X, Y) <> 2 THEN
        YOU(X, Y) = 0
      END IF
      IF ENEMY(X, Y) <> 2 THEN
        ENEMY(X, Y) = 0
      END IF
    NEXT X
  NEXT Y
  CALL BOX(7, 18, 26, 4)
  LOCATE 19, 8: PRINT "[ARROWS] - Move cursor    ";
  LOCATE 20, 8: PRINT " [SPACE] - Fire           ";
  LOCATE 21, 8: PRINT "   [END] - Restart game   ";
  LOCATE 22, 8: PRINT "   [ESC] - Exit           ";
  ENDGAME = 0: LMAX = 4
  REDRAW
END SUB
 
FUNCTION SETSHIP% (CX AS INTEGER, CY AS INTEGER, L AS INTEGER, R AS INTEGER)
  IF VALIDATE(CX, CY, L, R) THEN
    FOR T = 0 TO L
      IF R THEN
        IF CX > 1 AND T = 0 THEN YOU(CX - 1, CY) = -1
        IF CX + T > 1 AND CY > 1 THEN YOU(CX + T - 1, CY - 1) = -1
        IF CX + T > 1 AND CY < 10 THEN YOU(CX + T - 1, CY + 1) = -1
        IF CX + T < 10 AND CY > 1 THEN YOU(CX + T + 1, CY - 1) = -1
        IF CX + T < 10 AND CY < 10 THEN YOU(CX + T + 1, CY + 1) = -1
        IF CX + L < 10 AND T = L THEN YOU(CX + L + 1, CY) = -1
        YOU(CX + T, CY) = 2
      ELSE
        IF CY > 1 AND T = 0 THEN YOU(CX, CY - 1) = -1
        IF CX > 1 AND CY + T > 1 THEN YOU(CX - 1, CY + T - 1) = -1
        IF CX > 1 AND CY + T < 10 THEN YOU(CX - 1, CY + T + 1) = -1
        IF CX < 10 AND CY + T > 1 THEN YOU(CX + 1, CY + T - 1) = -1
        IF CX < 10 AND CY + T < 10 THEN YOU(CX + 1, CY + T + 1) = -1
        IF CY + L < 10 AND T = L THEN YOU(CX, CY + L + 1) = -1
        YOU(CX, CY + T) = 2
      END IF
    NEXT
    YOUTOA
    REDRAW
    SHIP(L + 1) = SHIP(L + 1) + 1
    IF SHIP(4) = 1 THEN
      L = 3
      IF SHIP(3) = 2 THEN
        L = 2
        IF SHIP(2) = 3 THEN
          L = 1
          IF SHIP(1) = 4 THEN
            L = 0
          END IF
        END IF
      END IF
    END IF
  END IF
  SETSHIP = L
END FUNCTION
 
SUB SETSHIPAI (L AS INTEGER, N AS INTEGER)
  DIM K AS INTEGER, R  AS INTEGER, X AS INTEGER, Y AS INTEGER
  L = L - 1
  K = 10 - L
  DO WHILE N > 0
'=============================================
    R = INT(RND * 2)
    IF R THEN
      X = INT(RND * K) + 1
      Y = INT(RND * 10) + 1
      IF VALIDATE(X, Y, L, R) THEN
        N = N - 1
        FOR T = 0 TO L
          A(X + T, Y) = 2
          IF T = 0 AND X > 1 THEN A(X - 1, Y) = -1
          IF Y > 1 THEN
            IF X + T > 1 THEN A(X + T - 1, Y - 1) = -1
            A(X + T, Y - 1) = -1
            IF X + T < 10 THEN A(X + T + 1, Y - 1) = -1
          END IF
          IF Y < 10 THEN
            IF X + T > 1 THEN A(X + T - 1, Y + 1) = -1
            A(X + T, Y + 1) = -1
            IF X + T < 10 THEN A(X + T + 1, Y + 1) = -1
          END IF
          IF T = L AND X + T < 10 THEN A(X + T + 1, Y) = -1
        NEXT T
      END IF
    ELSE
      X = INT(RND * 10) + 1
      Y = INT(RND * K) + 1
      IF VALIDATE(X, Y, L, R) THEN
        N = N - 1
        FOR T = 0 TO L
          A(X, Y + T) = 2
          IF T = 0 AND Y > 1 THEN A(X, Y - 1) = -1
          IF X > 1 THEN
            IF Y + T > 1 THEN A(X - 1, Y + T - 1) = -1
            A(X - 1, Y + T) = -1
            IF Y + T < 10 THEN A(X - 1, Y + T + 1) = -1
          END IF
          IF X < 10 THEN
            IF Y + T > 1 THEN A(X + 1, Y + T - 1) = -1
            A(X + 1, Y + T) = -1
            IF Y + T < 10 THEN A(X + 1, Y + T + 1) = -1
          END IF
          IF T = L AND Y + T < 10 THEN A(X, Y + T + 1) = -1
        NEXT T
      END IF
    END IF
  LOOP
END SUB
 
SUB SHOWCUR (CX AS INTEGER, CY AS INTEGER, L AS INTEGER, R AS INTEGER)
  DIM X AS INTEGER, Y AS INTEGER
  X = CX + 8
  Y = CY + 4
  IF VALIDATE(CX, CY, L, R) THEN
    COLOR 15
  ELSE
    COLOR 12
  END IF
  FOR T = 0 TO L
    IF R THEN
      LOCATE Y, X + T
    ELSE
      LOCATE Y + T, X
    END IF
    PRINT "±";
  NEXT T
  PAUSE 5
  COLOR 15
  FOR T = 0 TO L
    IF R THEN
      LOCATE Y, X + T
        IF YOU(CX + T, CY) = 2 THEN
          PRINT "Ы";
        ELSE
          PRINT " ";
        END IF
    ELSE
      LOCATE Y + T, X
        IF YOU(CX, CY + T) = 2 THEN
          PRINT "Ы";
        ELSE
          PRINT " ";
        END IF
    END IF
  NEXT T
  PAUSE 5
END SUB
 
SUB SHOWCURSOR (X AS INTEGER, Y AS INTEGER)
  COLOR 15
  LOCATE Y + 4, X + 22
  PRINT "±";
  PAUSE 5
  LOCATE Y + 4, X + 22
  SELECT CASE ENEMY(X, Y)
    CASE 1
      PRINT "ъ";
    CASE 3
      PRINT "X";
    CASE ELSE
      PRINT " ";
  END SELECT
  PAUSE 5
END SUB
 
FUNCTION VALIDATE% (X AS INTEGER, Y AS INTEGER, L AS INTEGER, R AS INTEGER)
  VALIDATE = 1
  FOR T = 0 TO L
    IF R THEN
      IF A(X + T, Y) <> 0 THEN
        VALIDATE = 0
        EXIT FOR
      END IF
    ELSE
      IF A(X, Y + T) <> 0 THEN
        VALIDATE = 0
        EXIT FOR
      END IF
    END IF
  NEXT T
END FUNCTION
 
SUB YOUTOA
  DIM X AS INTEGER, Y AS INTEGER
  FOR Y = 1 TO 10
    FOR X = 1 TO 10
      A(X, Y) = YOU(X, Y)
    NEXT X
  NEXT Y
END SUB