Retro1.org codex

       PROGRAM SHOWEX
*  TITLE SHOWEX - SHOWEX EXECUTIVE PROGRAM.
*
***    SHOWEX - SHOWEX EXECUTIVE PROGRAM.
*
*      *SHOWEX* WILL DISPLAY A PREDEFINED PRIMARY PANEL, AND
*      AN OPTIONAL SECOND PANEL WHICH CAN BE AN OVERLAY OR AN
*      ANOTHER PRIMARY PANEL, FROM LOCAL FILE *PANELIB* OR
*      GLOBAL LIBRARY SET FOR VISUAL CHECKOUT ON THE SCREEN.
*
*      *SHOWEX* USES THE SCREEN FORMATTING LIBRARY (SFLIB)
*      *SFOPEN*, TO OPEN THE SPECIFIED PANEL(S), *SFSREA*
*      (TO ALLOW VARIABLES DEFINED WITH DEFAULT VALUES TO
*      BE SEEN) TO DISPLAY THE PANELS(S), AND *SFCLOS* TO
*      CLOSE THE PANEL(S) AND REVERT TO LINE MODE.  IF THE
*      PANEL(S) CAN NOT BE OPENED AN ERROR MESSAGE IS SENT.
*
*      PROGRAM SHOWEX
*
*      ENTRY   *PPANEL* = PRIMARY PANEL NAME.
*              *OPANEL* = OPTIONAL OVERLAY PANEL.
*
*      EXIT    PANEL(S) DISPLAYED, TERMINAL RESET TO LINE MODE.
*
*      CALLS   GETPARM, SFCLOS, SFOPEN, SFSREA.
*
*      COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
*
 
       CHARACTER*7 PARM
       CHARACTER*7 PPANEL
       CHARACTER*7 OPANEL
       CHARACTER*1 DUMMY
 
       DUMMY = ' '
       CALL GETPARM(PARM,PPANEL,I)
       IF ((I.EQ.0).AND.(PPANEL.NE.'       ')) THEN
*        CONTROL STATEMENT PARAMETER RETURNED.
         CALL SFOPEN(PPANEL,J)
         IF (J.EQ.0) THEN
*          DISPLAY SUCCESSFULLY OPENED PANEL.
           CALL SFSREA(PPANEL,DUMMY)
           CALL GETPARM(PARM,OPANEL,I)
           IF ((I.EQ.0).AND.(OPANEL.NE.'       ')) THEN
*          CONTROL STATEMENT PARAMETER RETURNED.
             CALL SFOPEN(OPANEL,J)
             IF (J.EQ.0) THEN
*              DISPLAY SUCCESSFULLY OPENED PANEL.
               CALL SFSREA(OPANEL,DUMMY)
*              CLOSE PANELS
               CALL SFCLOS(OPANEL,0)
               CALL SFCLOS(PPANEL,2)
             ELSE
*              CLOSE FIRST PANEL
               CALL SFCLOS(PPANEL,2)
*              ISSUE ERROR MESSAGE
               GO TO (100,200,300,300,200,300,300) J
 100           PRINT*,'SHOW - ',OPANEL,' NOT FOUND IN PANELIB.'
               GO TO 400
 200           PRINT*,'SHOW - BAD OR MISSING PANELIB.'
               GO TO 400
 300           PRINT*,'SHOW - INTERNAL ERROR.'
 400           CONTINUE
             ENDIF
           ELSE
*            CLOSE FIRST PANEL
             CALL SFCLOS(PPANEL,2)
           ENDIF
         ELSE
*          CLOSE PANEL, CLEARING SCREEN, ISSUE MESSAGE
           GO TO (500,600,700,700,600,800,810) J
 500       CALL SFCLOS(PPANEL,1)
           PRINT*,'SHOW - ',PPANEL,' NOT FOUND IN PANELIB.'
           GO TO 900
 600       CALL SFCLOS(PPANEL,1)
           PRINT*,'SHOW - BAD OR MISSING PANELIB.'
           GO TO 900
 700       CALL SFCLOS(PPANEL,1)
           PRINT*,'SHOW - SHOW INTERNAL ERROR.'
           GO TO 900
*          NEVER IN SCREEN MODE, SO NO CALL TO SFCLOS
 800       PRINT*,'SHOW - TERMINAL NOT IN SCREEN MODE.'
           GO TO 900
 810       PRINT*,'SHOW - TERMINAL MODEL UNKNOWN OR UNSUPPORTED.'
 900       CONTINUE
         ENDIF
       ENDIF
       END