(	morse.tal
	by aleteoryx, all rights released

	international morse code encoder/decoder

	encoding:
	echo SOS | uxncli morse.rom e
	uxncli morse.rom e SOS
	uxncli morse.rom ef '`\\blah blah'

	decoding:
	echo '... --- ...' | uxncli morse.rom
	uxncli morse.rom d '... --- ...' )

@on-reset ( -> )
	;meta #06 DEO2
	#17 DEI ?{ ;on-char #10 DEO2 BRK }
	;args/on-char #10 DEO2
	BRK

@usage ( -- )
	;/str puts
	#010f DEO BRK
@usage/str
	"usage: 0a
	09 "uxncli 20 "morse.rom 20 "e[f] 20 "<message.txt 0a
	09 "uxncli 20 "morse.rom 20 "[d] 20 "<morse.txt 0a $1

@meta $1
	"morse.rom 0a
	"international 20 "morse 20 "code 20 "encoder/decoder 0a
	"by 20 "aleteoryx, 20 "all 20 "rights 20 "released 0a
	"20260501 $2


@puts/loop ( s* -- )
	LDAk #18 DEO INC
	@puts LDAk ?/loop
	POP2 JMP2r


@args/on-char ( -> )
	#0217 DEI EQU ?{
		;on-char #10 DEO2
		BRK
	}

	[ LIT2 "d 12 ] DEI NEQ ?{ ;dec/ode ,on-char/mode STR2 BRK }
	[ LIT2 "e 12 ] DEI NEQ ?{ ;enc/ode ,on-char/mode STR2 BRK }
	[ LIT2 "f 12 ] DEI NEQ ?{ [ LIT2 01 _enc/force ] STR BRK }

	!usage


@on-char ( l n -> l n )
	#0417 DEI NEQ ?{ #0a18 DEO #800f DEO BRK }
	#12 DEI
	[ LIT2 &mode =dec/ode ] JSR2
	BRK

@enc/err ( -- )
	[ LIT &force 00 ]
	?{
		#12 DEI #18 DEO
		;/errmsg puts
		#020f DEO BRK
	}
	JMP2r
	&errmsg ": 20 "invalid 20 "character 0a 00

@enc/ode ( b -- )
	#00 SWP ;/tab ADD2
	LDAk     ?{ POP2 !/err }
	LDAk INC ?{ POP2 !/slash }

	LDA #c0 ANDk NEQ ?{	( 6-bit code )
		#06c0 ROT EOR
		!/putcode
	}

	DUP #05 SFT SWP
	DUP #55 SFT EOR
	( >> )

@enc/putcode ( l n -- )
	putcode #2018 DEO JMP2r

@putcode ( l n -- )
	OVR ?{ POP2 JMP2r }
	#01 ANDk
	[ LIT2 ".- ]
	ROT JMP [ SWP ] NIP
	#18 DEO
	SFT
	SWP #01 SUB SWP
	!putcode

@enc/slash ( -- )
	[ LIT2 "/ 18 ] DEO
	#2018 DEO
	JMP2r


@dec/ode ( l n b -- l n )
	ROTk NIP NIP #07 LTH ?{ POP !/bogus }

	DUP [ LIT ". ] EQU ?/dit
	DUP [ LIT "- ] EQU ?/dash
	DUP [ LIT "/ ] EQU ?/slash
	POP
	( >> )

@dec/lookup ( l n -- l n )
	STH2k POP
	#00 SWP #10 SFT2
	;/tab ADD2 LDA2
	ORAk ?{ POP2r DUP2 EOR2 JMP2r }	( empty code )
	DUP2 ;/5 LTH2 ?/lookup-1234
	( >> )

@dec/lookup-56 ( tab* `l `n -- l n )
	LDAk INC ?{ POP2 STH2r !/bogus }
	LDAk STHrk EQU ?{ INC2 INC2 !/lookup-56 }
	INC2 LDA #18 DEO
	POP2r #0000 JMP2r

@dec/lookup-1234 ( tab* `l `n -- l n )
	#00 STHrk ADD2
	LDAk ?{ POP2 STH2r !/bogus }		( bad code )
	LDA #18 DEO
	POP2r #0000 JMP2r

@dec/dit ( l n b -- l n )
	POP
	SWP INC SWP
	#10 SFT
	JMP2r

@dec/dash ( l n b -- l n )
	POP
	SWP INC SWP
	#10 SFT
	#01 ORA
	JMP2r

@dec/slash ( l n b -- l n )
	POP
	/lookup
	#2018 DEO
	JMP2r

@dec/bogus ( l n -- l n )
	[ LIT2 "[ 18 ] DEO

	STH2k POPr
	[ LITr 00 ]
	&bl
		[ LITr 10 ] SFTr
		#01 ANDk STH ORAr
		SFT
		SWP #01 SUB SWP
		OVR ?/bl
	POP2 STH2r putcode

	[ LIT2 "] 18 ] DEO
	#0000 JMP2r


@dec/tab	$2 =/1 =/2 =/3 =/4 =/5 =/6

	&1 	"ET
	&2 	"IANM
	&3 	"SURWDKGO
	&4 	"HVF $1 "L $1 "PJ "BXCY "ZQ $2

	&5 	1f "0  0f "1  07 "2  03 "3  01 "4  00 "5  10 "6  18 "7
		1c "8  1e "9  12 "/  16 "(  11 "=  0a "+  ff
	&6	15 ".  33 ",  0c "?  1e "'  2d ")  38 ":  21 "-  12 ""
		1a "@  ff

@enc/tab
	( lll nnnnn, l is length, n is code bits in reverse
	  if lll is 11x, n is 6 bits long instead
	  ff = '/' )
	00 00 00 00 00 00 00 00 00 ff ff 00 00 00 00 00
	00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
	ff 00 d2 00 00 00 00 de ad ed 00 aa f3 e1 ea a9
	bf be bc b8 b0 a0 a1 a3 a7 af c7 00 00 b1 00 cc
	d6 42 81 85 61 20 84 63 80 40 8e 65 82 43 41 67
	86 8b 62 60 21 64 88 66 89 8d 83 00 00 00 00 00
	00 42 81 85 61 20 84 63 80 40 8e 65 82 43 41 67
	86 8b 62 60 21 64 88 66 89 8d 83 (  00 00 00 00 .. )