SUBROUTINE MPRMEN (FILE, LUNIT) C***************************************************************************** C C Description : Main routine of the MPR-subroutine package C Opens file, reads general info records, and controls C menu processing according users commands C C Arguments : FILE = STRING containing the file-name without extension C (max. 26 characters) C LUNIT = INTEGER logical unit number C C Author : F.A.Minkema C AKZO PHARMA, Oss Holland C dept. SDA C C Version : V1.1 Date : 16-jun-1983 C C Module name : MPRMEN.FTN C C Package : TRAMP C C Compilation/Linking : FOR/F4P/TR:NONE MPRMEN C C Updates : name F.A.Minkema version V1.1 C C description : Partial display of screen implemented for break-through C in combination with function returncode=0 C Filename extended to 26 characters C C***************************************************************************** C BYTE CLRSTR,ERLSTR,CLRVAT,FLSVAT,FNPPOS,FNGPOS,FLSPOS, 1 MESPAT,GENVAT,GENLAT,MENPAT,FUNTAB,TYPTAB,MFTTAB COMMON/MPRCOM/ISCR,NUNIT,IBTFLG,IMESFL,MAXBUF,LMAR, 1 MSTACK,ISTACK(8),NRMMR,NRNRCM,NRFUN, 2 NRFFLR,NRLFLR,NRTTAB(12), 3 CLRSTR(8),ERLSTR(4),CLRVAT(6),FLSVAT(8), 4 FNPPOS(8),FNGPOS(8),FLSPOS(8),MESPAT(14), 5 GENVAT(8),GENLAT(4,2),MENPAT(10), 6 FUNTAB(6,12),TYPTAB(12),MFTTAB(7,12) C C general info record 1 C VNR ! version number C NRMMR ! rec.nr. of main menu C CLRSTR ! esc.seq: clear screen C ERLSTR ! esc.seq: erase line C CLRVAT ! esc.seq: clear video attributes C FLSVAT ! esc.seq: function-list key video attributes C C general info record 2 C LMAR ! left margin text lines C FNPPOS ! esc.seq: position 'Function:'-text C FNGPOS ! esc.seq: position to get command string C FLSPOS ! esc.seq: start position of function-list C MESPAT ! esc.seq: pos. & video-attr. messages C C general info record 3 C GENVAT ! esc.seq: general header video attributes C GENLAT ! esc.seq: general header line attributes C MENPAT ! esc.seq: menu header pos. & line attributes C C BYTE FILNAM(32),PROG(8),COMSTR(60),FILE(1) DATA PROG/'M','P','R','M','E','N',2*0/ C C generate complete file-name and open C CALL SCOPY(FILE,FILNAM,26) CALL SCOPY('.MEX',FILNAM(LEN(FILNAM)+1)) OPEN (UNIT=LUNIT,NAME=FILNAM,TYPE='OLD', 1 ACCESS='DIRECT',RECORDSIZE=10,ERR=9000) C C attach terminal C CALL QIO("1400,5,3) CALL WAITFR(3) C C read general info records for initialization C READ (LUNIT'1,ERR=9010) VNR,NRMMR,CLRSTR,ERLSTR,CLRVAT,FLSVAT IF (VNR.NE.'V1.0') GOTO 9020 READ (LUNIT'2,ERR=9030) LMAR,FNPPOS,FNGPOS,FLSPOS,MESPAT READ (LUNIT'3,ERR=9040) GENVAT,GENLAT,MENPAT NUNIT=LUNIT ISCR=5 MAXBUF=40 MSTACK=8 DO 5 I=1,MSTACK ISTACK(I)=0 5 CONTINUE IBTFLG=0 IMESFL=0 IPCL=1 IFUN=0 NRNRCM=0 NREC=NRMMR C C init menu and display eventually C 10 CALL MPRPM(NREC) CALL MPRDM(IPCL) IWBT=IBTFLG CALL MPRGF(IFUN,COMSTR) C C examine IFUN C IF (IFUN.EQ.0) GOTO 90 ! 'EXIT' entered, return to main-program IPCL=2 IF (IFUN.EQ.-1) 20,30,30 C THEN ! '<' entered 20 NREC=MPRPP() ! unroll stack IF (NREC.NE.0) GOTO 20 NREC=NRMMR GOTO 10 C ENDIF 30 IF (IFUN.EQ.-2) 32,40,40 ! '.' entered C THEN ! get former menu, 32 NREC=MPRPP() ! or clear screen and GOTO 10 ! return to main program C ENDIF C C positive value for IFUN C 40 IF (TYPTAB(IFUN).EQ.'M') 42,50,50 ! next menu wanted C THEN 42 CALL MPRPS NREC=NRTTAB(IFUN) GOTO 10 C ENDIF 50 CALL MPREXE(MFTTAB(1,IFUN),IRET) ! execute function IF (IRET.LT.0 .OR. 1 (TYPTAB(IFUN).EQ.'F' .AND. IRET.GT.1) .OR. 2 (TYPTAB(IFUN).EQ.'S' .AND. IRET.GT.3)) 52,60,60 C THEN 52 CALL SWRITE(ISCR,' ',MESPAT,CLRVAT,ERLSTR) ! invalid return code CALL SWRITE(ISCR,' ',ERLSTR,'?',PROG,'-I-',MFTTAB(1,IFUN)) GOTO 9050 C ENDIF 60 IPCL=IRET IF (TYPTAB(IFUN).EQ.'F') 62,70,70 C THEN 62 IF (IPCL.EQ.0 .AND. IWBT.EQ.1) IPCL=2 GOTO 10 C ELSE 70 IF (IRET .GT. 1) 72,74,74 C THEN 72 IPCL=IRET-2 IF (IPCL.EQ.0 .AND. IWBT.EQ.1) IPCL=2 GOTO 10 C ELSE 74 CALL MPRPS NREC=NRTTAB(IFUN) ! menu after execution of function IPCL=2-IRET GOTO 10 C ENDIF C ENDIF C C clear screen C 90 CALL SWRITE(ISCR,'+$',CLRSTR,CLRVAT) C C go back to calling routine C RETURN C C errors C 9000 CALL FATAL(PROG,'OPEN-error MPR-library file') 9010 CALL FATAL(PROG,'READ-error first general info record') 9020 CALL FATAL(PROG,'Invalid version MPR-library file') 9030 CALL FATAL(PROG,'READ-error second general info record') 9040 CALL FATAL(PROG,'READ-error third general info record') 9050 CALL FATAL(PROG,'Invalid return-code from function') END