3BSD/usr/src/cmd/apl/asciiterm.c

#include "apl.h"

asciich() {
	extern unsigned char	*iline;
	extern struct asoperbox charconv[OPERBOXSIZE];
	register D,E,F,I;
	
	F = *iline++;
	if ( ( F == '.') && ( digit(*iline) == 0 ) ) {
		D = (int)*iline++;
		E = (int)*iline++;
		for (I = 0; I <= OPERBOXSIZE;I++) {
			if (( D== (charconv[I].letters[0]) ) &&
			    ( E== (charconv[I].letters[1]) ) ) {
				F = charconv[I].returnchar;
				goto out;
			}
		}
		--iline;--iline;
	}
out:	return(F);
};

/* eventually this should be replaces with arrays that hae a better	*/
/*	method of selecting and returning the lexical value, but	*/
/*	for now, this is a quick implementation 			*/
/*									*/
/*	use char as subscript from ascii - get apl character hopefully  */
/*	for character conversion from ascii to apl char set ---		*/
/* see files write2.c and write3.c for more recent version 		*/

struct asoperbox charconv[OPERBOXSIZE] = {
/* ascii mnemonic ( from HP  APL ascii char mnemonics and 		*/
/*	equivalent apl character value.					*/
/* 	all are two lowercase letters preceeded by a dot.		*/
/*	letters for identifiers are lowercase or uppercase		*/
/*	lowercase corresponding to apl uppercase and			*/
/*	uppercase corresponding to apl underscored letters.		*/

"le",	/* less than or equal	*/ '$',
"ge",	/* greater than or equal*/ '^',
"ne",	/* not equal		*/ '*',
"om",	/* omega ( not used )	*/ 'W',
"ep",	/* epsilon		*/ 'E',
"rh",	/* shape (rho)		*/ 'R',
"nt",	/* not ( also '~' )	*/ 'T',
"tk",	/* take ( also '^' )	*/ 'Y',
"dr",	/* drop			*/ 'U',
"it",	/* iota			*/ 'I',
"ci",	/* circular function	*/ 'O',
"al",	/* alpha ( not used )	*/ 'A',
"cl",	/* maximum ( ceiling )  */ 'S',
"fl",	/* minimum ( floor )	*/ 'D',
"dl",	/* del ( not used )	*/ 'G',
"de",	/* upside down del	*/ 'H',
"jt",	/* small circle ( null )*/ 'J',
"qd",	/* quad			*/ 'L',
"ss",	/* right U ( not used )	*/ 'Z',
"sc",	/* left U ( not used )	*/ 'X',
"si",	/* Down U		*/ 'C',
"su",	/* U ( not used )	*/ 'V',
"[^",	/* upside-down del	*/ 'H',
"bv",	/* decode ( base )	*/ 'B',
"rp",	/* encode ( rep )	*/ 'N',
"br",	/* residue ( mod )	*/ 'M',
"sp",	/* assignment		*/ '[',
"go",	/* goto			*/ ']',
"or",	/* or			*/ '(',
"nn",	/* nand			*/ 0205,
"nr",	/* nor			*/ 0206,
"lg",	/* log			*/ 0207, 
"rv",	/* reversal		*/ 0217,
"tr",	/* transpose		*/ 0212,
"rb",	/* reverse bar		*/ 0214,
"cb",	/* comma bar ( not used)*/ 0,
"sb",	/* slash bar		*/ 0200,
"bb",	/* blackslash bar	*/ 0201,
"gu",	/* grade up		*/ 0215,
"gd",	/* grade down		*/ 0216,
"qq",	/* quote quad		*/ 0202,
"dm",	/* domino		*/ 0214,
"lm",	/* lamp			*/ 0204,
"ib",	/* i - beam		*/ 0213,
"ex",	/* execute ( not used )	*/ 0,
"fr",	/* format( not used )	*/ 0,
"di",	/* diamond ( not used )	*/ 0,
"ot",	/* out ( not used ) 	*/ 0,
"ld",	/* locked del (not used)*/ 0,
"[a",	/* alias for 'A'	*/ 0220,
"[b",	/* alias for 'B'	*/ 0221,
"[c",	/* alias for 'C'	*/ 0222,
"[d",	/* alias for 'D'	*/ 0223,
"[e",	/* alias for 'E'	*/ 0224,
"[f",	/* alias for 'F'	*/ 0225,
"[g",	/* alias for 'G'	*/ 0226,
"[h",	/* alias for 'H'	*/ 0227,
"[i",	/* alias for 'I'	*/ 0230,
"[j",	/* alias for 'J'	*/ 0231,
"[k",	/* alias for 'K'	*/ 0232,
"[l",	/* alias for 'L'	*/ 0233,
"[m",	/* alias for 'M'	*/ 0234,
"[n",	/* alias for 'N'	*/ 0235,
"[o",	/* alias for 'O'	*/ 0236,
"[p",	/* alias for 'P'	*/ 0237,
"[q",	/* alias for 'Q'	*/ 0240,
"[r",	/* alias for 'R'	*/ 0241,
"[s",	/* alias for 'S'	*/ 0242,
"[t",	/* alias for 'T'	*/ 0243,
"[u",	/* alias for 'U'	*/ 0244,
"[v",	/* alias for 'V'	*/ 0245,
"[w",	/* alias for 'W'	*/ 0246,
"[x",	/* alias for 'X'	*/ 0247,
"[y",	/* alias for 'Y'	*/ 0250,
"[z",	/* alias for 'Z'	*/ 0251
};