134 lines
4.4 KiB
Plaintext
134 lines
4.4 KiB
Plaintext
|
subroutine U01A6( proc, ibn, pib, sib, ip, obn, pob, sob )
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Position the cursor from a ProVerb
|
||
|
|
*
|
||
|
|
* Module %M% Version %I% Date %H%
|
||
|
|
*
|
||
|
|
* (c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
|
||
|
|
* This is unpublished proprietary source code of Ardent Software Inc.
|
||
|
|
* The copyright notice above does not evidence any actual or intended
|
||
|
|
* publication of such source code.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* Maintenence log - insert most recent change descriptions at top
|
||
|
|
*
|
||
|
|
* Date.... GTAR# WHO Description.........................................
|
||
|
|
* 10/14/98 23801 SAP Change copyrights.
|
||
|
|
* 03/17/93 9178 PVW Fix problem with ICONV
|
||
|
|
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
* This "user-exit", called from a ProVerb, takes a number
|
||
|
|
* pair (either or both of which may be indirect references) and
|
||
|
|
* positions the cursor to that column/row. "B" sounds the terminal
|
||
|
|
* bell. "C" clears the screen. "X" indicates the hexadecimal
|
||
|
|
* equivalent of an ASCII character.
|
||
|
|
*
|
||
|
|
* Usage:
|
||
|
|
* U01A6
|
||
|
|
* ( col.reference, row.reference )
|
||
|
|
*
|
||
|
|
* All references can be indirect through the proc buffers.
|
||
|
|
*
|
||
|
|
* Arguments to this subroutine are:
|
||
|
|
* proc - the text of the proc itself
|
||
|
|
* ibn - the current input buffer switch (0 = primary;
|
||
|
|
* 1 = secondary)
|
||
|
|
* pib - the primary input buffer
|
||
|
|
* sib - the secondary input buffer
|
||
|
|
* ip - the input buffer pointer
|
||
|
|
* obn - the current output buffer switch (0 = primary;
|
||
|
|
* 1 = secondary)
|
||
|
|
* pob - the primary output buffer
|
||
|
|
* sob - the secondary output buffer
|
||
|
|
*
|
||
|
|
*******************************************************************************
|
||
|
|
*
|
||
|
|
EQUATE true TO 1
|
||
|
|
EQUATE false TO 0
|
||
|
|
|
||
|
|
DIM cntrl( 100 )
|
||
|
|
|
||
|
|
temp = ""
|
||
|
|
LOOP
|
||
|
|
REMOVE line FROM proc SETTING x
|
||
|
|
MATPARSE cntrl FROM line,"(),'":'"'
|
||
|
|
tokens = INMAT()
|
||
|
|
done = true
|
||
|
|
|
||
|
|
FOR i = 1 TO tokens
|
||
|
|
BEGIN CASE
|
||
|
|
CASE cntrl(i) = "("
|
||
|
|
i += 1
|
||
|
|
CALL $INDIRECT( result, pib, sib, pob, sob, obn,cntrl( i ))
|
||
|
|
r = result
|
||
|
|
i += 1
|
||
|
|
IF cntrl( i ) = "," THEN
|
||
|
|
i += 1
|
||
|
|
CALL $INDIRECT( result, pib, sib, pob, sob, obn,cntrl( i ))
|
||
|
|
i += 1
|
||
|
|
IF cntrl( i ) # ")" THEN
|
||
|
|
PRINT "ProVerb syntax error: missing closing parenthesis."
|
||
|
|
PRINT line
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
temp := @( r, result )
|
||
|
|
END ELSE
|
||
|
|
IF cntrl( i ) = ")" THEN
|
||
|
|
temp := @( result )
|
||
|
|
END
|
||
|
|
i += 1
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE cntrl( i ) = ")"
|
||
|
|
PRINT "ProVerb syntax error: extraneous closing parenthesis."
|
||
|
|
PRINT line
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
CASE cntrl( i ) = '"' or cntrl( i ) = "'"
|
||
|
|
quote = cntrl( i )
|
||
|
|
i += 1
|
||
|
|
LOOP
|
||
|
|
UNTIL cntrl( i ) = quote OR i = tokens DO
|
||
|
|
temp := cntrl( i )
|
||
|
|
i += 1
|
||
|
|
REPEAT
|
||
|
|
IF i = tokens AND cntrl( i ) # quote THEN
|
||
|
|
PRINT "ProVerb syntax error: missing closing quotation mark."
|
||
|
|
PRINT line
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
CASE cntrl( i ) = ","
|
||
|
|
IF i = tokens THEN done = false
|
||
|
|
|
||
|
|
CASE cntrl( i )[ 1, 1 ] = "X"
|
||
|
|
char.string = ICONV( cntrl( i )[ 2, 2 ], "MX0C" )
|
||
|
|
IF STATUS() THEN
|
||
|
|
PRINT "ProVerb syntax error: invalid hexadecimal number."
|
||
|
|
PRINT line
|
||
|
|
END
|
||
|
|
temp := char.string
|
||
|
|
|
||
|
|
CASE cntrl(i)[1,1] = "B"
|
||
|
|
temp := @SYS.BELL
|
||
|
|
|
||
|
|
CASE cntrl( i )[ 1, 1 ] = "C"
|
||
|
|
PRINT @( -1 ):
|
||
|
|
|
||
|
|
CASE cntrl( i ) = "+"
|
||
|
|
NULL
|
||
|
|
|
||
|
|
END CASE
|
||
|
|
|
||
|
|
NEXT i
|
||
|
|
UNTIL done DO
|
||
|
|
REPEAT
|
||
|
|
|
||
|
|
PRINT temp:
|
||
|
|
RETURN
|
||
|
|
END
|