962 lines
31 KiB
Plaintext
Executable File
962 lines
31 KiB
Plaintext
Executable File
*****************************************************************************
|
||
*
|
||
* Maintain GGI File
|
||
*
|
||
* 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/25/96 18026 PGW For MS Win, allow GCI file name on command line
|
||
* 03/21/96 17935 JC Added new wchar_t varients.
|
||
* 04/22/94 12300 LA Added new fields for PI/open data types + extra
|
||
* validation.
|
||
* 02/18/90 6841 DTW comment out prompts to update DATA.TYPES file
|
||
* 10/15/89 6314 DTW add module prompt
|
||
* 07/25/88 - - Maintenence log purged at 5.2.1, see release 5.1.10.
|
||
*
|
||
*******************************************************************************
|
||
*
|
||
* This program was produced in part by SCREENGEN, a proprietary program of
|
||
* Infocel, Inc., P.O. Box 18305, Raleigh, N.C. 27609
|
||
*
|
||
*****************************************************************************
|
||
*
|
||
*
|
||
*
|
||
*
|
||
$OPTIONS A
|
||
CLEAR COMMON
|
||
COMMON CLR, CL, CL.ERR, PROMPT, ERR, HELP, HELP3, STD.HELP, MV.HELP,
|
||
ERR.MSG, MSG1, MSG2, MSG3, MSG4, MSG5, MSG6,
|
||
ID, Q, NEW.ITEM, REC(12)
|
||
*
|
||
$INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
|
||
*
|
||
CLR = @(-1)
|
||
CL = @(-4)
|
||
CL.ERR = @(0,23):CL
|
||
EQU BELL TO CHAR(7)
|
||
PROMPT=@(0,22):CL:@(0,21):CL ; PROMPT ""
|
||
*
|
||
EQU TRUE TO 1, FALSE TO 0
|
||
*
|
||
ERR = CL.ERR:BELL
|
||
HELP = CL.ERR
|
||
HELP3 = CL.ERR:PROMPT
|
||
*
|
||
STD.HELP=HELP3
|
||
STD.HELP=STD.HELP:'Enter "?" for help, "^" to back up to previous prompt, "XX" to cancel input,'
|
||
STD.HELP=STD.HELP:@(0,22):' or data value requested by prompt. Data will be edited and an error'
|
||
STD.HELP=STD.HELP:@(0,23):' will appear if data are invalid. --- Enter <CR>'
|
||
MV.HELP=HELP3
|
||
MV.HELP=MV.HELP:'Enter "?" for help, "^" to back up to previous prompt, "XX" to cancel input,'
|
||
MV.HELP=MV.HELP:@(0,22):' "+" to display next value group, "DE" to delete value, "I" to insert value,'
|
||
MV.HELP=MV.HELP:@(0,23):' "/" to end value input, or data value requested. --- Enter <CR>'
|
||
SUB.HELP=HELP3:'Name used in BASIC program to call C/F77 subroutine. '
|
||
SUB.HELP=SUB.HELP:@(0,22):'If it is called as a BASIC subroutine or is defined using a "DEFFUN" statement, the'
|
||
SUB.HELP=SUB.HELP:@(0,23):'the first character of this name must one of the characters *,-,$, or !.'
|
||
LANG.HELP=HELP3:'Languages supported are "c" (default) and "f77".'
|
||
EXT.HELP=HELP3:'Name of the c/f77 routine defined in the source file.'
|
||
EXT.HELP=EXT.HELP:@(0,22):'By default, this is the same as the subroutine name.'
|
||
MOD.HELP=HELP3:'Name of the module containing the c/f77 subroutine, without the ".c" or ".f"'
|
||
MOD.HELP=MOD.HELP:@(0,22):'suffix. By default, this is the same as the subroutine name.'
|
||
DESC.HELP=HELP3:'A short description of the subroutine (optional).'
|
||
ARGS.HELP=HELP3:'The number of arguments to the c/f77 routine.'
|
||
RET.HELP=HELP3:'Return value of the c/f77 routine.'
|
||
RET.HELP=RET.HELP:@(0,22):'For "c" routines, this can be a valid data type or "void".'
|
||
RET.HELP=RET.HELP:@(0,23):'For "f77" routines, it can only be "void".'
|
||
DIR.HELP=HELP3:'Argument direction: Input (I), Ouput (O) or Input/Output (I/O or B).'
|
||
TYP.HELP=HELP3:'Data type of argument.'
|
||
TYP.HELP=TYP.HELP:@(0,22):'For supported data types see the DATA.TYPES file or the GCI manual.'
|
||
LEN.HELP=HELP3:'Length of character string.'
|
||
LEN.HELP=LEN.HELP:@(0,22):'This is only used for character types which require the GCI to allocate space'
|
||
LEN.HELP=LEN.HELP:@(0,23):'("c" types "lchar*" and "charvar*", "f77" type "character").'
|
||
ROW.HELP=HELP3:'Enter number of rows for numeric array, or <CR> if this is not an array'
|
||
ROW.HELP=ROW.HELP:@(0,22):'argument.'
|
||
COL.HELP=HELP3:'Enter number of columns for a two-dimensional array, or <CR> if this is only'
|
||
COL.HELP=COL.HELP:@(0,22):'a single-dimensional array.'
|
||
ARGDESC.HELP=HELP3:'A short description of the argument (optional).'
|
||
ERR.MSG=ERR:"Your response does not pass the edits. Enter a new response."
|
||
MSG1=ERR:'Unable to open the file - '
|
||
MSG2=ERR:'A response is required.'
|
||
MSG3=ERR:'Response is too long.'
|
||
MSG4=ERR:'Numeric input required.'
|
||
MSG5=ERR:'Invalid data type specified.'
|
||
MSG6=ERR:'Number of arguments does not match the number of data types'
|
||
MSG7=ERR:'This data type does not have an input conversion'
|
||
MSG8=ERR:'This data type does not have an output conversion'
|
||
MSG9=ERR:'Number of arguments does no match the number of argument types'
|
||
MSG10=ERR:PROD.NAMEU:' General Calling Interface is not installed.'
|
||
MSG11=ERR:'Invalid language specified.'
|
||
MSG12=ERR:'Negative values are invalid'
|
||
*
|
||
*
|
||
EQU AM TO CHAR(254)
|
||
EQU VM TO CHAR(253)
|
||
EQU SVM TO CHAR(252)
|
||
EQU NO.DATA TO CHAR(0)
|
||
*
|
||
*
|
||
MV5=1 ;* IO.ARGS
|
||
COL5=2:AM:2:AM:2:AM:2:AM:2
|
||
LIN5=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
COL6=18:AM:18:AM:18:AM:18:AM:18
|
||
LIN6=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
COL9=30:AM:30:AM:30:AM:30:AM:30
|
||
LIN9=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
COL10=39:AM:39:AM:39:AM:39:AM:39
|
||
LIN10=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
COL11=46:AM:46:AM:46:AM:46:AM:46
|
||
LIN11=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
COL12=53:AM:53:AM:53:AM:53:AM:53
|
||
LIN12=13:AM:14:AM:15:AM:16:AM:17
|
||
*
|
||
*
|
||
*
|
||
dim SAVE.REC( 12 )
|
||
*
|
||
EQU LANGUAGE TO REC(1)
|
||
EQU EXT.NAME TO REC(2), SAVE.EXT.NAME to SAVE.REC( 2 )
|
||
EQU MOD.NAME TO REC(7), SAVE.MOD.NAME to SAVE.REC( 7 )
|
||
EQU RET.VAL TO REC(3)
|
||
EQU NO.ARGS TO REC(4), SAVE.NO.ARGS to SAVE.REC( 4 )
|
||
EQU DATA.TYPES TO REC(5)
|
||
EQU IO.ARGS TO REC(6)
|
||
EQU SUB.DESC TO REC(8)
|
||
EQU LENGTHS TO REC(9)
|
||
EQU ROWS TO REC(10)
|
||
EQU COLS TO REC(11)
|
||
EQU ARG.DESCS TO REC(12)
|
||
*
|
||
IF OS.TYPE = "UNIX" THEN
|
||
DEF.FILE.NAME = 'GCI'
|
||
END ELSE
|
||
* Windows NT:
|
||
* You can specify the definition file by putting its name on the
|
||
* command line, otherwise it defaults to 'GCI'
|
||
CMD = CONVERT(" ", @FM, TRIM(@SENTENCE))
|
||
DEF.FILE.NAME = CMD<4>
|
||
IF DEF.FILE.NAME = "" THEN DEF.FILE.NAME = 'GCI'
|
||
END
|
||
|
||
SSA11=CLR ;* Maintain GCI
|
||
SSA11=SSA11:@(0,0):"General Calling Interface Administration":SPACE(28):" GCI.MAINT"
|
||
IF OS.TYPE = "UNIX" THEN
|
||
SSA11=SSA11:@(22,1):"Maintain ":PROD.NAMEU:" GCI File"
|
||
END ELSE
|
||
SSA11=SSA11:@(12,1):"Maintain GCI Definition File ":DEF.FILE.NAME
|
||
END
|
||
SSA11=SSA11:@(0,2):STR("-",79)
|
||
SSA11=SSA11:@(7,4):"Subroutine name:"
|
||
SSA11=SSA11:@(0,6):"1. Language:"
|
||
SSA11=SSA11:@(0,7):"2. External Name:"
|
||
SSA11=SSA11:@(0,8):"3. Module Name:"
|
||
SSA11=SSA11:@(0,9):"4. Description:"
|
||
SSA11=SSA11:@(0,10):"5. Number of Arguments:"
|
||
SSA11=SSA11:@(39,10):"6. Return Value:"
|
||
SSA11=SSA11:@(0,12):"7. Direction"
|
||
SSA11=SSA11:@(18,12):"Data Type"
|
||
SSA11=SSA11:@(30,12):"Length"
|
||
SSA11=SSA11:@(39,12):"Rows"
|
||
SSA11=SSA11:@(46,12):"Cols"
|
||
SSA11=SSA11:@(53,12):"Description"
|
||
SSA11=SSA11:@(0,13):"7.1"
|
||
SSA11=SSA11:@(0,14):"7.2"
|
||
SSA11=SSA11:@(0,15):"7.3"
|
||
SSA11=SSA11:@(0,16):"7.4"
|
||
SSA11=SSA11:@(0,17):"7.5"
|
||
SSA11=SSA11:@(0,19):STR("-",79)
|
||
*
|
||
CLR.SSA11=@(0,0):@(25,6):CL:@(25,7):CL:@(25,8):CL:@(25,9):CL:@(25,10):SPACE(5):@(57,10):CL
|
||
CLR.SSA11=CLR.SSA11:@(2,13):1:CL:@(2,14):2"L#70":@(2,15):3"L#70":@(2,16):4"L#70":@(1,17):".":5"L#70":@(25,4):CL
|
||
*
|
||
H.ROWS = ""
|
||
H.COLS = ""
|
||
1 OPEN '','DATA.TYPES' TO FVDATA.TYPES ELSE
|
||
PRINT MSG10:
|
||
INPUT Q: ; PRINT CL.ERR: ; STOP
|
||
END
|
||
2 OPEN '',DEF.FILE.NAME TO FVGCI ELSE
|
||
PRINT MSG1:DEF.FILE.NAME:
|
||
INPUT Q: ; PRINT CL.ERR: ; STOP
|
||
END
|
||
*
|
||
************* ENTER RECORD KEY ***************
|
||
*
|
||
30 PRINT SSA11: ;* Maintain GCI
|
||
LOOP
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
40 PRINT PROMPT:"Enter subroutine name: ":
|
||
INPUT ID,32: ; PRINT CL.ERR:PROMPT:
|
||
EXECUTE "PTERM CASE INVERT"
|
||
IF ID = "?" THEN
|
||
PRINT SUB.HELP: ; INPUT Q: ; PRINT HELP3
|
||
GOTO 40
|
||
END
|
||
IF LEN(ID)>32 THEN
|
||
PRINT MSG3:
|
||
GOTO 40
|
||
END
|
||
UNTIL ID='' OR ID='^' OR ID='XX' or ID="xx" DO
|
||
NEW.ITEM=FALSE
|
||
MATREAD REC FROM FVGCI,ID ELSE
|
||
*
|
||
*
|
||
MAT REC=''; NEW.ITEM=TRUE
|
||
END
|
||
mat SAVE.REC = mat REC
|
||
PRINT @(25,4):CL:ID:
|
||
GOSUB 50 ;*** UPDATE RECORD
|
||
REPEAT
|
||
STOP
|
||
50***** UPDATE SUBROUTINE *****
|
||
IF NEW.ITEM THEN ;***** PROMPT FOR INPUT OF NEW REC
|
||
MV=0
|
||
FOR Z = 1 TO 7
|
||
Q=NO.DATA
|
||
ON Z GOSUB 100,200,700,800,300,400,500
|
||
IF Q="^" THEN IF MV>1 THEN MV=MV-2 ; Z=Z-1 ELSE IF Z<=1 THEN GOTO 9999 ELSE Z=Z-2
|
||
IF Q="XX" or Q="xx" THEN GOTO 9999
|
||
NEXT Z
|
||
NEW.ITEM=FALSE
|
||
END ELSE
|
||
MV=0 ; Q=""; GOSUB 88 ;*** PRINT SCREEN AND DATA
|
||
END
|
||
*
|
||
*######################### PRIMARY CONTROL LOOP #########################
|
||
60*
|
||
LOOP
|
||
* PRINT PROMPT:"Enter save(S), cancel(XX), delete(DE), or field # to change: ":
|
||
PRINT PROMPT:"Enter save(S), cancel(XX), delete(DE), or field # to change: ":
|
||
INPUT Q ; PRINT CL.ERR:PROMPT:
|
||
Q = upcase( Q )
|
||
UNTIL Q="S" OR Q="s" OR Q="." DO
|
||
if Q = "+" then Q = "7,+"
|
||
Z=FIELD(Q,",",1)
|
||
BEGIN CASE
|
||
CASE Z>=1 AND Z<8 AND NUM(Z)
|
||
Q=Q[COL2()+1,999]
|
||
IF Q="" THEN Q=NO.DATA
|
||
ON Z GOSUB 100,200,700,800,300,400,500
|
||
MV=0
|
||
CASE Q="XX"
|
||
GOTO 9999
|
||
CASE Q="xx"
|
||
GOTO 9999
|
||
CASE Q="DE"OR Q="de"
|
||
PRINT PROMPT:"Are you sure you want to delete this record (Y/N)? ":
|
||
INPUT Z ; IF Z="Y" OR Z="y" THEN DELETE FVGCI,ID
|
||
print SSA11:
|
||
RETURN
|
||
CASE Q="R" OR Q="^^"; PRINT SSA11: ; GOSUB 88 ;* REFRESH SCREEN
|
||
CASE 1 ; PRINT ERR:'Enter one of the requested commands.':
|
||
END CASE
|
||
REPEAT
|
||
*
|
||
IF NO.ARGS#DCOUNT(DATA.TYPES,@VM) THEN
|
||
PRINT MSG6:
|
||
GOTO 60
|
||
END
|
||
IF NO.ARGS#DCOUNT(IO.ARGS,@VM) THEN
|
||
PRINT MSG9:
|
||
GOTO 60
|
||
END
|
||
MATWRITE REC ON FVGCI,ID
|
||
*
|
||
*
|
||
*
|
||
*
|
||
*
|
||
line.no = 0
|
||
eof = FALSE
|
||
found = 0
|
||
*
|
||
9999 PRINT CLR.SSA11:PROMPT:
|
||
RETURN ;********** EXIT UPDATE ROUTINE
|
||
*
|
||
88*** REFRESH DATA
|
||
PRINT @(25,4):CL:ID:
|
||
PRINT @(25,6):LANGUAGE "L#30"
|
||
PRINT @(25,7):EXT.NAME "L#32"
|
||
PRINT @(25,8):MOD.NAME "L#55"
|
||
PRINT @(25,9):SUB.DESC "L#50"
|
||
PRINT @(25,10):NO.ARGS "L#2"
|
||
PRINT @(57,10):RET.VAL "L#30"
|
||
GOSUB 560 ; MV=0 ;* DISPLAY IO.ARGS
|
||
Q=NO.DATA
|
||
RETURN
|
||
*
|
||
*##########################################################################
|
||
*
|
||
100*** ########## LANGUAGE
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
IF Q=NO.DATA THEN
|
||
110 PRINT PROMPT:"Enter subroutine language: ":STR(".",30):@(27,21):
|
||
INPUT Q,30: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
Q = DOWNCASE(Q)
|
||
IF Q="" THEN
|
||
Q="c"
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT LANG.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 110
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN
|
||
PRINT @(25,6):"" "L#30"
|
||
RETURN
|
||
END
|
||
130*** EDITS FOR LANGUAGE
|
||
|
||
IF Q # "c" THEN
|
||
PRINT MSG11:
|
||
GOTO 110
|
||
END
|
||
140*** DISPLAY LANGUAGE
|
||
LANGUAGE=Q
|
||
PRINT @(25,6):Q "L#30"
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
*
|
||
200*** ########## EXT.NAME
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
IF Q=NO.DATA THEN
|
||
210 PRINT PROMPT:"Enter subroutine external name: ":STR(".",32):@(32,21):
|
||
INPUT Q,32: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" THEN
|
||
Q=ID
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT EXT.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 210
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN
|
||
PRINT @(25,7):"" "L#32"
|
||
RETURN
|
||
END
|
||
230*** EDITS FOR EXT.NAME
|
||
IF LEN(Q)>32 THEN
|
||
PRINT MSG3:
|
||
GOTO 210
|
||
END
|
||
240*** DISPLAY EXT.NAME
|
||
EXT.NAME=Q
|
||
PRINT @(25,7):Q "L#32"
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
*
|
||
300*** ########## NO.ARGS
|
||
IF Q=NO.DATA THEN
|
||
310 PRINT PROMPT:"Enter the number of arguments: ":STR(".",2):@(31,21):
|
||
INPUT Q,2: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" THEN
|
||
PRINT MSG2:
|
||
GOTO 310
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT ARGS.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 310
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN
|
||
PRINT @(25,10):"" "L#2"
|
||
RETURN
|
||
END
|
||
330*** EDITS FOR NO.ARGS
|
||
ICONV.TEMP=ICONV(Q,"MD0")
|
||
IF STATUS()#0 THEN
|
||
PRINT MSG4:
|
||
GOTO 310
|
||
END
|
||
IF LEN(Q)>2 THEN
|
||
PRINT MSG3:
|
||
GOTO 310
|
||
END
|
||
IF Q < 0 THEN
|
||
PRINT MSG12:
|
||
GOTO 310
|
||
END
|
||
|
||
340*** DISPLAY NO.ARGS
|
||
NO.ARGS=Q
|
||
PRINT @(25,10):Q "L#2"
|
||
RETURN
|
||
*
|
||
400*** ########## RET.VAL
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
IF Q=NO.DATA THEN
|
||
410 PRINT PROMPT:"Enter the return value: ":str(".",30):@(24,21):
|
||
INPUT Q,30: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
Q = DOWNCASE(Q)
|
||
IF Q="" THEN
|
||
PRINT MSG2:
|
||
GOTO 410
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT RET.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 410
|
||
END
|
||
IF Q="^" OR Q="xx" THEN
|
||
PRINT @(57,10):"" "L#30"
|
||
RETURN
|
||
END
|
||
*** EDITS FOR RET.VAL
|
||
IF LEN(Q)>30 THEN
|
||
PRINT MSG3:
|
||
GOTO 410
|
||
END
|
||
IF LANGUAGE = "f77" THEN
|
||
IF Q#'void' THEN
|
||
PRINT MSG5:
|
||
GOTO 410
|
||
END
|
||
END ELSE ;* 'c' - any valid data type
|
||
IF Q#'void' THEN
|
||
TYPES.ID = LANGUAGE:".":Q
|
||
READ DUMMY FROM FVDATA.TYPES,TYPES.ID ELSE
|
||
PRINT MSG5:
|
||
GOTO 410
|
||
END
|
||
IF DUMMY<2> = "" THEN
|
||
PRINT MSG8:
|
||
GOTO 410
|
||
END
|
||
END
|
||
END
|
||
|
||
440*** DISPLAY RET.VAL
|
||
RET.VAL = Q
|
||
PRINT @(57,10):Q "L#30"
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
*
|
||
500*** ########## IO.ARGS
|
||
* MULTIVALUE
|
||
H.IO.ARGS=IO.ARGS
|
||
* EXECUTE "PTERM CASE NOINVERT"
|
||
VALUE.INSERTED=FALSE
|
||
IF NEW.ITEM THEN MV=MV+1 ELSE
|
||
MV=FIELD(Z,".",2) ; Z=INT(Z)
|
||
IF MV<1 THEN
|
||
IF Q="DE" OR Q="de" THEN
|
||
DATA.TYPES=""; IO.ARGS=""; MV=1 ; GOSUB 560 ;* DELETE FIELD
|
||
END ELSE IF Q="+" THEN MV=1 ELSE
|
||
FOR MV=1 TO 99 UNTIL IO.ARGS<1,MV>=""; NEXT MV
|
||
IF MV>MV5+5 THEN GOSUB 560 ;* DISPLAY FIELD
|
||
END
|
||
END ELSE IF IO.ARGS<1,MV>='' AND (Q#'DE' AND Q#'de') THEN GOTO 500
|
||
END
|
||
IF NO.ARGS<=0 THEN RETURN
|
||
IF Q=NO.DATA THEN
|
||
510 PRINT PROMPT:"Enter argument " : MV"R#2" : " direction (I/O/B): ":STR(".",4):@(37,21):
|
||
INPUT Q,4: ; PRINT CL.ERR:PROMPT:
|
||
IF ( Q="" or Q="/" ) AND NOT(VALUE.INSERTED) THEN
|
||
PRINT @(COL5<MOD(MV-1,5)+1>,LIN5<MOD(MV-1,5)+1>):MV:CL
|
||
MV=0 ;
|
||
* EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
END
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND IO.ARGS<1,MV>#"" THEN GOTO 550 ;*DO NOT CHANGE VALUE
|
||
IF Q="" THEN
|
||
PRINT MSG2:
|
||
GOTO 510
|
||
END
|
||
IF Q="INS" OR Q="INSERT" THEN
|
||
VALUE.INSERTED=TRUE ; DATA.TYPES=INSERT(DATA.TYPES,1,MV,0,"")
|
||
IO.ARGS=INSERT(IO.ARGS,1,MV,0,"")
|
||
GOSUB 560 ; Q=NO.DATA ; GOTO 510 ;* INSERT MV
|
||
END
|
||
IF Q="+" THEN ;* DISPLAY ONLY
|
||
MV=MV5+5
|
||
GOSUB 560
|
||
* EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
END
|
||
IF Q="DE" OR Q="de" THEN ;* DELETE MV
|
||
DATA.TYPES=DELETE(DATA.TYPES,1,MV,0)
|
||
IO.ARGS=DELETE(IO.ARGS,1,MV,0)
|
||
GOSUB 560
|
||
* EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT DIR.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 510
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" OR Q="/" THEN
|
||
* if Q="^" then Z -= 1
|
||
* EXECUTE "PTERM CASE INVERT"
|
||
IF NOT(VALUE.INSERTED) THEN
|
||
MV=0
|
||
return
|
||
END ELSE
|
||
DATA.TYPES=DELETE(DATA.TYPES,1,MV,0)
|
||
IO.ARGS=DELETE(IO.ARGS,1,MV,0)
|
||
GOSUB 560 ; MV=0
|
||
RETURN
|
||
END
|
||
END
|
||
530*** EDITS FOR IO.ARGS
|
||
Q=UPCASE(Q)
|
||
IF Q="I/O" THEN Q="B"
|
||
IF Q#"I" AND Q#"O" AND Q#"B" THEN
|
||
PRINT ERR:"Response must be Input(I), Output(O) or Both(B).":
|
||
GOTO 510
|
||
END
|
||
540*** DISPLAY IO.ARGS
|
||
H.IO.ARGS<1,MV>=Q
|
||
IF MV<MV5 OR MV>MV5+4 THEN GOSUB 560
|
||
PRINT @(COL5<MOD(MV-1,5)+1>,LIN5<MOD(MV-1,5)+1>):MV"L#3":Q "L#4"
|
||
550 FOR J = 1 TO 5
|
||
Q=NO.DATA ; ON J GOSUB 600, 900, 1000, 1100, 1200
|
||
IF (Q="XX" OR Q="xx") AND NEW.ITEM THEN RETURN
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN IF J<=1 THEN GOTO 510 ELSE J=J-2 ; Q.PREV = Q
|
||
NEXT J
|
||
DATA.TYPES<1,MV>=H.DATA.TYPES<1,MV>
|
||
IO.ARGS<1,MV>=H.IO.ARGS<1,MV>
|
||
LENGTHS<1,MV>=H.LENGTHS<1,MV>
|
||
ROWS<1,MV>=H.ROWS<1,MV>
|
||
COLS<1,MV>=H.COLS<1,MV>
|
||
ARG.DESCS<1,MV>=H.ARG.DESCS<1,MV>
|
||
|
||
IF NEW.ITEM THEN MV=MV+1 ; GOTO 510 ELSE MV=0
|
||
RETURN
|
||
560 MV5=5*INT((MV-1)/5)+1 ;* DISPLAY FIELD
|
||
IF IO.ARGS<1,MV5>="" AND Q="+" THEN MV5=1
|
||
FOR K=MV5 TO MV5+4
|
||
PRINT @(COL5<MOD(K-1,5)+1>,LIN5<MOD(K-1,5)+1>):K"L#3":
|
||
IF IO.ARGS<1,K>="" THEN PRINT CL: ELSE
|
||
PRINT IO.ARGS<1,K> "L#4":
|
||
GOSUB 660 ;*DISPLAY ASSOCIATED VALUES
|
||
GOSUB 960
|
||
GOSUB 1060
|
||
GOSUB 1160
|
||
GOSUB 1260
|
||
END
|
||
NEXT K
|
||
PRINT @(COL5<5>-1,LIN5<5>):
|
||
IF IO.ARGS<1,K>#"" THEN PRINT "+" ELSE PRINT "."
|
||
RETURN
|
||
*
|
||
*
|
||
600*** ######### DATA.TYPES
|
||
* ASSOCIATED MULTIVALUE
|
||
Q.PREV = NO.DATA
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
H.DATA.TYPES=DATA.TYPES
|
||
IF Q=NO.DATA THEN
|
||
610 PRINT PROMPT:"Enter data type " : MV"R#2" :": ":STR(".",30):@(20,21):
|
||
INPUT Q,30: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND DATA.TYPES<1,MV>#"" THEN
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN ;* DO NOT CHANGE VALUE
|
||
END
|
||
IF Q="" THEN
|
||
PRINT MSG2:
|
||
GOTO 610
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT TYP.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 610
|
||
END
|
||
IF Q="^" OR Q="XX" OR Q="xx" THEN
|
||
* PRINT @(COL6<MOD(MV-1,5)+1>,LIN6<MOD(MV-1,5)+1>):"" "L#30"
|
||
PRINT @(COL6<MOD(MV-1,5)+1>,LIN6<MOD(MV-1,5)+1>):CL
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
END
|
||
630*** EDITS FOR DATA.TYPES
|
||
IF LEN(Q)>30 THEN
|
||
PRINT MSG3:
|
||
GOTO 610
|
||
END
|
||
TYPES.ID=LANGUAGE:".":Q
|
||
READ DUMMY FROM FVDATA.TYPES,TYPES.ID ELSE
|
||
PRINT MSG5:
|
||
***
|
||
*** Can't modify DATA.TYPES file
|
||
***
|
||
* PRINT PROMPT:"Do you wish to add new data types (Y/N) ":
|
||
* INPUT ANS
|
||
* IF ANS="Y" OR ANS ="y" THEN
|
||
* PA=''
|
||
* PA<1>='RUN APP.PROGS TYPES.MAINT'
|
||
* PA<2>='DATA ':LANGUAGE
|
||
* PA<3>='DATA ':Q
|
||
* EXECUTE PA
|
||
* SAVE.Q=Q ; SAVE.MV=MV
|
||
* PRINT SSA11
|
||
* GOSUB 88
|
||
* Q=SAVE.Q ; MV=SAVE.MV
|
||
* PRINT @(COL5<MOD(MV-1,5)+1>,LIN5<MOD(MV-1,5)+1>):MV"L#3":H.IO.ARGS<1,MV> "L#3"
|
||
* EXECUTE "PTERM CASE NOINVERT"
|
||
* GOTO 630
|
||
* END ELSE
|
||
GOTO 610
|
||
* END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="I" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<1>="" THEN
|
||
PRINT MSG7:
|
||
* PRINT PROMPT:"Do you wish to update the data types file (Y/N) ":
|
||
* INPUT ANS
|
||
* IF ANS="Y" OR ANS ="y" THEN
|
||
* PA=''
|
||
* PA<1>='RUN APP.PROGS TYPES.MAINT'
|
||
* PA<2>='DATA ':LANGUAGE
|
||
* PA<3>='DATA ':Q
|
||
* PA<4>='DATA 2'
|
||
* EXECUTE PA
|
||
* SAVE.Q=Q ; SAVE.MV=MV
|
||
* PRINT SSA11
|
||
* GOSUB 88
|
||
* Q=SAVE.Q ; MV=SAVE.MV
|
||
* PRINT @(COL5<MOD(MV-1,5)+1>,LIN5<MOD(MV-1,5)+1>):MV"L#3":H.IO.ARGS<1,MV> "L#3"
|
||
* EXECUTE "PTERM CASE NOINVERT"
|
||
* GOTO 630
|
||
* END ELSE
|
||
GOTO 610
|
||
* END
|
||
END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="O" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<2>="" THEN
|
||
PRINT MSG8:
|
||
* PRINT PROMPT:"Do you wish to update the DATA.TYPES file (Y/N) ":
|
||
* INPUT ANS
|
||
* IF ANS="Y" OR ANS ="y" THEN
|
||
* PA=''
|
||
* PA<1>='RUN APP.PROGS TYPES.MAINT'
|
||
* PA<2>='DATA ':LANGUAGE
|
||
* PA<3>='DATA ':Q
|
||
* PA<4>='DATA 3'
|
||
* EXECUTE PA
|
||
* SAVE.Q=Q ; SAVE.MV=MV
|
||
* PRINT SSA11
|
||
* GOSUB 88
|
||
* Q=SAVE.Q ; MV=SAVE.MV
|
||
* PRINT @(COL5<MOD(MV-1,5)+1>,LIN5<MOD(MV-1,5)+1>):MV"L#3":H.IO.ARGS<1,MV> "L#3"
|
||
* EXECUTE "PTERM CASE NOINVERT"
|
||
* GOTO 630
|
||
* END ELSE
|
||
GOTO 610
|
||
* END
|
||
END
|
||
END
|
||
640*** DISPLAY DATA.TYPES
|
||
H.DATA.TYPES<1,MV>=Q
|
||
PRINT @(COL6<MOD(MV-1,5)+1>,LIN6<MOD(MV-1,5)+1>):Q "L#30"
|
||
RETURN
|
||
660*** DISPLAY MULTIVALUE
|
||
PRINT @(COL6<MOD(K-1,5)+1>,LIN6<MOD(K-1,5)+1>):DATA.TYPES<1,K> "L#30":
|
||
RETURN
|
||
*
|
||
700*** ########## MOD.NAME
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
IF Q=NO.DATA THEN
|
||
710 PRINT PROMPT:"Enter file name (without the '.c'): ":STR(".",55):@(36,21):
|
||
INPUT Q,55: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" THEN
|
||
Q=ID
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT MOD.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 710
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN
|
||
PRINT @(25,8):"" "L#55"
|
||
RETURN
|
||
END
|
||
730*** EDITS FOR MOD.NAME
|
||
IF LEN(Q)>55 THEN
|
||
PRINT MSG3:
|
||
GOTO 710
|
||
END
|
||
740*** DISPLAY MOD.NAME
|
||
MOD.NAME=Q
|
||
PRINT @(25,8):Q "L#55"
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
*
|
||
800*** ########## SUB.DESC
|
||
EXECUTE "PTERM CASE NOINVERT"
|
||
IF Q=NO.DATA THEN
|
||
810 PRINT PROMPT:"Enter subroutine description: ":STR(".",50):@(30,21):
|
||
INPUT Q,50: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT DESC.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 810
|
||
END
|
||
IF Q="^" OR Q="XX" or Q="xx" THEN
|
||
PRINT @(25,9):"" "L#50"
|
||
RETURN
|
||
END
|
||
830*** EDITS FOR SUB.DESC
|
||
IF LEN(Q)>50 THEN
|
||
PRINT MSG3:
|
||
GOTO 810
|
||
END
|
||
840*** DISPLAY SUB.DESC
|
||
SUB.DESC=Q
|
||
PRINT @(25,9):Q "L#50"
|
||
EXECUTE "PTERM CASE INVERT"
|
||
RETURN
|
||
*
|
||
900*** ######### LENGTHS
|
||
* ASSOCIATED MULTIVALUE
|
||
H.LENGTHS=LENGTHS
|
||
IF H.DATA.TYPES<1,MV> # "lchar*" AND H.DATA.TYPES<1,MV> # "charvar*" AND H.DATA.TYPES<1,MV> # "character" AND H.DATA.TYPES<1,MV> # "lwchar_t*" AND H.DATA.TYPES<1,MV> # "wchar_tvar*" THEN
|
||
IF Q.PREV = "^" THEN Q = Q.PREV
|
||
RETURN
|
||
END
|
||
Q.PREV = NO.DATA
|
||
IF Q=NO.DATA THEN
|
||
910 PRINT PROMPT:"Enter string length " : MV"R#2" :": ":STR(".",6):@(24,21):
|
||
INPUT Q,6: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND LENGTHS<1,MV>#"" THEN
|
||
RETURN ;* DO NOT CHANGE VALUE
|
||
END
|
||
IF Q="" THEN
|
||
PRINT MSG2:
|
||
GOTO 910
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT LEN.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 910
|
||
END
|
||
IF Q="^" OR Q="XX" OR Q="xx" THEN
|
||
* PRINT @(COL9<MOD(MV-1,5)+1>,LIN9<MOD(MV-1,5)+1>):"" "L#6"
|
||
PRINT @(COL9<MOD(MV-1,5)+1>,LIN9<MOD(MV-1,5)+1>):CL
|
||
RETURN
|
||
END
|
||
930*** EDITS FOR LENGTHS
|
||
IF Q THEN
|
||
ICONV.TEMP=ICONV(Q,"MD0")
|
||
IF STATUS()#0 THEN
|
||
PRINT MSG4:
|
||
GOTO 910
|
||
END
|
||
IF LEN(Q)>6 THEN
|
||
PRINT MSG3:
|
||
GOTO 910
|
||
END
|
||
IF Q < 0 THEN
|
||
PRINT MSG12:
|
||
GOTO 910
|
||
END
|
||
IF H.IO.ARGS<1,MV>="I" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<1>="" THEN
|
||
PRINT MSG7:
|
||
GOTO 910
|
||
END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="O" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<2>="" THEN
|
||
PRINT MSG8:
|
||
GOTO 910
|
||
END
|
||
END
|
||
END
|
||
940*** DISPLAY LENGTHS
|
||
H.LENGTHS<1,MV>=Q
|
||
PRINT @(COL9<MOD(MV-1,5)+1>,LIN9<MOD(MV-1,5)+1>):Q "L#6"
|
||
RETURN
|
||
960*** DISPLAY MULTIVALUE
|
||
PRINT @(COL9<MOD(K-1,5)+1>,LIN9<MOD(K-1,5)+1>):LENGTHS<1,K> "L#6":
|
||
RETURN
|
||
*
|
||
|
||
1000*** ######### ROWS
|
||
* ASSOCIATED MULTIVALUE
|
||
POS = INDEX(H.DATA.TYPES<1,MV>, "char", 1)
|
||
IF POS THEN
|
||
IF Q.PREV = "^" THEN Q = Q.PREV
|
||
RETURN
|
||
END
|
||
Q.PREV = NO.DATA
|
||
H.ROWS=ROWS
|
||
IF Q=NO.DATA THEN
|
||
1010 PRINT PROMPT:"Enter number of rows " : MV"R#2" :": ":STR(".",5):@(25,21):
|
||
INPUT Q,5: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND ROWS<1,MV>#"" THEN
|
||
RETURN ;* DO NOT CHANGE VALUE
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT ROW.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 1010
|
||
END
|
||
IF Q="^" OR Q="XX" OR Q="xx" THEN
|
||
* PRINT @(COL10<MOD(MV-1,5)+1>,LIN10<MOD(MV-1,5)+1>):"" "L#5"
|
||
PRINT @(COL10<MOD(MV-1,5)+1>,LIN10<MOD(MV-1,5)+1>):CL
|
||
RETURN
|
||
END
|
||
1030*** EDITS FOR ROWS
|
||
IF Q THEN
|
||
ICONV.TEMP=ICONV(Q,"MD0")
|
||
IF STATUS()#0 THEN
|
||
PRINT MSG4:
|
||
GOTO 1010
|
||
END
|
||
IF LEN(Q)>5 THEN
|
||
PRINT MSG3:
|
||
GOTO 1010
|
||
END
|
||
IF Q < 0 THEN
|
||
PRINT MSG12:
|
||
GOTO 1010
|
||
END
|
||
IF H.IO.ARGS<1,MV>="I" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<1>="" THEN
|
||
PRINT MSG7:
|
||
GOTO 1010
|
||
END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="O" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<2>="" THEN
|
||
PRINT MSG8:
|
||
GOTO 1010
|
||
END
|
||
END
|
||
END
|
||
1040*** DISPLAY ROWS
|
||
H.ROWS<1,MV>=Q
|
||
PRINT @(COL10<MOD(MV-1,5)+1>,LIN10<MOD(MV-1,5)+1>):Q "L#5"
|
||
RETURN
|
||
1060*** DISPLAY MULTIVALUE
|
||
PRINT @(COL10<MOD(K-1,5)+1>,LIN10<MOD(K-1,5)+1>):ROWS<1,K> "L#5":
|
||
RETURN
|
||
*
|
||
|
||
1100*** ######### COLS
|
||
* ASSOCIATED MULTIVALUE
|
||
POS = INDEX(H.DATA.TYPES<1,MV>, "char", 1)
|
||
IF POS OR NOT(H.ROWS<1,MV>) THEN
|
||
IF Q.PREV = "^" THEN Q = Q.PREV
|
||
RETURN
|
||
END
|
||
Q.PREV = NO.DATA
|
||
H.COLS=COLS
|
||
IF Q=NO.DATA THEN
|
||
1110 PRINT PROMPT:"Enter number of columns " : MV"R#2" :": ":STR(".",6):@(28,21):
|
||
INPUT Q,6: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND COLS<1,MV>#"" THEN
|
||
RETURN ;* DO NOT CHANGE VALUE
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT COL.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 1110
|
||
END
|
||
IF Q="^" OR Q="XX" OR Q="xx" THEN
|
||
* PRINT @(COL11<MOD(MV-1,5)+1>,LIN11<MOD(MV-1,5)+1>):"" "L#6"
|
||
PRINT @(COL11<MOD(MV-1,5)+1>,LIN11<MOD(MV-1,5)+1>):CL
|
||
RETURN
|
||
END
|
||
1130*** EDITS FOR COLS
|
||
IF Q THEN
|
||
ICONV.TEMP=ICONV(Q,"MD0")
|
||
IF STATUS()#0 THEN
|
||
PRINT MSG4:
|
||
GOTO 1110
|
||
END
|
||
IF LEN(Q)>6 THEN
|
||
PRINT MSG3:
|
||
GOTO 1110
|
||
END
|
||
IF Q < 0 THEN
|
||
PRINT MSG12:
|
||
GOTO 1110
|
||
END
|
||
IF H.IO.ARGS<1,MV>="I" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<1>="" THEN
|
||
PRINT MSG7:
|
||
GOTO 1110
|
||
END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="O" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<2>="" THEN
|
||
PRINT MSG8:
|
||
GOTO 1110
|
||
END
|
||
END
|
||
END
|
||
1140*** DISPLAY COLS
|
||
H.COLS<1,MV>=Q
|
||
PRINT @(COL11<MOD(MV-1,5)+1>,LIN11<MOD(MV-1,5)+1>):Q "L#6"
|
||
RETURN
|
||
1160*** DISPLAY MULTIVALUE
|
||
PRINT @(COL11<MOD(K-1,5)+1>,LIN11<MOD(K-1,5)+1>):COLS<1,K> "L#6":
|
||
RETURN
|
||
*
|
||
|
||
1200*** ######### ARG.DESC
|
||
* ASSOCIATED MULTIVALUE
|
||
H.ARG.DESCS=ARG.DESCS
|
||
Q.PREV = NO.DATA
|
||
IF Q=NO.DATA THEN
|
||
1210 PRINT PROMPT:"Enter argument description " : MV"R#2" :": ":STR(".",15):@(31,21):
|
||
INPUT Q,15: ; PRINT CL.ERR:PROMPT:
|
||
END
|
||
IF Q="" AND NOT(NEW.ITEM) AND ARG.DESCS<1,MV>#"" THEN
|
||
RETURN ;* DO NOT CHANGE VALUE
|
||
END
|
||
IF Q="?" THEN
|
||
PRINT ARGDESC.HELP: ; INPUT Q: ; PRINT HELP3:
|
||
GOTO 1210
|
||
END
|
||
IF Q="^" OR Q="XX" OR Q="xx" THEN
|
||
* PRINT @(COL12<MOD(MV-1,5)+1>,LIN12<MOD(MV-1,5)+1>):"" "L#15"
|
||
PRINT @(COL12<MOD(MV-1,5)+1>,LIN12<MOD(MV-1,5)+1>):CL
|
||
RETURN
|
||
END
|
||
1230*** EDITS FOR COLS
|
||
IF LEN(Q)>15 THEN
|
||
PRINT MSG3:
|
||
GOTO 1210
|
||
END
|
||
IF H.IO.ARGS<1,MV>="I" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<1>="" THEN
|
||
PRINT MSG7:
|
||
GOTO 1210
|
||
END
|
||
END
|
||
IF H.IO.ARGS<1,MV>="O" OR H.IO.ARGS<1,MV>="B" THEN
|
||
IF DUMMY<2>="" THEN
|
||
PRINT MSG8:
|
||
GOTO 1210
|
||
END
|
||
END
|
||
1240*** DISPLAY ARG.DESCS
|
||
H.ARG.DESCS<1,MV>=Q
|
||
PRINT @(COL12<MOD(MV-1,5)+1>,LIN12<MOD(MV-1,5)+1>):Q "L#15"
|
||
RETURN
|
||
1260*** DISPLAY MULTIVALUE
|
||
PRINT @(COL12<MOD(K-1,5)+1>,LIN12<MOD(K-1,5)+1>):ARG.DESCS<1,K> "L#15":
|
||
RETURN
|
||
*
|
||
|
||
END
|
||
|