zeno network programs

This commit is contained in:
~d6 2024-02-27 14:47:56 -05:00
parent 586d14bc69
commit d758578ef3
3 changed files with 578 additions and 0 deletions

315
zenochat.tal Normal file
View File

@ -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

214
zenosrv.tal Normal file
View File

@ -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

49
zenoutil.tal Normal file
View File

@ -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^] )