• Print

Author Topic: Battle Ship - Lan or local game  (Read 350 times)

Petr

  • Hero Member
  • *****
  • Posts: 657
Battle Ship - Lan or local game
« on: March 31, 2018, 02:51:14 am »
Hi all.

After a long time I finally finished the development of this game. It's a classic game you sometimes play on squared paper in two 10x10 squares. During the development of the network version of this game, I learned a lot. The game offers automatic player shipbuilding - or manual boarding by the player (then right mouse button rotate with boat), the game on one computer and the network game on the local network.

If you try localhost network game, please copy this program to two different directories and then start it. For localhost do not write IP, just press enter on client computer.

Code: [Select]
'WARNING! For Lan game in LOCALHOST mode please use two different directories, copy game files in and start then both programs. Fullscreen is not locked, use Alt + ENTER for window switching.
'or use two computers :-D
'of course you can play in offline mode with computer :-D

Constructor "BattleShip.pmf"
StartLan = 1
TYPE setup
    BSound AS _BYTE 'sound in background
    Esound AS _BYTE 'sound effects
    Edit AS STRING * 4 'if you need your boats insert manually, goto menu / setup click to INSERT SHIPS MANUALLY, then goto menu / set game type, select game type and start it.
END TYPE

DIM SHARED INI AS setup
inistart:
IF _FILEEXISTS("lode.ini") THEN
    iniF = FREEFILE
    OPEN "lode.ini" FOR BINARY AS #iniF
    GET #iniF, , INI
    CLOSE #iniF
ELSE INICreate 1, 1, "AUTO"
    GOTO inistart
END IF

TYPE MIDI
    Song AS STRING * 5
    Lenght AS SINGLE
END TYPE
DIM SHARED MIDI(3) AS MIDI, MIDposition
MIDI(1).Song = "y.mid": MIDI(1).Lenght = 126 '                       real midi sound lenght
MIDI(2).Song = "g.mid": MIDI(2).Lenght = 181
MIDI(3).Song = "k.mid": MIDI(3).Lenght = 413
MIDposition = 1

DIM SHARED Lan, Host AS LONG, Client AS LONG
DIM SHARED poleA(1 TO 10, 1 TO 10) AS _BYTE '                        players array
DIM SHARED poleB(1 TO 10, 1 TO 10) AS _BYTE '                        enemy array
DIM SHARED exploze(7) AS LONG
TYPE Lod '                                                           array LodA contains informations about number, type and positions your boats, LodB is the same for enemy. This is later used for calculating damaged boats.
    pos AS STRING * 1
    typ AS _BYTE
    x AS _BYTE
    y AS _BYTE
END TYPE
REDIM SHARED LodA(15) AS Lod, Typ, GenX AS _BYTE, GenY AS _BYTE, PaletteSave(255) AS LONG
REDIM SHARED LodB(15) AS Lod, Pocty(10) AS _BYTE, Sn(1) AS STRING, Frames, Big
DIM pX AS INTEGER, pY AS INTEGER
REDIM prijemX AS _BYTE, prijemY AS _BYTE

'arrays LodA and PoleA are for player, LodB and PoleB for enemy or computer

DECLARE DYNAMIC LIBRARY "playmidi32" '                                see to wiki for more info
    FUNCTION PlayMIDI& (filename AS STRING)
END DECLARE



Vycisti_poleA
a = -1: B = -1: C = -1: d = -1: e = -1



SCREEN 13: _FULLSCREEN '                                                comment fullscreen if you try localhost lan game

SavePalette



i32to256 "lod0.gif", 0, 30
Big = reader("LODE.PBF") '
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15
noplay:
menu
'settings restart --------------
xx = FREEFILE
OPEN "lode.ini" FOR BINARY AS #xx
GET #xx, , INI
CLOSE #xx
'-------------------------------
i32to256 "lod0.gif", 0, 30 '                                            this sub again transform 32 bit loaded image to 256 color screen
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15


DO UNTIL Typ > 0 AND Typ < 4
    RANDOMIZE TIMER
    Typ = INT(RND * 4)
LOOP
uvod = 1


GameRestart:
_KEYCLEAR: _AUTODISPLAY
'initPlayer
CLS


ResetPalette '                                                           set color palette to original values

IF INI.Edit = "AUTO" THEN '                                              set this values in menu / setup. AUTO is for autogenerating boats on the map, MANU if boats are inserted manually
    initPlayer
    Show_Area
    DO WHILE i$ <> CHR$(13)
        i$ = INKEY$
        IF i$ = CHR$(27) THEN _KEYCLEAR: GOTO noplay
        COLOR 14
        textar "Press enter for select map or", -6, 1
        textar "SPACE key for generate map", -6, 12

        COLOR 15
        DO UNTIL Typ > 0 AND Typ < 4
            RANDOMIZE TIMER
            Typ = INT(RND * 4)
        LOOP

        SELECT CASE i$
            CASE " "
                Vycisti_poleA
                Vycisti_LodeA
                initPlayer
                Show_Area
                Typ = 0
        END SELECT
    LOOP
END IF



CLS
uvod = 0
i32to256 "lod0.gif", 0, 30
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15




' ---------------------- Generate Computers Ships --------------------------------------
IF INI.Edit = "MANU" THEN InsertShipsManually
initComputer
Show_Area

REDIM posX AS _BYTE, posY AS _BYTE
posX = 1: posY = 1: player = 1
CLS
ResetPalette
Zobraz_Stav 40, 135, 0
Zobraz_Stav 221, 135, 1

COLOR 15
FOR popisky = 1 TO 10 'draw 1 to 10 and A - J to maps
    znak = 64 + popisky
    textar CHR$(znak), 3 + (10 * popisky), 22: textar CHR$(znak), 172 + (10 * popisky), 22 'HORNI!
    IF popisky < 10 THEN textar (STR$(popisky)), -10, 22 + popisky * 10: textar (STR$(popisky)), 161, 22 + popisky * 10 ELSE textar (STR$(popisky)), -16, 22 + popisky * 10: textar (STR$(popisky)), 154, 22 + popisky * 10
NEXT popisky

PCOPY _DISPLAY, 1


DIM Mx, My, Lb, vvv

DO
    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
    IF komplet THEN komplet = 0: GOTO GameRestart
    invalid:
    i& = _KEYHIT
    IF i& = 27 THEN menu
    vvv = _MOUSEINPUT
    Mx = _MOUSEX
    My = _MOUSEY
    Lb = _MOUSEBUTTON(1)
    '    CLS
    PCOPY 1, _DISPLAY
    Pocty_Lodi
    textar STR$(Pocty(5)), 10, 136
    textar STR$(Pocty(4)), 10, 150
    textar STR$(Pocty(3)), 10, 163
    textar STR$(Pocty(2)), 10, 176
    textar STR$(Pocty(1)), 10, 189
    textar STR$(Pocty(10)), 255, 136
    textar STR$(Pocty(9)), 255, 150
    textar STR$(Pocty(8)), 255, 163
    textar STR$(Pocty(7)), 255, 176
    textar STR$(Pocty(6)), 255, 189
    IF INI.BSound THEN midas
    SELECT CASE Lan
        CASE 0 'NO LAN GAME
            SELECT CASE player
                CASE 1
                    _MOUSESHOW
                    COLOR 14: textar " Human Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                    END IF
                    IF posX < 1 THEN posX = 1
                    IF posY < 1 THEN posY = 1
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1
                    IF Lb = -1 THEN _MOUSEHIDE
                    IF Lb = -1 AND poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid
                    IF Lb = -1 AND poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: player = 0
                    IF Lb = -1 AND poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: player = 0
                    Show_Area
                    Show_B_Area
                CASE 0
                    secondly:
                    generX = 0: generY = 0
                    _MOUSEHIDE
                    COLOR 14: textar "Computer Play", 100, 1: COLOR 15
                    RANDOMIZE TIMER
                    DO UNTIL generX > 0 AND generX < 11
                        generX = CINT(RND * 10)
                    LOOP
                    RANDOMIZE TIMER
                    DO UNTIL generY > 0 AND generY < 11
                        generY = CINT(RND * 10)
                    LOOP

                    IF poleA(generX, generY) = 2 OR poleA(generX, generY) = 3 THEN GOTO secondly
                    info$ = "Fire to:" + LTRIM$(STR$(generY) + LTRIM$(CHR$(64 + generX)) + "  ")
                    textar info$, 1, 1
                    IF poleA(generX, generY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(generX, generY) = 2: player = 1
                    IF poleA(generX, generY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(generX, generY) = 3: player = 1
                    Show_Area
                    Show_B_Area
            END SELECT '                              for player select - human or computer

            '=============================Down is========================= 1 = HOST, 2 = CLIENT, writed for ONE CLIENT ==============================

        CASE -1: PRINT "Connection error.": BEEP: BEEP: menu ' NENI OTESTOVANO JAK SE TO BUDE CHOVAT V MENU!
        CASE 1 'HOST (SERVER)
            _TITLE "host"

            DO
                Lb = 0
                _KEYCLEAR
                i& = _KEYHIT
                IF i& = 27 THEN menu
                WHILE _MOUSEINPUT
                    Mx = _MOUSEX
                    My = _MOUSEY
                    Lb = _MOUSEBUTTON(1)
                WEND
                PCOPY 1, _DISPLAY
                Pocty_Lodi
                textar STR$(Pocty(5)), 10, 136
                textar STR$(Pocty(4)), 10, 150
                textar STR$(Pocty(3)), 10, 163
                textar STR$(Pocty(2)), 10, 176
                textar STR$(Pocty(1)), 10, 189
                textar STR$(Pocty(10)), 255, 136
                textar STR$(Pocty(9)), 255, 150
                textar STR$(Pocty(8)), 255, 163
                textar STR$(Pocty(7)), 255, 176
                textar STR$(Pocty(6)), 255, 189

                IF firstRun = 0 THEN LanHost: firstRun = 1: HOSTPLAY = 1: Lb = 0
                'HOST play first
                IF INI.BSound THEN midas
                IF HOSTPLAY THEN
                    _MOUSESHOW
                    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                    COLOR 14: textar " Host Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                        IF posX < 1 THEN posX = 1
                        IF posY < 1 THEN posY = 1
                        IF Lb = -1 THEN
                            Lb = 0
                            _MOUSEHIDE
                            IF poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid
                            IF posX > 10 OR posX < 1 OR posY > 10 OR posY < 1 THEN STOP 'test input value, so if program run, then value muss be correct.
                            PUT #Host&, , posX
                            PUT #Host&, , posY
                            IF poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: HOSTPLAY = 0
                            IF poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: HOSTPLAY = 0
                            HOSTPLAY = 0
                            prevzal = 0

                        END IF
                    END IF
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1
                    Show_Area
                    Show_B_Area
                    IF OverTest THEN menu
                ELSE
                    _MOUSEHIDE
                    prijemX = 0: prijemY = 0
                    DO
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        i$ = INKEY$
                        IF i$ = CHR$(32) THEN BEEP: PRINT prijemX, prijemY 'manual bug test, if program wait to values   -  its from developing times
                        IF i$ = CHR$(27) THEN menu
                        IF prijemX = 0 THEN GET #Host&, , prijemX 'missing IF conditions in this place caused me really BIG problems. One month for such this bug.
                        IF prijemY = 0 THEN GET #Host&, , prijemY
                        COLOR 14: textar " Host wait   ", 100, 1: COLOR 15
                        Show_Area
                        Show_B_Area
                        _DISPLAY
                        IF prijemX > 0 AND prijemY > 0 THEN EXIT DO
                    LOOP
                    IF prijemX > 0 AND prijemX < 11 AND prijemY > 0 AND prijemY < 11 THEN
                        IF poleA(prijemX, prijemY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(prijemX, prijemY) = 2: HOSTPLAY = 1
                        IF poleA(prijemX, prijemY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(prijemX, prijemY) = 3: HOSTPLAY = 1
                    ELSE SOUND 350, 1: STOP ' For unknown bug
                    END IF
                END IF
                _DISPLAY
                IF OverTest THEN menu
            LOOP

        CASE 2 'CLIENT
            _TITLE "client"

            DO
                i& = _KEYHIT
                IF i& = 27 THEN menu
                WHILE _MOUSEINPUT
                    Mx = _MOUSEX
                    My = _MOUSEY
                    Lb = _MOUSEBUTTON(1)
                WEND
                PCOPY 1, _DISPLAY
                Pocty_Lodi
                textar STR$(Pocty(5)), 10, 136
                textar STR$(Pocty(4)), 10, 150
                textar STR$(Pocty(3)), 10, 163
                textar STR$(Pocty(2)), 10, 176
                textar STR$(Pocty(1)), 10, 189
                textar STR$(Pocty(10)), 255, 136
                textar STR$(Pocty(9)), 255, 150
                textar STR$(Pocty(8)), 255, 163
                textar STR$(Pocty(7)), 255, 176
                textar STR$(Pocty(6)), 255, 189

                IF firstRun = 0 THEN LanClient: firstRun = 1: CLIENTPLAY = 0: Lb = 0
                IF INI.BSound THEN midas

                IF CLIENTPLAY THEN
                    _MOUSESHOW
                    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                    COLOR 14: textar " Client Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                        IF posX < 1 THEN posX = 1
                        IF posY < 1 THEN posY = 1

                        IF Lb = -1 THEN
                            Lb = 0
                            _MOUSEHIDE
                            IF poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid

                            'error detection
                            IF posX > 10 OR posX < 1 OR posY > 10 OR posY < 1 THEN STOP
                            PUT #Client&, , posX
                            PUT #Client&, , posY
                            IF poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: CLIENTPLAY = 0
                            IF poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: CLIENTPLAY = 0
                            CLIENTPLAY = 0
                            oka = 0

                        END IF
                    END IF
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1

                    Show_Area
                    Show_B_Area
                    IF OverTest THEN menu
                ELSE
                    _MOUSEHIDE
                    COLOR 14: textar " Client wait   ", 100, 1: COLOR 15
                    REDIM p AS _BYTE
                    prijemX = 0: prijemY = 0: p = 1
                    'BEEP

                    DO
                        i$ = INKEY$
                        IF i$ = CHR$(32) THEN BEEP: PRINT prijemX, prijemY ' manual test - program wait to values!
                        IF i$ = CHR$(27) THEN menu
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        Show_Area
                        Show_B_Area
                        _DISPLAY
                        IF prijemX = 0 THEN GET #Client&, , prijemX
                        IF prijemY = 0 THEN GET #Client&, , prijemY
                        IF prijemX > 0 AND prijemY > 0 THEN EXIT DO '       valid condition
                    LOOP
                    IF prijemX >= 1 AND prijemX <= 10 AND prijemY >= 1 AND prijemY <= 10 THEN
                        IF poleA(prijemX, prijemY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(prijemX, prijemY) = 2: CLIENTPLAY = 1
                        IF poleA(prijemX, prijemY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(prijemX, prijemY) = 3: CLIENTPLAY = 1
                    ELSE SOUND 350, 1: STOP ' for unknown bug
                    END IF
                END IF
                _DISPLAY
                IF OverTest THEN menu
            LOOP
            '======================================================================================================================================================






    END SELECT 'pro LAN typ hry
    A_OK = 0: B_OK = 0

    IF OverTest THEN menu
    _LIMIT 180
    _DISPLAY
LOOP




FUNCTION OverTest
    SHARED Lan
    OverTest = 0
    FOR controlA = 1 TO 10
        FOR controlB = 1 TO 10
            IF poleA(controlA, controlB) = 1 THEN A_OK = 1
            IF poleB(controlA, controlB) = 1 THEN B_OK = 1
        NEXT
    NEXT

    IF A_OK = 0 THEN
        ResetPalette
        CLS
        i32to256 "lod4.gif", 0, 20
        IF Lan = 0 THEN
            COLOR 40: textar "Computer WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1
        ELSE
            SELECT CASE Lan
                CASE 1
                    COLOR 40: textar "CLIENT WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Host&
                CASE 2
                    COLOR 40: textar "HOST WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Client&
            END SELECT
        END IF
    END IF


    IF B_OK = 0 THEN
        ResetPalette
        CLS
        i32to256 "lod3.gif", 35, 0
        IF Lan = 0 THEN
            COLOR 40: textar "Human WIN", 120, 10: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1
        ELSE
            SELECT CASE Lan
                CASE 1
                    COLOR 40: textar "HOST WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Host&: Lan = 0
                CASE 2
                    COLOR 40: textar "CLIENT WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Client&: Lan = 0
            END SELECT
        END IF
    END IF
END FUNCTION


SUB cil (x AS _BYTE, y AS _BYTE)
    SHARED player
    IF player = 1 THEN EXIT SUB
    LINE (20 + (10 * (x - 1)) + 3, 30 + (10 * (y - 1)) + 3)-(30 + (10 * (x - 1) - 1), 40 + (10 * (y - 1) - 1)), 14, BF
END SUB



SUB midas
    SHARED midResult, midTimer, midName$, MIDposition 'this is not very good example for programming....
    IF midTimer > TIMER THEN
        EXIT SUB
    ELSE
        result = PlayMIDI("" + CHR$(0)) 'stop
        MIDposition = MIDposition + 1
        IF MIDposition > UBOUND(midi) THEN MIDposition = 1
        midTimer = TIMER + MIDI(MIDposition).Lenght: midName$ = MIDI(MIDposition).Song
        result = PlayMIDI(midName$ + CHR$(0))
        IF result THEN PRINT "Error. Playmidi32.dll not found, background music will not played."
    END IF
END SUB

FUNCTION zvuk (co AS _BYTE)
    SHARED generX, generY, Splash&, exploz
    IF exploze(0) = 0 THEN
        exploze(0) = _SNDOPEN("explode0.mp3")
        exploze(1) = _SNDOPEN("explode1.mp3")
        exploze(2) = _SNDOPEN("explode2.mp3")
        exploze(3) = _SNDOPEN("explode3.mp3")
        exploze(4) = _SNDOPEN("explode4.mp3")
        exploze(5) = _SNDOPEN("explode5.mp3")
        exploze(6) = _SNDOPEN("explode6.mp3")
        exploze(7) = _SNDOPEN("explode7.mp3")
        Splash& = _SNDOPEN("splash.mp3"): IF INI.Esound = 0 THEN _SNDVOL (Splash&), 0 ELSE _SNDVOL (Splash&), 1
    END IF

    '1 lod, 2 voda         1 boat, 2 water

    'for online
    IF Lan THEN
        exploz = exploz + 1: IF exploz > 7 THEN exploz = 0
        GOTO NO_RANDOM
    END IF

    ' for offline
    exploz = -1
    DO UNTIL exploz > -1 AND exploz < 8
        RANDOMIZE TIMER
        exploz = INT(RND + RND * 5)
    LOOP

    NO_RANDOM:
    IF INI.Esound = 0 THEN _SNDVOL exploze(exploz), 0 'this solution is best for tha same time duration after fire with and without sound
    _SNDPLAY exploze(exploz)
    DO WHILE _SNDPLAYING(exploze(exploz)): Show_Area: Show_B_Area: cil generX, generY:: _DISPLAY: LOOP
    _SNDSTOP exploze(exploz)

    IF co = 2 THEN
        _SNDPLAY Splash&
        DO WHILE _SNDPLAYING(Splash&): Show_Area: Show_B_Area: cil generX, generY:: _DISPLAY: LOOP
        _SNDSTOP Splash&
    END IF
    zvuk = 1
END FUNCTION



SUB Zobraz_Stav (x AS INTEGER, y AS INTEGER, typ) 'draw boats flags
    oldY = y
    SELECT CASE typ
        CASE 0

            FOR G = 1 TO 5
                FOR f = 1 TO 50 - I STEP 10
                    LINE (x + f, y)-(x + f + 10, y + 10), 23, BF
                    LINE (x + f, y)-(x + f + 10, y + 10), 15, B
                NEXT f
                I = I + 10
                y = y + 13
            NEXT G

        CASE 1
            I = 0: y = oldY
            FOR G = 1 TO 5
                FOR f = 40 TO I STEP -10
                    LINE (x + f, y)-(x + f + 10, y + 10), 23, BF
                    LINE (x + f, y)-(x + f + 10, y + 10), 15, B
                NEXT f
                I = I + 10
                y = y + 13
            NEXT G
    END SELECT
END SUB




SUB Pocty_Lodi 'calculate number of boats
    death1 = 0: death2 = 0: death3 = 0: death4 = 0: death5 = 0
    FOR Lode = 1 TO 10
        FOR lodf = 1 TO 10
            FOR L = 1 TO UBOUND(loda)
                IF LodA(L).typ = 1 AND LodA(L).x = Lode AND LodA(L).y = lodf AND poleA(Lode, lodf) > 1 THEN death1 = death1 + 1
                SELECT CASE LodA(L).typ
                    CASE 2
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 THEN death2 = death2 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 THEN death2 = death2 + 1
                            END SELECT
                        END IF



                    CASE 3
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 THEN death3 = death3 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 THEN death3 = death3 + 1
                            END SELECT
                        END IF


                    CASE 4
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 AND poleA(3 + LodA(L).x, LodA(L).y) > 1 THEN death4 = death4 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 AND poleA(LodA(L).x, 3 + LodA(L).y) > 1 THEN death4 = death4 + 1
                            END SELECT
                        END IF



                    CASE 5
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 AND poleA(3 + LodA(L).x, LodA(L).y) > 1 AND poleA(4 + LodA(L).x, LodA(L).y) > 1 THEN death5 = death5 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 AND poleA(LodA(L).x, 3 + LodA(L).y) > 1 AND poleA(LodA(L).x, 4 + LodA(L).y) > 1 THEN death5 = death5 + 1
                            END SELECT
                        END IF
                END SELECT

    NEXT L, lodf, Lode
    Pocty(1) = 5 - death1
    Pocty(2) = 4 - death2
    Pocty(3) = 3 - death3
    Pocty(4) = 2 - death4
    Pocty(5) = 1 - death5



    death1 = 0: death2 = 0: death3 = 0: death4 = 0: death5 = 0
    FOR Lode = 1 TO 10
        FOR lodf = 1 TO 10
            FOR L = 1 TO UBOUND(lodb)
                IF LodB(L).typ = 1 AND LodB(L).x = Lode AND LodB(L).y = lodf AND poleB(Lode, lodf) > 1 THEN death1 = death1 + 1
                SELECT CASE LodB(L).typ
                    CASE 2
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 THEN death2 = death2 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 THEN death2 = death2 + 1
                            END SELECT
                        END IF



                    CASE 3
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 THEN death3 = death3 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 THEN death3 = death3 + 1
                            END SELECT
                        END IF


                    CASE 4
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 AND poleB(3 + LodB(L).x, LodB(L).y) > 1 THEN death4 = death4 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 AND poleB(LodB(L).x, 3 + LodB(L).y) > 1 THEN death4 = death4 + 1
                            END SELECT
                        END IF



                    CASE 5
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 AND poleB(3 + LodB(L).x, LodB(L).y) > 1 AND poleB(4 + LodB(L).x, LodB(L).y) > 1 THEN death5 = death5 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 AND poleB(LodB(L).x, 3 + LodB(L).y) > 1 AND poleB(LodB(L).x, 4 + LodB(L).y) > 1 THEN death5 = death5 + 1
                            END SELECT
                        END IF
                END SELECT

    NEXT L, lodf, Lode

    Pocty(6) = 5 - death1
    Pocty(7) = 4 - death2
    Pocty(8) = 3 - death3
    Pocty(9) = 2 - death4
    Pocty(10) = 1 - death5
END SUB

SUB Vycisti_poleA
    FOR x = 1 TO 10
        FOR y = 1 TO 10
            poleA(x, y) = 0
    NEXT y, x
END SUB

SUB Vycisti_LodeA 'uvolni lodni pole
    REDIM LodA(0) AS Lod
END SUB


SUB Vycisti_poleB
    FOR x = 1 TO 10
        FOR y = 1 TO 10
            poleB(x, y) = 0
    NEXT y, x
END SUB

SUB Vycisti_LodeB 'uvolni lodni pole
    REDIM LodB(0) AS Lod
END SUB




SUB Show_Area
    SHARED anima, uvod
    y2 = 0
    FOR y = 1 TO 100 STEP 10
        y2 = y2 + 1
        FOR x = 1 TO 100 STEP 10
            x2 = x2 + 1
            TypLodi = 0
            barva = 0
            FOR B = 0 TO 15
                IF LodA(B).x = x2 AND LodA(B).y = y2 THEN TypLodi = LodA(B).typ: EXIT FOR
                IF x2 >= LodA(B).x AND LodA(B).pos = "X" AND x2 <= LodA(B).typ + LodA(B).x AND y2 = LodA(B).y THEN TypLodi = LodA(B).typ: EXIT FOR
                IF y2 >= LodA(B).y AND LodA(B).pos = "Y" AND y2 <= LodA(B).typ + LodA(B).y AND x2 = LodA(B).x THEN TypLodi = LodA(B).typ: EXIT FOR
            NEXT B
            SELECT CASE TypLodi
                CASE 0: barva = 60
                CASE 1: barva = 22
                CASE 2: barva = 23
                CASE 3: barva = 24
                CASE 4: barva = 25
                CASE 5: barva = 26
            END SELECT
            SELECT CASE poleA(x2, y2)
                CASE 0 '                                                                                             VODA
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 1, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                    anima = anima + .0001: IF anima > 3 THEN anima = 1
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                CASE 1 '                                                                                             LOD
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), barva, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                CASE 2 '                                                                                             Zasah lod
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), 5, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                    COLOR 38 + anima: rozpis 40 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                CASE 3 '                                                                                             Zasah voda
                    LINE (x + 20 + 1, y + 40 - 1)-(x + 30 - 1, y + 30 + 1), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), 15
                    LINE (x + 20 + 1, y + 40 - 1)-(x + 30 - 1, y + 30 + 1), 15
                    LINE (x + 20, y + 30)-(x + 30, y + 40), 15, B
            END SELECT

        NEXT x
        x2 = 0
        IF uvod = 0 THEN
        END IF
    NEXT y
END SUB



SUB Show_B_Area
    SHARED anima
    x2 = 0: y2 = 0
    FOR y = 1 TO 100 STEP 10
        y2 = y2 + 1
        FOR x = 1 TO 100 STEP 10
            x2 = x2 + 1
            TypLodi = 0
            barva = 0
            FOR B = 1 TO 15
                IF x2 >= LodB(B).x AND LodB(B).pos = "X" AND x2 <= LodB(B).typ + LodB(B).x AND y2 = LodB(B).y THEN TypLodi = LodB(B).typ: EXIT FOR
                IF y2 >= LodB(B).y AND LodB(B).pos = "Y" AND y2 <= LodB(B).typ + LodB(B).y AND x2 = LodB(B).x THEN TypLodi = LodB(B).typ: EXIT FOR
            NEXT B
            SELECT CASE TypLodi
                CASE 1: barva = 22
                CASE 2: barva = 23
                CASE 3: barva = 24
                CASE 4: barva = 25
                CASE 5: barva = 26
            END SELECT
            m = 0
            SELECT CASE poleB(x2, y2)
                CASE 0 '                                                                  voda na pozici   Water on position
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 1 '                                                                  lod na pozici
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 1, BF '                      Rewrite 1  before ,BF to show enemy boats.
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 2 '                                                                  zasah lode       Boat damage
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 5, BF
                    COLOR 38 + anima: rozpis 40 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 3
                    LINE (x + 190 + 1, y + 40 - 1)-(x + 200 - 1, y + 30 + 1), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 15
                    LINE (x + 190 + 1, y + 40 - 1)-(x + 200 - 1, y + 30 + 1), 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
            END SELECT
        NEXT x
        x2 = 0
    NEXT y
END SUB

FUNCTION Rozmisti_lodeX (rozmisti AS _BYTE)
    T = TIMER + .2
    index = UBOUND(LodA)
    SELECT CASE rozmisti
        CASE 1
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoA(GenX, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1 + lod) AS Lod
                    LodA(index + 1 + lod).pos = "X": LodA(index + 1 + lod).typ = 1: LodA(index + 1 + lod).x = GenX: LodA(index + 1 + lod).y = GenY
                    poleA(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 2
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 2: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY
                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 3
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 3: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY
                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) AND VolnoA(GenX + 3, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 4: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: poleA(GenX + 3, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP
        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5

                REDIM _PRESERVE A5(lod, GenX TO GenX + 5, GenY) AS _BYTE

                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) AND VolnoA(GenX + 3, GenY) AND VolnoA(GenX + 4, GenY) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 5: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY


                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: poleA(GenX + 3, GenY) = 1: poleA(GenX + 4, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP
    END SELECT
END FUNCTION




FUNCTION Rozmisti_B_lodeX (rozmisti AS _BYTE)
    GenX = 0: GenY = 0
    T = TIMER + .2 'time limit for genarating
    index = UBOUND(LodB)
    lod = 0
    SELECT CASE rozmisti
        CASE 1
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoB(GenX, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1 + lod) AS Lod
                    LodB(index + 1 + lod).pos = "X": LodB(index + 1 + lod).typ = 1: LodB(index + 1 + lod).x = GenX: LodB(index + 1 + lod).y = GenY
                    poleB(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 2: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 3: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) AND VolnoB(GenX + 3, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 4: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: poleB(GenX + 3, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP
        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) AND VolnoB(GenX + 3, GenY) AND VolnoB(GenX + 4, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 5: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: poleB(GenX + 3, GenY) = 1: poleB(GenX + 4, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP
    END SELECT
END FUNCTION



FUNCTION Rozmisti_lodeY (rozmisti AS _BYTE)
    T = TIMER + .2
    index = UBOUND(lodA)
    SELECT CASE rozmisti
        CASE 1
            'JEDNICKA lod
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoA(GenX, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1 + lod) AS Lod
                    LodA(index + 1 + lod).pos = "Y": LodA(index + 1 + lod).typ = 1: LodA(index + 1 + lod).x = GenX: LodA(index + 1 + lod).y = GenY
                    poleA(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2


                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 2: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3

                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 3: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) AND VolnoA(GenX, GenY + 3) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 4: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: poleA(GenX, GenY + 3) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP


        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) AND VolnoA(GenX, GenY + 3) AND VolnoA(GenX, GenY + 4) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 5: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY


                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: poleA(GenX, GenY + 3) = 1: poleA(GenX, GenY + 4) = 1: lod = lod + 1
                END IF
            LOOP
            IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
    END SELECT
END FUNCTION

FUNCTION Rozmisti_B_lodeY (rozmisti AS _BYTE)
    GenX = 0: GenY = 0
    T = TIMER + .2
    index = UBOUND(lodB)
    SELECT CASE rozmisti
        CASE 1
            'JEDNICKA lod
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen

                IF VolnoB(GenX, GenY) THEN

                    REDIM _PRESERVE LodB(index + 1 + lod) AS Lod
                    LodB(index + 1 + lod).pos = "Y": LodB(index + 1 + lod).typ = 1: LodB(index + 1 + lod).x = GenX: LodB(index + 1 + lod).y = GenY

                    poleB(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2


                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 2: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3

                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 3: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) AND VolnoB(GenX, GenY + 3) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 4: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: poleB(GenX, GenY + 3) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP


        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) AND VolnoB(GenX, GenY + 3) AND VolnoB(GenX, GenY + 4) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 5: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: poleB(GenX, GenY + 3) = 1: poleB(GenX, GenY + 4) = 1: lod = lod + 1
                END IF
            LOOP
            IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
    END SELECT
END FUNCTION


FUNCTION VolnoA (x AS _BYTE, y AS _BYTE)
    IF x = 1 THEN startX = 1 ELSE startX = x - 1
    IF y = 1 THEN startY = 1 ELSE startY = y - 1
    IF x >= 10 THEN CilX = 10 ELSE CilX = x + 1
    IF y >= 10 THEN CilY = 10 ELSE CilY = y + 1


    FOR scnX = startX TO CilX
        FOR scnY = startY TO CilY
            IF poleA(scnX, scnY) <> 0 THEN Volno = 1: GOTO vystup
    NEXT scnY, scnX
    vystup:
    IF Volno THEN VolnoA = 0 ELSE VolnoA = 1
END FUNCTION


FUNCTION VolnoB (x AS _BYTE, y AS _BYTE)
    IF x = 1 THEN startX = 1 ELSE startX = x - 1
    IF y = 1 THEN startY = 1 ELSE startY = y - 1
    IF x >= 10 THEN CilX = 10 ELSE CilX = x + 1
    IF y >= 10 THEN CilY = 10 ELSE CilY = y + 1


    FOR scnX = startX TO CilX
        FOR scnY = startY TO CilY
            IF poleB(scnX, scnY) <> 0 THEN Volno = 1: GOTO vystup
    NEXT scnY, scnX
    vystup:
    IF Volno THEN VolnoB = 0 ELSE VolnoB = 1
END FUNCTION



SUB initPlayer
    DO
        SELECT CASE Typ
            CASE 1
                'dve ctyrky
                a = Rozmisti_lodeY(4)
                a = Rozmisti_lodeX(4)

                ' tri trojky
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeX(3)

                'jedna petka
                e = Rozmisti_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)

            CASE 2
                a = Rozmisti_lodeX(4)
                a = Rozmisti_lodeX(4)

                ' tri trojky
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeY(3)

                'jedna petka
                e = Rozmisti_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)

            CASE 3

                'jedna petka
                e = Rozmisti_lodeY(5)

                a = Rozmisti_lodeY(4)
                a = Rozmisti_lodeY(4)

                ' tri trojky
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeX(3)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)
        END SELECT

        IF a = 0 AND b = 0 AND c = 0 AND d = 0 AND e = 0 AND UBOUND(lodA) = 15 THEN
            EXIT DO
        ELSE
            RANDOMIZE TIMER
            Vycisti_poleA
            Vycisti_LodeA
        END IF
    LOOP
END SUB



SUB initComputer
    a = -1: b = -1: c = -1: d = -1: e = -1

    DO
        SELECT CASE Typ
            CASE 1
                'dve ctyrky
                a = Rozmisti_B_lodeY(4)
                a = Rozmisti_B_lodeX(4)

                ' tri trojky
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeX(3)

                'jedna petka
                e = Rozmisti_B_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)

            CASE 2
                a = Rozmisti_B_lodeX(4)
                a = Rozmisti_B_lodeX(4)

                ' tri trojky
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeY(3)

                'jedna petka
                e = Rozmisti_B_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)

            CASE 3

                'jedna petka
                e = Rozmisti_B_lodeY(5)

                a = Rozmisti_B_lodeY(4)
                a = Rozmisti_B_lodeY(4)

                ' tri trojky
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeX(3)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)
        END SELECT

        IF a = 0 AND b = 0 AND c = 0 AND d = 0 AND e = 0 AND UBOUND(lodB) = 15 THEN
            '        PRINT UBOUND(lodB)
            EXIT DO
        ELSE
            RANDOMIZE TIMER
            Vycisti_poleB
            Vycisti_LodeB
        END IF
    LOOP
END SUB



SUB textar (veta AS STRING, x AS INTEGER, y AS INTEGER)
    c = 25
    FOR r = 1 TO LEN(veta$)
        ch$ = UCASE$(MID$(veta$, r, 1))
        SELECT CASE ch$
            CASE ":": in = 36
            CASE "A": in = 0
            CASE "B": in = 1
            CASE "C": in = 2
            CASE "D": in = 3
            CASE "E": in = 4
            CASE "F": in = 5
            CASE "G": in = 6
            CASE "H": in = 7
            CASE "I": in = 8
            CASE "J": in = 9
            CASE "K": in = 10
            CASE "L": in = 11
            CASE "M": in = 12
            CASE "N": in = 13
            CASE "O": in = 14
            CASE "P": in = 15
            CASE "Q": in = 16
            CASE "R": in = 17
            CASE "S": in = 18
            CASE "T": in = 19
            CASE "U": in = 20
            CASE "V": in = 21
            CASE "W": in = 22
            CASE "X": in = 23
            CASE "Y": in = 24
            CASE "Z": in = 25
            CASE "0": in = 26
            CASE "1": in = 27
            CASE "2": in = 28
            CASE "3": in = 29
            CASE "4": in = 30
            CASE "5": in = 31
            CASE "6": in = 32
            CASE "7": in = 33
            CASE "8": in = 34
            CASE "9": in = 35
            CASE " ": in = -1
        END SELECT
        krokX = krokX + 9: IF krokX > _WIDTH - 13 - x THEN krokX = 0: krokY = krokY + 12
        IF in = -1 THEN _CONTINUE
        rozpis in, x + krokX, y + krokY
        in = 0
    NEXT
END SUB


FUNCTION reader (file AS STRING)
    SHARED Frames
    kx = 0: ky = 1
    oo = FREEFILE
    IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #oo ELSE BEEP: PRINT "Error opening file "; file$: EXIT SUB
    ident$ = SPACE$(4)
    REDIM big AS INTEGER
    GET #oo, , ident$
    IF ident$ <> "Petr" THEN PRINT "This is not my file format": SLEEP 2: EXIT SUB
    GET #oo, , big
    Frames = (LOF(oo) - 6) / (big ^ 2 / 8)
    REDIM udaj AS _UNSIGNED _BYTE
    REDIM Sn(Frames) AS STRING
    WHILE NOT EOF(oo)
        GET #oo, , udaj
        binar$ = DECtoBIN$(udaj)
        Sn(snindex) = Sn(snindex) + binar$
        FOR rozklad = 1 TO LEN(binar$)
            inSeek = inSeek + 1
            povel = VAL(MID$(binar$, rozklad, 1))
            kx = kx + 1: IF kx > big THEN kx = 1: ky = ky + 1
        NEXT rozklad
        IF inSeek MOD (big ^ 2) = 0 THEN ky = ky + 10: snindex = snindex + 1
        IF _HEIGHT - ky < big THEN ky = 1: posun = posun + 60
    WEND
    reader = big
    CLOSE #oo
END FUNCTION


SUB rozpis (snimek AS INTEGER, posX AS INTEGER, posY AS INTEGER)
    binar$ = Sn(snimek)
    FOR rozklad = 1 TO LEN(binar$)
        povel = VAL(MID$(binar$, rozklad, 1))
        kx = kx + 1: IF kx > Big THEN kx = 1: ky = ky + 1
        IF povel = 1 THEN PSET (posX + kx, posY + ky) 'ELSE PRESET (posX + kx, posY + ky)
    NEXT rozklad
END SUB

FUNCTION DECtoBIN$ (vstup)
    SHARED BINARY$
    FOR rj = 7 TO 0 STEP -1
        IF vstup AND 2 ^ rj THEN BINtoDE$ = BINtoDE$ + "1" ELSE BINtoDE$ = BINtoDE$ + "0"
    NEXT rj
    DECtoBIN$ = BINtoDE$
END FUNCTION


SUB i32to256 (image AS STRING, x AS INTEGER, y AS INTEGER) '     this is already on the .NET forum writed by me. As example how show pictures in 256 colors.
    IF _FILEEXISTS(image$) THEN
        image& = _LOADIMAGE(image$, 32)
        TYPE colors
            ClrVal AS LONG '                                    this contais color number in long format (_RGB32)
            ClrNmbr AS LONG '                                   this contais number for color. How much is this one color used in picture. Is for future use, if 32bit image contais more than 256 colors, then
        END TYPE '                                              i will use the most used only.
        REDIM colors(256) AS colors
        REDIM scn AS LONG, col AS LONG, scan AS LONG, control AS LONG, TotalColors AS LONG
        REDIM m AS _MEM
        m = _MEMIMAGE(image&)

        FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4 ' use 32 bit, step is 4 byt * 8 bit = 32 bit, i read 4 bytes (LONG) in one loop, so STEP 4
            _MEMGET m, m.OFFSET + scan, col&
            FOR control = 0 TO TotalColors&
                IF col& = colors(control).ClrVal THEN colors(control).ClrNmbr = colors(control).ClrNmbr + 1: col& = 0: EXIT FOR
            NEXT
            IF col& <> 0 THEN colors(control + 1).ClrVal = col&: colors(control + 1).ClrNmbr = 1: TotalColors& = TotalColors& + 1: col& = 0
            IF TotalColors& > 255 THEN EXIT FOR
        NEXT scan
        IF TotalColors& <= 256 THEN
            image256& = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
            _DEST image256&
            DIM m2 AS _MEM
            m2 = _MEMIMAGE(image256&)
            FOR MESecam = 255 - TotalColors& TO 255
                _DEST 0
                _PALETTECOLOR MESecam, colors(255 - MESecam).ClrVal
            NEXT

            REDIM SelectColor AS _UNSIGNED _BYTE
            FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4
                _MEMGET m, m.OFFSET + scan, Value&
                FOR SelectColor = 255 - TotalColors& TO 255
                    IF colors(255 - SelectColor).ClrVal& = Value& THEN _MEMPUT m2, m2.OFFSET + position256, SelectColor
                NEXT SelectColor
                position256 = position256 + 1
            NEXT scan
            _PUTIMAGE (x, y), image256&, 0
            _MEMFREE m: _MEMFREE m2: _FREEIMAGE image&: _FREEIMAGE image256&
        ELSE PRINT "Image contains more than 256 colors."
        END IF
    ELSE PRINT "File "; image$; " not exists.": SLEEP 5
    END IF
END SUB

SUB SavePalette
    FOR S = 0 TO 255
        COLOR _RGB(_RED(S), _GREEN(S), _BLUE(S))
        PaletteSave(S) = _RGB(_RED(S), _GREEN(S), _BLUE(S))
    NEXT S
END SUB

SUB ResetPalette
    FOR S = 0 TO 255
        _PALETTECOLOR S, _RGB32(_RED(PaletteSave(S)), _GREEN(PaletteSave(S)), _BLUE(PaletteSave(S)))
    NEXT S
END SUB

SUB menu
    menuBegin:
    _KEYCLEAR
    k& = 0
    CLS
    n = 1: gametype = 1
    DO
        i& = _KEYHIT
        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
        SELECT CASE i&
            CASE 13: GOSUB selected
            CASE 27: eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
            CASE 18432: n = n - 1: IF n < 1 THEN n = 1
            CASE 20480: n = n + 1: IF n > 4 THEN n = 4
        END SELECT
        IF INI.BSound THEN midas
        i32to256 "lod0.gif", 0, 30
        COLOR 40
        textar "Battle Ship 01 BETA", 10, 0
        SELECT CASE n
            CASE 1
                COLOR 20
                textar "Set game type", 150, 50
                COLOR 40
                textar "Setup", 150, 70
                textar "About", 150, 90
                textar "Quit game", 150, 110

            CASE 2
                COLOR 40
                textar "Set game type", 150, 50
                COLOR 20
                textar "Setup", 150, 70
                COLOR 40
                textar "About", 150, 90
                textar "Quit game", 150, 110


            CASE 3
                COLOR 40
                textar "Set game type", 150, 50
                textar "Setup", 150, 70
                COLOR 20
                textar "About", 150, 90
                COLOR 40
                textar "Quit game", 150, 110


            CASE 4
                COLOR 40
                textar "Set game type", 150, 50
                textar "Setup", 150, 70
                textar "About", 150, 90
                COLOR 20
                textar "Quit game", 150, 110
        END SELECT
        COLOR 15
        _DISPLAY
    LOOP
    selected:

    SELECT CASE n
        CASE 1 'select game type
            DO WHILE k& <> 13
                k& = _KEYHIT
                IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                SELECT CASE k&
                    CASE 27: GOTO menuBegin 'destructor a k tomu uvolnit vse za hlavni smyckou
                    CASE 18432: gametype = gametype - 1: IF gametype < 1 THEN gametype = 1
                    CASE 20480: gametype = gametype + 1: IF gametype > 2 THEN gametype = 2
                END SELECT
                SELECT CASE gametype
                    CASE 1
                        IF INI.BSound THEN midas
                        i32to256 "lod0.gif", 0, 30
                        COLOR 20
                        textar "Game VS computer", 150, 50
                        COLOR 40
                        textar "LAN Game", 150, 70
                    CASE 2
                        IF INI.BSound THEN midas
                        i32to256 "lod0.gif", 0, 30
                        COLOR 40
                        textar "Game VS computer", 150, 50
                        COLOR 20
                        textar "LAN Game", 150, 70
                END SELECT
                _DISPLAY
            LOOP
            SELECT CASE gametype
                CASE 1: CLS: i32to256 "lod0.gif", 0, 30: _DISPLAY: Lan = 0: EXIT SUB
                CASE 2
                    IF INI.BSound THEN midas
                    CLS
                    i32to256 "lod0.gif", 0, 30
                    COLOR 40
                    textar "LAN GAME", 10, 0
                    textar "Press C for Client or H for Host", 10, 100
                    _DISPLAY
                    DO
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        i$ = INKEY$
                        SELECT CASE LCASE$(i$)
                            CASE "c": computer$ = "C": EXIT DO
                            CASE "h": computer$ = "H": EXIT DO
                        END SELECT
                    LOOP

                    IF INI.BSound THEN midas
                    CLS
                    i32to256 "lod0.gif", 0, 30
                    COLOR 40
                    textar "LAN GAME", 10, 0
                    IF LEN(computer$) THEN LINE (0, 0)-(150, 25), 0, BF

                    IF computer$ = "C" THEN
                        textar "Input IP adress or press ESC", 10, 1
                        IP$ = IPinput$(85, 82)
                        LINE (0, 0)-(320, 25), 0, BF
                        Lan = Network(IP$)
                    ELSE
                        textar "Waiting for client", 10, 100:
                        DO UNTIL Lan
                            Lan = Network(IP$)
                            IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        LOOP
                    END IF

                    IF Lan = 0 THEN GOTO menuBegin 'pressed ESC when HOST wait for CLIENT
                    _DISPLAY
            END SELECT

        CASE 2 'sound setup
            _MOUSESHOW
            IF INI.BSound THEN midas
            CLS
            WHILE i& <> 27
                _LIMIT 30
                COLOR 40
                textar "Setup", 100, 15
                COLOR 15
                textar "Use background music", 20, 50
                textar "Use sound effects", 20, 80
                textar "Use AUTO generator for ships", 20, 110
                textar "Insert ships manually", 20, 140

                IF INI.BSound = 0 THEN LINE (10, 50)-(15, 55), 15, B ELSE LINE (10, 50)-(15, 55), 14, BF
                IF INI.Esound = 0 THEN LINE (10, 80)-(15, 85), 15, B ELSE LINE (10, 80)-(15, 85), 14, BF
                IF INI.Edit = "AUTO" THEN LINE (10, 110)-(15, 115), 14, BF ELSE LINE (10, 110)-(15, 115), 15, B
                IF INI.Edit = "MANU" THEN LINE (10, 140)-(15, 145), 14, BF ELSE LINE (10, 140)-(15, 145), 15, B

                i& = _KEYHIT
                DO WHILE _MOUSEINPUT
                    SELECT CASE _MOUSEX
                        CASE 10 TO 15
                            SELECT CASE _MOUSEY
                                CASE 50 TO 55: IF _MOUSEBUTTON(1) THEN
                                        SHARED midTimer
                                        IF INI.BSound = 1 THEN INI.BSound = 0: r = PlayMIDI("" + CHR$(0)) ELSE INI.BSound = 1: midTimer = 0: midas
                                    END IF
                                CASE 80 TO 85: IF _MOUSEBUTTON(1) THEN
                                        IF INI.Esound = 1 THEN INI.Esound = 0 ELSE INI.Esound = 1
                                    END IF
                                CASE 110 TO 115: IF _MOUSEBUTTON(1) THEN
                                        INI.Edit = "AUTO"
                                    END IF
                                CASE 140 TO 145
                                    IF _MOUSEBUTTON(1) THEN
                                        INI.Edit = "MANU"
                                    END IF
                            END SELECT
                    END SELECT
                LOOP
                _DISPLAY
                CLS
            WEND
            INICreate INI.BSound, INI.Esound, INI.Edit
            GOTO menuBegin

        CASE 3 'about
            CLS
            FOR F = 0 TO 200
                i32to256 "battleship.gif", 60, F
                _DISPLAY
                _LIMIT 25
                CLS
            NEXT F
            CLS
            COLOR 40
            textar "About BattleShip game", 10, 10
            textar "This game is based on desktop game", 1, 30
            textar "as in previous picture", 1, 45
            textar "Quads represents ships and player", 1, 60
            textar "try destroy it all as first", 1, 75
            textar "Both players have the same number", 1, 90
            textar "of Ships", 1, 105
            textar "Left map is for player and right", 1, 120
            textar "map is for enemy", 1, 135
            textar "Use mouse on the right map to  ", 1, 150
            textar "determine target and shoot", 1, 165

            textar "Press any key ", 1, 190
            _DISPLAY
            i$ = ""
            _KEYCLEAR
            DO UNTIL i$ <> "": i$ = INKEY$: IF INI.BSound THEN midas
            LOOP
            ResetPalette
            _AUTODISPLAY
            GOTO menuBegin
        CASE 4 ' end
            FOR CLOSURE = 0 TO 7
                _SNDCLOSE exploze(CLOSURE)
            NEXT CLOSURE
            _SNDCLOSE Splash&
            eee = PlayMIDI&("")
            Destructor "BattleShip.pmf"
            SYSTEM
    END SELECT

END SUB

FUNCTION Network (IP AS STRING)
    _AUTODISPLAY
    Client& = _OPENCLIENT("TCP/IP:3455:" + LTRIM$(IP$))
    IF Client& THEN
        Network = 2 'client
    ELSE
        PRINT "No host found"
        _DELAY 1
        _DELAY 1
        Client& = _OPENHOST("TCP/IP:3455")
        IF Client& THEN
            PRINT "Host created!"
            DO
                i& = _KEYHIT
                IF i& = 27 THEN EXIT FUNCTION
                Host& = _OPENCONNECTION(Client&)
                _DISPLAY
            LOOP UNTIL Host&
            CLS
            Network = 1
        ELSE
            eee = PlayMIDI&("")
            Destructor "BattleShip.pmf"
            SYSTEM
        END IF
    END IF
END FUNCTION


SUB INICreate (BSound AS _BYTE, ESound AS _BYTE, Edit AS STRING * 4)
    lode = FREEFILE
    OPEN "lode.ini" FOR OUTPUT AS #lode: CLOSE #lode
    OPEN "lode.ini" FOR BINARY AS #lode
    INI.BSound = BSound
    INI.Esound = ESound
    INI.Edit = Edit
    PUT #lode, , INI
    CLOSE #lode
END SUB

SUB InsertShipsManually
    REDIM LodA(15) AS Lod
    DIM shL(1) AS Lod
    SHARED anima
    index = 0
    _AUTODISPLAY
    IF INI.BSound THEN midas
    poloha = 1
    Vycisti_poleA
    CLS
    ResetPalette
    COLOR 14
    textar "Insert ALL ships to water then      click to done or press Esc for quit Right click for ship rotate         R for reset", -10, 1
    COLOR 15
    L1 = 5: L2 = 4: L3 = 3: L4 = 2: L5 = 1: x = 110: y = 60
    oL1 = 5: oL2 = 4: oL3 = 3: oL4 = 2: oL5 = 1
    PCOPY _DISPLAY, 3
    DO UNTIL i& = 27
        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
        DIM pX AS _BYTE, pY AS _BYTE
        FOR navrhy = 1 TO 100 STEP 10
            FOR navrhx = 1 TO 100 STEP 10
                LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 1, BF
                LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 15, B
                LINE (275, 170)-(311, 190), 15, B
                IF complete THEN COLOR 15 ELSE COLOR 19
                _PRINTSTRING (278, 176), "Done"
                COLOR 15


                i& = _KEYHIT
                i$ = INKEY$
                IF i& = 27 THEN menu
                IF LCASE$(i$) = "r" THEN Vycisti_poleA: Vycisti_LodeA: index = 0: REDIM LodA(15) AS Lod: L5 = 1: L4 = 2: L3 = 3: L2 = 4: L1 = 5
                anima = anima + .0005: IF anima > 3 THEN anima = 1
                pX = _CEIL(navrhx / 10): pY = _CEIL(navrhy / 10)
                IF poleA(pX, pY) = 0 THEN
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + navrhx - 5, 1 + y + navrhy - 5: COLOR 15
                ELSE
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 49, BF
                END IF
                IF poleA(pX, pY) = 1 THEN
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 29, BF
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 15, B
                END IF
            NEXT navrhx
            IF navrhy <= 90 THEN textar CHR$(49 + navrhy / 10), 197, 55 + navrhy + 2
            textar CHR$(65 + navrhy / 10), 94 + navrhy + 2, 160
            textar "10", 197, 148
        NEXT navrhy
        Zobraz_Stav 5, 75, 1
        textar STR$(L1) + "x", 40, 129
        textar STR$(L2) + "x", 40, 116
        textar STR$(L3) + "x", 40, 102
        textar STR$(L4) + "x", 40, 89
        textar STR$(L5) + "x", 40, 76
        DO WHILE _MOUSEINPUT
            mx = _MOUSEX: my = _MOUSEY: Lb = _MOUSEBUTTON(1): Rb = _MOUSEBUTTON(2)
            IF mx > 5 AND mx < 55 AND my > 75 AND my < 85 AND Lb = -1 AND L5 > 0 THEN vybrano = 5
            IF mx > 15 AND mx < 55 AND my > 88 AND my < 98 AND Lb = -1 AND L4 > 0 THEN vybrano = 4
            IF mx > 25 AND mx < 55 AND my > 101 AND my < 111 AND Lb = -1 AND L3 > 0 THEN vybrano = 3
            IF mx > 35 AND mx < 55 AND my > 114 AND my < 124 AND Lb = -1 AND L2 > 0 THEN vybrano = 2
            IF mx > 45 AND mx < 55 AND my > 127 AND my < 137 AND Lb = -1 AND L1 > 0 THEN vybrano = 1
            IF vybrano > 1 AND Rb = -1 THEN poloha = poloha * -1: Rb = 0
            IF complete AND Lb = -1 AND mx > 275 AND mx < 311 AND my > 170 AND my < 190 THEN EXIT SUB
        LOOP
        SELECT CASE vybrano '                      BLOK JEN PRO GRAFICKE ZOBRAZENI!   block for graphic view only ---------------------------------

            CASE 1
                LINE (mx - 5, my - 5)-(mx + 5, my + 5), 23, BF: LINE (mx - 5, my - 5)-(mx + 5, my + 5), 15, B
            CASE 2
                IF poloha = 1 THEN
                    FOR delka = mx - 5 TO mx + 5 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 5 TO my + 5 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 3
                IF poloha = 1 THEN
                    FOR delka = mx - 10 TO mx + 10 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 10 TO my + 10 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 4
                IF poloha = 1 THEN
                    FOR delka = mx - 15 TO mx + 15 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 15 TO my + 15 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 5
                IF poloha = 1 THEN
                    FOR delka = mx - 20 TO mx + 20 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 20 TO my + 20 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
        END SELECT
        '------------------------------------------------------------------------------------------------------------------------------------------

        'blok ktery prepocita kam chces lod umistit   this block calculate, if your selected area in manual inserting is valid for ship
        REDIM PnX AS _UNSIGNED _BYTE, PnY AS _UNSIGNED _BYTE
        IF mx > 106 AND mx < 206 AND my > 56 AND my < 156 THEN
            PnX = _CEIL(mx - 101) / 10 'pnx i pny ok
            PnY = _CEIL(my - 51) / 10
            IF vybrano = 1 AND L1 > 0 THEN
                cilX = PnX: cilY = PnY
                IF Lb = -1 AND VolnoA(PnX, PnY) THEN poleA(PnX, PnY) = 1: L1 = L1 - 1
            END IF

            IF vybrano = 2 AND poloha = 1 AND L2 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: L2 = L2 - 1
                END IF
            END IF
            IF vybrano = 2 AND poloha = -1 AND L2 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 THEN
                    IF VolnoA(PnX, PnY) AND VolnoA(PnX, PnY - 1) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: L2 = L2 - 1
                END IF
            END IF


            IF vybrano = 3 AND poloha = 1 AND L3 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 AND PnX + 1 < 11 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: L3 = L3 - 1
                END IF
            END IF
            IF vybrano = 3 AND poloha = -1 AND L3 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 AND PnY + 1 < 11 THEN
                    IF VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY - 1) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: L3 = L3 - 1
                END IF
            END IF


            IF vybrano = 4 AND poloha = 1 AND L4 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 AND PnX + 2 < 11 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) AND VolnoA(PnX + 2, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: poleA(PnX + 2, PnY) = 1: L4 = L4 - 1
                END IF
            END IF
            IF vybrano = 4 AND poloha = -1 AND L4 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 AND PnY + 2 < 11 THEN
                    IF VolnoA(PnX, PnY - 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY + 2) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: poleA(PnX, PnY + 2) = 1: L4 = L4 - 1
                END IF
            END IF

            IF vybrano = 5 AND poloha = 1 AND L5 > 0 THEN
                IF Lb = -1 AND PnX - 2 > 0 AND PnX + 2 < 11 THEN
                    IF VolnoA(PnX - 2, PnY) AND VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) AND VolnoA(PnX + 2, PnY) THEN poleA(PnX - 2, PnY) = 1: poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: poleA(PnX + 2, PnY) = 1: L5 = L5 - 1
                END IF
            END IF
            IF vybrano = 5 AND poloha = -1 AND L5 > 0 THEN
                IF Lb = -1 AND PnY - 2 > 0 AND PnY + 2 < 11 THEN
                    IF VolnoA(PnX, PnY - 2) AND VolnoA(PnX, PnY - 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY + 2) THEN poleA(PnX, PnY - 2) = 1: poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: poleA(PnX, PnY + 2) = 1: L5 = L5 - 1
                END IF
            END IF
            IF L1 = 0 AND L2 = 0 AND L3 = 0 AND L4 = 0 AND L5 = 0 THEN complete = 1 ELSE complete = 0
            textar "Position:" + STR$(PnX) + STR$(PnY), 250, 140

            '            IF opacnychod THEN index = index - 1: opacnychod = 0: GOTO nepricitat
            IF oL1 <> L1 THEN index = index + 1: oL1 = L1: zmena = 1
            IF oL2 <> L2 THEN index = index + 1: oL2 = L2: zmena = 1
            IF oL3 <> L3 THEN index = index + 1: oL3 = L3: zmena = 1
            IF oL4 <> L4 THEN index = index + 1: oL4 = L4: zmena = 1
            IF oL5 <> L5 THEN index = index + 1: oL5 = L5: zmena = 1
            nepricitat:
            IF index < 0 THEN index = 0

            IF index > 15 THEN
                index = 0
                DO UNTIL LodA(index).x = 0 AND LodA(index).y = 0
                    index = index + 1
                LOOP
                zmena = 1
            END IF

            IF zmena THEN
                IF poloha = 1 THEN LodA(index).pos = "X"
                IF poloha = -1 THEN LodA(index).pos = "Y"
                LodA(index).typ = vybrano
                IF vybrano = 1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY
                END IF
                IF vybrano = 2 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 2 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 3 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 3 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 4 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 4 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 5 AND poloha = 1 THEN
                    LodA(index).x = PnX - 2
                    LodA(index).y = PnY
                END IF
                IF vybrano = 5 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 2
                END IF
                vybrano = 0
                zmena = 0
            END IF
        END IF
        _DISPLAY
        _LIMIT 75
        PCOPY 3, _DISPLAY
    LOOP
END SUB


FUNCTION IPinput$ (x AS INTEGER, y AS INTEGER) '                  PRESS ENTER FOR LOCALHOST MODE
    _AUTODISPLAY
    _PRINTSTRING (30, 180), "PRESS ENTER FOR LOCALHOST MODE!"
    LINE (x, y)-(x + 150, y + 35), 18, BF
    LINE (x, y)-(x + 150, y + 35), 15, B
    COLOR , 18
    _PRINTSTRING (x + 35, y + 5), "Insert IP:"
    LOCATE 14, 12: INPUT ip$
    IF ip$ = "" THEN ip$ = "localhost"
    IPinput$ = ip$
END FUNCTION


SUB LanHost
    pass = 0
    FOR aLan = 1 TO 10
        FOR bLan = 1 TO 10
            value = poleA(aLan, bLan) + 1
            PUT #Host, , value
            pass = 0
    NEXT bLan, aLan
    DO UNTIL pass
        GET #Host, , pass
    LOOP

    pass = 1
    FOR PrijemC = 1 TO 10
        FOR prijemCl = 1 TO 10
            DO UNTIL valu
                GET #Host, , valu
                poleB(PrijemC, prijemCl) = valu - 1
            LOOP
            valu = 0
        NEXT prijemCl
    NEXT PrijemC
    PUT #Host, , pass

    pass = 0 'od 5
    prenes_LodA_Host

END SUB

SUB prenes_LodA_Host
    valu = 0: pass = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        LX = LodA(posli).x + 1
        LY = LodA(posli).y + 1
        LS = ASC(LodA(posli).pos)
        LT = LodA(posli).typ + 1
        PUT #Host, , LX
        PUT #Host, , LY
        PUT #Host, , LS
        PUT #Host, , LT
    NEXT posli
    pass = 1
    value = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        GET #Host, , value: LodB(posli).x = value - 1: value = 0
        GET #Host, , value: LodB(posli).y = value - 1: value = 0
        GET #Host, , value: LodB(posli).pos = CHR$(value): value = 0
        GET #Host, , value: LodB(posli).typ = value - 1: value = 0
    NEXT posli
END SUB




SUB LanClient
    value = 0
    pass = 1
    FOR aLan = 1 TO 10
        FOR bLan = 1 TO 10
            DO UNTIL value
                GET #Client, , value
                poleB(aLan, bLan) = value - 1
            LOOP

            value = 0
        NEXT bLan
    NEXT aLan
    PUT #Client, , pass

    FOR poA = 1 TO 10
        FOR poAA = 1 TO 10
            value = poleA(poA, poAA) + 1
            PUT #Client, , value
            value = 0
    NEXT poAA, poA
    DO UNTIL ok
        GET #Client, , ok
    LOOP
    ok = 0

    pass = 0 'od 5
    prenes_LodA_Client
END SUB

SUB prenes_LodA_Client
    valu = 0: pass = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        LX = LodA(posli).x + 1
        LY = LodA(posli).y + 1
        LS = ASC(LodA(posli).pos)
        LT = LodA(posli).typ + 1
        PUT #Client, , LX
        PUT #Client, , LY
        PUT #Client, , LS
        PUT #Client, , LT
    NEXT posli
    pass = 1
    value = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        GET #Client, , value: LodB(posli).x = value - 1: value = 0
        GET #Client, , value: LodB(posli).y = value - 1: value = 0
        GET #Client, , value: LodB(posli).pos = CHR$(value): value = 0
        GET #Client, , value: LodB(posli).typ = value - 1: value = 0
    NEXT posli
END SUB

SUB Constructor (vystup AS STRING) 'extract files from .PMF
    TYPE head2
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        DIM head AS head2
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        IF head.identity = "Petr's MultiFile" THEN ELSE PRINT "Head Failure": SLEEP 3: END
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, 21 + head.much * 4 ' start DATA area
        FOR total = 1 TO head.much
            IF total = 1 THEN velikost& = starts(1) - (21 + head.much * 4) ELSE velikost& = starts(total) - starts(total - 1) 'velikost is SIZE english -
            record$ = SPACE$(velikost&)
            GET #e, , record$
            i = FREEFILE
            jmeno$ = "$Ext" + LTRIM$(STR$(total))
            OPEN jmeno$ FOR OUTPUT AS #i: CLOSE #i: OPEN jmeno$ FOR BINARY AS #i
            PUT #i, , record$
            CLOSE #i
        NEXT total
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
            '    PRINT "File name: "; NameIt; "lenght in bytes is "; NamesLenght(NameIt)
        NEXT NameIt

        CLOSE #i
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            jm$ = "$Ext" + LTRIM$(STR$(Name2))
            erh:
            IF _FILEEXISTS(s$) THEN
                BEEP: INPUT "Warnig! Extracted file the same name already exists!!!! (O)verwrite, (R)ename or (E)xit? "; er$
                SELECT CASE LCASE$(er$)
                    CASE "o": KILL s$: NAME jm$ AS s$
                    CASE "r": INPUT "Input new name"; s$: GOTO erh
                    CASE "e": Destructor "tetris.pmf": SYSTEM
                END SELECT
            ELSE
                NAME jm$ AS s$
            END IF
        NEXT Name2
        CLOSE #e

        FOR ctrl = 1 TO head.much
            nam$ = "$ext" + LTRIM$(STR$(ctrl))
            IF _FILEEXISTS(nam$) THEN KILL nam$
        NEXT ctrl
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB

SUB Destructor (vystup AS STRING) 'delete files created by Constructor
    TYPE head
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        CLOSE
        DIM head AS head
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, starts(head.much) ' start DATA area
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
        NEXT NameIt
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            IF _FILEEXISTS(s$) THEN KILL s$
        NEXT Name2
        CLOSE #e
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB


Upgraded source code - bug in IP dialog. Test in real net - work not! in localhost work! I such why.
« Last Edit: March 31, 2018, 10:40:48 am by Petr »
Coding is relax.

Ashish

  • Hero Member
  • *****
  • Posts: 604
  • Eat.... Sleep.... CODE.... Repeat.....
Re: Battle Ship - Lan or local game
« Reply #1 on: March 31, 2018, 07:14:39 am »
Nice work Petr. I only have one computer, so I can't test it on LAN. :)
if (Me.Success) {Me.Improve();} else {Me.TryAgain();}

aKFrameWork - http://bit.ly/aKFrameWork
p5js.bas - http://bit.ly/p5jsbas
Menu System - http://bit.ly/guiMenuBar

OpenGL Demos - http://bit.ly/openGLdemos

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #2 on: March 31, 2018, 07:20:32 am »
Hi Ashish. You can. Run two copyes from diferent directories, in menu select lan game and in client window in IP dialog insert none IP but press enter. Game then start in localhost mode.
Coding is relax.

bplus

  • Hero Member
  • *****
  • Posts: 756
  • B = B + _
Re: Battle Ship - Lan or local game
« Reply #3 on: March 31, 2018, 08:01:59 am »
Hi Petr,

I haven't checked out the code yet, but I have to say what you are doing here is fabulous!

Thumbs up to you man!
Will you still love me, will you still need me, when I'm (QB) 64?

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #4 on: March 31, 2018, 09:51:56 am »
Hi Bplus!
 Thank you. It was a huge challenge for me. Now we can play ships on the net with a daughter. Actually, it occurred me in time, when I had a version of a human vs. computer this game already completed. At that time, Ashish released his demo, where he sent circles through the localhost. It occurred to me that this game over the network was much better. I encountered many problems because I was working with the network for the first time. Johny B help helped me in beginners help forum, so as Ashish program.
I would also like to tell developers that I appreciate this huge opportunity to write network games. It's perfect.  :)
Coding is relax.

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #5 on: March 31, 2018, 01:06:38 pm »
So i thing, that muss be bug in QB64. NETWORK game lines 229 - 421 in source.

I do not understand why data traffic behaves in localhost mode other than in the actual network. What is stable in localhost does not work at all on the network. Here is a version that works partially in real network. The state of enemy ships that have been transferred completely without any problems in the localhost mode are not transmitted for unknown reasons in the network at all. In the middle of the game, the data being sent is somewhere in the way and the counterparty freezes in anticipation of the opponent's turn. The fact that the game will behave differently than in the localhost mode is very crazy for me. The fact that the data sent to the other party is not transmitted during the transmission is also striking. Next experimenting tommorrow.  ::)

Code: [Select]
'WARNING! For Lan game in LOCALHOST mode please use two different directories, copy game files in and start then both programs. Fullscreen is not locked, use Alt + ENTER for window switching.
'or use two computers :-D
'of course you can play in offline mode with computer :-D

Constructor "BattleShip.pmf"
StartLan = 1
TYPE setup
    BSound AS _BYTE 'sound in background
    Esound AS _BYTE 'sound effects
    Edit AS STRING * 4 'if you need your boats insert manually, goto menu / setup click to INSERT SHIPS MANUALLY, then goto menu / set game type, select game type and start it.
END TYPE

DIM SHARED INI AS setup
inistart:
IF _FILEEXISTS("lode.ini") THEN
    iniF = FREEFILE
    OPEN "lode.ini" FOR BINARY AS #iniF
    GET #iniF, , INI
    CLOSE #iniF
ELSE INICreate 1, 1, "AUTO"
    GOTO inistart
END IF

TYPE MIDI
    Song AS STRING * 5
    Lenght AS SINGLE
END TYPE
DIM SHARED MIDI(3) AS MIDI, MIDposition
MIDI(1).Song = "y.mid": MIDI(1).Lenght = 126 '                       real midi sound lenght
MIDI(2).Song = "g.mid": MIDI(2).Lenght = 181
MIDI(3).Song = "k.mid": MIDI(3).Lenght = 413
MIDposition = 1

DIM SHARED Lan, Host AS LONG, Client AS LONG
DIM SHARED poleA(1 TO 10, 1 TO 10) AS _BYTE '                        players array
DIM SHARED poleB(1 TO 10, 1 TO 10) AS _BYTE '                        enemy array
DIM SHARED exploze(7) AS LONG
TYPE Lod '                                                           array LodA contains informations about number, type and positions your boats, LodB is the same for enemy. This is later used for calculating damaged boats.
    pos AS STRING * 1
    typ AS _BYTE
    x AS _BYTE
    y AS _BYTE
END TYPE
REDIM SHARED LodA(15) AS Lod, Typ, GenX AS _BYTE, GenY AS _BYTE, PaletteSave(255) AS LONG
REDIM SHARED LodB(15) AS Lod, Pocty(10) AS _BYTE, Sn(1) AS STRING, Frames, Big
DIM pX AS INTEGER, pY AS INTEGER
REDIM prijemX AS _BYTE, prijemY AS _BYTE

'arrays LodA and PoleA are for player, LodB and PoleB for enemy or computer

DECLARE DYNAMIC LIBRARY "playmidi32" '                                see to wiki for more info
    FUNCTION PlayMIDI& (filename AS STRING)
END DECLARE



Vycisti_poleA
a = -1: B = -1: C = -1: d = -1: e = -1



SCREEN 13: _FULLSCREEN '                                                comment fullscreen if you try localhost lan game

SavePalette



i32to256 "lod0.gif", 0, 30
Big = reader("LODE.PBF") '
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15
noplay:
menu
'settings restart --------------
xx = FREEFILE
OPEN "lode.ini" FOR BINARY AS #xx
GET #xx, , INI
CLOSE #xx
'-------------------------------
i32to256 "lod0.gif", 0, 30 '                                            this sub again transform 32 bit loaded image to 256 color screen
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15


DO UNTIL Typ > 0 AND Typ < 4
    RANDOMIZE TIMER
    Typ = INT(RND * 4)
LOOP
uvod = 1


GameRestart:
_KEYCLEAR: _AUTODISPLAY
'initPlayer
CLS


ResetPalette '                                                           set color palette to original values

IF INI.Edit = "AUTO" THEN '                                              set this values in menu / setup. AUTO is for autogenerating boats on the map, MANU if boats are inserted manually
    initPlayer
    Show_Area
    DO WHILE i$ <> CHR$(13)
        i$ = INKEY$
        IF i$ = CHR$(27) THEN _KEYCLEAR: GOTO noplay
        COLOR 14
        textar "Press enter for select map or", -6, 1
        textar "SPACE key for generate map", -6, 12

        COLOR 15
        DO UNTIL Typ > 0 AND Typ < 4
            RANDOMIZE TIMER
            Typ = INT(RND * 4)
        LOOP

        SELECT CASE i$
            CASE " "
                Vycisti_poleA
                Vycisti_LodeA
                initPlayer
                Show_Area
                Typ = 0
        END SELECT
    LOOP
END IF



CLS
uvod = 0
i32to256 "lod0.gif", 0, 30
COLOR 40: textar "BATTLE SHIP", 110, 60: COLOR 15




' ---------------------- Generate Computers Ships --------------------------------------
IF INI.Edit = "MANU" THEN InsertShipsManually
initComputer
Show_Area

REDIM posX AS _BYTE, posY AS _BYTE
posX = 1: posY = 1: player = 1
CLS
ResetPalette
Zobraz_Stav 40, 135, 0
Zobraz_Stav 221, 135, 1

COLOR 15
FOR popisky = 1 TO 10 'draw 1 to 10 and A - J to maps
    znak = 64 + popisky
    textar CHR$(znak), 3 + (10 * popisky), 22: textar CHR$(znak), 172 + (10 * popisky), 22 'HORNI!
    IF popisky < 10 THEN textar (STR$(popisky)), -10, 22 + popisky * 10: textar (STR$(popisky)), 161, 22 + popisky * 10 ELSE textar (STR$(popisky)), -16, 22 + popisky * 10: textar (STR$(popisky)), 154, 22 + popisky * 10
NEXT popisky

PCOPY _DISPLAY, 1


DIM Mx, My, Lb, vvv

DO
    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
    IF komplet THEN komplet = 0: GOTO GameRestart
    invalid:
    i& = _KEYHIT
    IF i& = 27 THEN menu
    vvv = _MOUSEINPUT
    Mx = _MOUSEX
    My = _MOUSEY
    Lb = _MOUSEBUTTON(1)
    '    CLS
    PCOPY 1, _DISPLAY
    Pocty_Lodi
    textar STR$(Pocty(5)), 10, 136
    textar STR$(Pocty(4)), 10, 150
    textar STR$(Pocty(3)), 10, 163
    textar STR$(Pocty(2)), 10, 176
    textar STR$(Pocty(1)), 10, 189
    textar STR$(Pocty(10)), 255, 136
    textar STR$(Pocty(9)), 255, 150
    textar STR$(Pocty(8)), 255, 163
    textar STR$(Pocty(7)), 255, 176
    textar STR$(Pocty(6)), 255, 189
    IF INI.BSound THEN midas
    SELECT CASE Lan
        CASE 0 'NO LAN GAME
            SELECT CASE player
                CASE 1
                    _MOUSESHOW
                    COLOR 14: textar " Human Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                    END IF
                    IF posX < 1 THEN posX = 1
                    IF posY < 1 THEN posY = 1
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1
                    IF Lb = -1 THEN _MOUSEHIDE
                    IF Lb = -1 AND poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid
                    IF Lb = -1 AND poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: player = 0
                    IF Lb = -1 AND poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: player = 0
                    Show_Area
                    Show_B_Area
                CASE 0
                    secondly:
                    generX = 0: generY = 0
                    _MOUSEHIDE
                    COLOR 14: textar "Computer Play", 100, 1: COLOR 15
                    RANDOMIZE TIMER
                    DO UNTIL generX > 0 AND generX < 11
                        generX = CINT(RND * 10)
                    LOOP
                    RANDOMIZE TIMER
                    DO UNTIL generY > 0 AND generY < 11
                        generY = CINT(RND * 10)
                    LOOP

                    IF poleA(generX, generY) = 2 OR poleA(generX, generY) = 3 THEN GOTO secondly
                    info$ = "Fire to:" + LTRIM$(STR$(generY) + LTRIM$(CHR$(64 + generX)) + "  ")
                    textar info$, 1, 1
                    IF poleA(generX, generY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(generX, generY) = 2: player = 1
                    IF poleA(generX, generY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(generX, generY) = 3: player = 1
                    Show_Area
                    Show_B_Area
            END SELECT '                              for player select - human or computer

            '=============================Down is========================= 1 = HOST, 2 = CLIENT, writed for ONE CLIENT ==============================

        CASE -1: PRINT "Connection error.": BEEP: BEEP: menu ' NENI OTESTOVANO JAK SE TO BUDE CHOVAT V MENU!
        CASE 1 'HOST (SERVER)
            _TITLE "host"

            DO
                Lb = 0
                _KEYCLEAR
                i& = _KEYHIT
                IF i& = 27 THEN menu
                WHILE _MOUSEINPUT
                    Mx = _MOUSEX
                    My = _MOUSEY
                    Lb = _MOUSEBUTTON(1)
                WEND
                PCOPY 1, _DISPLAY
                Pocty_Lodi
                textar STR$(Pocty(5)), 10, 136
                textar STR$(Pocty(4)), 10, 150
                textar STR$(Pocty(3)), 10, 163
                textar STR$(Pocty(2)), 10, 176
                textar STR$(Pocty(1)), 10, 189
                textar STR$(Pocty(10)), 255, 136
                textar STR$(Pocty(9)), 255, 150
                textar STR$(Pocty(8)), 255, 163
                textar STR$(Pocty(7)), 255, 176
                textar STR$(Pocty(6)), 255, 189

                IF firstRun = 0 THEN LanHost: firstRun = 1: HOSTPLAY = 1: Lb = 0
                'HOST play first
                IF INI.BSound THEN midas
                IF HOSTPLAY THEN
                    _MOUSESHOW
                    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                    COLOR 14: textar " Host Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                        IF posX < 1 THEN posX = 1
                        IF posY < 1 THEN posY = 1
                        IF Lb = -1 THEN
                            Lb = 0
                            _MOUSEHIDE
                            IF poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid
                            IF posX > 10 OR posX < 1 OR posY > 10 OR posY < 1 THEN STOP 'test input value, so if program run, then value muss be correct.


                            PUT #Host&, , NULL
                            PUT #Host&, , NULL
                            PUT #Host&, , posX
                            PUT #Host&, , posY


                            IF poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: HOSTPLAY = 0
                            IF poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: HOSTPLAY = 0
                            HOSTPLAY = 0
                            prevzal = 0

                        END IF
                    END IF
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1
                    Show_Area
                    Show_B_Area
                    IF OverTest THEN menu
                ELSE
                    _MOUSEHIDE
                    prijemX = 0: prijemY = 0
                    DO
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        i$ = INKEY$
                        IF i$ = CHR$(32) THEN BEEP: PRINT prijemX, prijemY 'manual bug test, if program wait to values   -  its from developing times
                        IF i$ = CHR$(27) THEN menu


                        IF prijemX < 1 THEN GET #Host&, , prijemX 'missing IF conditions in this place caused me really BIG problems. One month for such this bug.
                        IF prijemY < 1 THEN GET #Host&, , prijemY ' basic value in REAL NETWORK is -127. Why for hell?

                        IF prijemX THEN LOCATE 1, 1: PRINT prijemX: _DISPLAY

                        COLOR 14: textar " Host wait   ", 100, 1: COLOR 15
                        Show_Area
                        Show_B_Area
                        _DISPLAY
                        IF prijemX > 0 AND prijemY > 0 THEN EXIT DO
                    LOOP
                    IF prijemX > 0 AND prijemX < 11 AND prijemY > 0 AND prijemY < 11 THEN
                        IF poleA(prijemX, prijemY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(prijemX, prijemY) = 2: HOSTPLAY = 1
                        IF poleA(prijemX, prijemY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(prijemX, prijemY) = 3: HOSTPLAY = 1
                        REM          ELSE SOUND 350, 1: STOP ' For unknown bug
                    END IF
                END IF
                _DISPLAY
                IF OverTest THEN menu
            LOOP

        CASE 2 'CLIENT
            _TITLE "client"

            DO
                i& = _KEYHIT
                IF i& = 27 THEN menu
                WHILE _MOUSEINPUT
                    Mx = _MOUSEX
                    My = _MOUSEY
                    Lb = _MOUSEBUTTON(1)
                WEND
                PCOPY 1, _DISPLAY
                Pocty_Lodi
                textar STR$(Pocty(5)), 10, 136
                textar STR$(Pocty(4)), 10, 150
                textar STR$(Pocty(3)), 10, 163
                textar STR$(Pocty(2)), 10, 176
                textar STR$(Pocty(1)), 10, 189
                textar STR$(Pocty(10)), 255, 136
                textar STR$(Pocty(9)), 255, 150
                textar STR$(Pocty(8)), 255, 163
                textar STR$(Pocty(7)), 255, 176
                textar STR$(Pocty(6)), 255, 189

                IF firstRun = 0 THEN LanClient: firstRun = 1: CLIENTPLAY = 0: Lb = 0
                IF INI.BSound THEN midas

                IF CLIENTPLAY THEN
                    _MOUSESHOW
                    IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                    COLOR 14: textar " Client Play  ", 100, 1: COLOR 15
                    IF Mx >= 190 AND Mx <= 290 AND My >= 30 AND My <= 130 THEN
                        posX = .4 + INT(Mx - 190) / 10
                        posY = .4 + INT(My - 30) / 10
                        IF posX < 1 THEN posX = 1
                        IF posY < 1 THEN posY = 1

                        IF Lb = -1 THEN
                            Lb = 0
                            _MOUSEHIDE
                            IF poleB(posX, posY) = 2 OR Lb = -1 AND poleB(posX, posY) = 3 THEN GOTO invalid

                            'error detection
                            IF posX > 10 OR posX < 1 OR posY > 10 OR posY < 1 THEN STOP


                            PUT #Client&, , NULL
                            PUT #Client&, , NULL
                            PUT #Client&, , posX
                            PUT #Client&, , posY


                            IF poleB(posX, posY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleB(posX, posY) = 2: CLIENTPLAY = 0
                            IF poleB(posX, posY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleB(posX, posY) = 3: CLIENTPLAY = 0
                            CLIENTPLAY = 0
                            oka = 0

                        END IF
                    END IF
                    info$ = "Fire to:" + LTRIM$(STR$(posY) + LTRIM$(CHR$(64 + posX)) + "  ")
                    textar info$, 1, 1

                    Show_Area
                    Show_B_Area
                    IF OverTest THEN menu
                ELSE
                    _MOUSEHIDE
                    COLOR 14: textar " Client wait   ", 100, 1: COLOR 15
                    REDIM p AS _BYTE
                    prijemX = 0: prijemY = 0: p = 1
                    'BEEP

                    DO
                        i$ = INKEY$
                        IF i$ = CHR$(32) THEN BEEP: PRINT prijemX, prijemY ' manual test - program wait to values!
                        IF i$ = CHR$(27) THEN menu
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        Show_Area
                        Show_B_Area
                        _DISPLAY


                        IF prijemX < 1 THEN GET #Client&, , prijemX
                        IF prijemY < 1 THEN GET #Client&, , prijemY

                        IF prijemX THEN LOCATE 1, 1: PRINT prijemX: _DISPLAY


                        IF prijemX > 0 AND prijemY > 0 THEN EXIT DO '       valid condition
                    LOOP
                    IF prijemX >= 1 AND prijemX <= 10 AND prijemY >= 1 AND prijemY <= 10 THEN
                        IF poleA(prijemX, prijemY) = 1 THEN DO UNTIL zvuk(1): LOOP: poleA(prijemX, prijemY) = 2: CLIENTPLAY = 1
                        IF poleA(prijemX, prijemY) = 0 THEN DO UNTIL zvuk(2): LOOP: poleA(prijemX, prijemY) = 3: CLIENTPLAY = 1
                        REM    ELSE SOUND 350, 1: STOP ' for unknown bug
                    END IF
                END IF
                _DISPLAY
                IF OverTest THEN menu
            LOOP
            '======================================================================================================================================================






    END SELECT 'pro LAN typ hry
    A_OK = 0: B_OK = 0

    IF OverTest THEN menu
    _LIMIT 180
    _DISPLAY
LOOP




FUNCTION OverTest
    SHARED Lan
    OverTest = 0
    FOR controlA = 1 TO 10
        FOR controlB = 1 TO 10
            IF poleA(controlA, controlB) = 1 THEN A_OK = 1
            IF poleB(controlA, controlB) = 1 THEN B_OK = 1
        NEXT
    NEXT

    IF A_OK = 0 THEN
        ResetPalette
        CLS
        i32to256 "lod4.gif", 0, 20
        IF Lan = 0 THEN
            COLOR 40: textar "Computer WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1
        ELSE
            SELECT CASE Lan
                CASE 1
                    COLOR 40: textar "CLIENT WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Host&
                CASE 2
                    COLOR 40: textar "HOST WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Client&
            END SELECT
        END IF
    END IF


    IF B_OK = 0 THEN
        ResetPalette
        CLS
        i32to256 "lod3.gif", 35, 0
        IF Lan = 0 THEN
            COLOR 40: textar "Human WIN", 120, 10: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1
        ELSE
            SELECT CASE Lan
                CASE 1
                    COLOR 40: textar "HOST WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Host&: Lan = 0
                CASE 2
                    COLOR 40: textar "CLIENT WIN", 110, 90: _DISPLAY: SLEEP: Vycisti_poleA: Vycisti_poleB: komplet = 1: OverTest = 1: CLOSE #Client&: Lan = 0
            END SELECT
        END IF
    END IF
END FUNCTION


SUB cil (x AS _BYTE, y AS _BYTE)
    SHARED player
    IF player = 1 THEN EXIT SUB
    LINE (20 + (10 * (x - 1)) + 3, 30 + (10 * (y - 1)) + 3)-(30 + (10 * (x - 1) - 1), 40 + (10 * (y - 1) - 1)), 14, BF
END SUB



SUB midas
    SHARED midResult, midTimer, midName$, MIDposition 'this is not very good example for programming....
    IF midTimer > TIMER THEN
        EXIT SUB
    ELSE
        result = PlayMIDI("" + CHR$(0)) 'stop
        MIDposition = MIDposition + 1
        IF MIDposition > UBOUND(midi) THEN MIDposition = 1
        midTimer = TIMER + MIDI(MIDposition).Lenght: midName$ = MIDI(MIDposition).Song
        result = PlayMIDI(midName$ + CHR$(0))
        IF result THEN PRINT "Error. Playmidi32.dll not found, background music will not played."
    END IF
END SUB

FUNCTION zvuk (co AS _BYTE)
    SHARED generX, generY, Splash&, exploz
    IF exploze(0) = 0 THEN
        exploze(0) = _SNDOPEN("explode0.mp3")
        exploze(1) = _SNDOPEN("explode1.mp3")
        exploze(2) = _SNDOPEN("explode2.mp3")
        exploze(3) = _SNDOPEN("explode3.mp3")
        exploze(4) = _SNDOPEN("explode4.mp3")
        exploze(5) = _SNDOPEN("explode5.mp3")
        exploze(6) = _SNDOPEN("explode6.mp3")
        exploze(7) = _SNDOPEN("explode7.mp3")
        Splash& = _SNDOPEN("splash.mp3"): IF INI.Esound = 0 THEN _SNDVOL (Splash&), 0 ELSE _SNDVOL (Splash&), 1
    END IF

    '1 lod, 2 voda         1 boat, 2 water

    'for online
    IF Lan THEN
        exploz = exploz + 1: IF exploz > 7 THEN exploz = 0
        GOTO NO_RANDOM
    END IF

    ' for offline
    exploz = -1
    DO UNTIL exploz > -1 AND exploz < 8
        RANDOMIZE TIMER
        exploz = INT(RND + RND * 5)
    LOOP

    NO_RANDOM:
    IF INI.Esound = 0 THEN _SNDVOL exploze(exploz), 0 'this solution is best for tha same time duration after fire with and without sound
    _SNDPLAY exploze(exploz)
    DO WHILE _SNDPLAYING(exploze(exploz)): Show_Area: Show_B_Area: cil generX, generY:: _DISPLAY: LOOP
    _SNDSTOP exploze(exploz)

    IF co = 2 THEN
        _SNDPLAY Splash&
        DO WHILE _SNDPLAYING(Splash&): Show_Area: Show_B_Area: cil generX, generY:: _DISPLAY: LOOP
        _SNDSTOP Splash&
    END IF
    zvuk = 1
END FUNCTION



SUB Zobraz_Stav (x AS INTEGER, y AS INTEGER, typ) 'draw boats flags
    oldY = y
    SELECT CASE typ
        CASE 0

            FOR G = 1 TO 5
                FOR f = 1 TO 50 - I STEP 10
                    LINE (x + f, y)-(x + f + 10, y + 10), 23, BF
                    LINE (x + f, y)-(x + f + 10, y + 10), 15, B
                NEXT f
                I = I + 10
                y = y + 13
            NEXT G

        CASE 1
            I = 0: y = oldY
            FOR G = 1 TO 5
                FOR f = 40 TO I STEP -10
                    LINE (x + f, y)-(x + f + 10, y + 10), 23, BF
                    LINE (x + f, y)-(x + f + 10, y + 10), 15, B
                NEXT f
                I = I + 10
                y = y + 13
            NEXT G
    END SELECT
END SUB




SUB Pocty_Lodi 'calculate number of boats
    death1 = 0: death2 = 0: death3 = 0: death4 = 0: death5 = 0
    FOR Lode = 1 TO 10
        FOR lodf = 1 TO 10
            FOR L = 1 TO UBOUND(loda)
                IF LodA(L).typ = 1 AND LodA(L).x = Lode AND LodA(L).y = lodf AND poleA(Lode, lodf) > 1 THEN death1 = death1 + 1
                SELECT CASE LodA(L).typ
                    CASE 2
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 THEN death2 = death2 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 THEN death2 = death2 + 1
                            END SELECT
                        END IF



                    CASE 3
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 THEN death3 = death3 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 THEN death3 = death3 + 1
                            END SELECT
                        END IF


                    CASE 4
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 AND poleA(3 + LodA(L).x, LodA(L).y) > 1 THEN death4 = death4 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 AND poleA(LodA(L).x, 3 + LodA(L).y) > 1 THEN death4 = death4 + 1
                            END SELECT
                        END IF



                    CASE 5
                        IF LodA(L).x = Lode AND LodA(L).y = lodf THEN
                            SELECT CASE LodA(L).pos
                                CASE "X"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(1 + LodA(L).x, LodA(L).y) > 1 AND poleA(2 + LodA(L).x, LodA(L).y) > 1 AND poleA(3 + LodA(L).x, LodA(L).y) > 1 AND poleA(4 + LodA(L).x, LodA(L).y) > 1 THEN death5 = death5 + 1
                                CASE "Y"
                                    IF poleA(LodA(L).x, LodA(L).y) > 1 AND poleA(LodA(L).x, 1 + LodA(L).y) > 1 AND poleA(LodA(L).x, 2 + LodA(L).y) > 1 AND poleA(LodA(L).x, 3 + LodA(L).y) > 1 AND poleA(LodA(L).x, 4 + LodA(L).y) > 1 THEN death5 = death5 + 1
                            END SELECT
                        END IF
                END SELECT

    NEXT L, lodf, Lode
    Pocty(1) = 5 - death1
    Pocty(2) = 4 - death2
    Pocty(3) = 3 - death3
    Pocty(4) = 2 - death4
    Pocty(5) = 1 - death5



    death1 = 0: death2 = 0: death3 = 0: death4 = 0: death5 = 0
    FOR Lode = 1 TO 10
        FOR lodf = 1 TO 10
            FOR L = 1 TO UBOUND(lodb)
                IF LodB(L).typ = 1 AND LodB(L).x = Lode AND LodB(L).y = lodf AND poleB(Lode, lodf) > 1 THEN death1 = death1 + 1
                SELECT CASE LodB(L).typ
                    CASE 2
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 THEN death2 = death2 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 THEN death2 = death2 + 1
                            END SELECT
                        END IF



                    CASE 3
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 THEN death3 = death3 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 THEN death3 = death3 + 1
                            END SELECT
                        END IF


                    CASE 4
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 AND poleB(3 + LodB(L).x, LodB(L).y) > 1 THEN death4 = death4 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 AND poleB(LodB(L).x, 3 + LodB(L).y) > 1 THEN death4 = death4 + 1
                            END SELECT
                        END IF



                    CASE 5
                        IF LodB(L).x = Lode AND LodB(L).y = lodf THEN
                            SELECT CASE LodB(L).pos
                                CASE "X"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(1 + LodB(L).x, LodB(L).y) > 1 AND poleB(2 + LodB(L).x, LodB(L).y) > 1 AND poleB(3 + LodB(L).x, LodB(L).y) > 1 AND poleB(4 + LodB(L).x, LodB(L).y) > 1 THEN death5 = death5 + 1
                                CASE "Y"
                                    IF poleB(LodB(L).x, LodB(L).y) > 1 AND poleB(LodB(L).x, 1 + LodB(L).y) > 1 AND poleB(LodB(L).x, 2 + LodB(L).y) > 1 AND poleB(LodB(L).x, 3 + LodB(L).y) > 1 AND poleB(LodB(L).x, 4 + LodB(L).y) > 1 THEN death5 = death5 + 1
                            END SELECT
                        END IF
                END SELECT

    NEXT L, lodf, Lode

    Pocty(6) = 5 - death1
    Pocty(7) = 4 - death2
    Pocty(8) = 3 - death3
    Pocty(9) = 2 - death4
    Pocty(10) = 1 - death5
END SUB

SUB Vycisti_poleA
    FOR x = 1 TO 10
        FOR y = 1 TO 10
            poleA(x, y) = 0
    NEXT y, x
END SUB

SUB Vycisti_LodeA 'uvolni lodni pole
    REDIM LodA(0) AS Lod
END SUB


SUB Vycisti_poleB
    FOR x = 1 TO 10
        FOR y = 1 TO 10
            poleB(x, y) = 0
    NEXT y, x
END SUB

SUB Vycisti_LodeB 'uvolni lodni pole
    REDIM LodB(0) AS Lod
END SUB




SUB Show_Area
    SHARED anima, uvod
    y2 = 0
    FOR y = 1 TO 100 STEP 10
        y2 = y2 + 1
        FOR x = 1 TO 100 STEP 10
            x2 = x2 + 1
            TypLodi = 0
            barva = 0
            FOR B = 0 TO 15
                IF LodA(B).x = x2 AND LodA(B).y = y2 THEN TypLodi = LodA(B).typ: EXIT FOR
                IF x2 >= LodA(B).x AND LodA(B).pos = "X" AND x2 <= LodA(B).typ + LodA(B).x AND y2 = LodA(B).y THEN TypLodi = LodA(B).typ: EXIT FOR
                IF y2 >= LodA(B).y AND LodA(B).pos = "Y" AND y2 <= LodA(B).typ + LodA(B).y AND x2 = LodA(B).x THEN TypLodi = LodA(B).typ: EXIT FOR
            NEXT B
            SELECT CASE TypLodi
                CASE 0: barva = 60
                CASE 1: barva = 22
                CASE 2: barva = 23
                CASE 3: barva = 24
                CASE 4: barva = 25
                CASE 5: barva = 26
            END SELECT
            SELECT CASE poleA(x2, y2)
                CASE 0 '                                                                                             VODA
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 1, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                    anima = anima + .0001: IF anima > 3 THEN anima = 1
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                CASE 1 '                                                                                             LOD
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), barva, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                CASE 2 '                                                                                             Zasah lod
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), 5, BF
                    LINE (x + 20 + m, y + 30 + m)-(x + 30 + m, y + 40 + m), 15, B
                    COLOR 38 + anima: rozpis 40 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                CASE 3 '                                                                                             Zasah voda
                    LINE (x + 20 + 1, y + 40 - 1)-(x + 30 - 1, y + 30 + 1), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 20, 1 + y + 30: COLOR 15
                    LINE (x + 20 + 1, y + 30 + 1)-(x + 30 - 1, y + 40 - 1), 15
                    LINE (x + 20 + 1, y + 40 - 1)-(x + 30 - 1, y + 30 + 1), 15
                    LINE (x + 20, y + 30)-(x + 30, y + 40), 15, B
            END SELECT

        NEXT x
        x2 = 0
        IF uvod = 0 THEN
        END IF
    NEXT y
END SUB



SUB Show_B_Area
    SHARED anima
    x2 = 0: y2 = 0
    FOR y = 1 TO 100 STEP 10
        y2 = y2 + 1
        FOR x = 1 TO 100 STEP 10
            x2 = x2 + 1
            TypLodi = 0
            barva = 0
            FOR B = 1 TO 15
                IF x2 >= LodB(B).x AND LodB(B).pos = "X" AND x2 <= LodB(B).typ + LodB(B).x AND y2 = LodB(B).y THEN TypLodi = LodB(B).typ: EXIT FOR
                IF y2 >= LodB(B).y AND LodB(B).pos = "Y" AND y2 <= LodB(B).typ + LodB(B).y AND x2 = LodB(B).x THEN TypLodi = LodB(B).typ: EXIT FOR
            NEXT B
            SELECT CASE TypLodi
                CASE 1: barva = 22
                CASE 2: barva = 23
                CASE 3: barva = 24
                CASE 4: barva = 25
                CASE 5: barva = 26
            END SELECT
            m = 0
            SELECT CASE poleB(x2, y2)
                CASE 0 '                                                                  voda na pozici   Water on position
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 1 '                                                                  lod na pozici
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 1, BF '                      Rewrite 1  before ,BF to show enemy boats.
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 2 '                                                                  zasah lode       Boat damage
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 5, BF
                    COLOR 38 + anima: rozpis 40 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
                CASE 3
                    LINE (x + 190 + 1, y + 40 - 1)-(x + 200 - 1, y + 30 + 1), 1, BF
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + 190, 1 + y + 30: COLOR 15
                    LINE (x + 190 + 1, y + 30 + 1)-(x + 200 - 1, y + 40 - 1), 15
                    LINE (x + 190 + 1, y + 40 - 1)-(x + 200 - 1, y + 30 + 1), 15
                    LINE (x + 190 + m, y + 30 + m)-(x + 200 + m, y + 40 + m), 15, B
            END SELECT
        NEXT x
        x2 = 0
    NEXT y
END SUB

FUNCTION Rozmisti_lodeX (rozmisti AS _BYTE)
    T = TIMER + .2
    index = UBOUND(LodA)
    SELECT CASE rozmisti
        CASE 1
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoA(GenX, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1 + lod) AS Lod
                    LodA(index + 1 + lod).pos = "X": LodA(index + 1 + lod).typ = 1: LodA(index + 1 + lod).x = GenX: LodA(index + 1 + lod).y = GenY
                    poleA(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 2
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 2: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY
                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 3
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 3: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY
                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) AND VolnoA(GenX + 3, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 4: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: poleA(GenX + 3, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP
        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5

                REDIM _PRESERVE A5(lod, GenX TO GenX + 5, GenY) AS _BYTE

                IF VolnoA(GenX, GenY) AND VolnoA(GenX + 1, GenY) AND VolnoA(GenX + 2, GenY) AND VolnoA(GenX + 3, GenY) AND VolnoA(GenX + 4, GenY) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "X": LodA(index + 1).typ = 5: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY


                    poleA(GenX, GenY) = 1: poleA(GenX + 1, GenY) = 1: poleA(GenX + 2, GenY) = 1: poleA(GenX + 3, GenY) = 1: poleA(GenX + 4, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeX = 1: EXIT FUNCTION
            LOOP
    END SELECT
END FUNCTION




FUNCTION Rozmisti_B_lodeX (rozmisti AS _BYTE)
    GenX = 0: GenY = 0
    T = TIMER + .2 'time limit for genarating
    index = UBOUND(LodB)
    lod = 0
    SELECT CASE rozmisti
        CASE 1
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoB(GenX, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1 + lod) AS Lod
                    LodB(index + 1 + lod).pos = "X": LodB(index + 1 + lod).typ = 1: LodB(index + 1 + lod).x = GenX: LodB(index + 1 + lod).y = GenY
                    poleB(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 2: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 3: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) AND VolnoB(GenX + 3, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 4: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: poleB(GenX + 3, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP
        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoB(GenX, GenY) AND VolnoB(GenX + 1, GenY) AND VolnoB(GenX + 2, GenY) AND VolnoB(GenX + 3, GenY) AND VolnoB(GenX + 4, GenY) THEN
                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "X": LodB(index + 1).typ = 5: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX + 1, GenY) = 1: poleB(GenX + 2, GenY) = 1: poleB(GenX + 3, GenY) = 1: poleB(GenX + 4, GenY) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeX = 1: EXIT FUNCTION
            LOOP
    END SELECT
END FUNCTION



FUNCTION Rozmisti_lodeY (rozmisti AS _BYTE)
    T = TIMER + .2
    index = UBOUND(lodA)
    SELECT CASE rozmisti
        CASE 1
            'JEDNICKA lod
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen
                IF VolnoA(GenX, GenY) THEN
                    REDIM _PRESERVE LodA(index + 1 + lod) AS Lod
                    LodA(index + 1 + lod).pos = "Y": LodA(index + 1 + lod).typ = 1: LodA(index + 1 + lod).x = GenX: LodA(index + 1 + lod).y = GenY
                    poleA(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2


                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 2: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3

                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 3: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) AND VolnoA(GenX, GenY + 3) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 4: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY

                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: poleA(GenX, GenY + 3) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
            LOOP


        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoA(GenX, GenY) AND VolnoA(GenX, GenY + 1) AND VolnoA(GenX, GenY + 2) AND VolnoA(GenX, GenY + 3) AND VolnoA(GenX, GenY + 4) THEN

                    REDIM _PRESERVE LodA(index + 1) AS Lod
                    LodA(index + 1).pos = "Y": LodA(index + 1).typ = 5: LodA(index + 1).x = GenX: LodA(index + 1).y = GenY


                    poleA(GenX, GenY) = 1: poleA(GenX, GenY + 1) = 1: poleA(GenX, GenY + 2) = 1: poleA(GenX, GenY + 3) = 1: poleA(GenX, GenY + 4) = 1: lod = lod + 1
                END IF
            LOOP
            IF TIMER > T THEN Rozmisti_lodeY = 1: EXIT FUNCTION
    END SELECT
END FUNCTION

FUNCTION Rozmisti_B_lodeY (rozmisti AS _BYTE)
    GenX = 0: GenY = 0
    T = TIMER + .2
    index = UBOUND(lodB)
    SELECT CASE rozmisti
        CASE 1
            'JEDNICKA lod
            DO WHILE lod < 5
                gen:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 10 OR GenX < 1 OR GenY > 10 OR GenY < 1 THEN GOTO gen

                IF VolnoB(GenX, GenY) THEN

                    REDIM _PRESERVE LodB(index + 1 + lod) AS Lod
                    LodB(index + 1 + lod).pos = "Y": LodB(index + 1 + lod).typ = 1: LodB(index + 1 + lod).x = GenX: LodB(index + 1 + lod).y = GenY

                    poleB(GenX, GenY) = 1: lod = lod + 1
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 2
            'DVOJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen2:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 9 OR GenX < 1 OR GenY > 9 OR GenY < 1 THEN GOTO gen2


                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 2: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 3
            'TROJKA LOD
            lod = 0
            DO WHILE lod < 1
                gen3:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)

                IF GenX > 8 OR GenX < 1 OR GenY > 8 OR GenY < 1 THEN GOTO gen3

                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 3: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP

        CASE 4
            'CTYRKA LOD
            lod = 0
            DO WHILE lod < 1
                gen4:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 7 OR GenX < 1 OR GenY > 7 OR GenY < 1 THEN GOTO gen4
                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) AND VolnoB(GenX, GenY + 3) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 4: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY

                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: poleB(GenX, GenY + 3) = 1: lod = lod + 1
                    EXIT FUNCTION
                END IF
                IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
            LOOP


        CASE 5
            'PETKA LOD
            lod = 0
            DO WHILE lod < 1
                gen5:
                RANDOMIZE TIMER
                GenX = CINT(RND * 10)
                GenY = CINT(RND * 10)
                IF GenX > 6 OR GenX < 1 OR GenY > 6 OR GenY < 1 THEN GOTO gen5
                IF VolnoB(GenX, GenY) AND VolnoB(GenX, GenY + 1) AND VolnoB(GenX, GenY + 2) AND VolnoB(GenX, GenY + 3) AND VolnoB(GenX, GenY + 4) THEN

                    REDIM _PRESERVE LodB(index + 1) AS Lod
                    LodB(index + 1).pos = "Y": LodB(index + 1).typ = 5: LodB(index + 1).x = GenX: LodB(index + 1).y = GenY
                    poleB(GenX, GenY) = 1: poleB(GenX, GenY + 1) = 1: poleB(GenX, GenY + 2) = 1: poleB(GenX, GenY + 3) = 1: poleB(GenX, GenY + 4) = 1: lod = lod + 1
                END IF
            LOOP
            IF TIMER > T THEN Rozmisti_B_lodeY = 1: EXIT FUNCTION
    END SELECT
END FUNCTION


FUNCTION VolnoA (x AS _BYTE, y AS _BYTE)
    IF x = 1 THEN startX = 1 ELSE startX = x - 1
    IF y = 1 THEN startY = 1 ELSE startY = y - 1
    IF x >= 10 THEN CilX = 10 ELSE CilX = x + 1
    IF y >= 10 THEN CilY = 10 ELSE CilY = y + 1


    FOR scnX = startX TO CilX
        FOR scnY = startY TO CilY
            IF poleA(scnX, scnY) <> 0 THEN Volno = 1: GOTO vystup
    NEXT scnY, scnX
    vystup:
    IF Volno THEN VolnoA = 0 ELSE VolnoA = 1
END FUNCTION


FUNCTION VolnoB (x AS _BYTE, y AS _BYTE)
    IF x = 1 THEN startX = 1 ELSE startX = x - 1
    IF y = 1 THEN startY = 1 ELSE startY = y - 1
    IF x >= 10 THEN CilX = 10 ELSE CilX = x + 1
    IF y >= 10 THEN CilY = 10 ELSE CilY = y + 1


    FOR scnX = startX TO CilX
        FOR scnY = startY TO CilY
            IF poleB(scnX, scnY) <> 0 THEN Volno = 1: GOTO vystup
    NEXT scnY, scnX
    vystup:
    IF Volno THEN VolnoB = 0 ELSE VolnoB = 1
END FUNCTION



SUB initPlayer
    DO
        SELECT CASE Typ
            CASE 1
                'dve ctyrky
                a = Rozmisti_lodeY(4)
                a = Rozmisti_lodeX(4)

                ' tri trojky
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeX(3)

                'jedna petka
                e = Rozmisti_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)

            CASE 2
                a = Rozmisti_lodeX(4)
                a = Rozmisti_lodeX(4)

                ' tri trojky
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeY(3)
                b = Rozmisti_lodeY(3)

                'jedna petka
                e = Rozmisti_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)

            CASE 3

                'jedna petka
                e = Rozmisti_lodeY(5)

                a = Rozmisti_lodeY(4)
                a = Rozmisti_lodeY(4)

                ' tri trojky
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeX(3)
                b = Rozmisti_lodeX(3)

                'ctyry dvojky
                c = Rozmisti_lodeY(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeX(2)
                c = Rozmisti_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_lodeY(1)
        END SELECT

        IF a = 0 AND b = 0 AND c = 0 AND d = 0 AND e = 0 AND UBOUND(lodA) = 15 THEN
            EXIT DO
        ELSE
            RANDOMIZE TIMER
            Vycisti_poleA
            Vycisti_LodeA
        END IF
    LOOP
END SUB



SUB initComputer
    a = -1: b = -1: c = -1: d = -1: e = -1

    DO
        SELECT CASE Typ
            CASE 1
                'dve ctyrky
                a = Rozmisti_B_lodeY(4)
                a = Rozmisti_B_lodeX(4)

                ' tri trojky
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeX(3)

                'jedna petka
                e = Rozmisti_B_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)

            CASE 2
                a = Rozmisti_B_lodeX(4)
                a = Rozmisti_B_lodeX(4)

                ' tri trojky
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeY(3)
                b = Rozmisti_B_lodeY(3)

                'jedna petka
                e = Rozmisti_B_lodeX(5)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)

            CASE 3

                'jedna petka
                e = Rozmisti_B_lodeY(5)

                a = Rozmisti_B_lodeY(4)
                a = Rozmisti_B_lodeY(4)

                ' tri trojky
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeX(3)
                b = Rozmisti_B_lodeX(3)

                'ctyry dvojky
                c = Rozmisti_B_lodeY(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeX(2)
                c = Rozmisti_B_lodeY(2)

                'pet jednicek (generuje 5 rovnou)
                d = Rozmisti_B_lodeY(1)
        END SELECT

        IF a = 0 AND b = 0 AND c = 0 AND d = 0 AND e = 0 AND UBOUND(lodB) = 15 THEN
            '        PRINT UBOUND(lodB)
            EXIT DO
        ELSE
            RANDOMIZE TIMER
            Vycisti_poleB
            Vycisti_LodeB
        END IF
    LOOP
END SUB



SUB textar (veta AS STRING, x AS INTEGER, y AS INTEGER)
    c = 25
    FOR r = 1 TO LEN(veta$)
        ch$ = UCASE$(MID$(veta$, r, 1))
        SELECT CASE ch$
            CASE ":": in = 36
            CASE "A": in = 0
            CASE "B": in = 1
            CASE "C": in = 2
            CASE "D": in = 3
            CASE "E": in = 4
            CASE "F": in = 5
            CASE "G": in = 6
            CASE "H": in = 7
            CASE "I": in = 8
            CASE "J": in = 9
            CASE "K": in = 10
            CASE "L": in = 11
            CASE "M": in = 12
            CASE "N": in = 13
            CASE "O": in = 14
            CASE "P": in = 15
            CASE "Q": in = 16
            CASE "R": in = 17
            CASE "S": in = 18
            CASE "T": in = 19
            CASE "U": in = 20
            CASE "V": in = 21
            CASE "W": in = 22
            CASE "X": in = 23
            CASE "Y": in = 24
            CASE "Z": in = 25
            CASE "0": in = 26
            CASE "1": in = 27
            CASE "2": in = 28
            CASE "3": in = 29
            CASE "4": in = 30
            CASE "5": in = 31
            CASE "6": in = 32
            CASE "7": in = 33
            CASE "8": in = 34
            CASE "9": in = 35
            CASE " ": in = -1
        END SELECT
        krokX = krokX + 9: IF krokX > _WIDTH - 13 - x THEN krokX = 0: krokY = krokY + 12
        IF in = -1 THEN _CONTINUE
        rozpis in, x + krokX, y + krokY
        in = 0
    NEXT
END SUB


FUNCTION reader (file AS STRING)
    SHARED Frames
    kx = 0: ky = 1
    oo = FREEFILE
    IF _FILEEXISTS(file$) THEN OPEN file$ FOR BINARY AS #oo ELSE BEEP: PRINT "Error opening file "; file$: EXIT SUB
    ident$ = SPACE$(4)
    REDIM big AS INTEGER
    GET #oo, , ident$
    IF ident$ <> "Petr" THEN PRINT "This is not my file format": SLEEP 2: EXIT SUB
    GET #oo, , big
    Frames = (LOF(oo) - 6) / (big ^ 2 / 8)
    REDIM udaj AS _UNSIGNED _BYTE
    REDIM Sn(Frames) AS STRING
    WHILE NOT EOF(oo)
        GET #oo, , udaj
        binar$ = DECtoBIN$(udaj)
        Sn(snindex) = Sn(snindex) + binar$
        FOR rozklad = 1 TO LEN(binar$)
            inSeek = inSeek + 1
            povel = VAL(MID$(binar$, rozklad, 1))
            kx = kx + 1: IF kx > big THEN kx = 1: ky = ky + 1
        NEXT rozklad
        IF inSeek MOD (big ^ 2) = 0 THEN ky = ky + 10: snindex = snindex + 1
        IF _HEIGHT - ky < big THEN ky = 1: posun = posun + 60
    WEND
    reader = big
    CLOSE #oo
END FUNCTION


SUB rozpis (snimek AS INTEGER, posX AS INTEGER, posY AS INTEGER)
    binar$ = Sn(snimek)
    FOR rozklad = 1 TO LEN(binar$)
        povel = VAL(MID$(binar$, rozklad, 1))
        kx = kx + 1: IF kx > Big THEN kx = 1: ky = ky + 1
        IF povel = 1 THEN PSET (posX + kx, posY + ky) 'ELSE PRESET (posX + kx, posY + ky)
    NEXT rozklad
END SUB

FUNCTION DECtoBIN$ (vstup)
    SHARED BINARY$
    FOR rj = 7 TO 0 STEP -1
        IF vstup AND 2 ^ rj THEN BINtoDE$ = BINtoDE$ + "1" ELSE BINtoDE$ = BINtoDE$ + "0"
    NEXT rj
    DECtoBIN$ = BINtoDE$
END FUNCTION


SUB i32to256 (image AS STRING, x AS INTEGER, y AS INTEGER) '     this is already on the .NET forum writed by me. As example how show pictures in 256 colors.
    IF _FILEEXISTS(image$) THEN
        image& = _LOADIMAGE(image$, 32)
        TYPE colors
            ClrVal AS LONG '                                    this contais color number in long format (_RGB32)
            ClrNmbr AS LONG '                                   this contais number for color. How much is this one color used in picture. Is for future use, if 32bit image contais more than 256 colors, then
        END TYPE '                                              i will use the most used only.
        REDIM colors(256) AS colors
        REDIM scn AS LONG, col AS LONG, scan AS LONG, control AS LONG, TotalColors AS LONG
        REDIM m AS _MEM
        m = _MEMIMAGE(image&)

        FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4 ' use 32 bit, step is 4 byt * 8 bit = 32 bit, i read 4 bytes (LONG) in one loop, so STEP 4
            _MEMGET m, m.OFFSET + scan, col&
            FOR control = 0 TO TotalColors&
                IF col& = colors(control).ClrVal THEN colors(control).ClrNmbr = colors(control).ClrNmbr + 1: col& = 0: EXIT FOR
            NEXT
            IF col& <> 0 THEN colors(control + 1).ClrVal = col&: colors(control + 1).ClrNmbr = 1: TotalColors& = TotalColors& + 1: col& = 0
            IF TotalColors& > 255 THEN EXIT FOR
        NEXT scan
        IF TotalColors& <= 256 THEN
            image256& = _NEWIMAGE(_WIDTH(image&), _HEIGHT(image&), 256)
            _DEST image256&
            DIM m2 AS _MEM
            m2 = _MEMIMAGE(image256&)
            FOR MESecam = 255 - TotalColors& TO 255
                _DEST 0
                _PALETTECOLOR MESecam, colors(255 - MESecam).ClrVal
            NEXT

            REDIM SelectColor AS _UNSIGNED _BYTE
            FOR scan = 0 TO (_WIDTH(image&) * _HEIGHT(image&) * 4) - 4 STEP 4
                _MEMGET m, m.OFFSET + scan, Value&
                FOR SelectColor = 255 - TotalColors& TO 255
                    IF colors(255 - SelectColor).ClrVal& = Value& THEN _MEMPUT m2, m2.OFFSET + position256, SelectColor
                NEXT SelectColor
                position256 = position256 + 1
            NEXT scan
            _PUTIMAGE (x, y), image256&, 0
            _MEMFREE m: _MEMFREE m2: _FREEIMAGE image&: _FREEIMAGE image256&
        ELSE PRINT "Image contains more than 256 colors."
        END IF
    ELSE PRINT "File "; image$; " not exists.": SLEEP 5
    END IF
END SUB

SUB SavePalette
    FOR S = 0 TO 255
        COLOR _RGB(_RED(S), _GREEN(S), _BLUE(S))
        PaletteSave(S) = _RGB(_RED(S), _GREEN(S), _BLUE(S))
    NEXT S
END SUB

SUB ResetPalette
    FOR S = 0 TO 255
        _PALETTECOLOR S, _RGB32(_RED(PaletteSave(S)), _GREEN(PaletteSave(S)), _BLUE(PaletteSave(S)))
    NEXT S
END SUB

SUB menu
    menuBegin:
    _KEYCLEAR
    k& = 0
    CLS
    n = 1: gametype = 1
    DO
        i& = _KEYHIT
        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
        SELECT CASE i&
            CASE 13: GOSUB selected
            CASE 27: eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
            CASE 18432: n = n - 1: IF n < 1 THEN n = 1
            CASE 20480: n = n + 1: IF n > 4 THEN n = 4
        END SELECT
        IF INI.BSound THEN midas
        i32to256 "lod0.gif", 0, 30
        COLOR 40
        textar "Battle Ship 01 BETA", 10, 0
        SELECT CASE n
            CASE 1
                COLOR 20
                textar "Set game type", 150, 50
                COLOR 40
                textar "Setup", 150, 70
                textar "About", 150, 90
                textar "Quit game", 150, 110

            CASE 2
                COLOR 40
                textar "Set game type", 150, 50
                COLOR 20
                textar "Setup", 150, 70
                COLOR 40
                textar "About", 150, 90
                textar "Quit game", 150, 110


            CASE 3
                COLOR 40
                textar "Set game type", 150, 50
                textar "Setup", 150, 70
                COLOR 20
                textar "About", 150, 90
                COLOR 40
                textar "Quit game", 150, 110


            CASE 4
                COLOR 40
                textar "Set game type", 150, 50
                textar "Setup", 150, 70
                textar "About", 150, 90
                COLOR 20
                textar "Quit game", 150, 110
        END SELECT
        COLOR 15
        _DISPLAY
    LOOP
    selected:

    SELECT CASE n
        CASE 1 'select game type
            DO WHILE k& <> 13
                k& = _KEYHIT
                IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                SELECT CASE k&
                    CASE 27: GOTO menuBegin 'destructor a k tomu uvolnit vse za hlavni smyckou
                    CASE 18432: gametype = gametype - 1: IF gametype < 1 THEN gametype = 1
                    CASE 20480: gametype = gametype + 1: IF gametype > 2 THEN gametype = 2
                END SELECT
                SELECT CASE gametype
                    CASE 1
                        IF INI.BSound THEN midas
                        i32to256 "lod0.gif", 0, 30
                        COLOR 20
                        textar "Game VS computer", 150, 50
                        COLOR 40
                        textar "LAN Game", 150, 70
                    CASE 2
                        IF INI.BSound THEN midas
                        i32to256 "lod0.gif", 0, 30
                        COLOR 40
                        textar "Game VS computer", 150, 50
                        COLOR 20
                        textar "LAN Game", 150, 70
                END SELECT
                _DISPLAY
            LOOP
            SELECT CASE gametype
                CASE 1: CLS: i32to256 "lod0.gif", 0, 30: _DISPLAY: Lan = 0: EXIT SUB
                CASE 2
                    IF INI.BSound THEN midas
                    CLS
                    i32to256 "lod0.gif", 0, 30
                    COLOR 40
                    textar "LAN GAME", 10, 0
                    textar "Press C for Client or H for Host", 10, 100
                    _DISPLAY
                    DO
                        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        i$ = INKEY$
                        SELECT CASE LCASE$(i$)
                            CASE "c": computer$ = "C": EXIT DO
                            CASE "h": computer$ = "H": EXIT DO
                        END SELECT
                    LOOP

                    IF INI.BSound THEN midas
                    CLS
                    i32to256 "lod0.gif", 0, 30
                    COLOR 40
                    textar "LAN GAME", 10, 0
                    IF LEN(computer$) THEN LINE (0, 0)-(150, 25), 0, BF

                    IF computer$ = "C" THEN
                        textar "Input IP adress or press ESC", 10, 1
                        IP$ = IPinput$(85, 82)
                        LINE (0, 0)-(320, 25), 0, BF
                        Lan = Network(IP$)
                    ELSE
                        textar "Waiting for client", 10, 100:
                        DO UNTIL Lan
                            Lan = Network(IP$)
                            IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
                        LOOP
                    END IF

                    IF Lan = 0 THEN GOTO menuBegin 'pressed ESC when HOST wait for CLIENT
                    _DISPLAY
            END SELECT

        CASE 2 'sound setup
            _MOUSESHOW
            IF INI.BSound THEN midas
            CLS
            WHILE i& <> 27
                _LIMIT 30
                COLOR 40
                textar "Setup", 100, 15
                COLOR 15
                textar "Use background music", 20, 50
                textar "Use sound effects", 20, 80
                textar "Use AUTO generator for ships", 20, 110
                textar "Insert ships manually", 20, 140

                IF INI.BSound = 0 THEN LINE (10, 50)-(15, 55), 15, B ELSE LINE (10, 50)-(15, 55), 14, BF
                IF INI.Esound = 0 THEN LINE (10, 80)-(15, 85), 15, B ELSE LINE (10, 80)-(15, 85), 14, BF
                IF INI.Edit = "AUTO" THEN LINE (10, 110)-(15, 115), 14, BF ELSE LINE (10, 110)-(15, 115), 15, B
                IF INI.Edit = "MANU" THEN LINE (10, 140)-(15, 145), 14, BF ELSE LINE (10, 140)-(15, 145), 15, B

                i& = _KEYHIT
                DO WHILE _MOUSEINPUT
                    SELECT CASE _MOUSEX
                        CASE 10 TO 15
                            SELECT CASE _MOUSEY
                                CASE 50 TO 55: IF _MOUSEBUTTON(1) THEN
                                        SHARED midTimer
                                        IF INI.BSound = 1 THEN INI.BSound = 0: r = PlayMIDI("" + CHR$(0)) ELSE INI.BSound = 1: midTimer = 0: midas
                                    END IF
                                CASE 80 TO 85: IF _MOUSEBUTTON(1) THEN
                                        IF INI.Esound = 1 THEN INI.Esound = 0 ELSE INI.Esound = 1
                                    END IF
                                CASE 110 TO 115: IF _MOUSEBUTTON(1) THEN
                                        INI.Edit = "AUTO"
                                    END IF
                                CASE 140 TO 145
                                    IF _MOUSEBUTTON(1) THEN
                                        INI.Edit = "MANU"
                                    END IF
                            END SELECT
                    END SELECT
                LOOP
                _DISPLAY
                CLS
            WEND
            INICreate INI.BSound, INI.Esound, INI.Edit
            GOTO menuBegin

        CASE 3 'about
            CLS
            FOR F = 0 TO 200
                i32to256 "battleship.gif", 60, F
                _DISPLAY
                _LIMIT 25
                CLS
            NEXT F
            CLS
            COLOR 40
            textar "About BattleShip game", 10, 10
            textar "This game is based on desktop game", 1, 30
            textar "as in previous picture", 1, 45
            textar "Quads represents ships and player", 1, 60
            textar "try destroy it all as first", 1, 75
            textar "Both players have the same number", 1, 90
            textar "of Ships", 1, 105
            textar "Left map is for player and right", 1, 120
            textar "map is for enemy", 1, 135
            textar "Use mouse on the right map to  ", 1, 150
            textar "determine target and shoot", 1, 165

            textar "Press any key ", 1, 190
            _DISPLAY
            i$ = ""
            _KEYCLEAR
            DO UNTIL i$ <> "": i$ = INKEY$: IF INI.BSound THEN midas
            LOOP
            ResetPalette
            _AUTODISPLAY
            GOTO menuBegin
        CASE 4 ' end
            FOR CLOSURE = 0 TO 7
                _SNDCLOSE exploze(CLOSURE)
            NEXT CLOSURE
            _SNDCLOSE Splash&
            eee = PlayMIDI&("")
            Destructor "BattleShip.pmf": SYSTEM
            SYSTEM
    END SELECT

END SUB

FUNCTION Network (IP AS STRING)
    _AUTODISPLAY
    Client& = _OPENCLIENT("TCP/IP:3455:" + LTRIM$(IP$))
    IF Client& THEN
        Network = 2 'client
    ELSE
        PRINT "No host found"
        _DELAY 1
        _DELAY 1
        Client& = _OPENHOST("TCP/IP:3455")
        IF Client& THEN
            PRINT "Host created!"
            DO
                i& = _KEYHIT
                IF i& = 27 THEN EXIT FUNCTION
                Host& = _OPENCONNECTION(Client&)
                _DISPLAY
            LOOP UNTIL Host&
            CLS
            Network = 1
        ELSE
            eee = PlayMIDI&("")
            Destructor "BattleShip.pmf"
            SYSTEM
        END IF
    END IF
END FUNCTION


SUB INICreate (BSound AS _BYTE, ESound AS _BYTE, Edit AS STRING * 4)
    lode = FREEFILE
    OPEN "lode.ini" FOR OUTPUT AS #lode: CLOSE #lode
    OPEN "lode.ini" FOR BINARY AS #lode
    INI.BSound = BSound
    INI.Esound = ESound
    INI.Edit = Edit
    PUT #lode, , INI
    CLOSE #lode
END SUB

SUB InsertShipsManually
    REDIM LodA(15) AS Lod
    DIM shL(1) AS Lod
    SHARED anima
    index = 0
    _AUTODISPLAY
    IF INI.BSound THEN midas
    poloha = 1
    Vycisti_poleA
    CLS
    ResetPalette
    COLOR 14
    textar "Insert ALL ships to water then      click to done or press Esc for quit Right click for ship rotate         R for reset", -10, 1
    COLOR 15
    L1 = 5: L2 = 4: L3 = 3: L4 = 2: L5 = 1: x = 110: y = 60
    oL1 = 5: oL2 = 4: oL3 = 3: oL4 = 2: oL5 = 1
    PCOPY _DISPLAY, 3
    DO UNTIL i& = 27
        IF _EXIT THEN eee = PlayMIDI&(""): Destructor ("battleship.pmf"): SYSTEM
        DIM pX AS _BYTE, pY AS _BYTE
        FOR navrhy = 1 TO 100 STEP 10
            FOR navrhx = 1 TO 100 STEP 10
                LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 1, BF
                LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 15, B
                LINE (275, 170)-(311, 190), 15, B
                IF complete THEN COLOR 15 ELSE COLOR 19
                _PRINTSTRING (278, 176), "Done"
                COLOR 15


                i& = _KEYHIT
                i$ = INKEY$
                IF i& = 27 THEN menu
                IF LCASE$(i$) = "r" THEN Vycisti_poleA: Vycisti_LodeA: index = 0: REDIM LodA(15) AS Lod: L5 = 1: L4 = 2: L3 = 3: L2 = 4: L1 = 5
                anima = anima + .0005: IF anima > 3 THEN anima = 1
                pX = _CEIL(navrhx / 10): pY = _CEIL(navrhy / 10)
                IF poleA(pX, pY) = 0 THEN
                    COLOR 53 + anima: rozpis 37 + INT(anima), 1 + x + navrhx - 5, 1 + y + navrhy - 5: COLOR 15
                ELSE
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 49, BF
                END IF
                IF poleA(pX, pY) = 1 THEN
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 29, BF
                    LINE (x + navrhx - 5, y + navrhy - 5)-(5 + x + navrhx, 5 + y + navrhy), 15, B
                END IF
            NEXT navrhx
            IF navrhy <= 90 THEN textar CHR$(49 + navrhy / 10), 197, 55 + navrhy + 2
            textar CHR$(65 + navrhy / 10), 94 + navrhy + 2, 160
            textar "10", 197, 148
        NEXT navrhy
        Zobraz_Stav 5, 75, 1
        textar STR$(L1) + "x", 40, 129
        textar STR$(L2) + "x", 40, 116
        textar STR$(L3) + "x", 40, 102
        textar STR$(L4) + "x", 40, 89
        textar STR$(L5) + "x", 40, 76
        DO WHILE _MOUSEINPUT
            mx = _MOUSEX: my = _MOUSEY: Lb = _MOUSEBUTTON(1): Rb = _MOUSEBUTTON(2)
            IF mx > 5 AND mx < 55 AND my > 75 AND my < 85 AND Lb = -1 AND L5 > 0 THEN vybrano = 5
            IF mx > 15 AND mx < 55 AND my > 88 AND my < 98 AND Lb = -1 AND L4 > 0 THEN vybrano = 4
            IF mx > 25 AND mx < 55 AND my > 101 AND my < 111 AND Lb = -1 AND L3 > 0 THEN vybrano = 3
            IF mx > 35 AND mx < 55 AND my > 114 AND my < 124 AND Lb = -1 AND L2 > 0 THEN vybrano = 2
            IF mx > 45 AND mx < 55 AND my > 127 AND my < 137 AND Lb = -1 AND L1 > 0 THEN vybrano = 1
            IF vybrano > 1 AND Rb = -1 THEN poloha = poloha * -1: Rb = 0
            IF complete AND Lb = -1 AND mx > 275 AND mx < 311 AND my > 170 AND my < 190 THEN EXIT SUB
        LOOP
        SELECT CASE vybrano '                      BLOK JEN PRO GRAFICKE ZOBRAZENI!   block for graphic view only ---------------------------------

            CASE 1
                LINE (mx - 5, my - 5)-(mx + 5, my + 5), 23, BF: LINE (mx - 5, my - 5)-(mx + 5, my + 5), 15, B
            CASE 2
                IF poloha = 1 THEN
                    FOR delka = mx - 5 TO mx + 5 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 5 TO my + 5 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 3
                IF poloha = 1 THEN
                    FOR delka = mx - 10 TO mx + 10 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 10 TO my + 10 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 4
                IF poloha = 1 THEN
                    FOR delka = mx - 15 TO mx + 15 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 15 TO my + 15 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
            CASE 5
                IF poloha = 1 THEN
                    FOR delka = mx - 20 TO mx + 20 STEP 10
                        LINE (delka - 5, my - 5)-(delka + 5, my + 5), 23, BF: LINE (delka - 5, my - 5)-(delka + 5, my + 5), 15, B
                    NEXT delka
                ELSE
                    FOR delka = my - 20 TO my + 20 STEP 10
                        LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 23, BF: LINE (mx - 5, delka - 5)-(mx + 5, delka + 5), 15, B
                    NEXT delka
                END IF
        END SELECT
        '------------------------------------------------------------------------------------------------------------------------------------------

        'blok ktery prepocita kam chces lod umistit   this block calculate, if your selected area in manual inserting is valid for ship
        REDIM PnX AS _UNSIGNED _BYTE, PnY AS _UNSIGNED _BYTE
        IF mx > 106 AND mx < 206 AND my > 56 AND my < 156 THEN
            PnX = _CEIL(mx - 101) / 10 'pnx i pny ok
            PnY = _CEIL(my - 51) / 10
            IF vybrano = 1 AND L1 > 0 THEN
                cilX = PnX: cilY = PnY
                IF Lb = -1 AND VolnoA(PnX, PnY) THEN poleA(PnX, PnY) = 1: L1 = L1 - 1
            END IF

            IF vybrano = 2 AND poloha = 1 AND L2 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: L2 = L2 - 1
                END IF
            END IF
            IF vybrano = 2 AND poloha = -1 AND L2 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 THEN
                    IF VolnoA(PnX, PnY) AND VolnoA(PnX, PnY - 1) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: L2 = L2 - 1
                END IF
            END IF


            IF vybrano = 3 AND poloha = 1 AND L3 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 AND PnX + 1 < 11 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: L3 = L3 - 1
                END IF
            END IF
            IF vybrano = 3 AND poloha = -1 AND L3 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 AND PnY + 1 < 11 THEN
                    IF VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY - 1) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: L3 = L3 - 1
                END IF
            END IF


            IF vybrano = 4 AND poloha = 1 AND L4 > 0 THEN
                IF Lb = -1 AND PnX - 1 > 0 AND PnX + 2 < 11 THEN
                    IF VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) AND VolnoA(PnX + 2, PnY) THEN poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: poleA(PnX + 2, PnY) = 1: L4 = L4 - 1
                END IF
            END IF
            IF vybrano = 4 AND poloha = -1 AND L4 > 0 THEN
                IF Lb = -1 AND PnY - 1 > 0 AND PnY + 2 < 11 THEN
                    IF VolnoA(PnX, PnY - 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY + 2) THEN poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: poleA(PnX, PnY + 2) = 1: L4 = L4 - 1
                END IF
            END IF

            IF vybrano = 5 AND poloha = 1 AND L5 > 0 THEN
                IF Lb = -1 AND PnX - 2 > 0 AND PnX + 2 < 11 THEN
                    IF VolnoA(PnX - 2, PnY) AND VolnoA(PnX - 1, PnY) AND VolnoA(PnX, PnY) AND VolnoA(PnX + 1, PnY) AND VolnoA(PnX + 2, PnY) THEN poleA(PnX - 2, PnY) = 1: poleA(PnX - 1, PnY) = 1: poleA(PnX, PnY) = 1: poleA(PnX + 1, PnY) = 1: poleA(PnX + 2, PnY) = 1: L5 = L5 - 1
                END IF
            END IF
            IF vybrano = 5 AND poloha = -1 AND L5 > 0 THEN
                IF Lb = -1 AND PnY - 2 > 0 AND PnY + 2 < 11 THEN
                    IF VolnoA(PnX, PnY - 2) AND VolnoA(PnX, PnY - 1) AND VolnoA(PnX, PnY) AND VolnoA(PnX, PnY + 1) AND VolnoA(PnX, PnY + 2) THEN poleA(PnX, PnY - 2) = 1: poleA(PnX, PnY - 1) = 1: poleA(PnX, PnY) = 1: poleA(PnX, PnY + 1) = 1: poleA(PnX, PnY + 2) = 1: L5 = L5 - 1
                END IF
            END IF
            IF L1 = 0 AND L2 = 0 AND L3 = 0 AND L4 = 0 AND L5 = 0 THEN complete = 1 ELSE complete = 0
            textar "Position:" + STR$(PnX) + STR$(PnY), 250, 140

            '            IF opacnychod THEN index = index - 1: opacnychod = 0: GOTO nepricitat
            IF oL1 <> L1 THEN index = index + 1: oL1 = L1: zmena = 1
            IF oL2 <> L2 THEN index = index + 1: oL2 = L2: zmena = 1
            IF oL3 <> L3 THEN index = index + 1: oL3 = L3: zmena = 1
            IF oL4 <> L4 THEN index = index + 1: oL4 = L4: zmena = 1
            IF oL5 <> L5 THEN index = index + 1: oL5 = L5: zmena = 1
            nepricitat:
            IF index < 0 THEN index = 0

            IF index > 15 THEN
                index = 0
                DO UNTIL LodA(index).x = 0 AND LodA(index).y = 0
                    index = index + 1
                LOOP
                zmena = 1
            END IF

            IF zmena THEN
                IF poloha = 1 THEN LodA(index).pos = "X"
                IF poloha = -1 THEN LodA(index).pos = "Y"
                LodA(index).typ = vybrano
                IF vybrano = 1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY
                END IF
                IF vybrano = 2 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 2 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 3 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 3 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 4 AND poloha = 1 THEN
                    LodA(index).x = PnX - 1
                    LodA(index).y = PnY
                END IF
                IF vybrano = 4 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 1
                END IF

                IF vybrano = 5 AND poloha = 1 THEN
                    LodA(index).x = PnX - 2
                    LodA(index).y = PnY
                END IF
                IF vybrano = 5 AND poloha = -1 THEN
                    LodA(index).x = PnX
                    LodA(index).y = PnY - 2
                END IF
                vybrano = 0
                zmena = 0
            END IF
        END IF
        _DISPLAY
        _LIMIT 75
        PCOPY 3, _DISPLAY
    LOOP
END SUB


FUNCTION IPinput$ (x AS INTEGER, y AS INTEGER) '                  PRESS ENTER FOR LOCALHOST MODE
    _AUTODISPLAY
    _PRINTSTRING (30, 180), "PRESS ENTER FOR LOCALHOST MODE!"
    LINE (x, y)-(x + 150, y + 35), 18, BF
    LINE (x, y)-(x + 150, y + 35), 15, B
    COLOR , 18
    _PRINTSTRING (x + 35, y + 5), "Insert IP:"
    LOCATE 14, 12: INPUT ip$
    IF ip$ = "" THEN ip$ = "localhost"
    IPinput$ = ip$
END FUNCTION


SUB LanHost
    pass = 0
    FOR aLan = 1 TO 10
        FOR bLan = 1 TO 10
            value = poleA(aLan, bLan) + 1
            PUT #Host, , value
            pass = 0
    NEXT bLan, aLan
    DO UNTIL pass
        GET #Host, , pass
    LOOP

    pass = 1
    FOR PrijemC = 1 TO 10
        FOR prijemCl = 1 TO 10
            DO UNTIL valu
                GET #Host, , valu
                poleB(PrijemC, prijemCl) = valu - 1
            LOOP
            valu = 0
        NEXT prijemCl
    NEXT PrijemC
    PUT #Host, , pass

    pass = 0 'od 5
    prenes_LodA_Host

END SUB

SUB prenes_LodA_Host
    valu = 0: pass = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        LX = LodA(posli).x + 1
        LY = LodA(posli).y + 1
        LS = ASC(LodA(posli).pos)
        LT = LodA(posli).typ + 1
        PUT #Host, , LX
        PUT #Host, , LY
        PUT #Host, , LS
        PUT #Host, , LT
    NEXT posli
    pass = 1
    value = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        GET #Host, , value: LodB(posli).x = value - 1: value = 0
        GET #Host, , value: LodB(posli).y = value - 1: value = 0
        GET #Host, , value: LodB(posli).pos = CHR$(value): value = 0
        GET #Host, , value: LodB(posli).typ = value - 1: value = 0
    NEXT posli
END SUB




SUB LanClient
    value = 0
    pass = 1
    FOR aLan = 1 TO 10
        FOR bLan = 1 TO 10
            DO UNTIL value
                GET #Client, , value
                poleB(aLan, bLan) = value - 1
            LOOP

            value = 0
        NEXT bLan
    NEXT aLan
    PUT #Client, , pass

    FOR poA = 1 TO 10
        FOR poAA = 1 TO 10
            value = poleA(poA, poAA) + 1
            PUT #Client, , value
            value = 0
    NEXT poAA, poA
    DO UNTIL ok
        GET #Client, , ok
    LOOP
    ok = 0

    pass = 0 'od 5
    prenes_LodA_Client
END SUB

SUB prenes_LodA_Client
    valu = 0: pass = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        LX = LodA(posli).x + 1
        LY = LodA(posli).y + 1
        LS = ASC(LodA(posli).pos)
        LT = LodA(posli).typ + 1
        PUT #Client, , LX
        PUT #Client, , LY
        PUT #Client, , LS
        PUT #Client, , LT
    NEXT posli
    pass = 1
    value = 0
    FOR posli = LBOUND(lodA) TO UBOUND(lodA)
        GET #Client, , value: LodB(posli).x = value - 1: value = 0
        GET #Client, , value: LodB(posli).y = value - 1: value = 0
        GET #Client, , value: LodB(posli).pos = CHR$(value): value = 0
        GET #Client, , value: LodB(posli).typ = value - 1: value = 0
    NEXT posli
END SUB

SUB Constructor (vystup AS STRING) 'extract files from .PMF
    TYPE head2
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        DIM head AS head2
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        IF head.identity = "Petr's MultiFile" THEN ELSE PRINT "Head Failure": SLEEP 3: END
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, 21 + head.much * 4 ' start DATA area
        FOR total = 1 TO head.much
            IF total = 1 THEN velikost& = starts(1) - (21 + head.much * 4) ELSE velikost& = starts(total) - starts(total - 1) 'velikost is SIZE english -
            record$ = SPACE$(velikost&)
            GET #e, , record$
            i = FREEFILE
            jmeno$ = "$Ext" + LTRIM$(STR$(total))
            OPEN jmeno$ FOR OUTPUT AS #i: CLOSE #i: OPEN jmeno$ FOR BINARY AS #i
            PUT #i, , record$
            CLOSE #i
        NEXT total
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
            '    PRINT "File name: "; NameIt; "lenght in bytes is "; NamesLenght(NameIt)
        NEXT NameIt

        CLOSE #i
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            jm$ = "$Ext" + LTRIM$(STR$(Name2))
            erh:
            IF _FILEEXISTS(s$) THEN
                BEEP: INPUT "Warnig! Extracted file the same name already exists!!!! (O)verwrite, (R)ename or (E)xit? "; er$
                SELECT CASE LCASE$(er$)
                    CASE "o": KILL s$: NAME jm$ AS s$
                    CASE "r": INPUT "Input new name"; s$: GOTO erh
                    CASE "e": Destructor "tetris.pmf": SYSTEM
                END SELECT
            ELSE
                NAME jm$ AS s$
            END IF
        NEXT Name2
        CLOSE #e

        FOR ctrl = 1 TO head.much
            nam$ = "$ext" + LTRIM$(STR$(ctrl))
            IF _FILEEXISTS(nam$) THEN KILL nam$
        NEXT ctrl
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB

SUB Destructor (vystup AS STRING) 'delete files created by Constructor
    TYPE head
        identity AS STRING * 16
        much AS LONG
    END TYPE
    IF INSTR(1, LCASE$(vystup$), ".pmf") THEN ELSE vystup$ = vystup$ + ".PMF"
    IF _FILEEXISTS(vystup$) THEN
        CLOSE
        DIM head AS head
        e = FREEFILE
        OPEN vystup$ FOR BINARY AS #e
        GET #e, , head
        DIM starts(head.much) AS LONG

        FOR celek = 1 TO head.much
            GET #e, , starts(celek)
        NEXT

        SEEK #e, starts(head.much) ' start DATA area
        DIM NamesLenght(head.much) AS INTEGER
        FOR NameIt = 1 TO head.much
            GET #e, , NamesLenght(NameIt)
        NEXT NameIt
        FOR Name2 = 1 TO head.much
            s$ = SPACE$(NamesLenght(Name2))
            GET #e, , s$
            IF _FILEEXISTS(s$) THEN KILL s$
        NEXT Name2
        CLOSE #e
    ELSE
        PRINT "Specified file not found": SLEEP 3
    END IF
END SUB


need the same external files
Coding is relax.

Donald Foster

  • Full Member
  • ***
  • Posts: 210
  • My Heart is Human.MyBlood is Boiling.My Brain IBM
    • The QB64 Edition / QB64 Coders delight / Video Games / Board
Re: Battle Ship - Lan or local game
« Reply #6 on: April 01, 2018, 06:44:21 am »
Hello all,

I haven't tried you game yet, looking forward to it. My laptop went up about 2 weeks ago haven't been able to work with QB64 or my games since. I downloaded QB64 on my wife's laptop and my games in .exe form and Qb64 and my games will not properly load in Windows 7 Ultra.

I made a Battleship game back in early to mid 80's on the TRS-80 Model 4. Both players play on the same game as bin the way I make all of my games. Back then I wished I had 2 Model 4s and connected them with a null modem and played that way. But I never learned networking and always wished I did.  I also wrote a Stratego game back then also.

So I'll have a working computer with QB64 and looking forward to try out your game.

Donald

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #7 on: April 01, 2018, 07:15:53 am »
Hello Donald,
Meanwhile, in the network, you can count on the issues we are talking about above. Something is still missing me. Something about why the coordinates do not come in half the game. I assumed that if it works properly in localhost mode (that is, you run the game twice on the same computer if you want to test it, each from the other directory, or CONSTRUCTOR will report bugs) so it's done and it must work in real network. I believed it that if work in localhost so muss working in real network so i   released it. Then I pulled out my notebook ... and shock...  . So i write the second version ( second source here). I will continue to work on it, this developing in real network, if localhost represent unusable output for real network.
Coding is relax.

Prithak

  • Jr. Member
  • **
  • Posts: 98
  • Programmer: A machine turns Coffee into Code.
Re: Battle Ship - Lan or local game
« Reply #8 on: April 20, 2018, 08:08:00 am »
For Some Unknown Reasons. The Code won't work.... Can anyone provide .exe file?????
Q: 0 is False and 1 is True, right?
A: 1

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #9 on: April 20, 2018, 08:20:51 am »
Hi. DLL and PMF file, both muss be in the same directory with BAS file. Without this files it start not, but write Specified file not found and end with subscript out of range error.
Coding is relax.

Prithak

  • Jr. Member
  • **
  • Posts: 98
  • Programmer: A machine turns Coffee into Code.
Re: Battle Ship - Lan or local game
« Reply #10 on: April 20, 2018, 11:23:28 pm »
They Both are in the same directory! And it still won't work!!!
Q: 0 is False and 1 is True, right?
A: 1

Petr

  • Hero Member
  • *****
  • Posts: 657
Re: Battle Ship - Lan or local game
« Reply #11 on: April 21, 2018, 12:24:37 am »
Is anyone else, for who it does not work? It works for me. I would be surprised if the in case, that program for others did not work that they would not me say it. The problem may be if windows prevents the program from writing to disk or antivirus. But it is already in the system setup and not in the program. Program work without problems on me machine.

Also check that you have Output EXE to SOURCE Folder selected in the IDE.

« Last Edit: April 21, 2018, 01:02:14 am by Petr »
Coding is relax.

  • Print