: WEB-ANSWER ( addr u R -- )
  FALSE LOG ! >R
  2DUP />\ 
  TIB >R >IN @ >R #TIB @ >R
  #TIB ! >IN 0! TO TIB
  BL WORD DROP >IN 1+! BL PARSE
  R> #TIB ! R> >IN ! R> TO TIB 2DUP + 0!
  DUP 0= IF DROP S" index.html" DUP >R HERE CELL+ SWAP 1+ MOVE HERE CELL+ R> THEN
  2 + SWAP 2 - [CHAR] . OVER C! [CHAR] \ OVER 1+ C! SWAP
  2DUP TYPE CR
  2DUP R/O OPEN-FILE
  IF DROP S" HTTP/1.0 400 Bad Request" R@ CELL+ @ WriteSocketLine DROP
     S" Content-Type: text/html" R@ CELL+ @ WriteSocketLine DROP
     R@ CELL+ @ WriteSocketCRLF DROP
     S" <BODY><H1>  :</H1></BODY>" R@ CELL+ @ WriteSocketLine DROP
     R> CELL+ @ WriteSocketLine DROP
     ." BAD REQUEST" CR
     EXIT
  THEN NIP NIP
  R@ 4 CELLS + !
  S" HTTP/1.0 200 OK" R@ CELL+ @ WriteSocketLine DROP
  S" Server: SP-Forth-PWS/0.1" R@ CELL+ @ WriteSocketLine DROP
  R@ CELL+ @ WriteSocketCRLF DROP
  BEGIN
    R@ 5 CELLS + 400 R@ 4 CELLS + @ READ-FILE
    IF DROP R> 4 CELLS + @ CLOSE-FILE DROP EXIT THEN
    ?DUP
  WHILE
    R@ 5 CELLS + SWAP R@ CELL+ @ WriteSocket DROP
  REPEAT
  R> 4 CELLS + @ CLOSE-FILE DROP
;

: (WEB-THREAD)
  INIT-THREAD
  500 ALLOCATE THROW >R
  CLIENTS-LIST @ R@ !
  CUR-TALK @ R@ CELL+ !
  BEGIN
    R@ 2 CELLS + 0!
    BEGIN
      R@ 3 CELLS + R@ 2 CELLS + @ +
      500 R@ 2 CELLS + @ -
      R@ CELL+ @ ReadSocket
      IF DROP R@ CELL+ DUP @ CloseSocket DROP 0! 0 R> FREE . ExitThread
      ELSE R@ 2 CELLS + +! THEN
      R@ 3 CELLS +  R@ 2 CELLS + @ CRLFCRLF 4 SEARCH NIP NIP
    UNTIL
    R@ 3 CELLS +  R@ 2 CELLS + @ R@ WEB-ANSWER
    R@ CELL+ @ CloseSocket DROP R@ FREE . 0 ExitThread
  AGAIN
  R> DROP 0
;
' (WEB-THREAD) WNDPROC: WEB-THREAD

: WEB-SERVER ( "port dir" -- )
  0 0 BL WORD COUNT >NUMBER 2DROP D>S
  HERE WEB-DIR ! 1 WORD ",
  SocketsStartup THROW
  CreateSocket THROW >R
  R@ BindSocket THROW
  R@ ListenSocket THROW
  BEGIN
    R@ AcceptSocket THROW DUP CUR-TALK !
    GetPeerName DROP CR TYPE ." : "
    ['] WEB-THREAD CREATE-THREAD DROP
  AGAIN
  R> DROP
;
