View source for Screen class using object-oriented syntax

The following example shows how the Sirius [[Screen class]] and [[Screenfield class]] can be used to create your own locally-defined screen class using object-orient syntax.

In this example (which is used in the [[ULSPF]] family of products) the locally defined SirScreen class ''extends'' the Sirius-provided Screen class -- meaning that all the features of the base class are available for use, but more features are being added.  Where the Screen class provides generic support for screen and screenfield generation, the SirScreen class that extends it exerts full control over the title line, command-line, pfKey definition, message-handling and error highlighting, as well as controlling whether a scale is turned on or off, and how an optional header is formatted.

This is an example of how the Sirius base classes are extended to provide centralized control on the look-and-feel of an application, while leaving the body of the page open for the application programmer to add business-function specific code.

Note the use of the '''!DUPEXIT''' directive at the top of this procedure.  !DUPEXIT tells the compiler that, no matter how many times this routine is included, it should only be compiled into the executable once.  This is useful if you need the SirScreen class included in an optional module, but also need it in a routine that may or may not include the optional module.  !DUPEXIT allows the inclusion of the routine anywhere it is needed, without the danger that the compiler will fail when it sees it more than once in a single routine.  In the Sirius code, for instance, the SirScreen procedure is used in the common "help" routines, which are included in most 3270 code.  By using the !DUPEXIT directive, the calling program can include the same routine for other screens without worrying about whether or not the help routine is included as well.


 !DUPEXIT
 *------------------------------------------------------------------*
 *                                                                  *
 * sirScreen: Screen wrapper class                                  *
 *                                                                  *
 * Screens in this class can be any width and height, and have the  *
 * following features:                                              *
 *                                                                  *
 * A title line and command line at the top.  Two PF Key lines      *
 * at the bottom that can be toggled visible or invisible.          *
 * A message line that is either at the bottom (if the PF Keys are  *
 * not visible) or third line from the bottom (if the PF Keys are   *
 * visible).  A variable number of undefined lines in the middle    *
 * to be used by the application.                                   *
 *                                                                  *
 * In other words, this class defines the stuff that's common to    *
 * all the ULSPF product screens, leaving the middle open for       *
 * the application to define.                                       *
 *                                                                  *
 * The screen object is destroyed and re-created when the calling   *
 * code makes changes that effect the number of lines available     *
 * for scrolling or other application use.                          *
 *                                                                  *
 * Things you can do with this screen object                        *
 *                                                                  *
 * 1. Assign a value to the title.                                  *
 * 2. Assign a value to the message line.                           *
 * 3. Assign values to the PF Keys and toggle their visibility.     *
 * 4. Toggle on and off the scale.                                  *
 * 6. Process commands from the command line.                       *
 * 7. Set attributes, like color, on a specific line.               *
 *                                                                  *
 * Usage: %myScreen Object sirScreen                                *
 *        %myScreen = New                                           *
 *                                                                  *
 *------------------------------------------------------------------*
 sirius case toUpper
 
 * Public class declarations
 * -------------------------
 
 Class sirScreen extends screen inherit
 
   Public
 
       Variable column          is Object screenField
       Variable commandLine     is Object screenField
       Variable headerLine      is Object screenField
       Variable headerProcCount is Object screenField
       Variable line            is Object screenField
       Variable messageLine     is Object screenField
       Variable pf1             is Object screenField
       Variable pf2             is Object screenField
       Variable scale           is Object screenField
       Variable Title           is Object screenField
 
       Variable startingColumn  is   Fixed dp 0
       Variable appStartRow     is   Fixed dp 0
       Variable appEndRow       is   Fixed dp 0
       Variable headerIsOn      is   Boolean
       Variable msgRow          is   Fixed dp 0
       Variable maxApp          is   Fixed dp 0
       Variable commandBack     is   String len 132
       Variable myTitle         is   String len 154
       Variable pf1String       is   String len 154
       Variable pf2String       is   String len 154
       Variable scaleIsOn       is   Boolean
       Variable PFKeysAreOn     is   Boolean
 
       Subroutine setPFKey (%pfKeyNumber Fixed, %pfKeyString String len 13)
       Subroutine setMsg (%msg longString)
       Subroutine setHelp (%msg longString)
       Subroutine setHeader (%header longString)
       Subroutine scaleOn (%lCol Fixed)
       Function read Enumeration ActionKey callable
       Function PFKeysVisible Enumeration Boolean callable
       Function PFKeysInvisible Enumeration Boolean callable
 
       Constructor New(%lines is Enumeration Boolean default(False) nameRequired, -
                        %cols is Enumeration Boolean default(False) nameRequired, -
                       %procs is Enumeration Boolean default(False) nameRequired, -
                 %reserveCols is Fixed dp 0 default(0) nameRequired)
 
   End Public
 
   Private
       *
   End Private
 
       Constructor New(%lines is Enumeration Boolean default(False) nameRequired, -
                        %cols is Enumeration Boolean default(False) nameRequired, -
                       %procs is Enumeration Boolean default(False) nameRequired, -
                 %reserveCols is Fixed dp 0 default(0) nameRequired)
 
     Construct %(screen):New
 
     %comLen      is Fixed
     %y           is Fixed
     %z           is Fixed
     %comLen      = %this:columns - 2
     %y           = %this:rows
     %z           = %this:columns
     %this:startingColumn = 1
     %appStartRow = 3
     %appEndRow   = %y - 3
     %msgRow      = %y - 2
     %maxApp      = %appEndRow - %appStartRow + 1
 
     * Top of the screen.
     %Title = %this:addField(row=1, column=2, width=%this:columns - 1, value='')
     %this:addField(row=2, column=2, value='>')
 
     * Command-line stuff:  The command input area has a variable length, depending on
     * whether the lines/columns fields are requested and whether the user has
     * requested space be reserved for application use.
 
     If %cols:isTrue Then
        %this:addField(row=2,column=(%z-14),value='Cols:',color=green)
        %column = %this:addField(row=2,column=(%z-8),width=9)
        %z = %z - 15
     End If
 
     If %lines:isTrue Then
        %this:addField(row=2,column=(%z-17),value='Line:',color=green)
        %line = %this:addField(row=2,column=(%z-11),width=11)
        %z = %z - 18
     End If
     If %procs:isTrue Then
        %this:addField(row=2,column=(%z-17),value='Proc:',color=green)
        %headerProcCount = %this:addField(row=2,column=(%z-11),width=11)
        %z = %z - 18
     End If
 
     * Reserve space to the right of the command-input field if there's
     * any space to save, keeping a minimum command-input field of 40 bytes.
     If %reserveCols gt 0 and -
        %this:columns-(%this:columns-(%z+2)) gt 41 Then
           %z = $max(%this:columns-(%z+%reserveCols+2),40)
           %commandLine = %this:addField(row=2, column=4, width=%z, protected=false, color=white)
     Else
        %commandLine = -
          %this:addField(row=2, column=4, width=%z-4,protected=false, color=white)
     End If
 
     %commandLine:setCursor
     %scaleIsOn   = False
     %PFKeysAreOn = True
     %headerIsOn  = False
 
  End Constructor
 
 End Class
 
 * ----------------------------------- *
 * Private blocks and methods.
 * ----------------------------------- *
 Class sirScreen
 
  Function read Enumeration ActionKey callable
     %env      is String len 30
     %dateTime is String len 20
     %LenEnv   is fixed   dp  0
 
     %dateTime = ' ' with $DateCnv('YY-MM-DD', 'YY/MM/DD', $Date) -
                  with ' ' with $Time
     %env = $view('JOBNM') with ' ' with $unblank($view('VERSION')) with -
            ' ' with $unblank($subsys) with ' V' with $SirVer with ' '
     %LenEnv = $Len(%env)
     %Title:value = %env with -
                    $center(%myTitle,%this:columns - (%LenEnv+20),'-') with -
                    %dateTime
 
     %Title:color = green
     %this:(screen)read
     %this:setMsg('')
     %this:messageLine:color = white
     %this:commandLine:color = white
     Return %this:ActionKey
  End Function
 
  * Set a PFKey value.  Each PFKey is allocated 12 bytes plus a
  * trailing blank.  PFKeys 1-6 go on line 1, 7-12 go on line 2.
  * Blank/null values in the second parameter blank out the label.
 
  Subroutine setPFKey (%pfKeyNumber Fixed, %pfKeyString String len 13)
     If not $VNum(%pfKeyNumber) Then
        %this:messageLine:value = 'Invalid PFKey value'
        Return
     End If
 
     If %pfKeyNumber gt 12 or %pfKeyNumber lt 1 Then
        %this:messageLine:value = 'Invalid PFKey value'
        Return
     End If
 
     * Changes to keys 1 through 3.
     If %pfKeynumber le 3 Then
        %pf1String = $substr(%pf1String,1,(%pfKeyNumber*13)-13) with -
                     $substr($unblank(%pfKeyString) with '             ',1,13) with -
                     $substr(%pf1String,(%PfKeyNumber*13)+1)
        If %this:pfKeysAreOn eq True Then
           %this:pf1:value = %pf1String
        End If
 
     * Changs to 4,5 and 6.
     ElseIf $OneOf(%pfKeynumber,'4/5/6','/') Then
        %pf1String = $substr(%pf1String,1,(%pfKeyNumber*13)-13) with ' ' with -
                     $substr($unblank(%pfKeyString) with '             ',1,12) with -
                     $substr(%pf1String,(%PfKeyNumber*13)+1)
        If %this:pfKeysAreOn eq True Then
           %this:pf1:value = %pf1String
        End If
 
     * Changes to the bottom PF Key line.
     Else
        %pf2String = $substr(%pf2String,1,((%pfKeyNumber-6)*13)-13) with -
                     $substr($unblank(%pfKeyString) with '             ',1,13) with -
                     $substr(%pf2String,(%PfKeyNumber*13)+1)
        If %this:pfKeysAreOn eq True Then
           %this:pf2:value = %pf2String
        End If
     End If
 
  End Subroutine
 
  * Update the msg.
  Subroutine setMsg (%msg longString)
 
     If %msg eq '' Then
        %this:messageLine:value = $pad('-','-',%this:columns)
        %this:commandLine:color = white
        %this:messageLine:color = white
     Else
        %this:messageLine:value = $pad(' ' with %msg with ' ','-',%this:columns - 2)
        %this:commandLine:color = red
        %this:messageLine:color = red
     End If
 
  End Subroutine
 
  Function PFKeysVisible Enumeration Boolean callable
     * If the PF Keys are already visible, ignore the request.
     %msgCol       is Fixed
     %msgCol       = %this:columns - 2
     %messageLine  = %this:addField(row=%this:msgRow, column=2, width=%msgCol, color=blue)
     %pf1 = %this:addField(row=%this:msgRow + 1, column=2, width=%msgCol, color=blue)
     %pf2 = %this:addField(row=%this:msgRow + 2, column=2, width=%msgCol-1, color=blue)
     %this:pf1:value   = %pf1String
     %this:pf2:value   = %pf2STring
     %this:PFKeysAreOn = True
     Return True
  End Function
 
  Function PFKeysInvisible Enumeration Boolean callable
     * If the PF Keys are already invisible, ignore the request.
     %msgRow       is Fixed
     %msgCol       is Fixed
     %msgRow       = %this:rows
     %msgCol       = %this:columns - 3
     %appEndRow    = %this:rows - 1
     %maxApp       = %maxApp + 2
     %messageLine  = %this:addField(row=%msgRow, column=2, width=%msgCol, color=blue)
     %this:PFKeysAreOn = True
     Return True
  End Function
 
 * Reserve the top "application" row for header content, and set it.
 * --------------------------------------------------------------- *
  Subroutine setHeader(%header longString)
     * if the header is not already on, reserve the space.
     If %this:headerIsOn eq False Then
        %appStartRow  = %appStartRow + 1
        %maxApp       = %maxApp - 1
     End If
     %headerLine = %this:addField(row=3, column=2, width=%this:columns-2, -
                   color=white, value=%header)
     %this:headerIsOn = True
  End Subroutine
 
 * Turn on the scale.
 * ------------------------------------- *
  Subroutine scaleOn(%lCol Fixed)
     * If the scale is already on, just ignore the request.
     If %this:scaleIsOn eq True Then
        Return
     End If
     %appStartRow  = %appStartRow + 1
     %maxApp       = %maxApp - 1
     %lCol         = $max(%lCol,1)
     %scaleLine is string len 255
     %scaleLine = '|...+....1....+....2....+....3....+....4....+....5' with -
                  '....+....6....+....7....+....8....+....9....+...10' with -
                  '....+...11....+...12....+...13....+...14....+...15' with -
                  '....+...16....+...17....+...18....+...19....+...20' with -
                  '....+...21....+...22....+...23....+...24....+...25....'

     %scale = %this:addField(row=3, column=2, width=%this:columns-2, -
                color=blue, value=$substr(%scaleLine,%lCol))
     %this:scaleIsOn = True
  End Subroutine
 
 End Class


==References==

The Janus SOAP manual in PDF format: http://sirius-software.com/maint/download/jansoapr.pdf

The [[Screen class]] page on the Sirius Wiki.

The [[Screenfield class]] page on the Sirius Wiki.

[[Screen Object Sample Code]]

How to use [[Mod6 Screen|Model 6]], or [[Mod6 Screens|Dynamically Sized screens]] in Model 204.

[[Conventions and terminology]] used in Sirius Software technical documentation.