zeno network programs
This commit is contained in:
parent
586d14bc69
commit
d758578ef3
|
|
@ -0,0 +1,315 @@
|
||||||
|
( zenochat.tal )
|
||||||
|
( )
|
||||||
|
( USAGE: uxnemu zenochat.rom ADDR PORT NICK )
|
||||||
|
( )
|
||||||
|
( COMMANDS DESCRIPTION )
|
||||||
|
( /help show help message )
|
||||||
|
( /names list the current people in the chat )
|
||||||
|
( /rename NICK change nickname to NICK )
|
||||||
|
( /quit exit the program )
|
||||||
|
( )
|
||||||
|
( DETAILS )
|
||||||
|
( - max nickname is 8 characters long, not including null )
|
||||||
|
( - no history, no scrolling )
|
||||||
|
( - no direct messages, yet )
|
||||||
|
( )
|
||||||
|
( MESSAGES )
|
||||||
|
( - 27 visible lines, 80 chars per line )
|
||||||
|
( - 5 chars: time "12:34" )
|
||||||
|
( - 1 char: space )
|
||||||
|
( - 8 chars: username "theodore" )
|
||||||
|
( - 1 char: space )
|
||||||
|
( - 65 chars: message line )
|
||||||
|
( )
|
||||||
|
( HISTORY LINE )
|
||||||
|
( - each history line is 80 bytes )
|
||||||
|
( - 1 byte: flags, 0x80 is-system, 0x01 is-continued )
|
||||||
|
( - 2 bytes: padding )
|
||||||
|
( - 2 bytes: hour [0-23] and minute [0-59] )
|
||||||
|
( - 9 bytes: nickname + null terminator; empty means system )
|
||||||
|
( - 66 bytes: text + null terminator )
|
||||||
|
( - window dimensions: 30 rows by 80 columns )
|
||||||
|
( - 27 visible lines; 65 text columns )
|
||||||
|
( )
|
||||||
|
( USER LIST )
|
||||||
|
( - 9 bytes, nickname + null terminator )
|
||||||
|
|
||||||
|
|00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 &dbg $1 &st $1 ]
|
||||||
|
|10 @Console [ &vect $2 &r $1 &pad $4 &type $1 &w $1 &e $1 ]
|
||||||
|
|20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
|
||||||
|
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
|
||||||
|
|90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
|
||||||
|
|a0 @File1 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
||||||
|
|b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|
||||||
|
|c0 @DateTime [ &year $2 &month $1 &day $1 &hr $1 &min $1 &sec $1 &dotw $1 &doty $2 &dst $1 ]
|
||||||
|
|
||||||
|
|0000
|
||||||
|
@pos $2
|
||||||
|
@dirty $1
|
||||||
|
@last-sec $1
|
||||||
|
|
||||||
|
|0100
|
||||||
|
( system settings )
|
||||||
|
#0280 .Screen/w DEO2
|
||||||
|
#0168 .Screen/h DEO2
|
||||||
|
#27ff .System/r DEO2
|
||||||
|
#039b .System/g DEO2
|
||||||
|
#1107 .System/b DEO2
|
||||||
|
|
||||||
|
( zero page )
|
||||||
|
#01 .dirty STZ
|
||||||
|
;input .pos STZ2
|
||||||
|
|
||||||
|
( vectors )
|
||||||
|
;on-refresh .Screen/vect DEO2
|
||||||
|
;on-key .Controller/vect DEO2
|
||||||
|
;read-args .Console/vect DEO2
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@usage "usage: 20 "zenochat.rom 20 "chat.server.net 20 "9999 20 "nick 0a 00
|
||||||
|
|
||||||
|
@usage-and-exit ( -> BRK )
|
||||||
|
;usage emit #01 .System/st DEO BRK
|
||||||
|
|
||||||
|
@read-arg ( -> BRK )
|
||||||
|
.Console/r DEI .pos LDZ2 STA
|
||||||
|
.pos LDZ2k INC2 ROT STZ2 BRK
|
||||||
|
|
||||||
|
@save-arg ( dst* maxlen* -> )
|
||||||
|
#00 .pos LDZ2 STA
|
||||||
|
.pos LDZ2 ;input SUB2
|
||||||
|
LTH2 ?usage-and-exit
|
||||||
|
;input emit #0a18 DEO
|
||||||
|
;input SWP2 copy
|
||||||
|
;input .pos STZ2 JMP2r
|
||||||
|
|
||||||
|
@read-args ( -> BRK )
|
||||||
|
.Console/type DEI #00 EQU ?usage-and-exit
|
||||||
|
.Console/type DEI #01 EQU ?usage-and-exit
|
||||||
|
.Console/type DEI #02 EQU ?read-arg
|
||||||
|
( state is 3 or 4 )
|
||||||
|
;addr LDA #00 EQU ?&addr
|
||||||
|
;port LDA #00 EQU ?&port
|
||||||
|
;nick LDA #00 EQU ?&nick
|
||||||
|
!usage-and-exit
|
||||||
|
&addr ;addr #00ff save-arg BRK
|
||||||
|
&port ;port #0005 save-arg BRK
|
||||||
|
&nick ;nick #000f save-arg
|
||||||
|
.Console/type DEI #04 NEQ ?usage-and-exit
|
||||||
|
;read-stdin .Console/vect DEO2
|
||||||
|
BRK
|
||||||
|
|
||||||
|
@read-stdin ( -> BRK ) BRK
|
||||||
|
|
||||||
|
@start-client ( -> BRK ) BRK
|
||||||
|
|
||||||
|
@update-clock ( -> )
|
||||||
|
LITr -last-sec STHkr LDZ ( ls^ [zp^] )
|
||||||
|
.DateTime/sec DEI DUP STHr STZ ( ls^ s^ ; zp<-s )
|
||||||
|
NEQ .dirty STZ JMP2r ( ; dirty<-s!=ls )
|
||||||
|
|
||||||
|
@on-refresh ( -> BRK )
|
||||||
|
update-clock
|
||||||
|
.dirty LDZ ?&refresh BRK
|
||||||
|
&refresh
|
||||||
|
redraw
|
||||||
|
#00 .dirty STZ BRK
|
||||||
|
|
||||||
|
@on-key ( -> BRK )
|
||||||
|
.Controller/key DEI
|
||||||
|
DUP #0d EQU ?&enter
|
||||||
|
DUP #08 EQU ?&backspace
|
||||||
|
DUP #20 LTH ?&skip
|
||||||
|
DUP #7f GTH ?&skip
|
||||||
|
.pos LDZ2 STA
|
||||||
|
.pos LDZ2 INC2 .pos STZ2
|
||||||
|
#00 .pos LDZ2 STA redraw BRK
|
||||||
|
&enter POP send-msg redraw BRK
|
||||||
|
&skip POP BRK
|
||||||
|
&backspace
|
||||||
|
;input .pos LDZ2 EQU2 ?&skip
|
||||||
|
POP
|
||||||
|
.pos LDZ2 #0001 SUB2 .pos STZ2
|
||||||
|
#00 .pos LDZ2 STA #0028 #015c #4b clear-line redraw BRK
|
||||||
|
|
||||||
|
@clear-line ( x* y* len^ -> )
|
||||||
|
#00 SWP SUB STH ( x* y* [-len^] )
|
||||||
|
.Screen/y DEO2 .Screen/x DEO2 ( [-len^] )
|
||||||
|
&loop ( [-i^] )
|
||||||
|
#03 #20 draw-char ( [-i^] )
|
||||||
|
.Screen/x DEI2k ( dev^ x* [-i^] )
|
||||||
|
#0008 ADD2 ROT DEO2 ( [-i^] ; dev<-x+8 )
|
||||||
|
INCr STHkr ?&loop ( [-i+1^] )
|
||||||
|
POPr JMP2r ( )
|
||||||
|
|
||||||
|
@send-msg
|
||||||
|
( ;input .pos LDZ2 #010e DEO POP2 POP2 )
|
||||||
|
!clear-input
|
||||||
|
|
||||||
|
@clear-input ( -> )
|
||||||
|
#0028 #015c #4b clear-line
|
||||||
|
#0000 ;input STA2
|
||||||
|
;input .pos STZ2 JMP2r
|
||||||
|
|
||||||
|
( TODO: write to intermediary buffers, then write to final topbar buffer )
|
||||||
|
( this will allow us to handle "long" strings better, e.g. hostnames )
|
||||||
|
( also consider reorder fields, put people before address )
|
||||||
|
( write clock last unconditionally with leading space + glyph )
|
||||||
|
@gui
|
||||||
|
&topbar
|
||||||
|
20 15 20 "z "e "n "o "c "h "a "t 20
|
||||||
|
20 02 20
|
||||||
|
&username
|
||||||
|
"c "a "r "o "l "i "n "e 20
|
||||||
|
20 03 20
|
||||||
|
&users
|
||||||
|
"1 "2 "9 20 "p "e "o "p "l "e 20
|
||||||
|
20 1d 20
|
||||||
|
&server
|
||||||
|
( 2001:0db8:85a3:0000:0000:8a2e:0370:7334 - 39 characters long )
|
||||||
|
( fe80::3210:b3ff:fe77:c5c6/64 )
|
||||||
|
( 123.156.189.123 - 15 characters long )
|
||||||
|
"1 "2 "3 ". "1 "5 "6 ". "1 "8 "9 ". "1 "2 "3 20 "1 "9 "9 "9 "9 20 20 20 20 20 20
|
||||||
|
20 0f 20
|
||||||
|
&hour
|
||||||
|
"2 "2 ":
|
||||||
|
&minute
|
||||||
|
"0 "3 ":
|
||||||
|
&second
|
||||||
|
"0 "9
|
||||||
|
20 00
|
||||||
|
|
||||||
|
&separator
|
||||||
|
cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
|
||||||
|
cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
|
||||||
|
cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
|
||||||
|
cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
|
||||||
|
cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd
|
||||||
|
00
|
||||||
|
|
||||||
|
&time1 "21:58 20 00
|
||||||
|
&u1 "alice 20 00
|
||||||
|
&msg1 "Isn't 20 "this 20 "whole 20 "thing 20 "kind 20 "of 20 "weird? 00
|
||||||
|
|
||||||
|
&time2 "21:59 20 00
|
||||||
|
&u2 "bob 20 00
|
||||||
|
&msg2 "Nah. 00
|
||||||
|
|
||||||
|
&info1 20 c4 c4 20 "013 20 "has 20 "connected 20 c4 c4 00
|
||||||
|
|
||||||
|
&time3 "22:02 20 00
|
||||||
|
&u3 "caroline 20 00
|
||||||
|
&msg3 "Well, 20 "I 20 "do 20 "think 20 "it's 20 "pretty 20 "wild... 00
|
||||||
|
|
||||||
|
&info2 20 c4 c4 20 "013 20 "is 20 "now 20 "called 20 "danny 20 c4 c4 00
|
||||||
|
|
||||||
|
&say "Say: 20 00
|
||||||
|
&edit "This 20 "is 20 "a 20 "test. 00
|
||||||
|
|
||||||
|
@draw-str-at ( tint^ s* x* y* -> )
|
||||||
|
.Screen/y DEO2 .Screen/x DEO2 !draw-str
|
||||||
|
|
||||||
|
@two-digit-copy ( n^ s* -> )
|
||||||
|
STH2 DUP #0a DIVk MUL SUB ( n^ n%10^ [s*] )
|
||||||
|
LIT "0 ADD STH2kr INC2 STA ( n^ [s*] ; s+1<-asc[n%10] )
|
||||||
|
#0a DIV LIT "0 ADD STH2r STA ( ; s<-asc[n/10] )
|
||||||
|
JMP2r ( )
|
||||||
|
|
||||||
|
@redraw ( -> )
|
||||||
|
.DateTime/hr DEI ;gui/hour two-digit-copy
|
||||||
|
.DateTime/min DEI ;gui/minute two-digit-copy
|
||||||
|
.DateTime/sec DEI ;gui/second two-digit-copy
|
||||||
|
|
||||||
|
#06 ;gui/topbar #0000 #0000 draw-str-at
|
||||||
|
|
||||||
|
#03 ;gui/time1 #0000 #000c draw-str-at
|
||||||
|
#02 ;gui/u1 #0030 #000c draw-str-at
|
||||||
|
#03 ;gui/msg1 #0078 #000c draw-str-at
|
||||||
|
|
||||||
|
#03 ;gui/time2 #0000 #0018 draw-str-at
|
||||||
|
#02 ;gui/u2 #0030 #0018 draw-str-at
|
||||||
|
#03 ;gui/msg2 #0078 #0018 draw-str-at
|
||||||
|
|
||||||
|
#01 ;gui/info1 #0000 #0024 draw-str-at
|
||||||
|
|
||||||
|
#03 ;gui/time3 #0000 #0030 draw-str-at
|
||||||
|
#02 ;gui/u3 #0030 #0030 draw-str-at
|
||||||
|
#03 ;gui/msg3 #0078 #0030 draw-str-at
|
||||||
|
|
||||||
|
#01 ;gui/info2 #0000 #003c draw-str-at
|
||||||
|
|
||||||
|
#03 ;gui/edit #0078 #0048 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0054 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0060 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #006c draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0078 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0084 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0090 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #009c draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00a8 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00b4 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00c0 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00cc draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00d8 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00e4 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00f0 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #00fc draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0108 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0114 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0120 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #012c draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0138 draw-str-at
|
||||||
|
#03 ;gui/edit #0078 #0144 draw-str-at
|
||||||
|
|
||||||
|
#01 ;gui/separator #0000 #0150 draw-str-at
|
||||||
|
#01 ;gui/say #0000 #015c draw-str-at
|
||||||
|
#03 ;input #0028 #015c draw-str-at
|
||||||
|
#08 #20 draw-char ( cursor )
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@draw-lit #0000 DIV
|
||||||
|
|
||||||
|
@draw-str ( tint^ s* -> )
|
||||||
|
STH2 ( tint^ [s*] )
|
||||||
|
&loop DUP STH2kr LDA DUP ?&ok ( tint^ tint^ c^ [pos*] )
|
||||||
|
POP POP2 POP2r JMP2r ( )
|
||||||
|
&ok draw-char INC2r ( tint^ [pos+1*] )
|
||||||
|
.Screen/x DEI2k #0008 ADD2 ( tint^ s/x^ x+8* [pos+1*] )
|
||||||
|
ROT DEO2 !&loop ( tint^ [pos+1*] )
|
||||||
|
|
||||||
|
@draw-char ( tint^ c^ -> )
|
||||||
|
SWP STH ( c^ [tint^] )
|
||||||
|
#00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] )
|
||||||
|
.Screen/addr DEO2k ( addr* s/a^ [tint^] )
|
||||||
|
STHkr .Screen/sprite DEO ( addr* s/a^ [tint^] )
|
||||||
|
.Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s/a^ [tint^] )
|
||||||
|
STH #0004 ADD2 STHr DEO2 ( [tint^] )
|
||||||
|
STHr .Screen/sprite DEO ( )
|
||||||
|
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
|
||||||
|
JMP2r ( )
|
||||||
|
|
||||||
|
@history-append-msg ( user* msg* -> )
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@history-append-sys ( msg* -> )
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
~zenoutil.tal
|
||||||
|
|
||||||
|
( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes )
|
||||||
|
( second tile only uses top 50% )
|
||||||
|
@cp437
|
||||||
|
~cp437.tal
|
||||||
|
|
||||||
|
( input and args )
|
||||||
|
@addr $100
|
||||||
|
@port $10
|
||||||
|
@nick $20
|
||||||
|
@input $1000
|
||||||
|
|
||||||
|
( compose buffer )
|
||||||
|
@compose $51 &limit
|
||||||
|
|
||||||
|
( 640x480 resolution means 80 x 40 = 3200 characters )
|
||||||
|
@history $c80 &start =history &limit =history
|
||||||
|
|
||||||
|
|
@ -0,0 +1,214 @@
|
||||||
|
( zenochat.tal )
|
||||||
|
( )
|
||||||
|
( uses uxnet protocol, see uxnet.txt for details )
|
||||||
|
( )
|
||||||
|
( the server assumes its assigned idxs are exactly 3 bytes long. )
|
||||||
|
( this is an implementation detail of uxnet.py not currently )
|
||||||
|
( required by the spec. )
|
||||||
|
( )
|
||||||
|
( clients send messages to the server using the > command. )
|
||||||
|
( each type of messages is identified by its first ASCII )
|
||||||
|
( character, which is otherwise ignored: )
|
||||||
|
( )
|
||||||
|
( CHAR MEANING )
|
||||||
|
( N sets username to $text )
|
||||||
|
( B broadcasts a chat message of $text )
|
||||||
|
( C notifies that user $text has connected )
|
||||||
|
( D notifies that user $text has disconnected )
|
||||||
|
( R expects $prev/$curr, user $prev is renamed to $curr )
|
||||||
|
( )
|
||||||
|
( nicknames are not allowed to have slashes, i.e. /, and must )
|
||||||
|
( be 16 bytes or fewer long. messages are not allowed to contain )
|
||||||
|
( the NULL byte, and are not expected to contain newlines. )
|
||||||
|
|
||||||
|
|10 @Console [ &vect $2 &r $1 &pad $4 &type $1 &w $1 &e $1 ]
|
||||||
|
|
||||||
|
|0000
|
||||||
|
@interpret $2
|
||||||
|
@pos $2
|
||||||
|
@next-client $2
|
||||||
|
|
||||||
|
|0100
|
||||||
|
;before-start .interpret STZ2
|
||||||
|
;addr .pos STZ2
|
||||||
|
;clients .next-client STZ2
|
||||||
|
;read-args .Console/vect DEO2
|
||||||
|
BRK
|
||||||
|
|
||||||
|
( we don't expect anything )
|
||||||
|
@before-start ( -> )
|
||||||
|
#0000 DIV JMP2r
|
||||||
|
|
||||||
|
( we expect to read $/ )
|
||||||
|
@when-starting ( -> )
|
||||||
|
;input LDAk LIT "$ NEQ ?&error
|
||||||
|
INC2 LDAk LIT "/ NEQ ?&error
|
||||||
|
POP2
|
||||||
|
( TODO: validate input )
|
||||||
|
;when-listening .interpret STZ2 JMP2r
|
||||||
|
&error #010f DEO BRK
|
||||||
|
|
||||||
|
( we expect to read $ # < )
|
||||||
|
@when-listening ( -> )
|
||||||
|
;input LDAk LIT "$ EQU ?connect
|
||||||
|
LDAk LIT "# EQU ?disconnect
|
||||||
|
LDAk LIT "< EQU ?receive
|
||||||
|
POP2 #0000 DIV
|
||||||
|
|
||||||
|
@connect ( input* -> )
|
||||||
|
( TODO: validate input )
|
||||||
|
INC2 !add-client
|
||||||
|
|
||||||
|
@disconnect ( input* -> )
|
||||||
|
( TODO: validate input )
|
||||||
|
INC2 !rm-client
|
||||||
|
|
||||||
|
( expect: <999/N...\0 )
|
||||||
|
( or: <999/B...\0 )
|
||||||
|
@receive ( input* -> )
|
||||||
|
( TODO: validate input )
|
||||||
|
INC2 DUP2 find-client ( msg=input+1* maybe* )
|
||||||
|
ORAk ?&found POP2 emit JMP2r ( )
|
||||||
|
&found ( msg* client* )
|
||||||
|
SWP2 #0004 ADD2 ( client* body=msg+4 )
|
||||||
|
LDAk LIT "N EQU ?rename ( client* body* )
|
||||||
|
LDAk LIT "B EQU ?broadcast ( client* body* )
|
||||||
|
POP2 POP2 JMP2r ( )
|
||||||
|
|
||||||
|
@broadcast ( client* body* -> )
|
||||||
|
INC2 SWP2 #0003 ADD2 ( data=body+1* name=client+3* )
|
||||||
|
start-output copy-dst0 ( data* dst+n* ; copy name into dst+5 )
|
||||||
|
#3a20 OVR2 STA2 ( data* dst+n-1* ; dst+n-1<-": " )
|
||||||
|
INC2 INC2 copy ( ; copy data into dst+n+1 )
|
||||||
|
!send-to-all ( )
|
||||||
|
|
||||||
|
( sends ;output to all clients )
|
||||||
|
( fn should have shape: client* -> )
|
||||||
|
@send-to-all ( -> )
|
||||||
|
.next-client LDZ2 ;clients ( limit* start* )
|
||||||
|
&loop GTH2k ?&ok POP2 POP2 JMP2r ( )
|
||||||
|
&ok DUP2 send-to #0014 ADD2 !&loop ( limit* pos+20* )
|
||||||
|
POP2 POP2 JMP2r ( )
|
||||||
|
|
||||||
|
( sends ;output to a client )
|
||||||
|
@send-to ( client* -> )
|
||||||
|
;output STH2k INC2 ( client* output+1* [output*] )
|
||||||
|
idx-copy ( [output*] ; copy idx into output+1 )
|
||||||
|
STH2r emit ( ; emit output )
|
||||||
|
( #0a18 DEO JMP2r ( need newline for interactive testing ) )
|
||||||
|
#0018 DEO JMP2r
|
||||||
|
|
||||||
|
@rename-msg 20 "is 20 "now 20 "called 20 00
|
||||||
|
|
||||||
|
@start-output ( -> dst* )
|
||||||
|
LIT2r :output
|
||||||
|
LIT "> STH2kr STA INC2r
|
||||||
|
LIT2 "00 STH2kr STA2 INC2r INC2r
|
||||||
|
LIT2 "0/ STH2kr STA2 INC2r INC2r
|
||||||
|
STH2r JMP2r
|
||||||
|
|
||||||
|
@rename ( client* body* -> )
|
||||||
|
OVR2 #0003 ADD2 ( client* body* name=client+3* )
|
||||||
|
start-output copy-dst0 ( client* body* dst* ; copy old name to output )
|
||||||
|
;rename-msg SWP2 copy-dst0 ( client* body* dst2* )
|
||||||
|
STH2 INC2 STH2k #00 STH2kr ( client* data=body+1* 0^ data* [dst2* data*] )
|
||||||
|
#0010 ADD2 STA ( client* data* ; data+16<-0 [dst2* data*] )
|
||||||
|
SWP2 #0003 ADD2 copy ( [dst2* data*] ; copy data into client+3 )
|
||||||
|
STH2r STH2r ( data* dst2* )
|
||||||
|
copy !send-to-all ( ; copy data into dst2 and send )
|
||||||
|
|
||||||
|
( we expect to read addr then port )
|
||||||
|
@read-args ( -> BRK )
|
||||||
|
.Console/type DEI #04 EQU ?start-server
|
||||||
|
.Console/type DEI #03 EQU ?&end-addr
|
||||||
|
.Console/r DEI .pos LDZ2 STA ( ; write c into buf )
|
||||||
|
.pos LDZ2k INC2 ROT STZ2 BRK ( BRK ; increment buf pos )
|
||||||
|
&end-addr ;port .pos STZ2 BRK ( BRK ; start raeding port port )
|
||||||
|
|
||||||
|
@read-stdin
|
||||||
|
( .Console/r DEI #0a NEQ ?&continue ( ; did we read null? ) )
|
||||||
|
.Console/r DEI ?&continue ( ; did we read null? )
|
||||||
|
#00 .pos LDZ2 STA ( ; write null )
|
||||||
|
.interpret LDZ2 JSR2 ( ; interpret message )
|
||||||
|
;input .pos STZ2 BRK ( ; reset input buffer )
|
||||||
|
&continue ( )
|
||||||
|
.Console/r DEI .pos LDZ2 STA ( ; write c into input buffer )
|
||||||
|
.pos LDZ2k INC2 ROT STZ2 BRK ( ; increment input buffer )
|
||||||
|
|
||||||
|
@start-server ( -> BRK )
|
||||||
|
LIT "@ .Console/w DEO ;addr emit
|
||||||
|
LIT "/ .Console/w DEO ;port emit
|
||||||
|
( #0a .Console/w DEO )
|
||||||
|
#00 .Console/w DEO
|
||||||
|
;input .pos STZ2
|
||||||
|
;when-starting .interpret STZ2
|
||||||
|
;read-stdin .Console/vect DEO2
|
||||||
|
BRK
|
||||||
|
|
||||||
|
( assumes idxs are 3 bytes long )
|
||||||
|
@idx-eq ( idx1* idx2* -> bool^ )
|
||||||
|
STH2 LDAk LDAkr STHr NEQ ?&nope
|
||||||
|
INC2 INC2r LDAk LDAkr STHr NEQ ?&nope
|
||||||
|
INC2 INC2r LDA LDAr STHr EQU JMP2r
|
||||||
|
&nope #00 JMP2r
|
||||||
|
|
||||||
|
( assumes idxs are 3 bytes long )
|
||||||
|
@idx-copy ( idx* dst* -> )
|
||||||
|
STH2 LDAk STH2kr STA INC2 INC2r ( idx+1* [dst+1*] ; dst<-idx )
|
||||||
|
LDAk STH2kr STA INC2 INC2r ( idx+2* [dst+2*] ; dst+1<-idx+1 )
|
||||||
|
LDA STH2r STA JMP2r ( ; dst+2<-idx+2 )
|
||||||
|
|
||||||
|
@connect-msg 20 "has 20 "connected 00
|
||||||
|
|
||||||
|
@add-client ( idx* -> )
|
||||||
|
LITr -next-client LDZ2r ( idx* [next*] )
|
||||||
|
DUP2 STH2kr copy-slash ( idx* [next*] ; copy idx to client-idx )
|
||||||
|
STH2kr #0003 ADD2 copy-slash ( [next*] ; copy idx to client-name )
|
||||||
|
#00 STH2kr #0006 ADD2 STA ( [next*] ; null terminate )
|
||||||
|
STH2kr #0003 ADD2 ( next+3* [next*] )
|
||||||
|
start-output copy-dst0 ( dst* [next*] ; start message )
|
||||||
|
;connect-msg SWP2 copy ( [next*] ; finish message )
|
||||||
|
STH2r #0014 ADD2 .next-client STZ2 ( ; next-client<-next+20 )
|
||||||
|
!send-to-all ( )
|
||||||
|
|
||||||
|
@disconnect-msg 20 "has 20 "disconnected 00
|
||||||
|
|
||||||
|
@rm-client ( idx* -> )
|
||||||
|
find-client ORAk ?&found ( addr* )
|
||||||
|
POP2 JMP2r ( )
|
||||||
|
&found ( addr* )
|
||||||
|
DUP2 #0003 ADD2 start-output ( addr* addr+3* dst* )
|
||||||
|
copy-dst0 ( addr* dst2* )
|
||||||
|
;disconnect-msg SWP2 copy ( addr* )
|
||||||
|
.next-client LDZ2 #0014 SUB2 SWP2 ( limit* addr* )
|
||||||
|
&loop GTH2k ?&ok !&done ( limit* pos* )
|
||||||
|
&ok DUP2 #0014 ADD2 LDA2 ( limit* pos* cc* )
|
||||||
|
OVR2 STA2 INC2 INC2 !&loop ( limit* pos+2* )
|
||||||
|
&done .next-client STZ2 POP2 ( )
|
||||||
|
!send-to-all ( )
|
||||||
|
|
||||||
|
( returns client addr or 0000 on failure )
|
||||||
|
( finds client based on 3 byte idx )
|
||||||
|
@find-client ( idx* -> addr* )
|
||||||
|
STH2 .next-client LDZ2 ;clients ( limit* clients* [idx*] )
|
||||||
|
&loop ( limit* c* [idx*] )
|
||||||
|
DUP2 STH2kr idx-eq ?&found ( limit* c* [idx*] )
|
||||||
|
#0014 ADD2 GTH2k ?&loop ( limit* c+20* [idx*] )
|
||||||
|
POP2r POP2 DUP2 EOR2 JMP2r ( 0* )
|
||||||
|
&found NIP2 POP2r JMP2r ( c* )
|
||||||
|
|
||||||
|
~zenoutil.tal
|
||||||
|
|
||||||
|
@addr $100
|
||||||
|
@port $6
|
||||||
|
@input $1000
|
||||||
|
@output $1000
|
||||||
|
|
||||||
|
( client layout: )
|
||||||
|
( - bytes 1-3: idx )
|
||||||
|
( - bytes 4-20: nickname\0 )
|
||||||
|
( every idx is 3 bytes )
|
||||||
|
( max username is 16 chars )
|
||||||
|
( username is null-terminated; idx is not )
|
||||||
|
( max # of clients is 64 )
|
||||||
|
@clients $500 &limit
|
||||||
|
|
@ -0,0 +1,49 @@
|
||||||
|
( copy null-terminated string from src into dst )
|
||||||
|
( includes the null terminator. )
|
||||||
|
( returns first unwritten address. )
|
||||||
|
@copy-dst ( src* dst* -> dst2* )
|
||||||
|
STH2 &loop ( in* [out*] )
|
||||||
|
LDAk DUP STH2kr STA ( in* c^ [out*] )
|
||||||
|
INC2r STH INC2 ( in+1* [out+1* c^] )
|
||||||
|
STHr ?&loop ( in+1 [out+1*] )
|
||||||
|
POP2 STH2r JMP2r ( dst2=out+1* )
|
||||||
|
|
||||||
|
( copy-dst but without null termination )
|
||||||
|
@copy-dst0 ( src* dst* -> dst2* )
|
||||||
|
copy-dst #0001 SUB2 JMP2r
|
||||||
|
|
||||||
|
( copy null-terminated string from src into dst )
|
||||||
|
( includes the null terminator. )
|
||||||
|
@copy ( src* dst* -> )
|
||||||
|
copy-dst POP2 JMP2r
|
||||||
|
|
||||||
|
( copy slash-terminated string from src into dst. )
|
||||||
|
( writes a null terminator. )
|
||||||
|
@copy-slash ( src/* dst* -> )
|
||||||
|
STH2 &loop LDAk LIT "/ EQU ?&done ( in* [out*] )
|
||||||
|
LDAk STH2kr STA INC2 INC2r !&loop ( in+1* [out+1*] )
|
||||||
|
&done #00 STH2r STA POP2 JMP2r ( )
|
||||||
|
|
||||||
|
( compare two null-terminated strings )
|
||||||
|
@eq ( s* t* -> eq^ )
|
||||||
|
STH2 ( s1* [s2*] )
|
||||||
|
&l LDAk LDAkr STHr NEQk ?&d ( s1* c1^ c2^ [s2*] )
|
||||||
|
DUP EOR EQUk ?&d ( s1* c1^ 0^ [s2*] )
|
||||||
|
POP2 INC2 INC2r !&l ( s1+1* [s2+1*] )
|
||||||
|
&d NIP2 POP2r EQU JMP2r ( eq^ )
|
||||||
|
|
||||||
|
( compare slash-terminated string against null-terminated )
|
||||||
|
( slash terminated string cannot contain nulls )
|
||||||
|
@eq-slash ( s/* str* -> )
|
||||||
|
STH2 ( s/* [str*] )
|
||||||
|
&loop LDAk LIT "/ EQU ?&end ( s/* [str*] )
|
||||||
|
LDAk LDAkr STHr NEQk ?&done ( s/* c1^ c2^ [str*] )
|
||||||
|
POP2 INC2 INC2r !&loop ( s/+1* [str+1*] )
|
||||||
|
&end LDAkr STHr DUPk EOR ( s/* c2^ 0^ [str*] )
|
||||||
|
&done NIP2 POP2r EQU JMP2r ( 0^ )
|
||||||
|
|
||||||
|
( write null-terminated string to stdout )
|
||||||
|
@emit ( buf* -> )
|
||||||
|
LITr -Console/w ( buf* [dev^] )
|
||||||
|
&loop LDAk ?&ok POP2 POPr JMP2r ( )
|
||||||
|
&ok LDAk STHkr DEO INC2 !&loop ( buf+1* [dev^] )
|
||||||
Loading…
Reference in New Issue