Screen class using object-oriented syntax

The following example shows how the Sirius Screen classes can be used to create your own locally-defined screen class using object-oriented 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 can be (and 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, command-line, pfKey definitions, 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 classes page
• Screen object sample code
• How to use Model 6, or Dynamically Sized screens in Model 204
• Notation conventions used in Janus SOAP documentation