× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  1.  Home
  2. MIDRANGE-L
  3. November 2004

Re: Display file attributes

I'm well behind in my reading ... 300 appends to get through ...

You can use the 5250 data stream to write code to show the attribute positions. Here is a CL example. Compile both display files then compile the CL program. Run SETATNPGM PGM(SHWATR_ATN) to set up then use the attention key to activate. The current screen will be redisplayed with an attribute replacement byte (x'9f'). I haven't worked out how to display the old-fashioned hex attribute codes and using different characters for each attribute byte is simply confusing. Note: I published the STDERR command and processing program used by this CL program years ago. They should be in the archives somewhere. If you can't find them then simply replace it with your own standard CL error handler.

SHWATRD1 -- Display file
      * Compile-time format to show the screen atrributes
      *
     A          R USRDFNRCD
     A            IO1         1800   B  1  2
     A            IO2         1800   B  1  2
     A            IO3         1800   B  1  2

SHWATRD2 -- Display file
      * Run-time formats to show the screen attributes
      *
     A                                      DSPSIZ(*DS3 *DS4)
     A                                      PRINT(*LIBL/QSYSPRT)
     A          R USRDFNRCD                 USRDFN
      *
     A          R DUMMYRCD                  ASSUME
     A            DUMMY1      1800   O  1  2
     A            DUMMY2      1800   O  1  2
     A            DUMMY3      1800   O  1  2

SHWATR_ATN - Attention program
 SHWATR_ATN: PGM

/*                                                                 */
/* ---------------- Input Parameter Declarations ----------------- */
/*                                                                 */
             DCL        VAR(&ERROPT) TYPE(*CHAR) LEN(4)
                        /* Error option                            */

/*                                                                 */
/* ------------------- Program Declarations ---------------------- */
/*                                                                 */
             DCLF       FILE(SHWATRD1)
                        /* Compile-time display file               */

             DCL        VAR(&IN) TYPE(*CHAR) LEN(5400)
                        /* Input buffer                            */
             DCL        VAR(&OUT) TYPE(*CHAR) LEN(5400)
                        /* Output buffer                           */
             DCL        VAR(&CHAR) TYPE(*CHAR) LEN(1)
                        /* Current character                       */
             DCL        VAR(&ATR) TYPE(*CHAR) LEN(1)
                        /* Saved attribute                         */
             DCL        VAR(&INCREMENT) TYPE(*DEC) LEN(5 0)
                        /* Increment                               */
             DCL        VAR(&ROW_POS) TYPE(*DEC) LEN(1 0) VALUE(5)
                        /* Row position in 5250 Data Stream        */
             DCL        VAR(&COL_POS) TYPE(*DEC) LEN(1 0) VALUE(6)
                        /* Column position in 5250 Data Stream     */
             DCL        VAR(&HEX_ROW) TYPE(*CHAR) LEN(2) VALUE(X'0000')
                        /* Number of rows - hexadecimal            */
             DCL        VAR(&HEX_COL) TYPE(*CHAR) LEN(2) VALUE(X'0000')
                        /* Number of columns - hexadecimal         */
             DCL        VAR(&ROW) TYPE(*DEC) LEN(5 0)
                        /* Number of rows                          */
             DCL        VAR(&COL) TYPE(*DEC) LEN(5 0)
                        /* Number of columns                       */
             DCL        VAR(&SIZE) TYPE(*DEC) LEN(5 0)
                        /* Screen size                             */
             DCL        VAR(&POS) TYPE(*DEC) LEN(5 0)
                        /* Position                                */
             DCL        VAR(&IDX) TYPE(*DEC) LEN(5 0)
                        /* Index of 5250DS buffer                  */
             DCL        VAR(&ERROR) TYPE(*LGL) LEN(1)
                        /* Error flag                              */

/*                                                                 */
/* ---------------- Mnemonic Value Declarations ------------------ */
/*                                                                 */
             DCL        VAR(&BLANK) TYPE(*CHAR) LEN(1) VALUE(X'40')
                        /* Mnemonic for 'blank'                    */
             DCL        VAR(&TRUE) TYPE(*LGL) LEN(1) VALUE('1')
                        /* Mnemonic for 'true'                     */
             DCL        VAR(&FALSE) TYPE(*LGL) LEN(1) VALUE('0')
                        /* Mnemonic for 'false'                    */
             DCL        VAR(&STAR) TYPE(*CHAR) LEN(1) VALUE('*')
                        /* Mnemonic for 'asterisk'                 */
             DCL        VAR(&QUOTE) TYPE(*CHAR) LEN(1) VALUE('''')
                        /* Mnemonic for 'quote'                    */
             DCL        VAR(&BATCH) TYPE(*CHAR) LEN(1) VALUE('0')
                        /* Mnemonic for 'batch job'                */
             DCL        VAR(&INTER) TYPE(*CHAR) LEN(1) VALUE('1')
                        /* Mnemonic for 'interactive job'          */
             DCL        VAR(&ZERO) TYPE(*DEC) LEN(1 0) VALUE(0)
                        /* Mnemonic for 'zero'                     */
             DCL        VAR(&HEX00) TYPE(*CHAR) LEN(2) VALUE(X'0000')
                        /* Mnemonic for 'binary zero'              */
             DCL        VAR(&YES) TYPE(*CHAR) LEN(1) VALUE('Y')
                        /* Mnemonic for 'yes'                      */
             DCL        VAR(&NO) TYPE(*CHAR) LEN(1) VALUE('N')
                        /* Mnemonic for 'no'                       */
             DCL        VAR(&NULL) TYPE(*CHAR) LEN(1) VALUE(X'00')
                        /* Mnemonic for 'NULL'                     */
             DCL        VAR(&HEX20) TYPE(*CHAR) LEN(1) VALUE(X'20')
                        /* Mnemonic for X'20'                      */
             DCL        VAR(&HEX3F) TYPE(*CHAR) LEN(1) VALUE(X'3F')
                        /* Mnemonic for X'3F'                      */
             DCL        VAR(&HEX9F) TYPE(*CHAR) LEN(1) VALUE(X'9F')
                        /* Mnemonic for X'9F'                      */
             DCL        VAR(&GDS) TYPE(*CHAR) LEN(2) VALUE(X'12A0')
                        /* Mnemonic for General Data Stream - DSPT */

/*                                                                 */
/* ------------------- Copyright Declarations -------------------- */
/*                                                                 */
             DCL        VAR(&COPYRIGHT) TYPE(*CHAR) LEN(80) +
                          VALUE('Copyright (C) FlyByNight Software. +
                          1999, 2004.')

/*                                                                 */
/* -------------- Global Message Monitor Intercept --------------- */
/*                                                                 */
             MONMSG     MSGID(CPF9999) EXEC(GOTO CMDLBL(FAILED))

/*                                                                 */
/* ---------- Force Copyright Notice in Executable Code ---------- */
/*                                                                 */
             CHGVAR     VAR(&COPYRIGHT) VALUE(&COPYRIGHT)

/*                                                                 */
/* ----------------- Send the Copyright Notice ------------------- */
/*                                                                 */
             SNDPGMMSG  MSG(&COPYRIGHT) TOPGMQ(*SAME)

             /* Initialise error indicator                         */
             CHGVAR     VAR(&ERROR) VALUE(&FALSE)

             /* Point to run-time display file                     */
             OVRDSPF    FILE(SHWATRD1) TOFILE(SHWATRD2) LVLCHK(*NO)

             /* Use "save immediate" to retrieve the number of     */
             /*   columns and screen size.                         */
             CHGVAR     VAR(&IO1) VALUE(X'00021518730402')
             /*                                     Ì              */
             SNDRCVF    RCDFMT(USRDFNRCD)

             /*  Save Immediate returns a "restore screen" 5250    */
             /*    command                                         */

             /*  Check for a GDS header in case this is a DSPT     */
             /*    screen                                          */
             IF         COND(%SST(&IO1 3 2) *EQ &GDS) THEN(DO)
               CHGVAR     VAR(&ROW_POS) VALUE(&ROW_POS + 10)
               CHGVAR     VAR(&COL_POS) VALUE(&COL_POS + 10)
             ENDDO

/* Extract the number of rows, convert to 2-byte hex */
CHGVAR VAR(%SST(&HEX_ROW 2 1)) VALUE(%SST(&IO1 &ROW_POS 1))

/* Extract the number of cols, convert to 2-byte hex */
CHGVAR VAR(%SST(&HEX_COL 2 1)) VALUE(%SST(&IO1 &COL_POS 1))

             /* Convert the number of rows to decimal              */
             CHGVAR     VAR(&ROW) VALUE(%BIN(&HEX_ROW))
             /* Convert the number of columns to decimal           */
             CHGVAR     VAR(&COL) VALUE(%BIN(&HEX_COL))
             /* Screen size = number_of_rows * number_of_columns   */
             CHGVAR     VAR(&SIZE) VALUE(&ROW * &COL)

             /* Build "clear unit" and "write to display" commands */
             /*   -- If display size is *DS3 ...                   */
             IF         COND(&SIZE *EQ 1920) THEN(DO)
               CHGVAR     VAR(&OUT) +
                              VALUE(X'078D000373044004110008110101')
                            /*                  |   |              */
               CHGVAR     VAR(&INCREMENT) VALUE(15)
             ENDDO
             /*      ... otherwise if display size is *DS4 ...     */
             ELSE       CMD(IF COND(&SIZE *EQ 3564) THEN(DO))
               CHGVAR     VAR(&OUT) +
                            VALUE(X'0DFA00037304200004110008110101')
                            /*                |     |              */
               CHGVAR     VAR(&INCREMENT) VALUE(16)
             ENDDO
             /*      ... otherwise unknown display size ...        */
             /*      --- usually a 5250 emulator problem ---       */
             /*       or possibly trying to run on S/38 console    */
             ELSE       CMD(DO)
/*                                                                 */
/* @A1D        IF         COND(&ERROPT *EQ '*DFT') THEN(DO)        */
                 /* Assume display size is *DS3 ...                */
                 CHGVAR     VAR(&OUT) +
                                VALUE(X'078D000373044004110008110101'
                              /*                  |   |            */
                 CHGVAR     VAR(&INCREMENT) VALUE(15)
                 CHGVAR     VAR(&ROW) VALUE(24)
                 CHGVAR     VAR(&COL) VALUE(80)
                 CHGVAR     VAR(&SIZE) VALUE(1920)
/* @A1D        ENDDO                                               */
/* @A1D        ELSE       CMD(DO)                                  */
/* @A1D          SNDPGMMSG  MSGID(CPF9898) MSGF(QCPFMSG) +         */
/* @A1D                       MSGDTA('Screen size cannot be +      */
/* @A1D                       determined. Emulator is not +        */
/* @A1D                       building a correct Restore Screen +  */
/* @A1D                       command') MSGTYPE(*ESCAPE)           */
/* @A1D        ENDDO                                               */
             ENDDO

             /* Use "read immediate" to get a snapshot of screen   */
             CHGVAR     VAR(&IO1) VALUE(X'00021518730462')
             /*                                     |              */
             SNDRCVF    RCDFMT(USRDFNRCD)
             CHGVAR     VAR(&IN) VALUE(&IO1 *CAT &IO2 *CAT &IO3)

             /* Initialise attribute byte                          */
             CHGVAR     VAR(&ATR) VALUE(&HEX9F)

             /* Loop for each byte in the input buffer ...         */
             CHGVAR     VAR(&POS) VALUE(1)
 LOOP:       CHGVAR     VAR(&CHAR) VALUE(%SST(&IN &POS 1))

             /* If an attribute byte was found ...                 */
             IF         COND((&CHAR *GE &HEX20)           *AND +
                             (&CHAR *LE &HEX3F)) THEN(DO)
               /* Replace attribute with magic marker              */
               CHGVAR     VAR(&CHAR) VALUE(&ATR)
             ENDDO

             /* Calculate the output position ...                  */
             CHGVAR     VAR(&IDX) VALUE(&POS - 1 + &INCREMENT)

             /* Build the new screen ...                           */
             CHGVAR     VAR(%SST(&OUT &IDX 1)) VALUE(&CHAR)
             CHGVAR     VAR(&POS) VALUE(&POS + 1)
             IF         COND(&POS *LE &SIZE) THEN(DO)
               GOTO       CMDLBL(LOOP)
             ENDDO

             /* Append "read input" command to display screen      */
             /*   attribute data and wait for user action.         */
             CHGVAR     VAR(&IDX) VALUE(&POS + &INCREMENT - 1)
             CHGVAR     VAR(%SST(&OUT &IDX 4)) VALUE(X'04420008')
             /*                                        |           */
             CHGVAR     VAR(&IO1) VALUE(%SST(&OUT    1 1800))
             CHGVAR     VAR(&IO2) VALUE(%SST(&OUT 1801 1800))
             CHGVAR     VAR(&IO3) VALUE(%SST(&OUT 3601 1800))
             SNDRCVF    RCDFMT(USRDFNRCD)
 EXIT:       RETURN     /* Normal end of program                   */

/*                                                                 */
/* --------------------- Exception Routine ----------------------- */
/*                                                                 */
 FAILED:     STDERR     PGMTYPE(*CPP)
             MONMSG     MSGID(CPF9999) /* Just in case             */

 SHWATRX:    ENDPGM

Regards,
Simon Coulter.
--------------------------------------------------------------------
   FlyByNight Software         AS/400 Technical Specialists

   http://www.flybynight.com.au/
   Phone: +61 3 9419 0175   Mobile: +61 0411 091 400        /"\
   Fax:   +61 3 9419 0175                                   \ /
                                                             X
                 ASCII Ribbon campaign against HTML E-Mail  / \
--------------------------------------------------------------------




As an Amazon Associate we earn from qualifying purchases.

This thread ...
Follow-Ups:
Replies:
Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2025 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.