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 on the Sirwiki
- Screen object sample code
- How to use Model 6, or Dynamically Sized screens in Model 204
- Notation conventions used in Janus SOAP documentation