h21498
s 01200/00000/00000
d D 1.1 83/03/23 16:20:34 bog 1 0
c date and time created 83/03/23 16:20:34 by bog
e
u
4
U
t
T
I 1
#############################################################################
#									    #
#	This material is confidential and is furnished under		    #
#	a written license agreement.  It may not be used,		    #
#	copied or disclosed to others except in accordance		    #
#	with the terms of that agreement.				    #
#									    #
#	Copyright (C) 1982 Graphic Software Systems, Inc.		    #
#	All rights reserved.						    #
#									    #
#############################################################################
#									    #
#	Function:  							    #
#		EmWord							    #
#		    Compile-Time Switch and Macro File			    #
#									    #
#	Called By:							    #
#		included in all compiled units				    #
#									    #
#	Routines Called:						    #
#									    #
#############################################################################
divert(-1)
 
#############################################################################
#									    #
# Note that MLeft and MRight and empget.m must be changed to be non-f80	    #
#									    #
#############################################################################
 
#	Driver Access and Language Specialization
 
	If `DEBUG' is seen then debugging code is included
define(`DEBUG',)
 
#	Set todays date in `VDateTime'
define(`tfile',maketemp(`dateXXXXX'))
syscmd(`/bin/csh /u/bog/exe/vd 'tfile)
define(`VDateTime',include(tfile))
syscmd(`rm 'tfile)
undefine(`tfile')
 
define(`DEFAULTZTYPE',0)
define(`DEFAULTZDASH',1)
define(`DEFAULTINTENSITY',126)
 
#	define the Communications access mechanisms
define(`SETCOMM',
`	{
	If (COpens) {
	    Call GHStop(Error)
	    COpens = FALSE
	    }
	Call GHInit(CmParS,InStSS,InGoSS,OtStSS,OtGoSS,Error)
	COpenS = TRUE
	}
')
define(`GETCOMMPORT',
`	{
	Call GHChNW($1,$2)
	}
')
define(`COMMPORTEMPTY',-1)
define(`PUTCOMMPORT',
`	{
	Call GHChOt($1,Error)
	}
')
define(`COMMPORTBREAK',-2)
define(`STOPCOMM',
`	{
	Call GHStop(Error)
	}
')
 
#	define the Keyboard access mechanisms
 
define(`KBEMPTY',-1)
define(`GETKB',
`	{
	Call TtyINW($1)
	ifelse(
	eval(EMPTY),eval(KBEMPTY),
`dnl Nothing if EMPTY is the same as KBEMPTY
',`	If ($1 == KBEMPTY) {
	    $1 = EMPTY
	    }
')dnl
	}
')
define(`PUTALPHA',
`	{
	DdCntl(1) = 8			# text
	DdCntl(2) = 1
	DdCntl(4) = 1
	DdPtsI(1) = X
	DdPtsI(2) = Y
	DdIntI(1) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
 
#	Map INTEGER 4010 space to NDC [0..32k) space
define(`XSCREEN',`MulDiv($1,XMul,XDiv)')
define(`YSCREEN',`MulDiv($1,YMul,YDiv)')
 
#	Map NDC [0..32k) space to INTEGER 4010 space
define(`X4010',`MulDiv($1+XMul/(2*XDiv),XDiv,XMul)')
define(`Y4010',`MulDiv($1+YMul/(2*YDiv),YDiv,YMul)')
 
#	define the interface to the device driver
define(`DRAW',
`	{
	DdCntl(1) = 6			#draw
	DdCntl(2) = 2
	DdPtsI(1) = LastX
	DdPtsI(2) = LastY
	DdPtsI(3) = $1
	DdPtsI(4) = $2
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	ifelse(X,$1,,X = $1)
	ifelse(Y,$2,,Y = $2)
	LastX = X
	LastY = Y
	}
')
define(`MOVE',
`	{
#	DdCntl(1) = 6			#move
#	DdCntl(2) = 1
#	DdPtsI(1) = $1
#	DdPtsI(2) = $2
#	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	ifelse(X,$1,,X = $1)
	ifelse(Y,$2,,Y = $2)
	LastX = X
	LastY = Y
	}
')
define(`DEFAULTLINESTYLE',1)
define(`LINESTYLE',
`	{
	DdCntl(1) = 15			#set dash pattern
	DdCntl(2) = 0
	DdIntI(1) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`TEXTSIZE',
`	{
	DdCntl(1) = 12
	DdCntl(2) = 1
	DdPtsI(1) = 0
	DdPtsI(2) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`ERASEPAGE',
`	{
	DdCntl(1) = 3			# New Frame
	DdCntl(2) = 0
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`STOPGRAPHICS',
`	{
	DdCntl(1) = 2			# Stop Graphics
	DdCntl(2) = 0
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	OpnDev = -1
	}
')
define(`LINECOLOR',
`	{
	DdCntl(1) = 17
	DdCntl(2) = 0
	DdIntI(1) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`TEXTCOLOR',
`	{
	DdCntl(1) = 22
	DdCntl(2) = 0
	DdIntI(1) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`MARKERCOLOR',
`	{
	DdCntl(1) = 20
	DdCntl(2) = 0
	DdIntI(1) = $1
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	}
')
define(`POINT',
`	{
	DdCntl(1) = 7			#marker
	DdCntl(2) = 1
	DdPtsI(1) = $1
	DdPtsI(2) = $2
	Call GZDdOp(DdCntl,DdIntI,DdPtsI,DdIntO,DdPtsO)
	ifelse(X,$1,,X = $1)
	ifelse(Y,$2,,Y = $2)
	LastX = X
	LastY = Y
	}
')
 
#	declare the target machine's language and define the funnies
#	 available targets are:
#	  `INTELFORTRAN86'	Intel Fortran-86 for 8086/88
#	  `MICROSOFTFORTRAN80'	Microsoft Fortran-80 for 8080,Z80,8085
#	  `UNIXF77'		Unix V7 f77 compiler
 
#	`define'(`TARGET',`UNIXF77')	#Quoted so script sets target
 
ifelse(
TARGET,`MICROSOFTFORTRAN80',
`
	define(`SPECIALKEYOFFSET',`-128')
	define(`LOGICAL',`Logical*1')
	define(`CHARACTER',`Integer*1')
	define(`INTEGER',`Integer*2')
	define(`REAL',`Real')
	define(`TRUE',`.True.')
	define(`FALSE',`.False.')
	define(`NOT',`(.Not.($1))')
	define(`BAND',`(($1).And.($2))')
	define(`BOR',`(($1).Or.($2))')
	define(`CAND',`(($1).And.($2))')
	define(`CDIFF',`(($1)-($2))')
	define(`CSHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`CSUM',`(($1)+($2))')
	define(`IAND',`(($1).And.($2))')
	define(`IOR',`(($1).Or.($2))')
	define(`ISHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`PROGRAM',`Program')
	define(`EOJ',`Call Exit')
',
TARGET,`INTELFORTRAN86',
`
	define(`SPECIALKEYOFFSET',`-128')
	define(`LOGICAL',`Logical*1')
	define(`CHARACTER',`Integer*1')
	define(`INTEGER',`Integer*2')
	define(`REAL',`Real')
	define(`TRUE',`.True.')
	define(`FALSE',`.False.')
	define(`NOT',`(.Not.($1))')
	define(`BAND',`(($1).And.($2))')
	define(`BOR',`(($1).Or.($2))')
	define(`CAND',`(($1).And.($2))')
	define(`CDIFF',`(($1)-($2))')
	define(`CSHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`CSUM',`(($1)+($2))')
	define(`IAND',`(($1).And.($2))')
	define(`IOR',`(($1).Or.($2))')
	define(`ISHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`PROGRAM',`Subroutine')
	define(`EOJ',`Return')
',
TARGET,`UNIXF77',
`
	define(`SPECIALKEYOFFSET',`128')
	define(`LOGICAL',`Logical')
	define(`CHARACTER',`Integer*2')
	define(`INTEGER',`Integer*2')
	define(`REAL',`Real')
	define(`TRUE',`.True.')
	define(`FALSE',`.False.')
	define(`NOT',`(.Not.($1))')
	define(`BAND',`(($1).And.($2))')
	define(`BOR',`(($1).Or.($2))')
	define(`CAND',`And($1,$2)')
	define(`CDIFF',`(($1)-($2))')
	define(`CSHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`CSUM',`(($1)+($2))')
	define(`IAND',`And($1,$2)')
	define(`IOR',`Or($1,$2)')
	define(`ISHIFT',
		`ifelse(
		1,eval(($2)<0),
			(($1)/eval(2**(-($2)))),
		1,eval(($2)=0),
			($1),
		1,eval(($2)>0),
			(($1)*eval(2**($2))))')
	define(`PROGRAM',`Program')
	define(`EOJ',`Call Exit')
',
TARGET,`target',
`
	define(`SPECIALKEYOFFSET',`value of first funny key code')
	define(`LOGICAL',`type for logical variables')
	define(`CHARACTER',`type for Ascii character variables')
	define(`INTEGER',`type for 16-bit integer variables')
	define(`REAL',`type for single-precision real variables')
	define(`TRUE',`LOGICAL constant')
	define(`FALSE',`LOGICAL constant')
	define(`NOT',`NOT of LOGICAL $1')
	define(`BAND',`AND of LOGICALs $1, $2')
	define(`BOR',`OR of LOGICALs $1, $2')
	define(`CAND',`bitwise AND of CHARACTERs $1, $2')
	define(`CDIFF',`CHARACTER $1-$2')
	define(`CSHIFT',`CHARACTER $1 SHIFTLEFT by constant $2')
	define(`CSUM',`CHARACTER $1+$2')
	define(`IAND',`bitwise AND of INTEGERs $1, $2')
	define(`IOR',`bitwise OR of INTEGERs $1, $2')
	define(`ISHIFT',`INTEGER $1 SHIFTLEFT by constant $2')
	define(`PROGRAM',`Program')
	define(`EOJ',`Call Exit')
')
 
#	Define the Special Keys
 
define(`NUL',0)
define(`SOH',1)
define(`STX',2)
define(`ETX',3)
define(`EOT',4)
define(`ENQ',5)
define(`ACK',6)
define(`BEL',7)
define(`BS',8)
define(`HT',9)
define(`LF',10)
define(`VT',11)
define(`FF',12)
define(`CR',13)
define(`SO',14)
define(`SI',15)
define(`DLE',16)
define(`DC1',17)
define(`DC2',18)
define(`DC3',19)
define(`DC4',20)
define(`NAK',21)
define(`SYN',22)
define(`ETB',23)
define(`CAN',24)
define(`EM',25)
define(`SUB',26)
define(`ESC',27)
define(`FS',28)
define(`GS',29)
define(`RS',30)
define(`US',31)
define(`SPACE',32)
define(`SHRIEK',33)
define(`DOUBLEQUOTE',34)
define(`SHARP',35)
define(`DOLLAR',36)
define(`PERCENT',37)
define(`AMPERSAND',38)
define(`SINGLEQUOTE',39)
define(`LEFTPAREN',40)
define(`RIGHTPAREN',41)
define(`SPLAT',42)
define(`PLUS',43)
define(`COMMA',44)
define(`HYPHEN',45)
define(`DOT',46)
define(`SLASH',47)
define(`ZERO',48)
define(`ONE',49)
define(`TWO',50)
define(`THREE',51)
define(`FOUR',52)
define(`FIVE',53)
define(`SIX',54)
define(`SEVEN',55)
define(`EIGHT',56)
define(`NINE',57)
define(`COLON',58)
define(`SEMICOLON',59)
define(`LESSTHAN',60)
define(`EQUALS',61)
define(`GREATERTHAN',62)
define(`QUESTIONMARK',63)
define(`AT',64)
define(`UPA',65)
define(`UPB',66)
define(`UPC',67)
define(`UPD',68)
define(`UPE',69)
define(`UPF',70)
define(`UPG',71)
define(`UPH',72)
define(`UPI',73)
define(`UPJ',74)
define(`UPK',75)
define(`UPL',76)
define(`UPM',77)
define(`UPN',78)
define(`UPO',79)
define(`UPP',80)
define(`UPQ',81)
define(`UPR',82)
define(`UPS',83)
define(`UPT',84)
define(`UPU',85)
define(`UPV',86)
define(`UPW',87)
define(`UPX',88)
define(`UPY',89)
define(`UPZ',90)
define(`LEFTSQUARE',91)
define(`BACKSLASH',92)
define(`RIGHTSQUARE',93)
define(`UPARROW',94)
define(`UNDERBAR',95)
define(`BACKQUOTE',96)
define(`LOWA',97)
define(`LOWB',98)
define(`LOWC',99)
define(`LOWD',100)
define(`LOWE',101)
define(`LOWF',102)
define(`LOWG',103)
define(`LOWH',104)
define(`LOWI',105)
define(`LOWJ',106)
define(`LOWK',107)
define(`LOWL',108)
define(`LOWM',109)
define(`LOWN',110)
define(`LOWO',111)
define(`LOWP',112)
define(`LOWQ',113)
define(`LOWR',114)
define(`LOWS',115)
define(`LOWT',116)
define(`LOWU',117)
define(`LOWV',118)
define(`LOWW',119)
define(`LOWX',120)
define(`LOWY',121)
define(`LOWZ',122)
define(`LEFTCURLY',123)
define(`VERTICALBAR',124)
define(`RIGHTCURLY',125)
define(`TILDE',126)
define(`DEL',127)
 
define(`EMPTY',eval(SPECIALKEYOFFSET+0))	# No character present
define(`PAGE',eval(SPECIALKEYOFFSET+1))
define(`RESET',eval(SPECIALKEYOFFSET+2))
define(`HARDCOPY',eval(SPECIALKEYOFFSET+3))
define(`STRAPCHANGE',eval(SPECIALKEYOFFSET+4))
define(`RELEASE',eval(SPECIALKEYOFFSET+5))
define(`TOGGLESOURCE',eval(SPECIALKEYOFFSET+6))
define(`TOGGLEMARGIN',eval(SPECIALKEYOFFSET+7))
define(`BREAK',eval(SPECIALKEYOFFSET+8))
define(`EXIT',eval(SPECIALKEYOFFSET+9))
 
#	Define COMMON Access
 
define(`BEGINCOMMON',
`dnl
define(`CommonOrg',
`define(`CommonCPc',1)define(`CommonIPc',1)define(`CommonLPc',1)')dnl
define(`CommonCVar',
`define('changequote([,])[`$][1']changequote`,CommonCPc)'dnl
`ifelse(0,len($'`2),
`define(`CommonCPc',incr(CommonCPc))',
`define(`CommonCPc',eval('$'`2`+CommonCPc))'
)dnl
')dnl
define(`CommonIVar',
`define('changequote([,])[`$][1']changequote`,CommonIPc)'dnl
`ifelse(0,len($'`2),
`define(`CommonIPc',incr(CommonIPc))',
`define(`CommonIPc',eval('$'`2`+CommonIPc))'
)dnl
')dnl
define(`CommonLVar',
`define('changequote([,])[`$][1']changequote`,CommonLPc)'dnl
`ifelse(0,len($'`2),
`define(`CommonLPc',incr(CommonLPc))',
`define(`CommonLPc',eval('$'`2`+CommonLPc))'
)dnl
')dnl
define(`CommonCArray',
`CHARACTER $'`1`'ifelse(1,CommonCPc,,`('eval(CommonCPc-1)`)')')dnl
define(`CommonIArray',
`INTEGER $'`1`'ifelse(1,CommonIPc,,`('eval(CommonIPc-1)`)')')dnl
define(`CommonLArray',
`LOGICAL $'`1`'ifelse(1,CommonLPc,,`('eval(CommonLPc-1)`)')')dnl
define(`_DivChan',divnum)dnl
divert(-1)dnl
divert(_DivChan)dnl
')
 
define(`COMMON',
`dnl
define(`_DivChan',divnum)dnl
divert(1)dnl
$2
divert(2)dnl
$3
divert(3)dnl
$4
divert(_DivChan)dnl
')
 
define(`ENDCOMMON',
`dnl
undivert`'dnl
undefine(`CommonOrg')dnl
undefine(`CommonCPc')undefine(`CommonCVar')dnl
undefine(`CommonIPc')undefine(`CommonIVar')dnl
undefine(`CommonLPc')undefine(`CommonLVar')dnl
undefine(`CommonCArray')undefine(`CommonIArray')undefine(`CommonLArray')dnl
')
 
# Emulator Beam & State common in menu subsystem
define(`MEmBeamState',1)
define(`BEAMSTATE',`include(emxbst.m)')
 
# Name for Comm Capability common in menu subsystem
define(`MCommCap',2)
define(`COMMCAPABILITY',`include(emxccp.m)')
 
define(`CONFIG',`include(emxcfg.m)')
 
# Name for current comm state common in menu system
define(`MCommState',3)
define(`COMMSTATE',`include(emxcst.m)')
 
define(`DRIVER',`include(emxdri.m)')
 
# Name for Emulator Initialization common in menu system
define(`MEmInit',4)
define(`INITIALIZATION',`include(emxini.m)')
 
define(`MenuMachine',5)
define(`MENUMACHINE',`include(emxmen.m)')
 
define(`MSpecialKeys',6)
define(`SPECIALKEYS',`include(emxspk.m)')
 
# Name for Emulator Straps common in menu subsystem
define(`MEmStraps',7)
define(`STRAPS',`include(emxstr.m)')
 
# Name for Emulator Switches common in menu system
define(`MEmSwitches',8)
define(`SWITCHES',`include(emxswt.m)')
 
define(`BAUDDIM',15)
define(`DATABITDIM',4)
define(`STOPBITDIM',3)
define(`FLAGSTRINGDIM',40)
 
#	Define Menu Machine Instructions
 
define(`MStringPc',1)
define(`MCodePc',1)
define(`MSBytePc',1)
 
changequote([,])
define([MAscii0],[` !"[#]$%&$()*+[,]-./0123456789:;<=>?])
define([MAscii1], [@ABCDEFGHIJKLMNOPQRSTUVWXYZ[$]^_])
define([MAscii2],[$abcdefghijklmnopqrstuvwxyz{|}~$'])
define([MAscii],MAscii0[]changequote({,})MAscii1{}changequote([,])MAscii2)
changequote
undefine(`MAscii0')
undefine(`MAscii1')
undefine(`MAscii2')
 
define(`MStringLabel',`MSDump`'define(`$1',MStringPc)')
 
define(`MSBDat',
`dnl
define(`MSBB'MSBytePc,$1)dnl
define(`MSBytePc',incr(MSBytePc))dnl
ifelse(1,eval(MSBytePc > 3),
`
Data MenStr(MStringPc),MenStr(incr(MStringPc)),	MenStr(eval(MStringPc+2))dnl
	/MSBB1,	MSBB2,MSBB3	/`#'<substr(MAscii,eval(MSBB1-SPACE),1)>dnl
 <substr(MAscii,eval(MSBB2-SPACE),1)> <substr(MAscii,eval(MSBB3-SPACE),1)>
define(`MStringPc',eval(MStringPc+3))dnl
define(`MSBytePc',1)dnl
')dnl
')
 
define(`MSpDump',
`ifelse(0,MSBSps,`',
1,MSBSps,`MSBDat(SPACE)',
`MSBDat(ETX)
MSBDat(MSBSps)')
define(`MSBSps',0)')
 
define(`MSBSps',0)
 
define(`MSByte',
`dnl
ifelse(0,eval(SPACE-$1),`define(`MSBSps',incr(MSBSps))',
`MSpDump
MSBDat(`$1')')
')
 
define(`MSChar',
`dnl
MSByte(eval(32+index(MAscii,substr(`$1',0,1))))dnl
')
 
define(`MString',
`dnl
ifelse(0,len(`$1'),,
`dnl
MSChar(`$1')dnl
MString(substr(`$1',1))dnl
')dnl
')
 
define(`MCrLf',
`dnl
ifelse(0,len(`$1'),
`dnl
MSByte(CR)dnl
MSByte(LF)dnl
',`dnl
ifelse(0,eval(`$1'),,
`dnl
MSByte(CR)dnl
MSByte(LF)dnl
MCrLf(eval(`$1'-1))dnl
')dnl
')dnl
')
 
define(`MSDump',
`dnl
MSpDump
ifelse(2,MSBytePc,
`
Data MenStr(00`'MStringPc)				/MSBB1		dnl
/`#'<substr(MAscii,eval(MSBB1-SPACE),1)>
define(`MStringPc',incr(MStringPc))dnl
define(`MSBytePc',1)dnl
',3,MSBytePc,
`
Data MenStr(0`'MStringPc),MenStr(incr(MStringPc))			dnl
/MSBB1,	MSBB2	/`#'<substr(MAscii,eval(MSBB1-SPACE),1)>dnl
 <substr(MAscii,eval(MSBB2-SPACE),1)>
define(`MStringPc',eval(MStringPc+2))dnl
define(`MSBytePc',1)dnl
')dnl
')
 
define(`MEos',
`dnl
MSByte(0)dnl
MSDump
')
 
define(`MLine',
`dnl
MStringLabel(`$1')dnl
MString(`$2')dnl
MCrLf(`$3')dnl
MEos`'dnl
')
 
define(`MTos',0)
 
define(`MPush',`define(`MTos',incr(MTos))define(`MStack'MTos,``$1'')')
 
define(`MVal',`$1')
 
define(`MPop',
`MVal(`MStack'MTos)`'undefine(`MStack'MTos)define(`MTos',eval(MTos-1))')
 
define(`MLabel',`
`#'`$1':
define(`$1',MCodePc)')
 
define(`MLeft',`eval($1 / 256)')
define(`MRight',`eval($1 % 256)')
 
define(`MOpB',
`
Data MenCod(0`'MCodePc)/		$1/		`#'`$1'
define(`MCodePc',incr(MCodePc))dnl
')
 
define(`MOpP',
`
Data MenCod(MCodePc),MenCod(incr(MCodePc))/	MLeft($1),	dnl
MRight($1)/	`#'`$1'
define(`MCodePc',eval(MCodePc+2))dnl
')
 
define(`MOpBB',
`
Data MenCod(MCodePc),MenCod(incr(MCodePc))/	$1,	$2/dnl
	`#'`$1'   `$2'
define(`MCodePc',eval(MCodePc+2))dnl
')
 
define(`MOpBP',`MOpB(`$1')MOpP(`$2')')
 
define(`MOpBBP',`MOpBB(`$1',`$2')MOpP(`$3')')
 
define(`MOp',1)
define(`MNextOp',`MOp`'define(`MOp',incr(MOp))')
 
define(`MProg',`
Data InitPc/			MCodePc/		`#'Initial MenuPc
$1
')
 
define(`MProc',`$1')
 
define(`MOpShowChar',MNextOp)
define(`MShowChar',`MOpBB(`MOpShowChar',`$1')')
 
define(`MOpShowI',MNextOp)
define(`MShowInteger',`MOpBBP(`MOpShowI',`$1',`$2')')
 
define(`MOpShowString',MNextOp)
define(`MShowString',`MOpBP(`MOpShowString',`$1')')
 
define(`MOpShowEditStr',MNextOp)
define(`MShowEditString',`MOpBB(`MOpShowEditStr',`$1')MOpP(`$2')MOpP(`$3')')
 
define(`MShowLine',
`dnl
MShowString(`MStringPc')dnl
MString(`$1')MCrLf(`$2')MEos`'dnl
')
 
define(`MShowOptLine',
`dnl
MNewCase(`$1')dnl
MShowChar(`-$1')dnl
MShowString(`MColonSpSp')dnl
MShowLine(`$2',`$3')dnl
')
 
define(`MPFixup',
`define(`MFoo',MPop)
Data MenCod(MFoo),MenCod(incr(MFoo))/	MLeft($1),dnl
	MRight($1)/	`#'`$2' Fixup:  `$1'dnl
undefine(`MFoo')')
 
define(`MIfCond',
`dnl
MOpB(`$1')dnl
MPush(MCodePc)dnl Place to put index of false path
define(`MCodePc',eval(MCodePc+2))dnl
$2
ifelse(0,len(`$3'),
`MPFixup(MCodePc,`FJump')dnl
',`
MPFixup(eval(MCodePc+3),`FJump')MOpB(`MOpGoto')dnl
define(`MCodePc',eval(MCodePc+2))dnl
MPush(eval(MCodePc-2))dnl
$3
MPFixup(MCodePc,`TJump')dnl
')dnl
')
 
define(`MOpIf',MNextOp)
define(`MIf',`MIfCond(`MOpIf',`$1',`$2')')
 
define(`MOpIfNot',MNextOp)
define(`MIfNot',`MIfCond(`MOpIfNot',`$1',`$2')')
 
define(`MOpIfEq',MNextOp)
define(`MIfEq',`MIfCond(`MOpIfEq',`$1',`$2')')
 
define(`MOpIfNe',MNextOp)
define(`MIfNe',`MIfCond(`MOpIfNe',`$1',`$2')')
 
define(`MOpIfLt',MNextOp)
define(`MIfLt',`MIfCond(`MOpIfLt',`$1',`$2')')
 
define(`MOpIfGe',MNextOp)
define(`MIfGe',`MIfCond(`MOpIfGe',`$1',`$2')')
 
define(`MOpIfGt',MNextOp)
define(`MIfGt',`MIfCond(`MOpIfGt',`$1',`$2')')
 
define(`MOpIfLe',MNextOp)
define(`MIfLe',`MIfCond(`MOpIfLe',`$1',`$2')')
 
define(`MOpCall',MNextOp)
define(`MCall',`MOpBP(`MOpCall',`$1')')
 
define(`MOpIxCall',MNextOp)
define(`MIxCall',`MOpBBP(`MOpIxCall',`$1',`$2')')
 
define(`MOpRet',MNextOp)
define(`MRet',`MOpB(`MOpRet')')
 
define(`MOpGoto',MNextOp)
define(`MGoto',`MOpBP(`MOpGoto',`$1')')
 
define(`MOpNewCase',MNextOp)
define(`MNewCase',`MOpBB(`MOpNewCase',`$1')')
 
define(`MOpLoadL',MNextOp)
define(`MLoadLogical',`MOpBBP(`MOpLoadL',`$1',`$2')')
 
define(`MOpAnd',MNextOp)
define(`MAndLogical',`MOpBBP(`MOpAnd',`$1',`$2')')
 
define(`MOpOr',MNextOp)
define(`MOrLogical',`MOpBBP(`MOpOr',`$1',`$2')')
 
define(`MOpStoreL',MNextOp)
define(`MStoreLogical',`MOpBBP(`MOpStoreL',`$1',`$2')')
 
define(`MOpLoadI',MNextOp)
define(`MLoadInteger',`MOpBBP(`MOpLoadI',`$1',`$2')')
 
define(`MOpAdd',MNextOp)
define(`MAddInteger',`MOpBBP(`MOpAdd',`$1',`$2')')
 
define(`MOpSub',MNextOp)
define(`MSubInteger',`MOpBBP(`MOpSub',`$1',`$2')')
 
define(`MOpLoadC',MNextOp)
define(`MLoadChar',`MOpBBP(`MOpLoadC',`$1',`$2')')
 
define(`MOpAddC',MNextOp)
define(`MAddChar',`MOpBBP(`MOpAddC',`$1',`$2')')
 
define(`MOpSubC',MNextOp)
define(`MSubChar',`MOpBBP(`MOpSubC',`$1',`$2')')
 
define(`MOpLoadIm',MNextOp)
define(`MLoadImmed',`MOpBB(`MOpLoadIm',`$1')')
 
define(`MOpAddIm',MNextOp)
define(`MAddImmed',`MOpBB(`MOpAddIm',`$1')')
 
define(`MOpSubIm',MNextOp)
define(`MSubImmed',`MOpBB(`MOpSubIm',`$1')')
 
define(`MOpStoreI',MNextOp)
define(`MStoreInteger',`MOpBBP(`MOpStoreI',`$1',`$2')')
 
define(`MOpStoreC',MNextOp)
define(`MStoreChar',`MOpBBP(`MOpStoreC',`$1',`$2')')
 
define(`MOpEditInt',MNextOp)
define(`MEditInteger',`MOpBBP(`MOpEditInt',`$1',`$2')')
 
define(`MOpEditStr',MNextOp)
define(`MEditString',
  `MOpBB(`MOpEditStr',`$1')MOpP(`$2')MOpP(`$3')MOpB(`$4')')
 
define(`MOpSaveXY',MNextOp)
define(`MSaveXY',`MOpBBP(`MOpSaveXY',`$1',`$2')')
 
define(`MOpMove',MNextOp)
define(`MMove',`MOpBBP(`MOpMove',`$1',`$2')')
 
define(`MOpChMode',MNextOp)
define(`MChMode',`MOpBB(`MOpChMode',`$1')')
 
define(`MOpNewPage',MNextOp)
define(`MNewPage',`MOpB(`MOpNewPage')')
 
define(`MOpExit',MNextOp)
define(`MExit',`MOpB(`MOpExit')')
 
define(`MSwitchFixupCount',0)
 
define(`MFixLinks',
  `ifelse(0,$1,,`MPFixup(MCodePc,`EndCase')MFixLinks(eval($1-1))')')
 
define(`MOpSwitch',MNextOp)
define(`MSwitch',
`dnl
MOpB(`MOpSwitch')dnl
MPush(MSwitchFixupCount)dnl
define(`MSwitchFixupCount',0)dnl
$1
Data MenCod(MCodePc),MenCod(incr(MCodePc))/	0,	0/dnl
	`#' OTHERWISE; no link
define(`MCodePc',eval(MCodePc+2))dnl
$2
MFixLinks(MSwitchFixupCount)dnl
define(`MSwitchFixupCount',MPop)dnl
')
 
define(`MCase',
`dnl
MPush(MCodePc)dnl
define(`MCodePc',eval(MCodePc+2))dnl
MOpB(`$1')dnl
$2
MPFixup(eval(MCodePc+3),`Caselink')dnl
MOpB(`MOpGoto')dnl
MPush(MCodePc)dnl
define(`MCodePc',eval(MCodePc+2))dnl
define(`MSwitchFixupCount',incr(MSwitchFixupCount))dnl
')
 
define(`MGLink',0)
define(`MILink',0)
define(`MOpGroups',MNextOp)
define(`MGroups',
`dnl
MOpB(`MOpGroups')dnl
MPush(MGLink)dnl
MPush(MILink)dnl
define(`MGLink',MCodePc)dnl
define(`MCodePc',eval(MCodePc+2))dnl
$1
MPush(MGLink)MPFixup(0,`Last Group')dnl
define(`MILink',MPop)dnl
define(`MGLink',MPop)dnl
')
 
define(`MOpGroup',MNextOp)
define(`MGroup',
`
MPush(MGLink)MPFixup(incr(MCodePc),`Group Link')MOpB(`MOpGroup')dnl
define(`MGLink',MCodePc)dnl
define(`MCodePc',eval(MCodePc+2))dnl
define(`MILink',MCodePc)dnl
MLabel(`$1')dnl
define(`MCodePc',eval(MCodePc+6))dnl
$2
MPush(MILink)MPFixup(0,`Last Item')dnl
')
 
define(`MOpItem',MNextOp)
define(`MItem',
`
MPush(MILink)MPFixup(incr(MCodePc),`Item Link')MOpB(`MOpItem')dnl
define(`MILink',MCodePc)dnl
define(`MCodePc',eval(MCodePc+3))dnl
$1
')
 
define(`MOpUpdGroup',MNextOp)
define(`MUpdateGroup',`MOpBP(`MOpUpdGroup',`$1')')
 
define(`MImmed',0)
`
      String Definition
	Note that strings cannot have "`", "'" or "," in them.  Sorry.
	They must be stuck in individually.  See the menu page strings.
 
	MStringLabel(`<stringname>')
	  Begin a string called <stringname>.
 
	MString(`<string>')
	  Define a string <string>.
 
	MCrLf(<n>)
	  Define <n> (1 if <n> null) CrLfs.
 
	MEos
	  End a string.
 
	MLine(`<stringname>',`<string>',<n>)
	  Define a string called <stringname> consisting of <string>
	  followed by <n> (1 if null) CrLfs.
 
 
      Data Access
	Most of the instructions use the <common>:<variable> form.
 
	The <common> is the common block in which the variable resides.
	A 0 (MImmed) implies that the <variable> is the value, not an
	index.  Negative values for <common> imply that the <variable>
	is to have the content of MIndex added to it before it is used
	to access the item.  MIndex is 1-based, not 0-based; i.e.
	  LoadInteger(`-MEmBeamState',`Foo')
	    with MIndex=1 is the same as
	  LoadInteger(`MEmBeamState',`Foo').
 
	Commons available are:
	  Menu Name	  Common /Name/	      Def file
	    MEmBeamState    EmBmSt		emcbst.m
	    MEmSwitches	    Switch		emcswt.m
	    MEmStraps	    Strap		emcstr.m
	    MEmInit	    GSDCap		emcini.m
	    MCommState	    EmCmSt		emccst.m
	    MCommCap	    EmCmCp		emcccp.m
	    MSpecialKeys    KbSpKy		emcspk.m
	    MenuMachine	    EmMenu		emcmen.m
	    MImmed	      ..		emmdmc.m, emstrp.m
 
 
      Instruction Set
 
	MShowChar(`<char>')
	  Display the literal ADE <char> at the current X, Y.
 
	MShowI(`<common>',`<variable>')
	  Show the <variable> in <common> on the screen at the current X, Y.
	  The format used is [`-' if negative][digits], leading zeros
	  suppressed, minimal width but no less than one digit.
 
	MShowString(`<stringname>')
	  Put string at <stringname> thru its MEos on screen
	  at current X,Y.
 
	MShowEditString(`<common>',`<string>',`<length>')
	  Display in "" with names for Ascii control characters and spaces
	  separating each character the string at <common>:<string> with
	  length <common>:<length>.
 
	MShowLine(`<string>',<n>)
	  Put literal <string> on screen at current X,Y followed by literal
	  <n> CrLfs.  One CrLf will be put out if <n> is not present.
 
	MShowOptLine(<n>,`<string>',<m>)
	  Does:	MNewCase(<n>)
		MShowChar(-<n>)
		MShowLine(`:  ',0)	#No CrLf
		MShowLine(`<string>',<m>)
	  Shows a line with the next sequential selection character.
 
	MIf(`<true path>',`<false path>')
	  If logical accumulator TRUE do <true path> else do <false path>
 
	MIfNot(`<false path>',`<true path>')
	  If logical accumulator FALSE do <false path> else do <true path>
 
	MIfEq(`<true path>',`<false path>')
	  If integer accumulator == 0 do <true path> else do <false path>
 
	MIfNe(`<true path>',`<false path>')
	  If integer accumulator != 0 do <true path> else do <false path>
 
	MIfLt(`<true path>',`<false path>')
	  If integer accumulator < 0 do <true path> else do <false path>
 
	MIfGe(`<true path>',`<false path>')
	  If integer accumulator >= 0 do <true path> else do <false path>
 
	MIfGt(`<true path>',`<false path>')
	  If integer accumulator > 0 do <true path> else do <false path>
 
	MIfLe(`<true path>',`<false path>')
	  If integer accumulator <= 0 do <true path> else do <false path>
 
	MCall(`<proc>')
	  Invoke the procedure <proc>, which must be defined before the call.
 
	MRet
	  Return from a procedure to the caller.  Note that the procedure
	  stack is limited in size.
 
	MGoto(`<proc>')
	  Go to (not call; cannot return) the defined procedure <proc>.
 
	MNewCase(<n>)
	  <n> chooses the next sequentially available selection
	  character for the MCase with -<n>.
 
	MLoadLogical(`<common>',`<variable>')
	  Load the <variable> in <common> into the logical accumulator.
 
	MAndLogical(`<common>',`<variable>')
	  And the <variable> in <common> into the logical accumulator.
 
	MOrLogical(`<common>',`<variable>')
	  Or the <variable> in <common> into the logical accumulator.
 
	MStoreLogical(`<common>',`<variable>')
	  Store the logical accumulator into the <variable> in <common>.
 
	MLoadInteger(`<common>',`<variable>')
	  Load the <variable> in <common> into the integer accumulator.
 
	MAddInteger(`<common>',`<variable>')
	  Add the <variable> in <common> into the integer accumulator.
 
	MSubInteger(`<common>',`<variable>')
	  Subtract the <variable> in <common> from the integer accumulator.
 
	MStoreInteger(`<common>',`<variable>')
	  Store the integer accumulator into the <variable> in <common>.
 
	MEditString(`<common>',`<variable>',`<length>',`max')
	  Fancy edit the string at <common>:<variable> with length at
	  <common>:<length> of maximum length literal max.
 
	MSaveXY(`<common',`<variable')
	  Store the current beam position at <common>:<variable>.
 
	MMove(`<common>',`<variable>')
	  Move the beam to the X, Y at <common>:<variable>.
 
	MChMode(<n>)
	  Change to Native character display mode if n is 1;  else
	  4010 character display mode.
 
	MNewPage
	  Erase the page, clear ??
 
	MExit
	  Return to the Emulator, restarting communications if necessary.
 
	MSwitch(`
	  MCase(`<val0>',`<path0>')
	  MCase(`<val1>',`<path1>')
	  MCase(`<val2>',`<path2>')
	  .
	  .
	  .
	  MCase(`<valn>',`<pathn>')
	',`
	  <otherwise path>
	')
	  Get a character from the keyboard.  If the character (ignoring
	  SPACE etc.) matches one of the <valn>, <pathn> is taken, otherwise
	  <otherwise path> is taken.  Note that negative <valn>s imply an
	  indirect character match using the character in the MNewCase whose
	  <val> corresponds.  This allows menu lines to be optionally deleted
	  but lets the select character set stay sequential.
 
	  The various paths each continue after the MSwitch statement.
 
	MGroups(`
	  MGroup(`<group label0>',`
	    MItem(`
	      .
	      .
	      ')
	    MItem(`
	      .
	      ')
	    ')
	  MGroup(`<group label1>',`
	    MItem(`
	      .
	      ')
	    .
	    ')
	  ')
	  These operations define groups of items to be flagged with a * when
	  set.  A page can contain multiple groups, which can contain
	  multiple items.
 
	  When the MGroups instruction is traversed, which should be when
	  the page is first drawn, the `splat counts' for each item in all
	  groups contained are cleared.
 
	  When an MGroup instruction is encountered, the beam should be just
	  after the `x:' for the first selection of the group.  The X, Y is
	  remembered so that future MUpdateGroup instructions can use it.
	  No `splat' markers need be put up when the page is being built.
 
	  Each MItem defines the place to put the markers for the selection.
 
	MUpdateGroup(`<group label>')
	  Even up the `splat counts' for the items in the group <group label>
	  by putting out splats until their splat counts match.  Then put an
	  extra splat on the <n>th item in the group, where n is the IAc
	  contents.
'
divert
E 1
