update

CONTRIB

@@ -0,0 +1,4 @@
+Patches prefered.
+Pull requests and issues will be acknowledged.
+
+Email me: emilwilliams@tuta.io

client/README

@@ -12,4 +12,9 @@ moontalk.tcl:
 
 moontalk.c:
 
-IS INCOMPLETE, do not use it.
+  IS INCOMPLETE, do not use it.
+
+  To compile it, use bake <https://git.lain.church/emil/bake> or just run:
+    gcc -O2 -std=gnu99 moontalk.c -o moontalk -lncurses -ltinfo
+
+  Run -help for further details for usage.

server/eventloop-server-experiment/commandline.4th

@@ -0,0 +1,69 @@
+
+80 constant COMMANDLINE_SIZE
+create commandline COMMANDLINE_SIZE allot
+variable cmdcursor
+variable cmdready
+
+: (cursor@) ( -- index-u ) cmdcursor @ ;
+: (translate) ( index-u -- addr )
+  commandline + ;
+: (last-position) ( -- index-u )
+  COMMANDLINE_SIZE 1- ;
+: (tail) ( index-u -- length-u )
+  COMMANDLINE_SIZE swap - ;
+: (cursor-left) ( -- ) (cursor@) 1- 0 max cmdcursor ! ;
+: (cursor-right) ( -- ) (cursor@) 1+ COMMANDLINE_SIZE 1- min cmdcursor ! ;
+: (overwrite-char) ( c -- )
+  commandline (cursor@) + c! ;
+: (append-char) ( c -- )
+  (cursor@) (last-position) <> IF
+    (cursor@) dup (translate) dup 1+ rot (tail) 1- move
+  THEN (overwrite-char) ;
+: (backspace) ( -- )
+  (cursor@) 0> IF
+    (cursor@) (translate) dup 1- (cursor@) (tail) move
+    bl (last-position) (translate) c!
+    (cursor-left)
+  THEN ;
+
+: commandline-handlekey ( ekey-n -- )
+  ekey>char if ( c )
+    CASE
+       10 OF true cmdready ! ENDOF \ newline
+       13 OF true cmdready ! ENDOF \ carriage return
+      127 OF (backspace) ENDOF \ DEL
+      (append-char) (cursor-right) EXIT
+    ENDCASE
+  else ekey>fkey if ( key-id )
+    case
+      k-left  of (cursor-left) endof
+      k-right of (cursor-right) endof
+    endcase
+  else ( keyboard-event )
+    drop \ just ignore an unknown keyboard event type
+  then then ;
+
+: commandline-getline ( -- c-addr u )
+  commandline COMMANDLINE_SIZE ;
+
+: (update-cursorpos) ( -- )
+  s\" \033[" type
+  (cursor@) 1+ s>d <# #s #> type
+  s" G" type ;
+: (carriage-return) ( -- )
+  13 emit ;
+: commandline-redraw ( -- )
+  (carriage-return)
+  commandline-getline type
+  (update-cursorpos) ;
+
+: commandline-reset ( -- )
+  commandline COMMANDLINE_SIZE bl fill
+  0 cmdcursor !
+  false cmdready ! ;
+
+: commandline-key? ( -- flag ) key? ;
+: commandline-key  ( -- ekey ) ekey ;
+: commandline-ready? ( -- flag ) cmdready @ ;
+
+commandline-reset

server/eventloop-server-experiment/event-constants.4th

@@ -1,6 +1,8 @@
 
 0 constant EVENT_IDLE
-1 constant EVENT_CONNECTION_NEW
+1 constant EVENT_COMMANDLINE
-2 constant EVENT_CONNECTION_CLOSED
+2 constant EVENT_MOTD_CHANGED
-3 constant EVENT_CONNECTION_SEND
+3 constant EVENT_CONNECTION_NEW
-4 constant EVENT_CONNECTION_RECV
+4 constant EVENT_CONNECTION_CLOSED
+5 constant EVENT_CONNECTION_SEND
+6 constant EVENT_CONNECTION_RECV

server/eventloop-server-experiment/main.4th

@@ -3,16 +3,29 @@ require eventloop.4th
 require event-constants.4th
 require server.4th
 
+variable clcounter
+0 clcounter !
+: handle-command-line? ( -- flag )
+  clcounter @ 10 >= dup IF
+    0 clcounter !
+  ELSE
+    1 clcounter +!
+  THEN ;
+
 : custom-eventloop ( -- )
   BEGIN
+    handle-command-line? IF
+      0 EVENT_COMMANDLINE events.enqueue
+    THEN
     eventloop.has-events? IF
       eventloop.dispatch
     ELSE
       server-idle? IF
-        10 ms false server-idle!
+        1 ms false server-idle!
       THEN
       0 0 events.enqueue eventloop.dispatch
     THEN
   AGAIN ;
 
-' custom-eventloop catch close-server throw
+: main ( -- ) ['] custom-eventloop catch close-server throw ;
+main

server/eventloop-server-experiment/motd.4th

@@ -0,0 +1,79 @@
+
+1024 constant MOTD_BUFFER_SIZE
+create motdbuffer MOTD_BUFFER_SIZE allot
+variable motd-length
+
+: (update) ( str -- )
+  MOTD_BUFFER_SIZE min dup motd-length !
+  motdbuffer swap move ;
+: motd-clear ( -- )
+  motdbuffer MOTD_BUFFER_SIZE bl fill
+  0 motd-length ! ;
+: motd-append ( str -- )
+  MOTD_BUFFER_SIZE motd-length @ - min
+  motdbuffer motd-length @ + swap dup motd-length +! move ;
+: motd@ ( -- str )
+  motdbuffer motd-length @ ;
+: motd-propagate ( -- )
+  0 EVENT_MOTD_CHANGED events.enqueue ;
+: .motd ( -- ) motd@ cr type ;
+
+: (strallot) ( str -- )
+  here swap dup allot move ;
+: (append-banner) ( start-addr size-u -- start-addr size-u )
+  BEGIN
+    10 parse
+    2dup s" end-motd-banner" search nip nip IF
+      2drop EXIT
+    THEN
+    dup 0<> IF
+      dup -rot (strallot) + 10 c, 1+
+    ELSE
+      2drop REFILL invert IF
+        EXIT
+      THEN
+    THEN
+  AGAIN ;
+
+: motd-banner ( "name" -- )
+  create here 0 , 0 (append-banner) swap ! ;
+: end-motd-banner ( -- )
+  true abort" run motd-banner first." ;
+
+: motd-banner@ ( addr -- str )
+  dup cell + swap @ ;
+
+: motd-compose ( message-str banner-str -- )
+  motd-clear
+  ( banner-str )  motd-append
+  s\" \n"         motd-append
+  ( message-str ) motd-append
+  s\" \n"         motd-append ;
+
+motd-banner motd-forth1
+  ________    ___   _______   _________  ____  ____ 
+ |_   __  | .'   `.|_   __ \ |  _   _  ||_   ||   _|
+   | |_ \_|/  .-.  \ | |__) ||_/ | | \_|  | |__| |  
+   |  _|   | |   | | |  __ /     | |      |  __  |  
+  _| |_    \  `-'  /_| |  \ \_  _| |_    _| |  | |_ 
+ |_____|    `.___.'|____| |___||_____|  |____||____|
+end-motd-banner
+
+motd-banner motd-forth2
+ _______  _____   ______ _______ _     _
+ |______ |     | |_____/    |    |_____|
+ |       |_____| |    \_    |    |     |
+end-motd-banner
+
+motd-banner motd-forth3
+    _/_/_/_/    _/_/    _/_/_/    _/_/_/_/_/  _/    _/   
+   _/        _/    _/  _/    _/      _/      _/    _/    
+  _/_/_/    _/    _/  _/_/_/        _/      _/_/_/_/     
+ _/        _/    _/  _/    _/      _/      _/    _/      
+_/          _/_/    _/    _/      _/      _/    _/       
+end-motd-banner
+
+: motd-current-banner ( -- str )
+  motd-forth3 motd-banner@ ;
+
+s" Lorem ipsum magnam quae aperiam maiores dolor quis ut." motd-current-banner motd-compose

server/eventloop-server-experiment/sendbuffer.4th

@@ -1,5 +1,5 @@
 variable sendbuffer-len 0 sendbuffer-len !
-2048 constant SENDBUFFER_SIZE
+4096 constant SENDBUFFER_SIZE
 create sendbuffer SENDBUFFER_SIZE allot
 
 \ Calling C here is just optimization.
@@ -7,7 +7,7 @@ c-library sanitizelib
 \c void csanitize(char *buffer, int buffersize) {
 \c     int lastIsNewline = buffer[buffersize-1] == '\n' ? 1 : 0;
 \c     for(int i = 0; i<buffersize; i++) {
-\c         if(buffer[i]<32 || buffer[i]>127) { buffer[i] = '?'; }
+\c         if(buffer[i]<32 || buffer[i]>126) { buffer[i] = '?'; }
 \c     }
 \c     if(lastIsNewline) { buffer[buffersize-1] = '\n'; }
 \c     return;

server/eventloop-server-experiment/server.4th

@@ -2,6 +2,8 @@ require unix/socket.fs
 
 require socket-extensions.4th
 require connections.4th
+require commandline.4th
+require motd.4th
 require sendbuffer.4th
 
 AF_INET constant SERVER_SOCKET_DOMAIN
@@ -148,8 +150,7 @@ create optval /option_value allot
     EVENT_CONNECTION_RECV events.enqueue
   ELSE \ disconnected
     (queue-disconnect)
-  THEN
+  THEN ;
-;
 : (recv-warning) ( -- ) ." Warning: recv failed, disconnecting client." cr ;
 : (recv-error) ( recv-result-n connection-addr -- )
   errno EAGAIN <> IF
@@ -178,26 +179,17 @@ create optval /option_value allot
     THEN
   LOOP ;
 
-: server-idle-accept ( eventdata-n eventid-n -- )
-  2drop (server-idle-accept) ;
-: server-idle-recv ( eventdata-n eventid-n -- )
-  2drop (server-idle-recv) ;
-: server-connection-new ( connection-addr eventid-n -- )
-  2drop ." New client connected!" cr ;
-: server-connection-closed ( connection-addr eventid-n -- )
-  2drop ." Client disconnected." cr ;
-
 : (to-string) ( n -- addr c )  s>d <# #s #> ;
-: (connectionnumber@) ( connection-addr -- c-addr u )
+: (connection.number>string) ( connection-addr -- c-addr u )
   connection.number @ (to-string) ;
-: (connectionbuffer@) ( connection-addr -- c-addr u )
+: (connection.buffer>string) ( connection-addr -- c-addr u )
   dup connection.buffer swap connection.bufferlen @ ;
 : (format-sendbuffer) ( from-connection-addr -- )
   >r sendbuffer-reset
-     s" Anon "              sendbuffer-append
+     s" Anon "                     sendbuffer-append
-     r@ (connectionnumber@) sendbuffer-append
+     r@ (connection.number>string) sendbuffer-append
-     s" : "                 sendbuffer-append
+     s" : "                        sendbuffer-append
-     r> (connectionbuffer@) sendbuffer-append
+     r> (connection.buffer>string) sendbuffer-append
   sendbuffer-sanitize ;
 : (connected?) ( connection-addr -- )
   connection.connected @ ;
@@ -207,11 +199,13 @@ create optval /option_value allot
   tuck (different-connection?) swap (connected?) and ;
 : (check-send) ( result-n -- )
   0< IF ." Warning: send failed." cr THEN ;
+: (send-sendbuffer) ( to-connection-addr -- )
+  connection.fd @ sendbuffer@ 0 send (check-send) ;
 : (send) ( from-connection-addr to-connection-addr -- )
-  nip connection.fd @ sendbuffer@ 0 send (check-send) ;
+  (send-sendbuffer) ;
 : (try-send) ( from-connection-addr to-connection-addr -- )
   2dup (send?) IF
-    (send)
+    nip (send-sendbuffer)
   ELSE
     2drop
   THEN ;
@@ -221,10 +215,82 @@ create optval /option_value allot
     dup I connections.at (try-send)
   LOOP drop ;
 
+: server-idle-accept ( eventdata-n eventid-n -- )
+  2drop (server-idle-accept) ;
+: server-idle-recv ( eventdata-n eventid-n -- )
+  2drop (server-idle-recv) ;
+variable (strstart)
+variable (strend)
+: (>str) ( startindex-n endindex-n str-addr -- c-addr u )
+  tuck + -rot + tuck - ;
+: (newline?) ( char -- flag ) 10 = ;
+\ TODO: FIXME: refactor and create words to be able to conveniently
+\ TODO: FIXME: send "Server: ..." messages. This will be useful in the repl too.
+: (prepare-motd) ( -- )
+\ TODO: FIXME: just write a proper parser at this point....
+  sendbuffer-reset
+  -1 (strstart) !
+  -1 (strend) !
+  motd@ 0 DO
+    (strstart) @ -1 = IF
+      I (strstart) !
+    THEN
+    dup I + c@ (newline?) IF
+      I (strend) !
+    THEN
+    (strend) @ -1 <> IF
+      s" Server: " sendbuffer-append
+      dup (strstart) @ (strend) @ rot (>str) sendbuffer-append
+      s\" \n" sendbuffer-append
+      -1 (strstart) !
+      -1 (strend) !
+    THEN
+  LOOP drop ;
+: (prepare-empty-line) ( -- )
+  sendbuffer-reset s\" Server: \n" sendbuffer-append ;
+: (prepare-identity) ( connection-addr -- )
+  sendbuffer-reset
+  s\" Server: You are now known as \"Anon " sendbuffer-append
+  (connection.number>string)                sendbuffer-append
+  s\" \".\n"                                sendbuffer-append ;
+: server-connection-new ( connection-addr eventid-n -- )
+  drop ." New client connected!" cr
+  dup (prepare-motd) (send-sendbuffer)
+  dup (prepare-empty-line) (send-sendbuffer)
+  dup (prepare-identity)
+      (send-sendbuffer) ;
+
+: server-connection-closed ( connection-addr eventid-n -- )
+  2drop ." Client disconnected." cr ;
+
+: server-commandline ( eventdata-n eventid-n -- )
+  2drop commandline-ready? IF
+    space commandline-getline ['] evaluate catch dup 0= IF
+      drop ."  ok"
+    ELSE
+      ." error code: " . 2drop
+    THEN
+    cr
+    commandline-reset 
+  ELSE
+    commandline-key? IF
+      commandline-key commandline-handlekey
+      commandline-redraw
+    THEN
+  THEN ;
+
+: server-motd-changed ( eventdata-n eventid-n -- )
+  2drop (prepare-motd)
+  connections.count 0 DO
+    I connections.at (send-sendbuffer)
+  LOOP ;
+
 ' server-idle-accept       EVENT_IDLE              eventhandlers.append
 ' server-idle-recv         EVENT_IDLE              eventhandlers.append
 ' server-connection-new    EVENT_CONNECTION_NEW    eventhandlers.append
 ' server-connection-closed EVENT_CONNECTION_CLOSED eventhandlers.append
 ' server-recv              EVENT_CONNECTION_RECV   eventhandlers.append
+' server-commandline       EVENT_COMMANDLINE       eventhandlers.append
+' server-motd-changed      EVENT_MOTD_CHANGED      eventhandlers.append
 
 initialize-server