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-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 class page on the Sirius Wiki.

The Screenfield class page on the Sirius Wiki.

Screen Object Sample Code

How to use Model 6, or Dynamically Sized screens in Model 204.

Conventions and terminology used in Sirius Software technical documentation.