Rosetta Code

$MORSE.REX: Difference between revisions

Page Discussion

$MORSE.REX (view source)

Revision as of 23:32, 7 May 2016

4,535 bytes added ,  8 years ago
m
→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, simplified some code.
m (added whitespace around links and references to links.)
m (→‎{{header|REXX}}: added/changed comments and whitespace, changed indentations, simplified some code.)
Line 14:
<br>The &nbsp; '''SOUND.REX''' &nbsp; REXX program is included here &nbsp; ──► &nbsp; [[SOUND.REX]].
<br><br>Some older REXXes don't have a &nbsp; '''changestr''' &nbsp; BIF, so one is included here &nbsp; ──► &nbsp; [[CHANGESTR.REX]].
<lang rexx>/**/traceREXX off;program sounds parseout arg !;(on the ifPC speaker) Morse code for !all(arg()almost) thenany exitgiven text.*/
trace off /*suppress non-zero return code message*/
if !cms then address ''
parse arg ! /*obtain required arguments from the CL*/
signal on halt; signal on novalue; signal on syntax
if !all( arg() ) then exit /*if any help requested, show it & exit*/
if !cms then address '' /*assist CMS in handling commands fast.*/
signal on halt /*be able to handle the halting of pgm.*/
signal on noValue /* " " " " undefined variables*/
signal on syntax /* " " " " pgm syntax errors.*/
 
if !=='' then exit /*No text to convert──►Morse code? exit*/
if !=='' then exit
@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc; upper @abcU
parse var ! ops '(' plainText
ops = space(ops)
 
@abc= 'abcdefghijklmnopqrstuvwxyz' /*define a lowercase (Latin) alphabet.*/
dah = '-'
@abcU=@abc; upper @abcU /* " " uppercase " " */
dit = '.'
parse var ! ops '(' plainText /*obtain text to convert ──► Morse code*/
if !cms then dit = 'af'x
ops=space(ops) /*elide any superfluous spaces in text.*/
if !dos then dit = 'f9'x
 
dah= /* _b1, _v2, and _b3 are pseudo'-blanks and they */'
_b1 = 'b0'x /* should be a character that can't be entereddit= from */.
if !cms then dit= 'af'x
_b2 = 'b1'x /* the keyboard easily. They are translated to */
if !dos then dit= 'f9'x
_b3 = 'b2'x /* true blanks by the tt internal subrountine. */
 
/* _b1, _v2, and _b3 are pseudo-blanks and they */
colors = !cms | !pcrexx | !r4 | !roo /*REXXes that support color. */
betweens _b1= 0'b0'x /*blanks betweenshould be a character that can't Morsebe symbols.entered from */
bf_b2= 'b1'x = 400 /* the keyboard (easily). /*beat frequencyThey (internalare translated to spkr).*/
clear_b3= 'b2'x = 0 /* true blanks by the /*clear the terminalTT internal subroutine. screen (| ¬)*/
 
code = /*Morse code characters (so far).*/
colors = !cms | !pcrexx | !r4 | !roo /*the REXXes that support color. */
delayspace = 1
betweens = 0 /*blanks between the Morse symbols. */
bf = 400 /*the beat frequency (internal speaker)*/
clear = 0 /*clear the terminal screen (or not). */
code = /*Morse code characters (so far). */
delaySpace = 1
emsg = 1
logs = 0
long_ = '='
longer_ = '~'
long = '__' /*a long dash. */
longer = '____' /*a longer dash. */
morsetypemorseType = 'I'
pause_ = '¬'
quiet = 0
Line 54 ⟶ 61:
split = 1
spread = 1
tfid = /*the temporary file identifier. */
timedelayTimeDelay = .2
dittimeditTime = .1
dahtimedahTime = .2
longtimelongTime = .4
longertimelongerTime = .8
pausetimepauseTime = .15
tops =
 
sw = linesize() /*get the width of the terminal screen width. */
 
do while ops\=='' /*keep parsing until no more options. */
parse var ops _1 2 1 _ . 1 _o ops /*pick apart various pieces of an opt. */
upper _ /*convert a value to uppercase (Latin).*/
upper _
 
select
when _==',' then nop
when _1=='.' & pos("=",_)\==0 then tops = tops _o
when abbn('CLearscreen') then clear = no()
when abbn('COLORs') then colors = no()
when abbn('LOGs') then logs = no()
when abbn('EMSGs') then emsg = no()
when abbn('SPLit') then split = no()
when abbn('Quiet') then quiet = no()
when abbn('SHOWcodes') then show = no()
when abbn('SOUnds')|,
abbn('BEEPs') then sound = no()
when abbn('SLIce') then slice = no()
when abb('BETWEENs') then dobetweens = nai()
betweens = nai()
if betweens<0 | betweens>sw then call er 81,0 sw betweens 'betweens'
end
when abb('DAHs')|,
abb('DASHs')|,
abb('DASHes') then dah = na()
when abb('DITs')|,
abb('DOTs') then dit = na()
when abb('LONGs') then long = na()
when abb('LONGERs') then longer = na()
when abb('SPAces') then dospaces = nai()
when abb('SPREADs') then spread spaces = nai()
if spaces<0 | spaces>sw then call er 81,0 sw spaces 'spaces'
end
when abb('SPREADs') then do
spread = nai()
if spread<0 | spread>sw then call er 81,0 sw spread 'spread'
end
when abb('AMERican') |,
abb('INTERnational') |,
Line 106 ⟶ 104:
abb('RAILways') |,
abb('RRs') |,
abb('USa') then morsetypemorseType = _1
otherwise call er 55,_o
end /*select*/
end /*while ops\==''*/
 
if betweens<0 | betweens>sw then call er 81,0 sw betweens 'betweens'
if spaces<0 | spaces>sw then call er 81,0 sw spaces 'spaces'
if spread<0 | spread>sw then call er 81,0 sw spread 'spread'
 
w=words(plainText)
if w==0 & emsg & \show then call er 35,'( plain-text'
dah = verchar(dah, 'DAH') /*verify dah Morse code character. */
dit = verchar(dit, 'DIT') /* " dit " " " */
if morsetypemorseType\=='I' then morsetypemorseType="R" /*Not internatioal? Assume R.Rrailroad. */
morsetype morseType= '0'morsetypemorseType /*construct the "type" of Morse code.*/
between_ = copies(' ',betweens) /*construct #number of "between" blanks. */
if logs then tops = '.F='gettfid(,"ANS") tops
if colors then tops = '.C=green' tops /*add color (if any) to TOPS. */
tops = space(tops) /*get rid of extraneous blanks. */
_ = dah
@ = dit
if clear & \quiet then !cls /*should we clear the terminal screen? */
/*┌───────────────────────────────────────────────────────────────────┐
│ 1 2 3 4 5 │
│ 123456789012345678901234567890123456789012345678901234 │
│ ABCDEFGHIJKLMNOPQRSTUVWZYZ0123456789':,-(.?;/_$!)=@&"+ │
└───────────────────────────────────────────────────────────────────┘*/
@chars = @abcu || "0123456789':,-(.?;/_$!)=@&""+"
$.=
$.0i.1 = mc(@ _) /* A letter */
$.0i.2 = mc(_ @ @ @) /* B letter */
$.0i.3 = mc(_ @ _ @) /* C letter */
$.0i.4 = mc(_ @ @) /* D letter */
$.0i.5 = mc(@) /* E letter */
$.0i.6 = mc(@ @ _ @) /* F letter */
$.0i.7 = mc(_ _ @) /* G letter */
$.0i.8 = mc(@ @ @ @) /* H letter */
$.0i.9 = mc(@ @) /* I letter */
$.0i.10 = mc(@ _ _ _) /* J letter */
$.0i.11 = mc(_ @ _) /* K letter */
$.0i.12 = mc(@ _ @ @) /* L letter */
$.0i.13 = mc(_ _) /* M letter */
$.0i.14 = mc(_ @) /* N letter */
$.0i.15 = mc(_ _ _) /* O letter */
$.0i.16 = mc(@ _ _ @) /* P letter */
$.0i.17 = mc(_ _ @ _) /* Q letter */
$.0i.18 = mc(@ _ @) /* R letter */
$.0i.19 = mc(@ @ @) /* S letter */
$.0i.20 = mc(_) /* T letter */
$.0i.21 = mc(@ @ _) /* U letter */
$.0i.22 = mc(@ @ @ _) /* V letter */
$.0i.23 = mc(@ _ _) /* W letter */
$.0i.24 = mc(_ @ @ _) /* X letter */
$.0i.25 = mc(_ @ _ _) /* Y letter */
$.0i.26 = mc(_ _ @ @) /* Z letter */
$.0i.27 = mc(_ _ _ _ _) /* 0 digit */
$.0i.28 = mc(@ _ _ _ _) /* 1 digit */
$.0i.29 = mc(@ @ _ _ _) /* 2 digit */
$.0i.30 = mc(@ @ @ _ _) /* 3 digit */
$.0i.31 = mc(@ @ @ @ _) /* 4 digit */
$.0i.32 = mc(@ @ @ @ @) /* 5 digit */
$.0i.33 = mc(_ @ @ @ @) /* 6 digit */
$.0i.34 = mc(_ _ @ @ @) /* 7 digit */
$.0i.35 = mc(_ _ _ @ @) /* 8 digit */
$.0i.36 = mc(_ _ _ _ @) /* 9 digit */
$.0i.37 = mc(@ _ _ _ _ @) /* ' apostrophe */
$.0i.38 = mc(_ _ _ @ @ @) /* : colon */
$.0i.39 = mc(_ _ @ @ _ _) /* , comma */
$.0i.40 = mc(_ @ @ @ @ _) /* - minus or hyphen */
$.0i.41 = mc(_ @ _ _ @ _) /* ( left parenthesis */
$.0i.42 = mc(@ _ @ _ @ _) /* . period */
$.0i.43 = mc(@ @ _ _ @ @) /* ? question mark */
$.0i.44 = mc(_ @ _ @ _ @) /* ; semi-colon */
$.0i.45 = mc(_ @ @ _ @) /* / slash */
$.0i.46 = mc(@ @ _ _ @ _) /* _ underscrore */
$.0i.47 = mc(@ @ @ _ @ @ _) /* $ dollar sign */
$.0i.48 = mc(@ _ @ _ @ @) /* ! exclamation mark */
$.0i.49 = mc(_ _ _ @ @) /* ) right parenthesis*/
$.0i.50 = mc(_ @ @ @ _) /* = equal sign */
$.0i.51 = mc(@ _ _ @ _ @) /* @ comercial at */
$.0i.52 = mc(_ _ _ _ @) /* & ampersand */
$.0i.53 = mc(@ _ @ @ _ @) /* " double-quote */
$.0i.54 = mc(@ _ @ _ @) /* + plus sign */
 
/*┌───────────────────────────────────────────────────────────────────┐
do j=1 for length(@chars)
│ 1 2 3 4 5 │
$.0r.j = $.0i.j
end /*j*/ │ 123456789012345678901234567890123456789012345678901234 /*use Int. for most chars.*/│
│ ABCDEFGHIJKLMNOPQRSTUVWZYZ0123456789':,-(.?;/_$!)=@&"+ │
└───────────────────────────────────────────────────────────────────┘*/
@chars = @abcu || "0123456789':,-(.?;/_$!)=@&""+" /*penultimate char is quotation char.*/
$.= /*default value (null) for all chars.*/
$.0i.1 = mc(@ _) /* A Latin letter */
$.0i.2 = mc(_ @ @ @) /* B Latin letter */
$.0i.3 = mc(_ @ _ @) /* C Latin letter */
$.0i.4 = mc(_ @ @) /* D Latin letter */
$.0i.5 = mc(@) /* E Latin letter */
$.0i.6 = mc(@ @ _ @) /* F Latin letter */
$.0i.7 = mc(_ _ @) /* G Latin letter */
$.0i.8 = mc(@ @ @ @) /* H Latin letter */
$.0i.9 = mc(@ @) /* I Latin letter */
$.0i.10 = mc(@ _ _ _) /* J Latin letter */
$.0i.11 = mc(_ @ _) /* K Latin letter */
$.0i.12 = mc(@ _ @ @) /* L Latin letter */
$.0i.13 = mc(_ _) /* M Latin letter */
$.0i.14 = mc(_ @) /* N Latin letter */
$.0i.15 = mc(_ _ _) /* O Latin letter */
$.0i.16 = mc(@ _ _ @) /* P Latin letter */
$.0i.17 = mc(_ _ @ _) /* Q Latin letter */
$.0i.18 = mc(@ _ @) /* R Latin letter */
$.0i.19 = mc(@ @ @) /* S Latin letter */
$.0i.20 = mc(_) /* T Latin letter */
$.0i.21 = mc(@ @ _) /* U Latin letter */
$.0i.22 = mc(@ @ @ _) /* V Latin letter */
$.0i.23 = mc(@ _ _) /* W Latin letter */
$.0i.24 = mc(_ @ @ _) /* X Latin letter */
$.0i.25 = mc(_ @ _ _) /* Y Latin letter */
$.0i.26 = mc(_ _ @ @) /* Z Latin letter */
$.0i.27 = mc(_ _ _ _ _) /* 0 decimal digit */
$.0i.28 = mc(@ _ _ _ _) /* 1 decimal digit */
$.0i.29 = mc(@ @ _ _ _) /* 2 decimal digit */
$.0i.30 = mc(@ @ @ _ _) /* 3 decimal digit */
$.0i.31 = mc(@ @ @ @ _) /* 4 decimal digit */
$.0i.32 = mc(@ @ @ @ @) /* 5 decimal digit */
$.0i.33 = mc(_ @ @ @ @) /* 6 decimal digit */
$.0i.34 = mc(_ _ @ @ @) /* 7 decimal digit */
$.0i.35 = mc(_ _ _ @ @) /* 8 decimal digit */
$.0i.36 = mc(_ _ _ _ @) /* 9 decimal digit */
$.0i.37 = mc(@ _ _ _ _ @) /* ' apostrophe */
$.0i.38 = mc(_ _ _ @ @ @) /* : colon */
$.0i.39 = mc(_ _ @ @ _ _) /* , comma */
$.0i.40 = mc(_ @ @ @ @ _) /* - minus or hyphen */
$.0i.41 = mc(_ @ _ _ @ _) /* ( left parenthesis */
$.0i.42 = mc(@ _ @ _ @ _) /* . period */
$.0i.43 = mc(@ @ _ _ @ @) /* ? question mark */
$.0i.44 = mc(_ @ _ @ _ @) /* ; semi-colon */
$.0i.45 = mc(_ @ @ _ @) /* / slash */
$.0i.46 = mc(@ @ _ _ @ _) /* _ underscrore */
$.0i.47 = mc(@ @ @ _ @ @ _) /* $ dollar sign */
$.0i.48 = mc(@ _ @ _ @ @) /* ! exclamation mark */
$.0i.49 = mc(_ _ _ @ @) /* ) right parenthesis */
$.0i.50 = mc(_ @ @ @ _) /* = equal sign */
$.0i.51 = mc(@ _ _ @ _ @) /* @ comercial at */
$.0i.52 = mc(_ _ _ _ @) /* & ampersand */
$.0i.53 = mc(@ _ @ @ _ @) /* " double-quote */
$.0i.54 = mc(@ _ @ _ @) /* + plus sign */
 
do j=1 for length(@chars)
$.0r.3 = mc(@ @ pause_ @) /* C, letter, railroad.*/
$.0r.j=$.0i.j
$.0r.6 = mc(@ long_ @) /* F, letter, railroad.*/
$.0r.10 = mc(_ @ _end /*j*/ @) /*use International code J,for letter,most railroad.chars*/
 
$.0r.12 = mc(long_) /* L, letter, railroad.*/
$.0r.153 = mc(@ @ pause_ @) /* O,C Latin letter, railroad. code*/
$.0r.166 = mc(@ @long_ @) @ @) /* P,F Latin letter, railroad. code*/
$.0r.1710 = mc(@_ @ long__ @) /* Q,J Latin letter, railroad. code*/
$.0r.1812 = mc(@long_) pause_ @ @) /* R,L Latin letter, railroad. code*/
$.0r.2415 = mc(@ long_ @pause_ @) /* X,O Latin letter, railroad. code*/
$.0r.2516 = mc(@ @ pause_@ @ @) /* Y,P Latin letter, railroad. code*/
$.0r.2617 = mc(@ @ @ pause_long_ @) /* Z,Q Latin letter, railroad. code*/
$.0r.2718 = mc(longer_@ pause_ @ @) /* 0,R digitLatin letter, railroad. code*/
$.0r.2824 = mc(@ _long_ _@ @) /* 1,X digitLatin letter, railroad. code*/
$.0r.2925 = mc(@ @ long_pause_ @ @) /* 2,Y digitLatin letter, railroad. code*/
$.0r.3026 = mc(@ @ @ long_pause_ @) /* 3,Z digitLatin letter, railroad. code*/
$.0r.3227 = mc(_longer_) _ _) /* 5,0 decimal digit, railroad. code*/
$.0r.3328 = mc(@ @_ @_ @) @ @) /* 6,1 decimal digit, railroad. code*/
$.0r.3429 = mc(_@ @ _long_ @ @) /* 7,2 decimal digit, railroad. code*/
$.0r.3530 = mc(_ @ @ @ long_ @) /* 8,3 decimal digit, railroad. code*/
$.0r.3632 = mc(_ @ @_ _) /* 9,5 decimal digit, railroad. code*/
$.0r.3933 = mc(@ _@ @ _@ @ @) /* , comma, /* 6 decimal digit, railroad. code*/
$.0r.4234 = mc(@ @ _ _ @ @) /* . period, /* 7 decimal digit, railroad. code*/
$.0r.4335 = mc(_ @ @ _@ @) /* ?8 question markdecimal digit, railroad. code*/
$.0r.4836 = mc(_ _ _@ @ _) /* !9 exclamation markdecimal digit, railroad. code*/
$.0r.5239 = mc(@ _ @ @ @_) /* &, a ampersandcomma, railroad. code*/
$.0r.42 = mc(@ @ _ _ @ @) /* . a period, railroad code*/
$.0r.43 = mc(_ @ @ _ @) /* ? a question mark, railroad code*/
$.0r.48 = mc(_ _ _ @) /* ! an exclamation mark, railroad code*/
$.0r.52 = mc(@ _ @ @ @) /* & an ampersand, railroad code*/
 
if show then do jshow=1 for length(@chars)
Line 220 ⟶ 223:
end /*jshow*/
 
from = '{}[]<>`\─' /*some charscharacters not in Morse code. */
into = "()()()'/─" /*translate chars──characters ──> Morse code. */
 
newText = translate(plainText, into, from) /*translate some other charscharacters. */
newText = space(newText, spaces) /*elide extraneous spaces. (blanks) */
spread_ = copies(_b2, spread) /*construct the spread. */
spaces_ = copies(_b3, spaces) /* " " spaces. */
 
do jw=1 for w
aword=word(newText, jw)
if code\=='' then code = code || spaces_
pb=
do jc=1 for length(aword)
? = substr(aword, jc, 1)
idx = pos(?,@chars)
if idx==0 then code=code || pb || ?
else code=code || pb || $.morsetypemorseType.idx
pb=spread_
end /*jc*/
end /*jw*/
 
if split then code = translate(code, , _b3)
if slice then code = translate(code, , _b2)
 
do jg=1 for words(code)
if jg\==1 & sound then call $tq ".Z="delayspacedelaySpace
glyph = word(code,jg)
cglyph = changestr(long_ , glyph, long)
cglyph = changestr(longer_, cglyph, longer)
call tt cglyph
call ss glyph
Line 254 ⟶ 257:
return unpsu(code)
 
/*──────────────────────────────────────────────────────────────────────────────────────*/
/*─────────────────────────────SS subroutine────────────────────────────*/
ss: if \sound then return
_s _s= unpsu( arg(1) )
do js=1 for length(_s)
 
do js=1 for length _c=substr(_s, js, 1)
if _c==' ' then call $tq ".Z="delaySpace
_c = substr(_s, js, 1)
if _c==' 'dit then call $tq ".ZB=1 .BF="bf ".BD="delayspaceditTime
if _c==ditdah then call $tq ".B=1 .BF="bf ".BD="dittimedahTime
if _c==dah long_ then call $tq ".B=1 .BF="bf ".BD="dahtimelongTime
if _c==long_ longer_ then call $tq ".B=1 .BF="bf ".BD="longtimelongerTime
if _c==longer_ then call $tq ".B=1 .BF="bf ".BDZ="longertimeTimeDelay
end call $tq ".Z="timedelay/*js*/
return
end /*js*/
return
 
/*─────────────────────────────general 1─line subs──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────*/
/*═════════════════════════════general 1-line subs════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════════*/
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys=='MSDOS'|!brexx|!r4|!roo then !env='SYSTEM'; if !os2 then !env='OS2'!env; !ebcdic=13=='f0f3'x; if !crx then !env='DOS'; return
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\',!fn); !fm=left(!fn,_); !fn=substr(!fn,_+1); parse var !fn !fn '.' !ft; end; return word(0 !fn !ft !fm,1+('0'arg(1)))
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx='KEXX'==!ver; !pcrexx='REXX/PERSONAL'==!ver|'REXX/PC'==!ver; !r4='REXX-R4'==!ver; !regina='REXX-REGINA'==left(!ver,11); !roo='REXX-ROO'==!ver; call !env; return
!sys: !cms=!sys=='CMS'; !os2=!sys=='OS2'; !tso=!sys=='TSO'|!sys=='MVS'; !vse=!sys=='VSE'; !dos=pos('DOS',!sys)\==0|pos('WIN',!sys)\==0|!sys=='CMD'; !crx=left(!sys,6)=='DOSCRX'; call !rex; return
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$fact!: procedure; parse arg x _ .; l=length(x); n=l-length(strip(x,'T',"!")); if n<=-n|_\==''|arg()\==1 then return x; z=left(x,l-n); if z<0|\isint(z) then return x; return $fact(z,n)
$fact!: procedure; parse arg x; l=length(x); n=l-length(strip(x,'T',"!")); z=left(x,l-n); if z<0|\datatype(z,'W') then return x; !=1; if n==1 then return $fact(z); do j=z to 2 by -n; !=!*j; end; return !
$fact: procedure; parse arg x _ .; arg ,n ! .; n=p(n 1); if \isint(n) then n=0; if x<-n|\isint(x)|n<1|_||!\==''|arg()>2 then return x||copies("!",max(1,n)); !=1; s=x//n; if s==0 then s=n; do j=s to x by n; !=!*j; end; return !
$sfxa: parse arg ,s,m; arg u,c; if pos(left(s,2),u)\==0 then do j=length(s) to compare(s,c)-1 by -1; if right(u,j)\==left(c,j) then iterate; _=left(u,length(u)-j); if isnum(_) then return m*_; leave; end; return arg(1)
$sfxf: parse arg y; if right(y,1)=='!' then y=$fact!(y); if \isnum(y) then y=$sfxz(); if isnum(y) then return y; return $sfxm(y)
$sfxm: parse arg z; arg w; b=1000; if right(w,1)=='I' then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isnum(r) then return r*b**p; return arg(1)
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$t: !call=']$T'; call "$T" tops arg(1); !call=; return
$tq: call $t '.Q=1' arg(1); return
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn)|abb('NO'abbn)
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
erx: call er '-'arg(1),arg(2); exit ''
getdtfid:tfid=p(!var("TMP") !var('TEMP') homedrive()"\"); if substr(tfid,2,1)==':' & substr(tfid,3,1)\=="\" then tfid=insert('\',t,2); return strip(tfid,'T',"\")'\'arg(1)'.'arg(2)
gettfidgetTFID:if symbol('TFID')=='LIT' then tfid=; if tfid\=='' then return tfid; gfn=word(arg(1) !fn,1); gft=word(arg(2) 'ANS',1); tfid='TEMP'; if !tso then tfid=gfn'.'gft; if !cms then tfid=gfn','gft",A4"; if !dos then tfid=getdtfidgetdTFID(gfn,gft); return tfid
halt: call er .1
homedrive:if symbol('HOMEDRIVE')\=="VAR" then homedrive=p(!var('HOMEDRIVE') 'C:'); return homedrive
int: int=num(arg(1),arg(2)); if \isint(int) then call er 92,arg(1) arg(2); return int/1
ishex: return datatype(arg(1),'X')
isint: return datatype(arg(1),'W')
isnum: return datatype(arg(1),'N')
mc: return translate(space(arg(1),betweens),_b1,' ')
na: if arg(1)\=='' then call er 01,arg(2); parse var ops na ops; if na=='' then call er 35,_o; return na
nai: return int(na(),_o)
nan: return num(na(),_o)
no: if arg(1)\=='' then call er 01,arg(2); return left(_,2)\=='NO'
novaluenoValue:!sigl=sigl; call er 17,!fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num: procedure; parse arg x .,f,q; if x=='' then return x; if isnum(x) then return x/1; x=space(translate(x,,','),0); if \isnum(x) then x=$sfxf(x); if isnum(x) then return x/1; if q==1 then return x; if q=='' then call er 53,x f; call erx 53,x f
p: return word(arg(1),1)
shorten:procedure; parse arg a,n; return left(a,max(0,length(a)-p(n 1)))
syntax: !sigl=sigl; call er 13,!fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)
tell: if tops=='' then say arg(1); else call $t tops arg(1); return
tt: if \quiet then call tell unpsu(arg(1)); return
unpsu: return translate(arg(1), , _b1 || _b2 || _b3)
verchar:procedure; parse arg y,w; _=length(y); if _==1 then return y; if _==2 then do; if \ishex(y) then call er 40,y w; return x2c(y); end; if _==3 then do; if \int(y) then call er 92,y ',' w; return d2c(y); end; call er 55,y w</lang>
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/223814"