\
\ N e t w o r k . f
\
\	Networking code for Win32forth
\	Makes use of the windows native socket support: ws2_32.dll
\
\	by Larry B. Daniel www.larrybrucedaniel.com/forth
\	October 12, 2005
\
ANEW -network-

: swab ( n - n ) \ Swab bytes in a word
	dup 0xFF and 256 * swap 256 / +
	;

:Class Network <Super Object

	winlibrary ws2_32.dll
	2 PROC WSAStartup
	3 PROC socket
	0 PROC WSAGetLastError
	1 PROC closesocket
	3 PROC connect
	4 PROC send
	4 PROC recv
	1 PROC inet_addr
	1 PROC gethostbyname
	1 PROC inet_ntoa

	\ Socket Address Structure
	create saddr AF_INET w, 0 w, 0 , 0 , 0 ,

	0 value hostentAddress
	0 value socketHandle

	:M GetError: ( -- error_number )
		call WSAGetLastError ;M

	:M SetAddress: ( Zstring -- ) \ Make an Address from a Zero terminated string
		call inet_addr saddr 4 + ! ;M

	:M SetPort: ( port -- ) \ port number
		 swab saddr 2 + w! ;M

	:M SetHost: ( zstring -- n ) \ zero terminated string
		call gethostbyname to hostentAddress
		hostentAddress 0<> if hostentAddress 12 + @ @ @ saddr 4 + !
		else GetError: self ." Error Setting Host " . then
		;M

	:M Open: ( -- )
		IPPROTO_TCP SOCK_STREAM AF_INET call socket to socketHandle
		GetError: self 0<> if ." Error opening stream socket" . then
		;m

	:M Close: ( -- )
		socketHandle call closesocket drop
		0 to socketHandle ;M

	:M Dump:
		saddr 4 + @  call inet_ntoa ." Address: " zcount type
		saddr 2 + w@ swab ."  Port: " . cr ;m

	:M Connect: ( -- )
		16 saddr socketHandle call connect 0<> if
			GetError: self ." connect error " .
		then
		;m

	:M Send: { adr len -- } \ Send string
		0 len adr socketHandle call send drop ;M

	:M SendLineFeed: ( -- ) \ Send just a line feed
		13 PAD c! 10 PAD 1 + c! pad 2 Send: self  ;M

	:M SendLine: ( adr len -- ) \ Send String with Newline Added
		Send: self SendLineFeed: self ;M

	:M Receive: { adr len -- n } \ Receive string
		0 len adr socketHandle call recv ;M

	:M ClassInit:
		pad 1 call WSAStartup drop
		ClassInit: super ;m

;class

Network net

: netTest ( -- )
	Z" www.google.com" SetHost: net
	80 SetPort: net
	Open: net
	Connect: net
	GetError: net 0<> if exit then
	S" GET / HTTP/1.0" SendLine: net SendLineFeed: net
	begin
		PAD 80 Receive: net ?dup 0>
	while
		PAD swap type
	repeat
	Close: net ;