tldm-universe/Ardent/UV/APP.PROGS/GET.PGMS

337 lines
10 KiB
Plaintext
Raw Normal View History

2024-09-09 21:51:08 +00:00
SUBROUTINE GET.PGMS(ID,Q,fvsavedlists,fvvoc,REC,SOURCE.MACHINE)
$INCLUDE UNIVERSE.INCLUDE MTF.INCL.H
******************************************************************************
*
* Enter names of BASIC program files; save into &SAVEDLISTS&
*
* 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.
* 08/05/92 9887 PVW Make valid machines same as CONVERT.VOC
* 05/13/91 8345 DTM changed print to tprints
* 05/09/91 8331 DTM Fixed Enter.box.b to handle F.4
* 03/19/91 8064 DTM Changed the way it asked for input
* 02/26/91 7673 DTM Changed parameter for ENTER.BOX.B for case conversion
* 01/13/91 7673 DTM Final changes
* 12/27/90 7403 DTM Initial programming
*
*******************************************************************************
* This subroutine will accept as an argument the value of the operation
* to perform. It can perform the following functions on spooler jobs:
******************************************************************************
id = "%W%"
******************************************************************************
* Various Prompts and Help string values
******************************************************************************
equ PRMPT.LOC to 2
equ SHRT.HELP to 4
equ LONG.HELP to 5
******************************************************************************
* Various other variables
******************************************************************************
equ Default to 1
equ PAINT to 1 ;* flag to paint forms
equ Yes to 1
equ No to 0
equ AM to char(254)
equ VM to char(253)
equ SVM to char(252)
******************************************************************************
CALL *DRAW.SCRN.B(UVREADMSG(073730,ID),1)
GOSUB init.files ;* Initialize /usr/spool/uv/sp.config
GOSUB init.form ;* Initialize forms to be used
GOSUB init.vars ;* initialize local variables
******************************************************************************
* In this section, we draw the first screen, print the menu bar and help
* areas, and put up the first title and form to fill out.
******************************************************************************
CALL *HELP.PRINT.B(UVREADMSG(073009,""),2)
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
MV=0
Q=NULL
GOSUB refresh.data
FOR Z=1 TO LAST.FIELD
Q=NULL
ON Z GOSUB file.names,sourcem
IF Q="XX" THEN GOTO exit.routine
NEXT Z
NEW.ITEM=No
LOOP
CALL *HELP.PRINT.B(NULL,3)
70 temp=NULL
CALL *ENTER.BOX.B(17,5,5,UVREADMSG(073737,""),temp,1)
IF temp="*" THEN GOTO 70
Q=temp
UNTIL UPCASE(Q)="S" OR Q="." OR Q=-1 DO
IF Q="+" THEN Q="1,+"
Z=FIELD(Q,",",1)
BEGIN CASE
CASE Z>=1 AND Z<=2.99 AND NUM(Z)
Q=Q[COL2()+1,999]
ON Z GOSUB file.names,sourcem
MV=0
CASE UPCASE(Q)="XX"
GOTO exit.routine
CASE UPCASE(Q)="R"
GOSUB refresh.data
CASE Default
CALL *HELP.PRINT.B(UVREADMSG(073732,""),2)
END CASE
REPEAT
REC=RAISE(REC)
WRITE REC ON fvsavedlists,ID
IF LAST.FIELD=2 AND SYSTEM(1001)#1 THEN WRITEV format ON fvvoc,"RELLEVEL",4
RETURN
******************************************************************************
* Init.form
* This routine initializes all the positional parameters, help strings,
* text strings, and default values for the two forms used in this subroutine
******************************************************************************
init.form:
form.size=2
form.line=1
form=NULL
temp.form=NULL
form<1,1>=@(5,14)
form<1,2>=@(35,14)
form<1,3>=UVREADMSG(073735,"")
form<1,4>=UVREADMSG(073738,"")
form<1,5>=form<1,4>
form<1,6>=40
form<1,7>=1
form<2,1>=@(5,15)
form<2,2>=@(35,15)
form<2,3>=UVREADMSG(073736,"")
form<2,4>=UVREADMSG(073739,"")
form<2,5>=form<2,4>:UVREADMSG(073734,"")
form<2,6>=40
form<2,7>=1
RETURN
******************************************************************************
* Init.files
* It also opens up the &DEVICE& File so they can both be used to modify
* entries, existing or not, for printers on system.
******************************************************************************
init.files:
OPEN '','&SAVEDLISTS&' TO fvsavedlists ELSE
retry=0
m1="Press <Retry> to attempt to open file again"
CALL *ERROR.BOX.B(10,3,0,UVREADMSG(073005,'&SAVEDLISTS&'),retry,m1)
IF retry=0 THEN GOTO init.files
SLEEP 3
STOP @(-1)
END
init.files2:
OPEN '','VOC' TO fvvoc ELSE
retry=0
m1="Press <Retry> to attempt to open file again"
CALL *ERROR.BOX.B(10,3,0,UVREADMSG(073005,'VOC'),retry,m1)
IF retry=0 THEN GOTO init.files2
SLEEP 3
STOP @(-1)
END
RETURN
******************************************************************************
* Init.vars -
* Routine which initializes various global variables
******************************************************************************
init.vars:
MV1=1
COL1=24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24:AM:24
LIN1=4:AM:5:AM:6:AM:7:AM:8:AM:9:AM:10:AM:11:AM:12:AM:13
TPRINT @(24,3):" ":UVREADMSG(073731,""):
READV format FROM fvvoc, "RELLEVEL", 4 ELSE format=NULL
BEGIN CASE
CASE format = "INFORMATION.FORMAT"
SOURCE.MACHINE = "PRIME"
CASE format = "REALITY.FORMAT"
SOURCE.MACHINE = "MICRODATA"
CASE format = "IN2.FORMAT"
SOURCE.MACHINE = "IN2"
CASE 1
SOURCE.MACHINE = NULL
END CASE
IF SOURCE.MACHINE = "" THEN
LAST.FIELD=2
END ELSE
LAST.FIELD=1
temp.form<2>=SOURCE.MACHINE
END
ID="BASIC.PGM.FILES"
READ REC FROM fvsavedlists,ID THEN
NEW.ITEM=No
REC=LOWER(REC)
END ELSE
NEW.ITEM=Yes
REC=NULL
END
RETURN
******************************************************************************
* file.names - routine to update basic program file names
******************************************************************************
file.names:
VALUE.INSERTED=No
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
REC=NULL; MV=1; GOSUB display.field
END ELSE IF Q="+" THEN MV=1 ELSE
FOR MV=1 TO 99 UNTIL REC<1,MV>=NULL; NEXT MV
IF MV>MV1+10 THEN GOSUB display.field
END
END ELSE IF REC<1,MV>=NULL AND Q # "DE" THEN GOTO file.names
END
IF Q=NULL THEN
floop1:
form.line=1
GOSUB get.input
temp.form<1>=NULL
Q=temp
IF (Q="/" OR Q=NULL) AND NOT(VALUE.INSERTED) THEN MV=0; RETURN
END
IF Q="I" OR Q="i" THEN
VALUE.INSERTED=Yes; REC=INSERT(REC,1,MV,0,NULL)
GOSUB display.field; Q=NULL; GOTO floop1
END
IF Q="+" THEN MV=MV1+10;GOSUB display.field;RETURN
IF Q="DE" OR Q="de" THEN
REC=DELETE(REC,1,MV,0)
GOSUB display.field; RETURN
END
IF Q="^" OR Q="XX" THEN RETURN
OPEN "",Q TO fvjunk ELSE
CALL *HELP.PRINT.B(UVREADMSG(073005,Q),2)
GOTO floop1
END
REC<1,MV>=Q
IF MV<MV1 OR MV>MV1+9 THEN GOSUB display.field
TPRINT @(COL1<MOD(MV-1,10)+1>,LIN1<MOD(MV-1,10)+1>):"1.":MV"L#3":Q "L#25"
IF Q=NULL THEN
MV=0
RETURN
END
MV=MV+1
GOTO floop1
RETURN
******************************************************************************
* refresh.data - refresh data
******************************************************************************
refresh.data:
GOSUB display.field
IF LAST.FIELD=2 THEN
temp.form<2>=SOURCE.MACHINE
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
END
Q=NULL
RETURN
******************************************************************************
* exit.routine - exit the menu
******************************************************************************
exit.routine:
STOP @(-1)
RETURN
******************************************************************************
* display.field - display file names to choose from
******************************************************************************
display.field:
MV1=10*INT((MV-1)/10)+1
IF REC<1,MV1>=NULL AND Q="+" THEN MV1=1
FOR K=MV1 TO MV1+9
TPRINT @(COL1<MOD(K-1,10)+1>,LIN1<MOD(K-1,10)+1>):STR(SPACE,30)
NEXT K
FOR K=MV1 TO MV1+9
TPRINT @(COL1<MOD(K-1,10)+1>,LIN1<MOD(K-1,10)+1>):"1.":K"L#3":REC<1,K> "L#25"
NEXT K
TPRINT @(COL1<10>-1,LIN1<10>):
IF REC<1,K>#NULL THEN TPRINT "+" ELSE TPRINT "."
RETURN
******************************************************************************
* get.input - get any input that is needed
******************************************************************************
get.input:
help.loop:
CALL *HELP.PRINT.B(form<form.line,SHRT.HELP>,1)
input.loop:
TPRINT form<form.line,PRMPT.LOC>:STR(" ",form<form.line,6>) ;* position cursor
TPRINT form<form.line,PRMPT.LOC>: ;* position cursor
temp=temp.form<form.line>
CALL *CINPUT.B(SEC.PRMPT,temp,special,form<form.line,6>,form<form.line,7>)
IF special # 0 THEN ;* if special character encountered
BEGIN CASE
CASE special = F.1
CALL *HELP.PRINT.B(form<form.line,LONG.HELP>,3)
GOTO input.loop ;* get more input
CASE special = ESCAPE ;* escape was pressed
GOTO exit.routine
CASE special = NEXT.PAGE
Q="+"
MV=MV1+10
GOSUB display.field
GOTO help.loop
CASE Default
GOTO help.loop
END CASE ;* end of case
END ;* end of if statement
RETURN
******************************************************************************
* sourcem - routine to update source machine data
******************************************************************************
sourcem:
IF Q=NULL THEN
sloop1:
form.line=2
GOSUB get.input
Q=temp
END
Q=UPCASE(Q)
IF Q="^" OR Q="XX" THEN RETURN
IF Q=NULL THEN
CALL *HELP.PRINT.B(UVREADMSG(071004,""),2)
GOTO sloop1
END
BEGIN CASE
CASE Q="PRIME"
format = "INFORMATION.FORMAT"
CASE Q="MICRODATA"
format = "REALITY.FORMAT"
CASE Q="IN2"
format = "IN2.FORMAT"
CASE Q = "ADDS" OR Q = "ULTIMATE" OR Q = "IBM PC-XT"
format = "PICK.FORMAT"
CASE Default
CALL *HELP.PRINT.B(UVREADMSG(073734,""),2)
GOTO sloop1
END CASE
IF LEN(Q) > 12 THEN
CALL *HELP.PRINT.B(UVREADMSG(073733,""),2)
GOTO sloop1
END
SOURCE.MACHINE=Q
temp.form<2>=Q
CALL *PUT.FORM.B(form.size,form,temp.form,PRMPT,PAINT)
RETURN
STOP @(-1)
END