• Print

Author Topic: (HOST) PUT # and GET #  (Read 447 times)

Petr

  • Hero Member
  • *****
  • Posts: 682
Re: (HOST) PUT # and GET #
« Reply #15 on: May 17, 2018, 10:09:11 am »
Great thanks to Fellippe!

Great excuse for developers!

Here, Prithak, after many experiments, is finally what you wanted. With names. I used the same path that I write binary files. And it works perfectly. I also needed to make it clear for me. Perfect query. New knowledge. Thanks you all.  ;D

Code: [Select]
_TITLE "Rangers Of Power!"
SCREEN _NEWIMAGE(800, 600, 32)
COLOR _RGB32(0, 0, 0)
COLOR , _RGB32(33, 22, 227)
CLS
DIM uname AS STRING * 10 'this muss be here. IF you need bigger string lenght for name, then REWRITE LEN conditions on lines 179 and 230!!!!


'Before Testing the Client and Maps. I will go to the game directly
map = 1
GOTO menu
client = _OPENHOST("TCP/IP:8080")
DO
    LOCATE 1, 1: PRINT "Trying to Connect to Client."
    z = _OPENCONNECTION(client)
    IF z THEN
        GET #z, , map
        CLOSE #z
    ELSE
        map = 0
    END IF
LOOP UNTIL map <> 0
menu:
IF _FILEEXISTS("name.txt") THEN
    OPEN "name.txt" FOR INPUT AS #1
    INPUT #1, uname$
    CLOSE #1
ELSE
    INPUT "Enter Your Name"; uname$ 'renamed to uname because NAME is statement
    OPEN "name.txt" FOR OUTPUT AS #1
    PRINT #1, uname$
    CLOSE #1
END IF
DO
    DO WHILE _MOUSEINPUT
        _LIMIT 1000
        _PRINTSTRING (_WIDTH / 2, 0), "Rangers Of Power!"
        IF MOUSEHOVER(_WIDTH / 2, _WIDTH / 2 + 100, _HEIGHT / 2, _HEIGHT / 2 + 100) <> -1 THEN
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(249, 155, 11), BF
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(0, 0, 0), B
        ELSE
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(55, 238, 244), BF
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(0, 0, 0), B
        END IF

        IF MOUSECLICK(_WIDTH / 2, _WIDTH / 2 + 100, _HEIGHT / 2, _HEIGHT / 2 + 100) = -1 THEN
            GOTO game
        END IF

        IF map = 0 THEN _PRINTSTRING (_WIDTH / 2, _HEIGHT / 2 + 100), "No Connection With Client"
        IF map = 1 THEN _PRINTSTRING (_WIDTH / 2, _HEIGHT / 2 + 100), "Current Map = Survivor"
        _DISPLAY
        _LIMIT 150
        CLS
    LOOP
LOOP

game:
SCREEN _NEWIMAGE(512, 512, 32)
COLOR _RGB32(0, 0, 0)
COLOR , _RGB32(33, 22, 227)
CLS
DO
    DO WHILE _MOUSEINPUT
        _LIMIT 1000
        LOCATE 1, 1: PRINT "Choose One"

        IF MOUSEHOVER(100, 200, 100, 200) THEN
            LINE (100, 100)-(200, 200), _RGB32(55, 238, 244), BF
            LINE (100, 100)-(200, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 100)-(200, 200), _RGB32(249, 155, 11), BF
            LINE (100, 100)-(200, 200), _RGB32(0, 0, 0), B
        END IF

        LINE (120, 110)-(180, 190), _RGB32(122, 26, 206), BF
        LINE (120, 110)-(180, 190), _RGB32(0, 0, 0), B

        IF MOUSEHOVER(300, 400, 100, 200) THEN
            LINE (300, 100)-(400, 200), _RGB32(55, 238, 244), BF
            LINE (300, 100)-(400, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (300, 100)-(400, 200), _RGB32(249, 155, 11), BF
            LINE (300, 100)-(400, 200), _RGB32(0, 0, 0), B
        END IF

        LINE (320, 110)-(380, 190), _RGB32(244, 28, 33), BF
        LINE (320, 110)-(380, 190), _RGB32(0, 0, 0), B


        IF MOUSECLICK(100, 200, 100, 200) THEN
            ch$ = "KELLY"
        ELSEIF MOUSECLICK(300, 400, 100, 200) THEN
            ch$ = "SOLT "
        END IF

        IF ch$ <> "" THEN GOTO playgame
        _DISPLAY
        _LIMIT 150
        CLS
    LOOP
LOOP

playgame:
CLS
DO
    DO WHILE _MOUSEINPUT
        IF MOUSEHOVER(100, 300, 100, 200) THEN
            LINE (100, 100)-(300, 200), _RGB32(55, 238, 244), BF
            LINE (100, 100)-(300, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 100)-(300, 200), _RGB32(249, 155, 11), BF
            LINE (100, 100)-(300, 200), _RGB32(0, 0, 0), B
        END IF
        IF MOUSEHOVER(100, 300, 300, 400) THEN
            LINE (100, 300)-(300, 400), _RGB32(55, 238, 244), BF
            LINE (100, 300)-(300, 400), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 300)-(300, 400), _RGB32(249, 155, 11), BF
            LINE (100, 300)-(300, 400), _RGB32(0, 0, 0), B
        END IF
        IF MOUSECLICK(100, 300, 100, 200) THEN type$ = "CLIENT": GOTO realgame
        IF MOUSECLICK(100, 300, 300, 400) THEN type$ = "HOST": GOTO realgame

        COLOR , _RGB32(249, 155, 11):
        _PRINTSTRING (200, 150), "CLIENT"
        _PRINTSTRING (200, 350), "HOST"

        COLOR , _RGB32(33, 22, 227)
        _DISPLAY
        CLS
        _LIMIT 1000
    LOOP
LOOP

realgame:
CLS
IF type$ = "HOST" THEN _TITLE "HOST": GOTO host
IF type$ = "CLIENT" THEN _TITLE "CLIENT": GOTO client

host:
SCREEN _NEWIMAGE(800, 600, 32)
DO
    x = _OPENHOST("TCP/IP:8080")

    IF x THEN EXIT DO ELSE PRINT "Can't Connect"
    _DISPLAY
    CLS
LOOP
PRINT "Waiting for Client"
DO
    z = _OPENCONNECTION(x)

    IF z THEN EXIT DO

    _DISPLAY
    CLS
LOOP
DO
    '    INPUT "Enter X"; xco
    '    INPUT "Enter Y"; yco

    k$ = UCASE$(INKEY$)

    IF k$ = "W" THEN yco = yco - 5
    IF k$ = "S" THEN yco = yco + 5
    IF k$ = "A" THEN xco = xco - 5
    IF k$ = "D" THEN xco = xco + 5
    Mark = 3000
    'redim _preserve uname as string * 10

    Total$ = MKS$(xco) + MKS$(yco) + ch$ + uname$

    PUT #z, , Total$

    Incoming$ = ""
    DO
        GET #z, , Incoming$
    LOOP WHILE LEN(Incoming$) < 23

    xco1 = CVS(MID$(Incoming$, 1, 4))
    yco1 = CVS(MID$(Incoming$, 5, 4))
    ch1$ = MID$(Incoming$, 9, 5)
    opname$ = MID$(Incoming$, 14, 10)


    IF ch$ = "KELLY" THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(122, 26, 206), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$
    IF ch$ = "SOLT " THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(244, 28, 33), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$

    IF ch1$ = "KELLY" THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(122, 26, 206), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$
    IF ch1$ = "SOLT " THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(244, 28, 33), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$

    LOCATE 1, 1: PRINT ch$, ch1$, xco1, yco1, xco, yco, oppname$
    _DISPLAY
    CLS
LOOP

client:
SCREEN _NEWIMAGE(800, 600, 32)
DO
    x = _OPENCLIENT("TCP/IP:8080:localhost")

    IF x THEN EXIT DO ELSE PRINT "Can't Connect"

    _DISPLAY
    CLS
LOOP

DO
    k$ = UCASE$(INKEY$)

    IF k$ = "W" THEN yco = yco - 5
    IF k$ = "S" THEN yco = yco + 5
    IF k$ = "A" THEN xco = xco - 5
    IF k$ = "D" THEN xco = xco + 5
    Mark = 3000



    'create new STRING contains ALL informations in one and this then send. The same way use Galleon for writing binary files.

    Total$ = MKS$(xco) + MKS$(yco) + ch$ + uname$
    '        4 bytes   + 4 bytes  +  5 bytes + 10 bytes  = sending 23 bytes

    PUT #x, , Total$

    Incoming$ = ""
    DO
        GET #x, , Incoming$
    LOOP WHILE LEN(Incoming$) < 23

    xco1 = CVS(MID$(Incoming$, 1, 4))
    yco1 = CVS(MID$(Incoming$, 5, 4))
    ch1$ = MID$(Incoming$, 9, 5)
    opname$ = MID$(Incoming$, 14, 10)

    IF ch$ = "KELLY" THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(122, 26, 206), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$
    IF ch$ = "SOLT " THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(244, 28, 33), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$

    IF ch1$ = "KELLY" THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(122, 26, 206), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$
    IF ch1$ = "SOLT " THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(244, 28, 33), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$

    LOCATE 1, 1: PRINT ch$, ch1$, xco1, yco1, xco, yco, opname$
    _DISPLAY
    CLS
LOOP

FUNCTION MOUSECLICK (x1, x2, y1, y2)
    mx = _MOUSEX
    my = _MOUSEY
    mb = _MOUSEBUTTON(1)

    IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 AND mb = -1 THEN
        MOUSECLICK = -1
    END IF
END FUNCTION

FUNCTION MOUSEHOVER (x1, x2, y1, y2)
    mx = _MOUSEX
    my = _MOUSEY
    mb = _MOUSEBUTTON(1)

    IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 THEN
        MOUSEHOVER = -1
    END IF
END FUNCTION

« Last Edit: May 17, 2018, 10:50:27 am by Petr »
Coding is relax.

FellippeHeitor

  • QB64 Partner Site Owner
  • Hero Member
  • *
  • Posts: 1901
  • LET IT = BE
    • QB64.org
Re: (HOST) PUT # and GET #
« Reply #16 on: May 17, 2018, 10:33:03 am »
Glad to hear you figured it out  ;)
- InForm for QB64 http://qb64.org/inform

- vWATCH64 (debugger for QB64) http://bit.ly/vWATCH64v1-103

- Games: http://bit.ly/2048_qb64 * http://bit.ly/ClonedShades_qb64source * http://bit.ly/2aqK866 * http://bit.ly/SpaceshipQB64 * http://bit.ly/2rD1pPP

Prithak

  • Full Member
  • ***
  • Posts: 109
  • Programmer: A machine turns Coffee into Code.
Re: (HOST) PUT # and GET #
« Reply #17 on: May 18, 2018, 08:30:02 am »
Quote from: Petr on May 17, 2018, 10:09:11 am
Great thanks to Fellippe!

Great excuse for developers!

Here, Prithak, after many experiments, is finally what you wanted. With names. I used the same path that I write binary files. And it works perfectly. I also needed to make it clear for me. Perfect query. New knowledge. Thanks you all.  ;D

Code: [Select]
_TITLE "Rangers Of Power!"
SCREEN _NEWIMAGE(800, 600, 32)
COLOR _RGB32(0, 0, 0)
COLOR , _RGB32(33, 22, 227)
CLS
DIM uname AS STRING * 10 'this muss be here. IF you need bigger string lenght for name, then REWRITE LEN conditions on lines 179 and 230!!!!


'Before Testing the Client and Maps. I will go to the game directly
map = 1
GOTO menu
client = _OPENHOST("TCP/IP:8080")
DO
    LOCATE 1, 1: PRINT "Trying to Connect to Client."
    z = _OPENCONNECTION(client)
    IF z THEN
        GET #z, , map
        CLOSE #z
    ELSE
        map = 0
    END IF
LOOP UNTIL map <> 0
menu:
IF _FILEEXISTS("name.txt") THEN
    OPEN "name.txt" FOR INPUT AS #1
    INPUT #1, uname$
    CLOSE #1
ELSE
    INPUT "Enter Your Name"; uname$ 'renamed to uname because NAME is statement
    OPEN "name.txt" FOR OUTPUT AS #1
    PRINT #1, uname$
    CLOSE #1
END IF
DO
    DO WHILE _MOUSEINPUT
        _LIMIT 1000
        _PRINTSTRING (_WIDTH / 2, 0), "Rangers Of Power!"
        IF MOUSEHOVER(_WIDTH / 2, _WIDTH / 2 + 100, _HEIGHT / 2, _HEIGHT / 2 + 100) <> -1 THEN
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(249, 155, 11), BF
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(0, 0, 0), B
        ELSE
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(55, 238, 244), BF
            LINE (_WIDTH / 2, _HEIGHT / 2)-(_WIDTH / 2 + 100, _HEIGHT / 2 + 100), _RGB32(0, 0, 0), B
        END IF

        IF MOUSECLICK(_WIDTH / 2, _WIDTH / 2 + 100, _HEIGHT / 2, _HEIGHT / 2 + 100) = -1 THEN
            GOTO game
        END IF

        IF map = 0 THEN _PRINTSTRING (_WIDTH / 2, _HEIGHT / 2 + 100), "No Connection With Client"
        IF map = 1 THEN _PRINTSTRING (_WIDTH / 2, _HEIGHT / 2 + 100), "Current Map = Survivor"
        _DISPLAY
        _LIMIT 150
        CLS
    LOOP
LOOP

game:
SCREEN _NEWIMAGE(512, 512, 32)
COLOR _RGB32(0, 0, 0)
COLOR , _RGB32(33, 22, 227)
CLS
DO
    DO WHILE _MOUSEINPUT
        _LIMIT 1000
        LOCATE 1, 1: PRINT "Choose One"

        IF MOUSEHOVER(100, 200, 100, 200) THEN
            LINE (100, 100)-(200, 200), _RGB32(55, 238, 244), BF
            LINE (100, 100)-(200, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 100)-(200, 200), _RGB32(249, 155, 11), BF
            LINE (100, 100)-(200, 200), _RGB32(0, 0, 0), B
        END IF

        LINE (120, 110)-(180, 190), _RGB32(122, 26, 206), BF
        LINE (120, 110)-(180, 190), _RGB32(0, 0, 0), B

        IF MOUSEHOVER(300, 400, 100, 200) THEN
            LINE (300, 100)-(400, 200), _RGB32(55, 238, 244), BF
            LINE (300, 100)-(400, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (300, 100)-(400, 200), _RGB32(249, 155, 11), BF
            LINE (300, 100)-(400, 200), _RGB32(0, 0, 0), B
        END IF

        LINE (320, 110)-(380, 190), _RGB32(244, 28, 33), BF
        LINE (320, 110)-(380, 190), _RGB32(0, 0, 0), B


        IF MOUSECLICK(100, 200, 100, 200) THEN
            ch$ = "KELLY"
        ELSEIF MOUSECLICK(300, 400, 100, 200) THEN
            ch$ = "SOLT "
        END IF

        IF ch$ <> "" THEN GOTO playgame
        _DISPLAY
        _LIMIT 150
        CLS
    LOOP
LOOP

playgame:
CLS
DO
    DO WHILE _MOUSEINPUT
        IF MOUSEHOVER(100, 300, 100, 200) THEN
            LINE (100, 100)-(300, 200), _RGB32(55, 238, 244), BF
            LINE (100, 100)-(300, 200), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 100)-(300, 200), _RGB32(249, 155, 11), BF
            LINE (100, 100)-(300, 200), _RGB32(0, 0, 0), B
        END IF
        IF MOUSEHOVER(100, 300, 300, 400) THEN
            LINE (100, 300)-(300, 400), _RGB32(55, 238, 244), BF
            LINE (100, 300)-(300, 400), _RGB32(0, 0, 0), B
        ELSE
            LINE (100, 300)-(300, 400), _RGB32(249, 155, 11), BF
            LINE (100, 300)-(300, 400), _RGB32(0, 0, 0), B
        END IF
        IF MOUSECLICK(100, 300, 100, 200) THEN type$ = "CLIENT": GOTO realgame
        IF MOUSECLICK(100, 300, 300, 400) THEN type$ = "HOST": GOTO realgame

        COLOR , _RGB32(249, 155, 11):
        _PRINTSTRING (200, 150), "CLIENT"
        _PRINTSTRING (200, 350), "HOST"

        COLOR , _RGB32(33, 22, 227)
        _DISPLAY
        CLS
        _LIMIT 1000
    LOOP
LOOP

realgame:
CLS
IF type$ = "HOST" THEN _TITLE "HOST": GOTO host
IF type$ = "CLIENT" THEN _TITLE "CLIENT": GOTO client

host:
SCREEN _NEWIMAGE(800, 600, 32)
DO
    x = _OPENHOST("TCP/IP:8080")

    IF x THEN EXIT DO ELSE PRINT "Can't Connect"
    _DISPLAY
    CLS
LOOP
PRINT "Waiting for Client"
DO
    z = _OPENCONNECTION(x)

    IF z THEN EXIT DO

    _DISPLAY
    CLS
LOOP
DO
    '    INPUT "Enter X"; xco
    '    INPUT "Enter Y"; yco

    k$ = UCASE$(INKEY$)

    IF k$ = "W" THEN yco = yco - 5
    IF k$ = "S" THEN yco = yco + 5
    IF k$ = "A" THEN xco = xco - 5
    IF k$ = "D" THEN xco = xco + 5
    Mark = 3000
    'redim _preserve uname as string * 10

    Total$ = MKS$(xco) + MKS$(yco) + ch$ + uname$

    PUT #z, , Total$

    Incoming$ = ""
    DO
        GET #z, , Incoming$
    LOOP WHILE LEN(Incoming$) < 23

    xco1 = CVS(MID$(Incoming$, 1, 4))
    yco1 = CVS(MID$(Incoming$, 5, 4))
    ch1$ = MID$(Incoming$, 9, 5)
    opname$ = MID$(Incoming$, 14, 10)


    IF ch$ = "KELLY" THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(122, 26, 206), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$
    IF ch$ = "SOLT " THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(244, 28, 33), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$

    IF ch1$ = "KELLY" THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(122, 26, 206), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$
    IF ch1$ = "SOLT " THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(244, 28, 33), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$

    LOCATE 1, 1: PRINT ch$, ch1$, xco1, yco1, xco, yco, oppname$
    _DISPLAY
    CLS
LOOP

client:
SCREEN _NEWIMAGE(800, 600, 32)
DO
    x = _OPENCLIENT("TCP/IP:8080:localhost")

    IF x THEN EXIT DO ELSE PRINT "Can't Connect"

    _DISPLAY
    CLS
LOOP

DO
    k$ = UCASE$(INKEY$)

    IF k$ = "W" THEN yco = yco - 5
    IF k$ = "S" THEN yco = yco + 5
    IF k$ = "A" THEN xco = xco - 5
    IF k$ = "D" THEN xco = xco + 5
    Mark = 3000



    'create new STRING contains ALL informations in one and this then send. The same way use Galleon for writing binary files.

    Total$ = MKS$(xco) + MKS$(yco) + ch$ + uname$
    '        4 bytes   + 4 bytes  +  5 bytes + 10 bytes  = sending 23 bytes

    PUT #x, , Total$

    Incoming$ = ""
    DO
        GET #x, , Incoming$
    LOOP WHILE LEN(Incoming$) < 23

    xco1 = CVS(MID$(Incoming$, 1, 4))
    yco1 = CVS(MID$(Incoming$, 5, 4))
    ch1$ = MID$(Incoming$, 9, 5)
    opname$ = MID$(Incoming$, 14, 10)

    IF ch$ = "KELLY" THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(122, 26, 206), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$
    IF ch$ = "SOLT " THEN LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(244, 28, 33), BF: LINE (xco, yco)-(xco + 10, yco + 10), _RGB32(0, 0, 0): COLOR _RGB32(72, 17, 255): _PRINTSTRING (xco, yco - 15), uname$

    IF ch1$ = "KELLY" THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(122, 26, 206), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$
    IF ch1$ = "SOLT " THEN LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(244, 28, 33), BF: LINE (xco1, yco1)-(xco1 + 10, yco1 + 10), _RGB32(0, 0, 0): COLOR _RGB32(255, 17, 72): _PRINTSTRING (xco1, yco1 - 15), opname$

    LOCATE 1, 1: PRINT ch$, ch1$, xco1, yco1, xco, yco, opname$
    _DISPLAY
    CLS
LOOP

FUNCTION MOUSECLICK (x1, x2, y1, y2)
    mx = _MOUSEX
    my = _MOUSEY
    mb = _MOUSEBUTTON(1)

    IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 AND mb = -1 THEN
        MOUSECLICK = -1
    END IF
END FUNCTION

FUNCTION MOUSEHOVER (x1, x2, y1, y2)
    mx = _MOUSEX
    my = _MOUSEY
    mb = _MOUSEBUTTON(1)

    IF mx >= x1 AND mx <= x2 AND my >= y1 AND my <= y2 THEN
        MOUSEHOVER = -1
    END IF
END FUNCTION

Wow. I am shocked beyond imagination... Time to get to make this a full-fledged game!!!!
Q: 0 is False and 1 is True, right?
A: 1

Petr

  • Hero Member
  • *****
  • Posts: 682
Re: (HOST) PUT # and GET #
« Reply #18 on: May 18, 2018, 11:02:47 am »
Yes, make it a full-fledged game. I like to play it.
Coding is relax.

Petr

  • Hero Member
  • *****
  • Posts: 682
Re: (HOST) PUT # and GET #
« Reply #19 on: May 18, 2018, 02:42:00 pm »
Prithak,

If you wanted to send pictures over the network, here I tried to make a demonstration of how to send it. I find that if I send the data too quickly, the picture will be corrupted. So, there's a chance to send it either smaller or before running your main program.

If Fellippe reads: Is there a chance to make it faster? (in 32 bit).

Code: [Select]

'for image data transfer use 400 Bytes blocks.

DIM SHARED Host AS LONG, Client AS LONG
I_am = Network("localhost")
Image& = _SCREENIMAGE '_LOADIMAGE("so.jpg", 32)

SELECT CASE I_am
    CASE 1 'HOST   -    in this demo HOST send image to client
        W& = _WIDTH(Image&)
        H& = _HEIGHT(Image&)
        D& = _PIXELSIZE(Image&)
        Head$ = MKL$(W&) + MKL$(H&) + MKL$(D&)
        PUT #Host, , Head$
        _DELAY .05
        CLS
        _TITLE "Host"
        FOR Y = 0 TO H& - 1
            FOR X = 0 TO W& - 1
                IF _CONNECTED(Host&) = 0 THEN PRINT "Connection failure.": END
                Show& = Show& + 1
                _SOURCE Image&
                Transport$ = Transport$ + MKL$(POINT(X, Y))
                IF LEN(Transport$) = 400 THEN '                                                  400 is divisible 4, return integer
                    PUT #Host, , Transport$: Transport$ = ""
                    _DELAY .008 '                                                                if is delay lower, data then are writed too late and picture is comming wrong
                    LOCATE 1, 1: PRINT "Sending picture data:"; CLNG(100 * (Show& / (H& * W&))); "%": _DISPLAY
                END IF
        NEXT X, Y
        LOCATE 2, 1: PRINT "Image transfered": _DISPLAY

    CASE 2 'CLIENT - in this demo receive picture and show it on the screen
        _TITLE "Client"
        Head$ = Transfer$(Client&, 12)
        W& = CVL(MID$(Head$, 1, 4))
        H& = CVL(MID$(Head$, 5, 4))
        D& = CVL(MID$(Head$, 9, 4))
        SELECT CASE D&
            CASE 0: PRINT "Textmode not supported": END
            CASE 1: clrs = 256
            CASE 4: clrs = 32
        END SELECT
        SCREEN _NEWIMAGE(W&, H&, clrs)


        DO UNTIL W& * H& < points&
            Inport$ = Transfer$(Client&, 400)
            FOR Drw = 1 TO 400 STEP 4
                IF _CONNECTED(Client&) = 0 THEN PRINT "Connection failure.": END
                PSET (imgx, imgy), CVL(MID$(Inport$, Drw, 4))
                IF imgx >= W& - 1 THEN imgx = 0: imgy = imgy + 1 ELSE imgx = imgx + 1
                points& = points& + 1
            NEXT Drw
            Inport$ = ""
        LOOP
END SELECT


FUNCTION Transfer$ (channel AS LONG, lenght)
    Transfer$ = ""
    DO
        GET #channel&, , Transfer$
        IF _CONNECTED(channel&) = 0 THEN PRINT "Connection failure.": END
    LOOP WHILE LEN(Transfer$) < lenght
END FUNCTION

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
        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&
            Network = 1
        END IF
    END IF
END FUNCTION

Coding is relax.

Petr

  • Hero Member
  • *****
  • Posts: 682
Re: (HOST) PUT # and GET #
« Reply #20 on: May 19, 2018, 04:05:00 am »
Fellippe is right, because none answer = TRY IT. And i tryed it again :-D I found that when transferring data across a network, it's best if the program does nothing else, because it fatally slows the transfer - even printing on the screen. During experiments, I also achieved in localhost mode that I was waiting for 8 minutes on the screen shot. Brutal. It just wants to try. This program is (perhaps) a easyer version of the previous program and I would say a bit faster. I do additional network experiments.

Code: [Select]



DIM SHARED Host AS LONG, Client AS LONG
I_am = Network("localhost")
Image& = _SCREENIMAGE '_LOADIMAGE("so.jpg", 32)
'Image& = _LOADIMAGE("b.jpg", 32)

SELECT CASE I_am
    CASE 1 'HOST   -    in this demo HOST send image to client
        W& = _WIDTH(Image&)
        H& = _HEIGHT(Image&)
        D& = _PIXELSIZE(Image&)
        Head$ = MKL$(W&) + MKL$(H&) + MKL$(D&)
        PUT #Host, , Head$
        _DELAY .05
        8 CLS

        _TITLE "Host"
        FOR Y = 0 TO H& - 1
            FOR X = 0 TO W& - 1
                Show& = Show& + 1
                _SOURCE Image&
                IMGDAT& = POINT(X, Y)
                PUT #Host&, , IMGDAT&
                IF LOF(Host&) > 10000 THEN BEEP
                LOCATE 1, 1: PRINT "Sending picture data:"; CLNG(100 * (Show& / (H& * W&))); "%": _DISPLAY
        NEXT X, Y
        PRINT "Waiting for confirm": _DISPLAY
        message$ = Transfer$(Host&, 6)
        DO
            PRINT message$
            IF message$ = "ALL OK" THEN LOCATE 2, 1: PRINT "Image transferred   ": _DISPLAY: END
            _DISPLAY
            _LIMIT 25
        LOOP

    CASE 2 'CLIENT - in this demo receive picture and show it on the screen
        _TITLE "Client"
        Head$ = Transfer$(Client&, 12)
        W& = CVL(MID$(Head$, 1, 4))
        H& = CVL(MID$(Head$, 5, 4))
        D& = CVL(MID$(Head$, 9, 4))
        SELECT CASE D&
            CASE 0: PRINT "Textmode not supported": END
            CASE 1: clrs = 256
            CASE 4: clrs = 32
        END SELECT
        SCREEN _NEWIMAGE(W&, H&, clrs)
        _DEST 0
        DO
            GET #Client&, , value&
            IF value& THEN
                PSET (imgx, imgy), value&
                IF imgx = W& - 1 THEN imgx = 0: imgy = imgy + 1 ELSE imgx = imgx + 1
                IndexClient& = IndexClient& + 1
                H = CLNG(100 * (IndexClient& / (H& * W&)))
                IF oldH <> H THEN LOCATE 1, 1: PRINT "Receiving data:"; H; "%": oldH = H '       MUSS TRY! Uncomment this IF condition and print this everytime. Big speed distance occured. (As with _MEM use)
                value& = 0
            END IF
        LOOP WHILE IndexClient& < (W& - 1) * (H& - 1)
        confirm$ = "ALL OK" '6 bytes
        PUT #Client&, , confirm$
        END
END SELECT


FUNCTION Transfer$ (channel AS LONG, lenght)
    Transfer$ = ""
    DO
        GET #channel&, , T$
        IF LEN(T$) THEN Transfer$ = Transfer$ + T$
        '  IF _CONNECTED(channel&) = 0 THEN PRINT "Connection failure.": END
    LOOP WHILE LEN(Transfer$) < lenght
END FUNCTION

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
        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&
            Network = 1
        END IF
    END IF
END FUNCTION

« Last Edit: May 19, 2018, 04:35:29 am by Petr »
Coding is relax.

FellippeHeitor

  • QB64 Partner Site Owner
  • Hero Member
  • *
  • Posts: 1901
  • LET IT = BE
    • QB64.org
Re: (HOST) PUT # and GET #
« Reply #21 on: May 19, 2018, 08:40:52 am »
You can read a whole image's contents from memory:

Code: [Select]
        DIM Buffer AS _MEM, Offset AS _OFFSET, lastOffset AS _OFFSET
        Buffer = _MEMIMAGE(Image&)
        Offset = Buffer.OFFSET
        lastOffset = Buffer.OFFSET + _WIDTH(Image&) * _HEIGHT(Image&) * 4

        imageData$ = SPACE$(lastOffset - Offset)
        _MEMGET Buffer, Offset, imageData$
        _MEMFREE Buffer

imageData$ now contains the whole image data and you didn't have to read it with POINT, pixel by pixel. Much faster, right? Now send imageData$ to the client and then the client will restore the image in memory with:

Code: [Select]
        receivedImage& = _NEWIMAGE(W&, H&, 32) 'use the width and height you transferred before here
        Buffer = _MEMIMAGE(receivedImage&)
        _MEMPUT Buffer, Buffer.OFFSET, imageData$
        _MEMFREE Buffer

Now receivedImage& contains the image data transferred before.
- InForm for QB64 http://qb64.org/inform

- vWATCH64 (debugger for QB64) http://bit.ly/vWATCH64v1-103

- Games: http://bit.ly/2048_qb64 * http://bit.ly/ClonedShades_qb64source * http://bit.ly/2aqK866 * http://bit.ly/SpaceshipQB64 * http://bit.ly/2rD1pPP

Petr

  • Hero Member
  • *****
  • Posts: 682
Re: (HOST) PUT # and GET #
« Reply #22 on: May 19, 2018, 10:01:14 am »
Hi Fellippe,

thank you for your example. I am now back so i try it.

Edit:

So I tried it.  :o  Well, that's something really unreal. I thought that the delay would be in the transmission ... but it seems that any converting of the values to strings or from strings to numeric values  in networking will multiply delay. Your solution with _MEM is a complete rocket. So very big difference! Thank again!

Code: [Select]



DIM SHARED Host AS LONG, Client AS LONG
DIM Buffer AS _MEM, Offset AS _OFFSET, lastOffset AS _OFFSET

I_am = Network("localhost")
image& = _SCREENIMAGE '_LOADIMAGE("so.jpg", 32)
'Image& = _LOADIMAGE("3.jpg", 32)

SELECT CASE I_am
    CASE 1 'HOST   -    in this demo HOST send image to client
        _TITLE "Host"
        Res$ = MKL$(_WIDTH(image&)) + MKL$(_HEIGHT(image&)) + MKL$(_PIXELSIZE(image&))
        PUT #Host, , Res$


        Buffer = _MEMIMAGE(image&)
        Offset = Buffer.OFFSET
        lastOffset = Buffer.OFFSET + _WIDTH(image&) * _HEIGHT(image&) * 4
        imageData$ = SPACE$(lastOffset - Offset)
        _MEMGET Buffer, Offset, imageData$
        _MEMFREE Buffer
        LOCATE 1, 1: PRINT "Sending picture data:"

        PUT #Host, , imageData$
        _DELAY .05
        PRINT "Waiting for confirm": _DISPLAY
        message$ = Transfer$(Host&, 6)

        DO
            IF message$ = "ALL OK" THEN LOCATE 2, 1: PRINT "Image transferred   ": _DISPLAY: END
            _DISPLAY
            _LIMIT 25
        LOOP


    CASE 2 'CLIENT - in this demo receive picture and show it on the screen
        _TITLE "Client"
        Head$ = Transfer$(Client&, 12)
        W& = CVL(MID$(Head$, 1, 4))
        H& = CVL(MID$(Head$, 5, 4))
        D& = CVL(MID$(Head$, 9, 4))
        SELECT CASE D&
            CASE 0: PRINT "Textmode not supported": END
            CASE 1: clrs = 256
            CASE 4: clrs = 32
        END SELECT

        imageData$ = Transfer$(Client&, (W& * H& * D&))
        receivedImage& = _NEWIMAGE(W&, H&, clrs) 'use the width and height you transferred before here
        Buffer = _MEMIMAGE(receivedImage&)
        _MEMPUT Buffer, Buffer.OFFSET, imageData$
        _MEMFREE Buffer
        SCREEN receivedImage&
        confirm$ = "ALL OK" '6 bytes
        PUT #Client&, , confirm$
        END
END SELECT


FUNCTION Transfer$ (channel AS LONG, lenght)
    Transfer$ = ""
    DO
        GET #channel&, , T$
        IF LEN(T$) THEN Transfer$ = Transfer$ + T$
        '  IF _CONNECTED(channel&) = 0 THEN PRINT "Connection failure.": END
    LOOP WHILE LEN(Transfer$) < lenght
END FUNCTION

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
        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&
            Network = 1
        END IF
    END IF
END FUNCTION


hmmm, i tested it in real network now.... and work not.     IT WORK  did not see the firewall message on the second monitor over my laptop monitor.  ::)
« Last Edit: May 19, 2018, 11:57:43 am by Petr »
Coding is relax.

  • Print