× 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.



Simon,

My solution was conceptually similar, but used DSM instead of USRDFN
data streams.  In addition, instead of clearing the unit and
displaying the image as one output field, I leave the input fields
intact and just overwrite the attribute bytes.  Then instead of simply
waiting for an AID key and exiting, I loop while Enter is pressed,
displaying the hex value of the cursor location until some other AID
key is pressed (eg F3 or F12).

I wasn't sure I should put a 200 line source directly in a reply, but
for the sake of comparison, here is a RPG alternative to the CL
program.  Once upon a time I used USRDFN, but now consider DSM much
more readable.

Here is my source, which I called DspDspAtr:

     H Option( *SrcStmt : *NoDebugIO )
     H DftActGrp( *No )
     H ActGrp( *Caller )
     H BndDir( 'QC2LE' )

      * Display display attributes

      * Use SETATNPGM DSPDSPATR then use ATTN key to invoke this program.
      * The current Screen will have all display attributes replaced by
      * a @ character.  Move the cursor and press Enter to have the hex
      * value of that position displayed.  Use any Fx key to exit.

      * Copyright 2004 Douglas Handy.
      * Permission is granted to distribute freely; all other rights
      * are reserved.

      * Stand-alone variables used
     D BegRow          S             10I 0
     D BegCol          S             10I 0
     D Rows            S             10I 0
     D Cols            S             10I 0
     D R               S             10I 0
     D C               S             10I 0
     D Hex             S              2

     D CmdBuf          S             10I 0
     D InpHnd          S             10I 0
     D BytRead         S             10I 0

     D ScrImg          S           3564
     D ScrImgPtr       S               *   Inz( *Null )
     D ScrBytePtr      S               *   Inz( *Null )
     D ScrByte         S              1    Based( ScrBytePtr )

     D InpDtaPtr       S               *   Inz( *Null )
     D InpDta          DS          3564    Based( InpDtaPtr )
     D  InpCsrRow                     3U 0
     D  InpCsrCol                     3U 0
     D  InpAID                        1

      * Convert character string to hex string (eg ABC to C1C2C3)
     D CvtToHex        PR                  ExtProc( 'cvthc' )
     D  Hex                        2048    Options( *Varsize )
     D  Char                       1024    Options( *Varsize )
     D  LenSrc                       10I 0 Value

      * Copy a block of memory (operands should not overlap)
     D memcpy          PR              *   ExtProc( '__memcpy' )
     D  Target                         *   Value
     D  Source                         *   Value
     D  Length                       10U 0 Value

      * Standard API error code DS
     D ApiErrCode      DS
     D  ErrBytPrv                     9B 0 Inz( %size( ApiErrCode ) )
     D  ErrBytAvl                     9B 0 Inz( 0 )
     D  ErrMsgID                      7
     D  ErrResv                       1
     D  ErrMsgDta                    80

      * Retrieve Screen dimensions of current mode (not capability).
     D RtvScrDim       PR            10I 0 ExtProc( 'QsnRtvScrDim' )
     D  Rows                         10I 0
     D  Cols                         10I 0
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Clear buffer.
     D ClrBuf          PR            10I 0 ExtProc( 'QsnClrBuf' )
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Create command buffer.
     D CrtCmdBuf       PR            10I 0 ExtProc( 'QsnCrtCmdBuf' )
     D  InitSize                     10I 0 Const
     D  IncrAmt                      10I 0 Options( *Omit ) Const
     D  MaxSize                      10I 0 Options( *Omit ) Const
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Create input buffer.
     D CrtInpBuf       PR            10I 0 ExtProc( 'QsnCrtInpBuf' )
     D  InitSize                     10I 0 Const
     D  IncrAmt                      10I 0 Options( *Omit ) Const
     D  MaxSize                      10I 0 Options( *Omit ) Const
     D  InpBuf                       10I 0 Options( *Omit )
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Delete buffer.
     D DltBuf          PR            10I 0 ExtProc( 'QsnDltBuf' )
     D  BufHnd                       10I 0 Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Read Screen (without waiting for an AID key).
     D ReadScr         PR            10I 0 ExtProc( 'QsnReadScr' )
     D  NbrByt                       10I 0 Options( *Omit )
     D  InpBuf                       10I 0 Options( *Omit ) Const
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Retrieve pointer to data in input buffer.
     D RtvDta          PR              *   ExtProc( 'QsnRtvDta' )
     D  InpBuf                       10I 0 Const
     D  InpDtaPtr                      *   Options( *Omit )
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Read input fields.
     D ReadInp         PR            10I 0 ExtProc( 'QsnReadInp' )
     D  CCByte1                       1    Const
     D  CCByte2                       1    Const
     D  NbrFldByt                    10I 0 Options( *Omit )
     D  InpBuf                       10I 0 Options( *Omit ) Const
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Get cursor address (does not wait for AID key).
     D GetCsrAdr       PR            10I 0 ExtProc( 'QsnGetCsrAdr' )
     D  CsrRow                       10I 0 Options( *Omit )
     D  CsrCol                       10I 0 Options( *Omit )
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Set cursor address.
     D SetCsrAdr       PR            10I 0 ExtProc( 'QsnSetCsrAdr' )
     D  FldID                        10I 0 Options( *Omit ) Const
     D  CsrRow                       10I 0 Options( *Omit ) Const
     D  CsrCol                       10I 0 Options( *Omit ) Const
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

      * Write data.
     D WrtDta          PR            10I 0 ExtProc( 'QsnWrtDta' )
     D  Data                       3600    Const
     D  DataLen                      10I 0 Const
     D  FldID                        10I 0 Options( *Omit ) Const
     D  Row                          10I 0 Options( *Omit ) Const
     D  Col                          10I 0 Options( *Omit ) Const
     D  StrMonoAtr                    1    Options( *Omit ) Const
     D  EndMonoAtr                    1    Options( *Omit ) Const
     D  StrClrAtr                     1    Options( *Omit ) Const
     D  EndClrAtr                     1    Options( *Omit ) Const
     D  CmdBuf                       10I 0 Options( *Omit ) Const
     D  EnvHnd                       10I 0 Options( *Omit ) Const
     D  ErrorDS                            Options( *Omit ) Like( ApiErrCode )

     C/Free

       // Get display size and save current contents of Screen image
       RtvScrDim( Rows: Cols: *Omit: *Omit );
       GetCsrAdr( BegRow: BegCol: *Omit: *Omit );
       InpHnd     = CrtInpBuf( %size( ScrImg ): *Omit: *Omit: *Omit: *Omit );
       BytRead    = ReadScr( *Omit: InpHnd: *Omit: *Omit: *Omit );
       InpDtaPtr  = RtvDta( InpHnd: *Omit: *Omit );
       ScrImgPtr  = %addr( ScrImg );
       memcpy( ScrImgPtr : InpDtaPtr: BytRead );

       // Create command buffer with an output command to replace
       // each display attribute byte with a @ character, except
       // for the attribute at row/col 1,1 because overlaying it
       // effects at least some emulators
       CrtCmdBuf( 1024: 1024: 6192: CmdBuf: *Omit );
       ScrBytePtr = %addr( ScrImg );

       For R = 1 to Rows;
         For C = 1 to Cols;
           If ScrByte >= x'20' and ScrByte <= x'3F';
             If not ( R = 1 and C = 1 );
               WrtDta( '@': 1: 0: R: C: *Omit: *Omit: *Omit: *Omit:
                       CmdBuf: *Omit: *Omit );
             Endif;
           Endif;
           ScrBytePtr = ScrBytePtr + 1;
         Endfor;
       Endfor;

       // Output cmd buffer to display and wait for AID key
       SetCsrAdr( *Omit: BegRow: BegCol: CmdBuf: *Omit: *Omit );
       ReadInp( x'20': x'40': BytRead: InpHnd: CmdBuf: *Omit: *Omit );
       InpDtaPtr  = RtvDta( InpHnd: *Omit: *Omit );

       // Show hex contents of cursor position until Enter not pressed
       Dou InpAID <> x'F1';
         ClrBuf( CmdBuf: *Omit );
         ScrBytePtr = ScrImgPtr + ( ( InpCsrRow - 1 ) * Cols ) + InpCsrCol - 1;
         CvtToHex( Hex: ScrByte: 2 );
         WrtDta( Hex: 2: 0: Rows: Cols-1: x'22': *Omit: x'22': *Omit:
                 CmdBuf: *Omit: *Omit );
         SetCsrAdr( *Omit: InpCsrRow: InpCsrCol: CmdBuf: *Omit: *Omit );
         ReadInp( x'20': x'40': BytRead: InpHnd: CmdBuf: *Omit: *Omit );
         InpDtaPtr  = RtvDta( InpHnd: *Omit: *Omit );
       Enddo;

       // Delete DSM buffers and end program
       DltBuf( CmdBuf: *Omit );
       DltBuf( InpHnd: *Omit );
       *InLR = *On;
      /End-free

Doug

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 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.