h41552
s 00610/00000/00000
d D 1.1 83/03/23 16:20:26 bog 1 0
c date and time created 83/03/23 16:20:26 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:  							    #
#		Subroutine EmStrp ()					    #
#		    Change communications parameters			    #
#		    Change special key definitions			    #
#		    Change 4012/4014 straps				    #
#									    #
#	Called By:							    #
#		Subroutine EmPoll ()					    #
#		    4012/4014 Emulator Main Polling Loop		    #
#									    #
#	Routines Called:						    #
#									    #
#############################################################################
 
Subroutine EmStrp
 
# Locals
INTEGER I,J,K
CHARACTER Char,C,C1,C2
CHARACTER SwChar		# Character which switches to EditString
INTEGER PagePc,PagTos		# Restart page context
INTEGER XSave,YSave,XBSave,YBSave#  for UpdateGroup
INTEGER Error			# For `SETCOMM'
CHARACTER SpSplt(8)		# For UpdateGroup
CHARACTER Spaces(9)		# For Item
 
# External functions
CHARACTER EmIKb			# Fetch a keyboard character
External EmIKb
 
CHARACTER EmOFet		# Fetch a code-space CHARACTER
External EmOFet
INTEGER EmPFet			# Fetch a code-space INTEGER, bump MenuPc
External EmPFet
INTEGER EmPGet			# Fetch code-space INTEGER, ^ param, no incr
External EmPGet
INTEGER EmPBmp			# EmPBmp param by code-space width of INTEGER
External EmPBmp
 
CHARACTER EmCFet		# Fetch a CHARACTER variable, ^ in code space
External EmCFet
CHARACTER EmCGet		# Fetch a CHARACTER variable, ^ is parameter
External EmCGet
INTEGER EmIFet			# Fetch an INTEGER variable, ^ in code space
External EmIFet
INTEGER EmIGet			# Fetch an INTEGER variable, ^ is parameter
External EmIGet
LOGICAL EmLFet			# Fetch a LOGICAL variable, ^ in code space
External EmLFet
LOGICAL EmLGet			# Fetch a LOGICAL variable, ^ is parameter
External EmLGet
 
LOGICAL EmMEdN			# Edit a number; true if repaint needed
External EmMEdN
LOGICAL EmMEdS			# Edit a string; true if repaint needed
External EmMEdS
 
INTEGER EmMStr			# Show a string
External EmMStr
CHARACTER EmAPut		# Show the name of a character
External EmAPut
CHARACTER EmNPut		# Show an integer
External EmNPut
 
BEGINCOMMON
COMMON(BEAMSTATE)
COMMON(COMMCAPABILITY)
COMMON(COMMSTATE)
COMMON(DRIVER)
COMMON(INITIALIZATION)
COMMON(MENUMACHINE)
COMMON(SPECIALKEYS)
COMMON(STRAPS)
COMMON(SWITCHES)
ENDCOMMON
 
Data SpSplt/SPACE,SPACE,SPACE,SPACE,SPACE,SPACE,SPLAT,0/
Data Spaces/SPACE,SPACE,SPACE,SPACE,SPACE,SPACE,SPACE,SPACE,0/
 
# Reset the Pc to initial point
MenuPc = InitPc
 
# Clear Menu stack
MenTos = 0
 
# Poop to screen, not plotter; force native ??**??**??**??**
LNativ = Native			#Save external settings
LCrLf = CrLf
LLfCr = LfCr
LPAspc = PAspct
 
Native = TRUE			#Force what menu needs
CrLf = FALSE
LfCr = FALSE
PAspct = TRUE
 
CurDev = MenDev
 
If (Going) {
  Call EmRest			#Reset before menu starts
  }
 
Repeat {			#Fetch until `MExit' BREAKs
 
  Char = EmOFet(Char)		#Fetch opcode
 
  If ((Char >= MOpLoadI) & (Char <= MOpSubIm)) {#Prefetch operand into I
#   Switch ((Char-MOpLoadI)/3) {
    {
    C = (Char-eval(MOpLoadI-3))/3
    Goto (10,11,12),C
 
#     Case 0: {			#Load, Add, Sub Integer
      10 {
	I = EmIFet(I)
	}
	Goto 19
 
#     Case 1: {			#Load, Add, Sub Char
      11 {
	I = EmCFet(C)
	Char = Char-3		#Adjust to Integer opcode
	}
	Goto 19
 
#     Case 2: {			#Load, Add, Sub Immed
      12 {
	I = EmOFet(C)
	Char = Char-6		#Adjust to Integer opcode
	}
#	Goto 19
 
    19 Continue
      }
    }
 
# Switch (Char) {		#Switch on opcode
  {
    Goto (101,102,103,104,105,106,107,108,109,110,111,
      112,113,114,115,116,117,118,119,120,121,122,
      123,124,199,199,199,199,199,199,131,132,133,
      134,135,136,137,138,139,140,141,142,143,144),Char
 
#   Case MOpShowChar: {		#Show a char on screen
    101 {
      Char = EmOFet(Char)	# Get the char or indirect
      If (Going) {		# Don't display if init time
	If (Char == 0) {	# If 0,
	  Char = MenIAc		#  use IAc contents
	  }			#  then substitute opt sel char if neg
	If (Char < 0) {		# If optional selection char
	  Char = -Char		# Need positive index
	  Char = MenNCh(Char)	# Get corresponding character
	  }
	Call EmAsci(Char)	#Poop out the character
	}
      }
      Goto 199
 
#   Case MOpShowI: {		#Show integer on screen
    102 {
      I = EmIFet(I)		#Get value
      If (Going) {		#Don't display at init time
	I = EmNPut(I)		#Show the value
	}
      }
      Goto 199
 
#   Case MOpShowString: {	#Show a string on the screen
    103 {
      I = EmPFet(I)		#Get index into string
      If (Going) {		#Don't display at init
	I = EmMStr(MenStr(I))	#Poop it out
	}
      }
      Goto 199
 
#   Case MOpShowEditStr: {	#Show "ascii"
    104 {
      Char = EmOFet(Char)	#Get <common>
      J = EmPFet(J)		#Get <string>
      K = EmPFet(K)		#Get <length>
      If (Going) {		#Don't display at init time
	C = EmCGet(Char,K)	#Get length
	Call EmAsci(DOUBLEQUOTE)	#Poop out "
	For (C1 = 1; C1 <= C; C1 = C1+1) {
	  C2 = EmAPut(EmCGet(Char,J))	#Poop out a character or its name
	  J = J+1			#Bump index
	  If (C1 < C) {		#No space after last
	    Call EmAsci(SPACE)	#Space after each except last
	    }
	  }
	Call EmAsci(DOUBLEQUOTE)	#Poop out ending "
	}
      }
      Goto 199
 
#   Case MOpIf: {		#If LAc true
    105 {
      I = EmPFet(I)		#Index of false path
      If (NOT(MenLAC)) {
	MenuPc = I		#If LAc not true, take false path
	}
      }
      Goto 199
 
#   Case MOpIfNot: {		#If LAc not true
    106 {
      I = EmPFet(I)		#Index of false path
      If (MenLAc) {
	MenuPc = I		#If LAc true, take false path
	}
      }
      Goto 199
 
#   Case MOpIfEq: {		#If IAc == 0
    107 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc != 0) {
	MenuPc = I		#If IAc != 0, take false path
	}
      }
      Goto 199
 
#   Case MOpIfNe: {		#If IAc != 0
    108 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc == 0) {
	MenuPc = I		#If IAc == 0, take false path
	}
      }
      Goto 199
 
#   Case MOpIfLt: {		#If IAc < 0
    109 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc >= 0) {
	MenuPc = I		#If IAc >= 0, take false path
	}
      }
      Goto 199
 
#   Case MOpIfGe: {		#If IAc >= 0
    110 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc < 0) {
	MenuPc = I		#If IAc < 0, take false path
	}
      }
      Goto 199
 
#   Case MOpIfGt: {		#If IAc > 0
    111 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc <= 0) {
	MenuPc = I		#If IAc <= 0, take false path
	}
      }
      Goto 199
 
#   Case MOpIfLe: {		#If IAc <= 0
    112 {
      I = EmPFet(I)		#Index of false path
      If (MenIAc > 0) {
	MenuPc = I		#If IAc > 0, take false path
	}
      }
      Goto 199
 
#   Case MOpCall: {		#Push return address, jump
    113 {
      I = EmPFet(I)		# Get routine address
      MenTos = MenTos+1		# Bump top of stack
      MenStk(MenTos) = MenuPc	# Push return address
      MenuPc = I		# Goto destination
      }
      Goto 199
 
#   Case MOpIxCall: {		#Compute offset from dest, push ret, jump
    114 {
      C = EmOFet(C)		# Get length of each item
      I = EmPFet(I)+(MenIx-1)*C	# Compute place to call
      MenTos = MenTos+1		# Bump top of stack
      MenStk(MenTos) = MenuPc	# Push return address
      MenuPc = I		# Goto destination
      }
      Goto 199
 
#   Case MOpRet: {		#Pop return address, goto it
    115 {
      MenuPc = MenStk(MenTos)	# Pop return address into Pc
      MenTos = MenTos-1		# Decrement stack pointer
      }
      Goto 199
 
#   Case MOpGoto: {
    116 {
      MenuPc = EmPFet(MenuPc)	#New Pc from next word
      }
      Goto 199
 
#   Case MOpNewCase: {		#Get next available choice character
    117 {
      MnNChN = MnNChN+1		# Bump to next
      C = EmOFet(C)		# Get index wanted
      If (C == 0) {
	C = MenIAc		# Use IAc if index 0
	}
      MenNCh(C) = MnNChN	# This index is next available choice char
      }
      Goto 199
 
#   Case MOpLoadL: {		#Load logical to accum
    118 {
      MenLAc = EmLFet(MenLAc)
      }
      Goto 199
 
#   Case MOpAnd: {		#And logical to accum
    119 {
      MenLAc = BAND(MenLAc,EmLFet(L))
      }
      Goto 199
 
#   Case MOpOr: {		#Or logical to accum
    120 {
      MenLAc = BOR(MenLAc,EmLFet(L))
      }
      Goto 199
 
#   Case MOpStoreL: {		#Store accum in logical
    121 {
      C = EmOFet(C)		# Get common ptr
      Call EmLPut(MenLAc,C,EmPFet(J))	# Stuff accum
      }
      Goto 199
 
#   Case MOpLoadI: {		#Load integer to accum
    122 {
      MenIAc = I		#Prefetched
      }
      Goto 199
 
#   Case MOpAdd: {		#Add integer to accum
    123 {
      MenIAc = MenIAc+I		#Prefetched
      }
      Goto 199
 
#   Case MOpSub: {		#Subtract integer from accum
    124 {
      MenIAc = MenIAc-I		#Prefetched
      }
      Goto 199
 
    # Hole for Load, Add, Sub Char and Immed
 
#   Case MOpStoreI: {		#Store accum in INTEGER variable
    131 {
      C = EmOFet(C)		# Get common ptr
      Call EmIPut(MenIAc,C,EmPFet(I))	# Stuff accum
      }
      Goto 199
 
#   Case MOpStoreC: {		#Store accum in CHARACTER variable
    132 {
      C = EmOFet(C)		# Get common ptr
      Call EmCPut(MenIAc,C,EmPFet(I))	# Stuff accum
      }
      Goto 199
 
#   Case MOpEditInt: {		# Input an integer
    133 {
      C = EmOFet(C)		# Get <Common>
      I = EmPFet(I)		# Get <Var>
      If (NOT(EmMEdN(C,I))) {	# If false, must repaint and continue
	Call EmPKb(SwChar)	#  so push the character which got us here
	MenuPc = PagePc		#  force a restart from top of page
	MenTos = PagTos		#  force stack to beginning of page state
	}
      }
      Goto 199
 
#   Case MOpEditStr: {		#Fancy edit string of Ascii
    134 {
      If (NOT(EmMEdS(I))) {	# If false, must repaint and continue
	Call EmPKb(SwChar)	#  so push the character which got us here
	MenuPc = PagePc		#  force a restart from top of page
	MenTos = PagTos		#  force stack to beginning of page state
	}
      }
      Goto 199
 
#   Case MOpSaveXY: {		#Save current X, Y
    135 {
      C = EmOFet(C)		#Get <common>
      J = EmPFet(J)		#Get <variable>
      Call EmIPut(X,C,J)		#Save X
      Call EmIPut(Y,C,J+1)	#Save Y
      }
      Goto 199
 
#   Case MOpMove: {		#Move beam to X, Y
    136 {
      C = EmOFet(C)		#Get <common>
      J = EmPFet(J)		#Get <variable>
      X = EmIGet(C,J)		#Get X
      Y = EmIGet(C,J+1)		#Get Y
      If (Going) {		#No show if init
	MOVE(X,Y)		#Move beam to X, Y
	}
      }
      Goto 199
 
#   Case MOpChMode: {		#Change character display mode
    137 {
      C = EmOFet(C)		#1: native, 2: 4010
      If (Going) {
	Native = (C == 1)
	Call EmRest
	}
      }
      Goto 199
 
#   Case MOpNewPage: {		#Reset for new menu page
    138 {
      If (Going) {		#Don't page at init time
	Call EmPage		#Clear the screen
	}
      MnNChN = eval(UPA-1)	#Reset next available choice letter to A
      For (C = 1; C <= 26; C = C+1) {
	MenNCh(C) = -1		#Reset each char
	}
      PagePc = MenuPc-1		#Save place to restart page
      PagTos = MenTos		# & stack pointer
      }
      Goto 199
 
#   Case MOpExit: {		#Return to emulator
    139 {
      If (Going) {		#Don't page at init time
	Call EmPage		#Clear the screen
	}
      Native = LNativ		#Restore local to external
      CrLf = LCrLf
      LfCr = LLfCr
      PAspct = LPAspc
      CurDev = NMNDev
      Going = TRUE		#Next time in, show stuff
      Call EmRest		#Open graphics
      If (ComChg) {		#Comm either needs to be opened or some
	If ((CmParS(MRxFlagMode) == 1)# If string flagging
	    & ((CmParS(MRxStopStrLen) < 1)#  and illegal length
	     | (CmParS(MRxGoStrLen) < 1))) {
	  CmParS(MRxFlagMode) = 0	#  then no flagging
	  }
	If (CmParS(MRxFlagMode) != 1) {	# If not string flagging
	  XSave = CmParS(MRxStopStrLen)	#  save string lengths
	  YSave = CmParS(MRxGoStrLen)
	  CmParS(MRxStopStrLen) = 0	#  & force to zero
	  CmParS(MRxGoStrLen) = 0
	  }
	SETCOMM			# parameter changed; initialize it
	If (CmParS(MRxFlagMode) != 1) {	# If not string flagging
	  CmParS(MRxStopStrLen) = XSave	#  restore string lengths
	  CmParS(MRxGoStrLen) = YSave
	  }
	ComChg = FALSE		#No change for next time
	}
      Return			#Return to emulator
      }
#     Goto 199
 
#   Case MOpSwitch: {		#Get char and disperse on it
    140 {
      Repeat {			#Get a non-empty character from the keyboard
	Char = EmIKb(Char)		#Get a char
	} Until (Char != EMPTY)
      If ((Char >= LOWA) & (Char <= LOWZ)) {
	Char = Char-eval(LOWA-UPA)	#Upcase lower case
	}
      SwChar = Char		#Save for EditString
      While (EmPFet(I) != 0) {	#Nerp though to end of chain
	C = EmOFet(C)		#Get value to test
	If ((C < 0) & (C > -27)) {#It's an optional character
	  C = -C		#Need positive index
	  C = MenNCh(C)		#C now has char to match
	  }
	If (Char == C) {	#Matched a character
	  Break			#Quit when char found
	  }
	MenuPc = I		#Step to next link
	}
      }
      Goto 199
 
#   Case MOpGroups: {		# Define groups on this page
    141 {
      For (I = EmPFet(I); I != 0; I = EmPGet(I)) {# Traverse group chain
	For (J = EmPGet(EmPBmp(I)); J != 0; J = EmPGet(J)) {# Trav item chain
	  K = EmPBmp(J)		# Point to splat count
	  MenCod(K) = -1	# Item not yet touched
	  }
	}
      }
      Goto 199
 
#   Case MOpGroup: {		# Next group
    142 {
      I = EmPFet(I)		# Fetch group link
      I = EmPFet(I)		# Fetch item link; point to place to save X
      Call EmPPut(X,MenuPc)	# Save X
      I = EmPFet(I)		# Fetch X; point to place to save Y
      Call EmPPut(Y,MenuPc)	# Save Y
      I = EmPFet(I)		# Point to next instruction
      }
      Goto 199
 
#   Case MOpItem: {		# Next item
    143 {
      I = EmPFet(I)		# Point to splat count
      MenCod(MenuPc) = 0	# Clear splat count
      MenuPc = MenuPc+1		#  & bypass it
      I = EmMStr(Spaces)	# Poop out 8 spaces
      }
      Goto 199
 
#   Case MOpUpdGroup: {		# Update selection of item in MenIAc
    144 {
      XSave = X			# Save previous X, Y
      YSave = Y
      I = EmPFet(I)		# Get ptr to item chain head
      If (Going) {		# Do nothing at init time
	J = EmPBmp(I)		# Point at saved X
	X = EmPGet(J)		# Fetch beginning X
	J = EmPBmp(J)		# Point at saved Y
	Y = EmPGet(J)		# Fetch beginning Y
	MOVE(X,Y)		# Move beam to first item's spot
	C = -1			# Minimum is -1 to start with
	C1 = 0			# Clear distance counter
	For (J = EmPGet(I); J != 0; J = EmPGet(J)) {# Traverse items
	  C1 = C1+1		# Distance to this item
	  K = EmPBmp(J)		# Point to splat count
	  If (MenCod(K) > C) { # Found new old option
	    Char = C1		# Save distance to new old option
	    C = MenCod(K)	# Save new old option splat count
	    }
	  }
	# MenIAc contains distance to new option selected
	# C      contains number of splats on old item selected
	# Char   contains distance to old item selected
	If (C > 4) {		# Max 5 splats
	  MenuPc = PagePc	#  so redraw page
	  MenTos = PagTos	#  by resetting menumachine to prev NewPage
	  }
	 Else {			# Still have room
	  If (C > -1) {		# Some item included
	    If ((C == 0) | (Char != MenIAc)) {# 1st update | selection change
	      C1 = 0		# Clear distance counter
	      For (J = EmPGet(I); J != 0; J = EmPGet(J)) {# Trav item links
		C1 = C1+1	# Bump distance
		K = EmPBmp(J)	# K points at splat count
		If (MenCod(K) > -1) {# Item included
		  C2 = C	# Assume not selected
		  If (C1 == Char) {# If this is old selection
		    C2 = 0	#  then it doesn't need an extra splat
		    }
		  If (C1 == MenIAc) {# If this is new selection
		    C2 = C2+1	#  it gets an extra splat
		    }
		  # Arrange that this item get C2 splats
		  # Poop out 7-C2 Sp, *
		  If (C2 != 0) {# Don't mark first time
		    MenCod(K) = MenCod(K)+1	# Bump splat count
		    XBSave = X	# Save X,Y
		    YBSave = EmMStr(SpSplt(C2))
		    YBSave = Y
		    If ((C1 == MenIAc) & (C != 0)) {# New item, not 1st
		      Call EmAsci(SPLAT)
		      MenCod(K) = MenCod(K)+1	# Extra bump
		      }
		    MOVE(XBSave,YBSave)# Restore position
		    }
		  Call EmAsci(LF) # Move to next item on screen
		  }		# End if item included
		}		# End traverse item links
	      }			# End first update or change in selection
	    }			# End some item included
	  }			# End max 5 splats
	MOVE(XSave,YSave)	# Move back so no net effect
	}			# End if going
      }				# End Case
#     Goto 199
 
    199 Continue
    }				# End Switch
  }				# End Repeat
End
E 1
