--- /dev/null
+Patches prefered.
+Pull requests and issues will be acknowledged.
+
+Email me: emilwilliams@tuta.io
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.
--- /dev/null
+
+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
0 constant EVENT_IDLE
-1 constant EVENT_CONNECTION_NEW
-2 constant EVENT_CONNECTION_CLOSED
-3 constant EVENT_CONNECTION_SEND
-4 constant EVENT_CONNECTION_RECV
+1 constant EVENT_COMMANDLINE
+2 constant EVENT_MOTD_CHANGED
+3 constant EVENT_CONNECTION_NEW
+4 constant EVENT_CONNECTION_CLOSED
+5 constant EVENT_CONNECTION_SEND
+6 constant EVENT_CONNECTION_RECV
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
--- /dev/null
+
+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
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.
\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;
require socket-extensions.4th
require connections.4th
+require commandline.4th
+require motd.4th
require sendbuffer.4th
AF_INET constant SERVER_SOCKET_DOMAIN
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
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
- r@ (connectionnumber@) sendbuffer-append
- s" : " sendbuffer-append
- r> (connectionbuffer@) sendbuffer-append
+ s" Anon " sendbuffer-append
+ r@ (connection.number>string) sendbuffer-append
+ s" : " sendbuffer-append
+ r> (connection.buffer>string) sendbuffer-append
sendbuffer-sanitize ;
: (connected?) ( connection-addr -- )
connection.connected @ ;
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 ;
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
projects / public-moontalk.git / commitdiff