-- Em3270BufferPack.Mesa
-- Revised for Star 3.3L by Lui: 13-Jul-84 15:40:17
-- Owner: Terminal Emulation
-- Em3270BufferPack implements the buffer manager software for the 3270 emulation. The buffer consists of 16-bit OIS format characters. The IBM 3270-format attribute characters are stored directly in the buffer, and are distinguished from other characters by the following format. The attribute parameters are stored in the high-order byte, and a "WSStringDefs.byteAttributesEsc" character is stored in the low-order byte. The "current" position in the buffer is retained in "my.bufferAddress[keyMode]" and "my.bufferAddress[hostMode]", where the former defines the location where the next keyboard input is written, and the latter defines where the next character sent by the host will be written. The host and keyboard processes of the same instance of the buffer are prevented from accessing the buffer at the same time by using the synchronization routines "Reserve" and "Release". --
DIRECTORY
CharADefs USING [Codes0],
CharDefs USING [Char, Chset, Code, RenderingSet360, Roman, UpperCase],
Em3270BufferDefs,
Em3270PrivDefs,
Process USING [EnableAborts],
SchemaDefs USING [Lschema,lschemaNil],
StandardDefs USING [Bv],
VDTDefs USING [EraseChars, EraseScreen, LptCharSeq,LschemaVDT, RewriteBlock, SetCursorPos, -- CRShape, GetCursorShape, SetCursorShape, ??? -- WriteChar,WriteBlock],
WSStringDefs USING [byteAttributesEsc],
ZoneMgrDefs USING [GetPredefinedZone];
Em3270BufferPack: MONITOR LOCKS my USING my:LptBufferData
IMPORTS CharDefs,Process, VDTDefs, ZoneMgrDefs
EXPORTS Em3270BufferDefs,Em3270PrivDefs
SHARES Em3270BufferDefs =
BEGIN OPEN Em3270BufferDefs,Em3270PrivDefs, StandardDefs;
-- ===========================
-- Constants --
-- ===========================
attributeCode: CharDefs.Code =
LOOPHOLE[WSStringDefs.byteAttributesEsc,CharDefs.Code];
initialAttrib: AttributeParams = [FALSE, FALSE, FALSE, regularNoSel, FALSE,FALSE];
duplicateChar: CharDefs.Char = CharDefs.RenderingSet360[ibmDup];
fieldMarkChar: CharDefs.Char = CharDefs.RenderingSet360[ibmFm];
nullChar: CharDefs.Char = CharDefs.Roman[null];
-- ===========================
-- Global Types
-- ===========================
AttribChar: TYPE = MACHINE DEPENDENT RECORD[ -- bit 7 is LSB --
unused(0:0..1):CARDINAL[0..3] ← 0,
protected(0:2..2): CARDINAL[0..1] ← 0, -- protected vs. unprotected field
numeric(0:3..3): CARDINAL[0..1] ← 0, -- numeric vs. alphameric field
visibility(0:4..5): CARDINAL[0..3] ← 0, -- displayibility and light pen Attributes --
reserved(0:6..6): CARDINAL[0..1] ← 0, -- always 0 --
modified(0:7..7): CARDINAL[0..1] ← 0 -- Modified data field flag --];
AttributeParams: TYPE = MACHINE DEPENDENT RECORD[ -- bit 7 is LSB --
unused(0:0..1):Bv ← FALSE,
protected(0:2..2): Bv ← FALSE, -- protected vs. unprotected field
numeric(0:3..3): Bv ← FALSE, -- numeric vs. alphameric field
visibility(0:4..5): Visibility ← regularNoSel, -- displayibility and light pen Attributes --
reserved(0:6..6): Bv ← FALSE, -- always 0 --
modified(0:7..7): Bv ← FALSE -- Modified data field flag --];
Buffer:TYPE = ARRAY [0..bufferSize) OF CharDefs.Char;
BufferAddress: TYPE = ARRAY AccessMode OF CharPos;
BufferData: PUBLIC TYPE = MONITORED RECORD [ -- vars. for each buffer instance --
buffer:LptBuffer ← NIL, -- pointer to the buffer --
lptToTransFile: BaseOISToEFile ← NIL, -- ptr to EBCDIC translation file, note this ptr is language dependent --
bufferAddress: BufferAddress ← ALL[0], -- cursor and CBA --
lschemaVDT: VDTDefs.LschemaVDT ← SchemaDefs.lschemaNil, -- VDT handle --
bufferFree: CONDITION, -- signals buffer is free --
bvIsFormatted: Bv ← FALSE,
currentAttributePosition: CharPos ← 0,
currentAttrib: AttributeParams ← initialAttrib,
-- saveCursorShape: VDTDefs.CRShape,??? --
reservation: Reservation ← unreserved,
savedAttributePosition: CharPos ← 0,
savedAttrib: AttributeParams ← initialAttrib];
EraseOperation: TYPE = {eraseAllUnprotected, eraseInputKey};
LptBuffer: TYPE = LONG POINTER TO Buffer;
LptBufferData: TYPE = LONG POINTER TO BufferData;
Reservation: TYPE = {reserved,unreserved};
-- ===========================
-- Global Variables --
-- ===========================
sessionZone: UNCOUNTED ZONE ← ZoneMgrDefs.GetPredefinedZone[session];
-- ===========================
--Synchronization Routines --
-- ===========================
Reserve: PUBLIC ENTRY PROCEDURE [my: LptBufferData] =
-- This entry procedure is used to lock out any calls to the buffer manager by a procedure other than the one which called 'Reserve' originally. When 'Release' is called later, the 'unreserved' variable is BROADCASTed, and the buffer is unlocked. The 'Reserve' and 'Release' procs are used to lock out the host and keyboard of a single instance of the emulator from each other. Processes relating to other instances of the emulator are not locked out. Any 'host' or 'keyboard' actions which change the buffer data should be surrounded by the Reserve-Release pair. --
BEGIN
ENABLE UNWIND => NULL;
WHILE my.reservation = reserved DO WAIT my.bufferFree ENDLOOP;
my.reservation ← reserved;
-- my.saveCursorShape ← VDTDefs.GetCursorShape[my.lschemaVDT]; ??? --
-- VDTDefs.SetCursorShape[my.lschemaVDT,invisible]; ??? --
END;
Release: PUBLIC ENTRY PROCEDURE [my: LptBufferData] =
-- This entry procedure BROADCASTs the 'unreserved' condition variable. This unlocks the buffer. --
BEGIN
-- SetBufferAddress[my,my.bufferAddress[keyMode]]; ??? --
-- VDTDefs.SetCursorShape[my.lschemaVDT,my.saveCursorShape]; ???--
my.reservation ← unreserved;
BROADCAST my.bufferFree;
END;
-- ===========================
-- Procedures --
-- ===========================
BackSpaceKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the back-space key. It causes the cursor to move one position to the left on the screen. The cursor may be moved into any character location, including unprotected and protected alphameric character and attribute character locations. If the cursor is in the first position of a line, the back-space causes the cursor to be positioned in the last position of the previous line. If the cursor is location 0 then it will move to the last position in the buffer. --
BEGIN
DecBufferAddress[my,keyMode];
SetCursor[my,my.bufferAddress[keyMode]];
END; -- BackSpaceKey --
BackTabKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the back-tab key. When the cursor is located in the attribute character position or the first alphameric character location of an unprotected data field or in any character location of a protected data field, this key moves the cursor to the first alphameric character location of the first preceding unprotected data field. When the cursor is located in any alphameric character location of an unprotected data field other than the first location, this key moves the cursor to the first alphameric character location of that field. In a display with no unprotected fields, the cursor is repositioned to character location 0. The cursor wraps from the beginning of the first line on the display and continues at the end of the last line if necessary.--
BEGIN
attribPos: CharPos;
stopPos: CharPos;
IF ~my.bvIsFormatted THEN
BEGIN
SetCursor[my,0];
RETURN;
END;
attribPos ← GetAttributeParams[my,my.bufferAddress[keyMode]].attribPos;
stopPos ← attribPos;
IF ~my.currentAttrib.protected THEN
IF ~IsAttribute[my,my.bufferAddress[keyMode]] THEN
BEGIN
DecBufferAddress[my,keyMode];
IF ~IsAttribute[my,my.bufferAddress[keyMode]] THEN
BEGIN
SetCursor[my,IncAndWrap[attribPos]];
RETURN;
END;
END;
DO -- set up & search for prev. attribute --
my.bufferAddress[keyMode] ← DecAndWrap[attribPos];
attribPos ← GetAttributeParams[my,my.bufferAddress[keyMode]].attribPos;
IF ~my.currentAttrib.protected AND ~IsAttribute[my,IncAndWrap[attribPos]] THEN
BEGIN
SetCursor[my,IncAndWrap[attribPos]];
RETURN;
END;
IF attribPos = stopPos THEN
BEGIN
SetCursor[my,0];
RETURN;
END;
ENDLOOP;
END; -- BackTabKey --
ClearBuffer: PUBLIC PROCEDURE [my:LptBufferData] =
-- The entire buffer is filled with null characters. The host buffer address and the cursor are set to 0. The caller should call 'DisplayBuffer' to update screen, since this routine will not. --
BEGIN
index: CharPos;
FOR index IN [0..bufferSize) DO
my.buffer[index] ← nullChar
ENDLOOP;
SetBufferAddressAndCursor[my,0];
my.bvIsFormatted ← FALSE; -- buffer is unformatted --
END; -- ClearBuffer --
ClearBufferAndScreen: PROCEDURE [my:LptBufferData] =
-- The entire buffer is filled with null characters. The cursor is set to 0, and the screen is cleared. --
-- This procedure is currently not used.
BEGIN
index: CharPos;
FOR index IN [0..bufferSize) DO
my.buffer[index] ← nullChar
ENDLOOP;
my.bufferAddress[keyMode] ← 0;
VDTDefs.EraseScreen[my.lschemaVDT]; -- sets cursor to 0 on screen, too. --
my.bvIsFormatted ← FALSE; -- buffer is unformatted --
END; -- ClearBufferAndScreen --
ClearOrSetModified: PROCEDURE [my:LptBufferData,attribPos:CharPos,bvNewBit:Bv] = INLINE
-- Set the 'modified' bit in buffer location 'attribPos' and the 'modified' parameter in the current attribute params to 'bvNewBit'. If the buffer is unformatted, then nothing happens --
BEGIN
IF ~my.bvIsFormatted THEN RETURN;
my.currentAttrib.modified ← bvNewBit;
LOOPHOLE[my.buffer[attribPos].chset,AttribChar].modified ← IF bvNewBit THEN 1 ELSE 0;
END; -- ClearOrSetModified --
Create: PUBLIC PROCEDURE [lschemaVDT:VDTDefs.LschemaVDT, lptToTransFile:BaseOISToEFile] RETURNS [my: LptBufferData] =
-- Allocates storage for the variables associated with a buffer instance. Returns a pointer to this storage. Also fills buffer with nulls, set CBA and cursor to 0, clears insert-mode flag. Enables aborts. --
BEGIN
my ← sessionZone.NEW[BufferData ← [lptToTransFile: lptToTransFile, lschemaVDT:lschemaVDT]]; -- init pointer and instance data --
my.buffer ← sessionZone.NEW[Buffer ← ALL[nullChar]]; -- pointer to buffer instance --
-- StartCursorProcess[]; ??? --
Process.EnableAborts[@my.bufferFree];
END; -- Create --
DecAndWrap: PROCEDURE[currentPos: CharPos] RETURNS [newPos: CharPos] = INLINE
-- Decrement 'currentPos' with wrap around --
BEGIN
IF currentPos = 0
THEN RETURN[bufferSize-1]
ELSE RETURN[currentPos-1]
END; -- DecAndWrap --
DecBufferAddress: PROCEDURE [my: LptBufferData,aMode: AccessMode] = INLINE
BEGIN
IF my.bufferAddress[aMode] = 0
THEN my.bufferAddress[aMode] ← bufferSize-1
ELSE my.bufferAddress[aMode] ← my.bufferAddress[aMode]-1
END;
DeleteKey: PUBLIC PROCEDURE [my:LptBufferData] RETURNS [aStatus:WriteError ← okay] =
-- Implements delete key. If the cursor is located in an alphameric character location in an unprotected field, deletes the character from the location identified by the cursor. Sets the 'modified' parameter for the field. The cursor does not move. All remaining characters in the unprotected field, to the right of the cursor and on the same row, will shift one character location to the left. Vacated character locations at the end of the row will be filled with nulls. If the unprotected field encompasses more than one row, characters in row other than the row identified by the cursor will not be affected. If the cursor is located in an attribute location or is within a protected data field, the keyboard is disabled, no character locations are cleared, the cursor is not moved, and the MDT bit is not set. --
BEGIN
attribPos,index,lastPos:CharPos;
IF IsAttribute[my,my.bufferAddress[keyMode]] THEN RETURN[attribute];
attribPos ← GetAttributeParams[my,my.bufferAddress[keyMode]].attribPos; -- unprotected, if no attribs found -
IF my.currentAttrib.protected THEN RETURN[protected];
ClearOrSetModified[my,attribPos,TRUE]; -- actually set bit in attrib. --
-- 'lastPos' is set to end of line or next Attribute pos. whichever comes first.
-- If no attribs are found in line, 'FindNextAttribute' is set to 'bufferSize',
-- which is past end of line,so 'lastPos' would be set to end of line, as desired.
lastPos ← MIN[DecAndWrap[FindNextAttribute[my,my.bufferAddress[keyMode],NextLine[my.bufferAddress[keyMode]]]],DecAndWrap[NextLine[my.bufferAddress[keyMode]]]];
FOR index IN [my.bufferAddress[keyMode]..lastPos)
DO
my.buffer[index] ← my.buffer[index+1];
ENDLOOP;
my.buffer[lastPos] ← nullChar;
DisplayBlock[my,my.bufferAddress[keyMode],lastPos+1-my.bufferAddress[keyMode],
FALSE]; -- update display, cursor doesn't move --
END; -- DeleteKey --
Destroy: PUBLIC PROCEDURE [my: LptBufferData] =
-- Frees storage allocated for the variables associated with a buffer instance. --
BEGIN
sessionZone.FREE[@my.buffer];
sessionZone.FREE[@my];
END; -- Destroy --
DisplayBlock:PROCEDURE[my:LptBufferData,firstPos: CharPos,n: CharPos,
bvCursorMove:Bv ← TRUE] =
-- Displays a block of 'n' characters starting at 'firstPos' according to the visibility attributes. If the block wraps around the end of the buffer, two calls to VDTDefs are made. IF 'bvCursorMove' is FALSE, the cursor doesn't move. --
BEGIN
IF firstPos + n > bufferSize THEN
SELECT my.currentAttrib.visibility FROM
invisible =>
BEGIN
VDTDefs.EraseChars[my.lschemaVDT,firstPos,bufferSize-firstPos,bvCursorMove];
VDTDefs.EraseChars[my.lschemaVDT,0,n-(bufferSize-firstPos),bvCursorMove];
END;
intense =>
BEGIN
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,bufferSize-firstPos,bvCursorMove,TRUE];
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
0,n-(bufferSize-firstPos),bvCursorMove,TRUE];
END;
ENDCASE =>
BEGIN
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,bufferSize-firstPos,bvCursorMove,FALSE];
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
0,n-(bufferSize-firstPos),bvCursorMove,FALSE];
END
ELSE
SELECT my.currentAttrib.visibility FROM
invisible => VDTDefs.EraseChars[my.lschemaVDT,firstPos,n,bvCursorMove];
intense =>
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,n,bvCursorMove,TRUE];
ENDCASE =>
VDTDefs.WriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,n,bvCursorMove,FALSE];
END; -- DisplayBlock --
DisplayBuffer: PUBLIC PROCEDURE [my: LptBufferData] =
-- Used to update the display. (to accurately reflect a possibly updated buffer.) Attribute character and non-displayable fields appear as blanks on the screen. Upon return, the current buffer address (cursor) is unchanged. --
BEGIN
saveCursor: CharPos ← my.bufferAddress[keyMode];
attribPos: CharPos ← 0;
my.bufferAddress[keyMode] ← 0;
SaveAttributeParams[my];
DO
IF IsAttribute[my,my.bufferAddress[keyMode]] THEN
BEGIN
SetAttributeParams[my,my.bufferAddress[keyMode]];
VDTDefs.EraseChars[my.lschemaVDT,my.bufferAddress[keyMode],1,FALSE];-- don't display attrib, don't move cursor --
IncBufferAddress[my,keyMode];
IF my.bufferAddress[keyMode] = 0 THEN GOTO DoReturn; -- attrib was in last loc. --
END
ELSE [] ← GetAttributeParams[my,my.bufferAddress[keyMode]]; -- wasn't an attribute (1st time only) --
attribPos ← FindNextAttribute[my,my.bufferAddress[keyMode],0]; -- search to end of buffer, no wrap-around
-- returns 'bufferSize' if none found.
ReDisplayBlock[my,my.bufferAddress[keyMode],attribPos-my.bufferAddress[keyMode],FALSE];
IF attribPos = bufferSize THEN GOTO DoReturn;
my.bufferAddress[keyMode] ← attribPos; -- point to next attrib., now loop --
REPEAT
DoReturn =>
BEGIN
SetCursor[my,saveCursor];
RestoreAttributeParams[my];
END;
ENDLOOP;
END; -- DisplayBuffer --
DisplayChar: PROCEDURE[my:LptBufferData,aChar:CharDefs.Char,
bvCursorMove:Bv ← TRUE] =
-- Displays the character at the appropriate current buffer address according to the visibility attributes. IF 'bvCursorMove' is FALSE, the cursor doesn't move. --
BEGIN
SELECT my.currentAttrib.visibility FROM
invisible =>
VDTDefs.EraseChars[my.lschemaVDT,my.bufferAddress[keyMode],1,bvCursorMove];
intense=> VDTDefs.WriteChar[my.lschemaVDT,my.bufferAddress[keyMode],aChar,bvCursorMove,TRUE];
ENDCASE => VDTDefs.WriteChar[my.lschemaVDT,my.bufferAddress[keyMode],aChar,bvCursorMove,FALSE];
END; -- DisplayChar --
DuplicateKey: PUBLIC PROCEDURE [my:LptBufferData]
RETURNS [aStatus: WriteError ← okay] =
-- Implements the duplicate key. It causes a unique character code to be entered into the buffer, a Tab key operation to be performed, and the MDT bit to be set to TRUE. (in PutChar) The DUP character, when stored in a device buffer, is displayed as an asterisk with an overscore. Operation of this key when the cursor is located in an attribute character location or is within a protected data field disables the keyboard; no character locations are cleared, the cursor is not moved, and the MDT bit is not set. --
BEGIN
RETURN[PutChar[my,duplicateChar]]; -- PutChar will take it from here. --
END; -- DuplicateKey --
EnumAllFieldsAndNulls:PUBLIC PROCEDURE[my:LptBufferData,pvFieldAndNullsHit:PvFieldAndNullsHit] =
-- This procedure calls a user-specified procedure to process each sequence of an attribute followed by all the text and/or nulls up to the next attribute. If the first field in the buffer is not preceded by an attribute, information concerning all the text up to, but not including the next attribute is passed for that call. This is meant to be called by 'MakeDocument' to capture a copy of the buffer data. (includes nulls). --
BEGIN
startPos:CharPos ← 0;
attribPos,oldAttribPos:CharPos;
attribPos ← FindNextAttribute[my,0,0];
[] ← GetAttributeParams[my,0]; -- set up current attrib params --
IF attribPos # 0 THEN -- 1st text block doesn't start with attribute --
BEGIN
pvFieldAndNullsHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],0,attribPos,FALSE,
my.currentAttrib.visibility];
IF attribPos = bufferSize THEN RETURN; -- was unformatted buffer --
END;
DO
IF attribPos = bufferSize - 1 THEN
BEGIN -- attrib in last loc. of buffer --
SetAttributeParams[my,attribPos]; -- set params just to be consistent --
pvFieldAndNullsHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],attribPos,1,TRUE,
my.currentAttrib.visibility];
RETURN;
END;
startPos ← attribPos;
oldAttribPos ← attribPos;
SetAttributeParams[my,oldAttribPos]; -- params according to preceding attrib --
attribPos ← FindNextAttribute[my,IncAndWrap[attribPos],0];
pvFieldAndNullsHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],startPos,attribPos-oldAttribPos,TRUE,my.currentAttrib.visibility];
IF attribPos = bufferSize THEN RETURN;
ENDLOOP;
END; -- EnumAllFieldsAndNulls --
EnumFields: PUBLIC PROCEDURE[my:LptBufferData,pvFieldHit:PvFieldHit,clientData:MDTStream,bvAll:Bv ← FALSE, accessMode: AccessMode ← keyMode] RETURNS [newClientData:MDTStream] =
-- This procedure calls a user-specified procedure to process each sequence of non-nulls. This is used to implement the 'Read-Modified' command, and the nulls are suppressed, since the host does not want them. The search for modified-fields end when the last buffer location is checked. If the last modified field wraps around the end of the buffer, the operation terminates after all the data in the field is transferred, and the buffer address at the end of the operation is the address of the next attribute in the buffer. (For an unformatted buffer it will be 0). If the last field wraps around, but was not modified, then the buffer address upon return is 0. If 'bvAll' is TRUE, all fields are considered, if FALSE, only modified fields. Defaults to just considering modified fields. --
-- If the accessMode is hostMode the search for modified fields begins at the CBA if the buffer is formatted. User generated read modified starts from 0, host generated read modified can start at any place. But where the search ends are the same for both. If the buffer is unformatted, the search always begins at 0 regardless of of who generated the RM.
BEGIN
ProcessField: PROCEDURE[attribPos:CharPos] RETURNS [CharPos] =
-- For each field, the first time that 'pvFieldHit' is called, 'bvIsNewField' is TRUE. For all subsequent runs of text in the field, 'bvIsNewField' is FALSE. Each time 'pvFieldHit' is called, 'startPos' points to the 1st char. in the text run. (the attrib. is not sent) --
BEGIN
nextPos,nextAttrPos: CharPos;
startPos: CharPos ← attribPos;
bvIsNewField ← TRUE;
SetAttributeParams[my,startPos];
startPos ← IncAndWrap[startPos]; -- skip attrib for process'g --
nextAttrPos ← FindNextAttribute[my,startPos,startPos];
IF ~bvAll AND ~my.currentAttrib.modified THEN RETURN[nextAttrPos];
DO --
[nextPos,bvAnyNulls] ← NextNull[my,startPos,nextAttrPos];
IF nextPos < startPos THEN -- process wrapped field --
BEGIN
newClientData ← pvFieldHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],startPos,bufferSize - startPos,newClientData,bvIsNewField, my.lptToTransFile];
bvIsNewField ← FALSE;
IF nextPos > 0 THEN newClientData ← pvFieldHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],0,nextPos,newClientData,bvIsNewField, my.lptToTransFile];
END
ELSE
BEGIN -- process field of length >= 0 --
newClientData ← pvFieldHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],startPos,nextPos - startPos,newClientData,bvIsNewField, my.lptToTransFile];
bvIsNewField ← FALSE;
END;
IF ~bvAnyNulls THEN RETURN[nextPos];
[nextPos,bvAnyNonNulls] ← NextNonNull[my,nextPos,nextAttrPos]; -- search starts at null char --
IF ~bvAnyNonNulls THEN RETURN[nextPos];
startPos ← nextPos;
ENDLOOP;
END; -- ProcessField --
EnumUnformatted: PROCEDURE =
-- For Unformatted buffers --
BEGIN
nextPos:CharPos;
startPos:CharPos ← 0;
DO
[nextPos,bvAnyNonNulls] ← NextNonNull[my,startPos,0]; -- find some text --
IF ~bvAnyNonNulls THEN RETURN; -- all nulls in buffer --
startPos ← nextPos; -- beginning of text --
[nextPos,bvAnyNulls] ← NextNull[my,startPos,0]; -- At this point there are text that have not been send in buffer.
IF ~bvAnyNulls THEN -- If bvAnyNulls is true then we are at end of buffer
BEGIN -- reach end of buffer, send all unsend text then return to caller
newClientData ← pvFieldHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],startPos,bufferSize-startPos,newClientData,FALSE, my.lptToTransFile];
RETURN;
END
ELSE
BEGIN -- have not reach the end of buffer yet.
newClientData ← pvFieldHit[LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],startPos,nextPos-startPos,newClientData,FALSE, my.lptToTransFile];
startPos ← nextPos; -- set up for next search --
END;
ENDLOOP;
END; -- EnumUnformatted --
bvAnyNulls, bvAnyNonNulls:Bv;
bvIsNewField:Bv ← TRUE;
attribPos, startPos:CharPos ← 0;
firstFieldPos:CharPos;
newClientData ← clientData;
IF ~my.bvIsFormatted THEN
BEGIN
my.bufferAddress[hostMode] ← 0; -- default upon return, if no wrapped-mod. field --
EnumUnformatted[]; -- no attributes --
RETURN;
END;
-- figured out where to stop by finding the first attribute in the buffer starting at location 0;
attribPos ← FindNextAttribute[my,attribPos,attribPos];
firstFieldPos ← attribPos;
-- figure out where to start to gather data to send to the host.
startPos ← IF accessMode = hostMode THEN my.bufferAddress[hostMode] ELSE 0;
attribPos ← FindNextAttribute[my,startPos,0];
-- we will find an attribute if we are in keyMode(ie. the stopPos above). but if we are in hostMode and there are only one attr in the buffer, we are not going to find another one. so:
IF (accessMode = hostMode) AND (attribPos = bufferSize) THEN RETURN; -- we are in hostMode and there aren't any modified field(starting at he current buffer address) in the buffer. Note the CBA remains unchanged.
my.bufferAddress[hostMode] ← 0; -- default upon return, if no wrapped-mod. field --
IF attribPos # 0 THEN -- set up return value for CBA --
BEGIN
[] ← SetAttributeParams[my,attribPos]; -- sets attribs for wrapped field --
IF bvAll OR my.currentAttrib.modified
THEN my.bufferAddress[hostMode] ← attribPos; -- considers wrapped field --
END;
DO
attribPos ← ProcessField[attribPos];
IF attribPos = firstFieldPos THEN EXIT; -- reached 1st attrib. again --
ENDLOOP;
END; -- EnumFields --
EraseAllUnprotected: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the Erase-All-Unprotected command. All the unprotected buffer character locations are filled with nulls. The MDT bit for each unprotected field is reset to 0. The cursor is repositioned to the 1st character location in the 1st unprotected field of the buffer. If no unprotected fields exist, the cursor is positioned to buffer location 0. --
BEGIN
my.bvIsFormatted ← IsFormatted[my];
EraseUnprotected[my,eraseAllUnprotected];
END; -- EraseAllUnprotected --
EraseEOFKey: PUBLIC PROCEDURE [my:LptBufferData]
RETURNS [aStatus: WriteError] =
-- Implements the Erase EOF key. If the cursor is located in an alphameric character location in an unprotected data field, this key clears the character location occupied by the cursor and all remaining character locations to the right in that field to nulls. The operation can wrap from the end of the last line on the display to the end of the field. ('EraseChars' must be called 2 times in this case.) The cursor does not move as a result of operating this key, and the MDT bit is set to 1. If the cursor is located in an attribute character location or is within a protected data field, an input-inhibit condition is caused, and the keyboard is disabled. (no character locations are cleared, the cursor is not moved, and the MDT bit is not set.) For unformatted buffers, all char locs from the cursor loc. to the end of the buffer are set to null. --
BEGIN
index,n: CharPos ← 0;
firstPos, currentPos: CharPos ← my.bufferAddress[keyMode];
IF IsAttribute[my,currentPos] THEN RETURN[attribute];
IF ~my.bvIsFormatted THEN
BEGIN
FOR index IN [firstPos..bufferSize)
DO
my.buffer[index] ← nullChar;
ENDLOOP;
VDTDefs.EraseChars[my.lschemaVDT,firstPos,bufferSize - firstPos,FALSE];
RETURN[okay];
END;
[] ← GetAttributeParams[my,currentPos];
IF my.currentAttrib.protected THEN RETURN[protected];
ClearOrSetModified[my,my.currentAttributePosition,TRUE];
DO
my.buffer[currentPos] ← nullChar;
currentPos ← IncAndWrap[currentPos];
n←n+1;
IF IsAttribute[my,currentPos] THEN
BEGIN
VDTDefs.EraseChars[my.lschemaVDT,firstPos,n,FALSE];
RETURN[okay];
END
ELSE
IF currentPos = 0 THEN
BEGIN
VDTDefs.EraseChars[my.lschemaVDT,firstPos,n,FALSE];
n←0;
firstPos←0;
END;
ENDLOOP;
END; --EraseEOFKey --
EraseInputKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the Erase Input key. This key clears all unprotected character locations to nulls, resets the MDT bit to 0 in unprotected fields, and repositions the cursor to the first unprotected character location on the screen. If the buffer does not contain any unprotected data fields, no character locations are cleared and the cursor is repositioned to character location 0. If the display contains no fields, the entire buffer is cleared to nulls and the cursor is repositioned to location 0. --
BEGIN
EraseUnprotected[my,eraseInputKey];
DisplayBuffer[my];
END; --EraseInputKey--
EraseUnprotected: PROCEDURE [my:LptBufferData, operation: EraseOperation] =
-- This procedure clears all unprotected character locations to nulls, resets the MDT bit to 0 in unprotected fields, and repositions the cursor to the first unprotected character location on the screen (for EraseInputKey), or to the 1st character location of the 1st unprotected field in the buffer. (for EraseAllUnprotected) If the buffer does not contain any unprotected data fields, no character locations are cleared and the cursor is repositioned to character location 0. If the display contains no fields, the entire buffer is cleared to nulls and the cursor is repositioned to location 0. Screen is not updated by this proc. (just cursor pos. on screen) --
BEGIN
SetCorrectCursor: PROCEDURE [firstUnprotectedPos: CharPos, operation:EraseOperation] =
-- For EraseInputKey, the cursor is set to the 1st unprotected char. loc. on screen. For EraseAllUnprotected, the cursor is set to the 1st unprotected char. loc. in the 1st unprotected field on the screen. (There is a difference only if there is a wrapped unprotected field.) --
BEGIN
IF (firstUnprotectedPos # 0) OR (operation = eraseInputKey) THEN
BEGIN
SetCursor[my, firstUnprotectedPos];
RETURN;
END;
my.bufferAddress[keyMode] ← 0;
TabKey[my]; -- there was a wrapped unprotected field. --
END; -- SetCorrectCursor --
bvFirstTime,bvFirstUnprotected:Bv ← TRUE;
index,firstUnprotectedPos: CharPos ← 0;
my.bufferAddress[keyMode] ← 0;
DO
IF IsAttribute[my,my.bufferAddress[keyMode]] THEN
IF my.bufferAddress[keyMode] = 0 THEN
BEGIN -- set attribs 1st, only if attrib is in loc. 0 --
SetAttributeParams[my,my.bufferAddress[keyMode]];
IncBufferAddress[my,keyMode];
END
ELSE
BEGIN -- was attrib, not in loc. 0 --
IF ~my.currentAttrib.protected
THEN ClearOrSetModified[my,my.currentAttributePosition,FALSE];
SetAttributeParams[my,my.bufferAddress[keyMode]]; -- params for this new attrib. --
IncBufferAddress[my,keyMode];
IF my.bufferAddress[keyMode] = 0 THEN
BEGIN
SetCorrectCursor[firstUnprotectedPos,operation]; -- actually update cursor --
RETURN;
END;
END
ELSE -- not an attribute --
BEGIN
IF bvFirstTime THEN
BEGIN
bvFirstTime ← FALSE;
IF ~GetAttributeParams[my,my.bufferAddress[keyMode]].anyAttribs THEN
BEGIN
FOR index IN [0..bufferSize) DO
my.buffer[index] ← nullChar
ENDLOOP;
SetCursor[my,0]; -- set cursor to 0 --
my.bvIsFormatted ← FALSE; -- buffer is unformatted --
RETURN;
END;
END;
IF ~my.currentAttrib.protected AND ~IsAttribute[my,my.bufferAddress[keyMode]] THEN
BEGIN
IF bvFirstUnprotected THEN
BEGIN
bvFirstUnprotected ← FALSE;
firstUnprotectedPos ← my.bufferAddress[keyMode]; -- 1st unprotected loc. --
END;
my.buffer[my.bufferAddress[keyMode]] ← nullChar;
END;
IncBufferAddress[my,keyMode];
IF my.bufferAddress[keyMode] = 0 THEN
BEGIN
IF ~my.currentAttrib.protected -- fix up last field --
THEN ClearOrSetModified[my,my.currentAttributePosition,FALSE];
SetCorrectCursor[firstUnprotectedPos,operation]; -- actually update cursor --
RETURN;
END;
END;
ENDLOOP;
END; -- EraseUnprotected --
EraseUnprotectedToAddress: PUBLIC PROCEDURE [my:LptBufferData,stopPosition: CharPos] =
-- This procedure inserts nulls in all unprotected buffer character locations, starting at the current buffer address and ending at, but not including, the specified stop address. When the stop address is lower than the current buffer address, this operation wraps from the bottom row of the buffer to the top row. When the stop address equals the current address, all unprotected character locations in the buffer are erased. Attribute characters are not affected. If there are no fields, then nothing is done. 'DisplayBuffer' must be called to update the screen, if desired. --
BEGIN
IF IsFormatted[my]
THEN my.bvIsFormatted ← TRUE
ELSE my.bvIsFormatted ← FALSE;
IF ~my.bvIsFormatted THEN RETURN;
[] ← GetAttributeParams[my,my.bufferAddress[hostMode]];
DO
IF IsAttribute[my,my.bufferAddress[hostMode]]
THEN SetAttributeParams[my,my.bufferAddress[hostMode]]
ELSE
IF ~my.currentAttrib.protected THEN
BEGIN
my.buffer[my.bufferAddress[hostMode]] ← nullChar;
END;
IncBufferAddress[my,hostMode];
IF my.bufferAddress[hostMode] = stopPosition THEN RETURN;
ENDLOOP;
END; -- EraseUnprotectedToAddress --
FieldMarkKey: PUBLIC PROCEDURE [my:LptBufferData]
RETURNS [aStatus:WriteError ← okay] =
-- Implements the field-mark key. A unique character code is entered into the buffer at the current cursor location and the MDT bit for that field is set. (The buffer address is incremented also.) The field mark character is displayed as a ';' with a line over it. If the cursor is located in an attribute character location or is within a protected data field, the keyboard is disabled, no character locations are cleared, the cursor is not moved, and the MDT bit is not set. Note: if the buffer has no fields, the default attribute will specify an unprotected field, so the field mark is inserted, as required. (Setting the MDT bit is meaningless here.) --
BEGIN
RETURN[PutChar[my,fieldMarkChar]];-- write a field mark character into current loc. --
END; --FieldMarkKey --
FindNextAttribute: PUBLIC PROCEDURE [my:LptBufferData,currentPos:CharPos,
stopPos:CharPos←0]RETURNS [attribPos:CharPos] =
-- Searches the buffer for attribute characters, starting at 'currentPos', and proceeding up to (but not including) the position specified by 'stopPos'. If none are found, then 'attribPos' is set to 'bufferSize', which is the index past the end of the buffer., otherwise the index of the next attribute is returned in 'attribPos'. Upon return, the current buffer address is unchanged. --
BEGIN
DO
IF IsAttribute[my,currentPos] THEN RETURN[currentPos];
currentPos ← IncAndWrap[currentPos];
IF stopPos = currentPos THEN RETURN[bufferSize]; -- no attribs were found --
ENDLOOP;
END; -- FindNextAttribute --
GetAttributeParams: PROCEDURE [my:LptBufferData,currentPos:CharPos]
RETURNS [anyAttribs: Bv,attribPos: CharPos] =
-- This procedure searches for the closest preceding attribute byte and sets the attribute parameters according to this byte. The 'currentBufferAddress' does not change as a result of this call, but the location of the closest preceding attribute is returned in 'attribPos'. If no attribute bytes are found, then the current attributes are set to the default,the current attribute position is set to 'bufferSize', and 'anyAttribs' is set to FALSE. --
BEGIN
stopPos:CharPos ← currentPos;
DO
IF IsAttribute[my,currentPos] THEN
BEGIN
SetAttributeParams[my,currentPos];
RETURN[TRUE,currentPos];
END
ELSE
currentPos ← DecAndWrap[currentPos];
IF stopPos = currentPos THEN
BEGIN
my.currentAttrib ← initialAttrib;
RETURN[FALSE,bufferSize];
END;
ENDLOOP;
END; -- GetAttributeParams --
GetBufferAddress: PUBLIC PROCEDURE [my: LptBufferData,aMode: AccessMode]
RETURNS [CharPos] =
BEGIN RETURN[my.bufferAddress[aMode]] END;
GetCursor: PUBLIC PROCEDURE [my:LptBufferData] RETURNS [cursorPos:CharPos] =
-- Returns the current position of the cursor on the screen. --
BEGIN
RETURN[my.bufferAddress[keyMode]];
END; -- GetCursor --
HomeKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the home key. It moves the cursor to the first unprotected character position on the screen. If the buffer is unformatted or if the display has no unprotected data fields, the cursor is repositioned to character location 0.--
BEGIN
bvFirstTime:Bv ← TRUE;
currentPos: CharPos ← 0;
stopPos: CharPos;
IF ~my.bvIsFormatted THEN
BEGIN
SetCursor[my,0]; -- unformatted buffer, set cursor to 0. --
RETURN;
END;
stopPos ← GetAttributeParams[my,0].attribPos;
IF ~IsAttribute[my,0] AND ~my.currentAttrib.protected THEN
BEGIN
SetCursor[my,0];
RETURN;
END;
DO -- like TabKey from this point --
IF ~bvFirstTime AND currentPos = stopPos THEN GOTO noneFound;
currentPos ← FindNextAttribute[my,currentPos,stopPos];
IF bvFirstTime THEN bvFirstTime ← FALSE;
IF currentPos = bufferSize THEN GOTO noneFound;
SetAttributeParams[my,currentPos];
currentPos ← IncAndWrap[currentPos]; -- point to char after attrib --
IF IsAttribute[my,currentPos] THEN LOOP; -- 2 attribs in a row --
IF ~my.currentAttrib.protected THEN -- found unprotected field! --
BEGIN
SetCursor[my,currentPos]; -- 1st char loc of u/p field --
RETURN;
END;
REPEAT
noneFound => SetCursor[my,0]; -- no unprotected fields found --
ENDLOOP;
END; -- HomeKey --
IncAndWrap: PROCEDURE[currentPos: CharPos] RETURNS [newPos: CharPos] = INLINE
-- Increment 'currentPos' with wrap around --
BEGIN
IF currentPos = bufferSize-1
THEN RETURN[0]
ELSE RETURN[currentPos+1]
END; -- IncAndWrap --
IncBufferAddress: PROCEDURE [my: LptBufferData,aMode: AccessMode] = INLINE
BEGIN -- *** Inline later --
IF my.bufferAddress[aMode] = bufferSize-1
THEN my.bufferAddress[aMode] ← 0
ELSE my.bufferAddress[aMode] ← my.bufferAddress[aMode]+1
END; -- IncBufferAddress --
InsertCursor: PUBLIC PROCEDURE [my:LptBufferData] =
-- This order repositions the cursor to the location specified by the current buffer address. Execution of this order does not change the current buffer address. --
BEGIN
SetCursor[my,my.bufferAddress[hostMode]];
END; -- InsertCursor --
IsAttribute: PROCEDURE [my:LptBufferData,currentPos: CharPos] RETURNS [Bv] = INLINE
-- Returns TRUE if the buffer character in the position specified by 'currentPos' is an attribute character.
BEGIN
RETURN[IF my.buffer[currentPos].code = attributeCode THEN TRUE ELSE FALSE];
END; -- IsAttribute --
IsFormatted: PROCEDURE [my:LptBufferData] RETURNS [anyAttribs: Bv ← TRUE] =
-- Searches the entire buffer for attribute characters. If none are found, then 'anyAttribs'; is set to FALSE, otherwise it is TRUE. Upon return the current buffer address is unchanged.
BEGIN
index: CharPos;
FOR index IN [0..bufferSize)
DO
IF IsAttribute[my,index] THEN RETURN;
ENDLOOP;
RETURN[FALSE];
END; -- IsFormatted --
IsNumeric: PROCEDURE [my:LptBufferData,aChar: CharDefs.Char]
RETURNS [bvNumeric: Bv ← FALSE] =
<<
The legal inputs for a 'numeric' field is defined to be all uppercase characters and symbols for a typewriter keyboard. It is all characters for a data-entry keyboard. Ref: IBM manual 2-17. Numeric Lock Feature Operation. It is unclear if IBM's definition for typewriter keyboard means #1) only keys in the "shifted" position on the real IBM keyboard can be entered or #2) only "uppercase characters" can be entered. We chose to implement #2, only "uppercase characters" can be entered. What the hell, it is 50-50 either way. Those fucking shifty bastards at IBM are probably trying to confuse us on purpose.
Returns TRUE if the 'aChar' is a numeric character according to definition 2 above.
>>
BEGIN
OPEN CharADefs;
code0: Codes0 = LOOPHOLE[aChar.code];
IF aChar = duplicateChar THEN RETURN[TRUE];
SELECT code0 FROM
IN [digit0..digit9],period,hyphen => RETURN[TRUE];
ENDCASE => RETURN[aChar = CharDefs.UpperCase[aChar]];
END; -- IsNumeric --
Line: PROCEDURE[thisChar: CharPos] RETURNS [CARDINAL] =
-- Given a character position on the screen, this procedure returns the line number of the specified character. (The 1st line on the screen is line 0) --
BEGIN
RETURN[LOOPHOLE[thisChar, CARDINAL]/lineSize]
END; -- Line --
NewLineKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the newline key. It moves the cursor to the first unprotected character location of the next line. If the display has no unprotected data fields, the cursor is repositioned to character location 0. If the display contains no fields, the cursor is repositioned to the first character position of the next line. (The NewLineKey is similar to the TabKey, but for the fact that we start searching from the last column of the current line. ) --
<< AR 4574: The NewLine key/function, while implemented to the 3270 Componet spec, does not operate as it does in "the field" for the case where (1) the current position is anywhere on a given line, (2) there is an attribute character in the last column of that line that describes an unprotected field whose first displayable character appears in column 1 of the next line. When the NewLine key is pressed, the cursor does not move to column 1 of the next line (as it does for real 3270's), but instead, moves past that column-1-field and finds the next unprotected field.
This is because of the definition of where a field begins - is it where the attribute character is, or is it where the first displayable character begins. For the Star 3.0 3270 we choose the first definition. John Davison of Xerox in Webster NY actually called me about this problem and told me that IBM has actually implemented to the second definition.
I agree we should change to fit what actually is happening in the field. >>
BEGIN
nextLinePos: CharPos ← NextLine[my.bufferAddress[keyMode]];
IF my.bvIsFormatted THEN {
my.bufferAddress[keyMode] ←
IF nextLinePos = 0 THEN bufferSize-1 ELSE nextLinePos-1;
TabKey[my] -- updates cursor, too. --
}
ELSE {
my.bufferAddress[keyMode] ← nextLinePos;
SetCursor[my,my.bufferAddress[keyMode]]
};
END; -- NewLineKey --
NextLine: PUBLIC PROCEDURE[currentPos: CharPos] RETURNS [nextLinePos:CharPos] =
-- Given a character position on the screen, this procedure returns the character position of the first character on the next line.(1st char. on line 0, is 0; 1st char. on line 1, is lineSize.) Wraps around to 1st line for characters in last line of buffer. --
BEGIN
nextLinePos ← LOOPHOLE[lineSize, CharPos]*Line[currentPos] + lineSize;
IF nextLinePos = bufferSize THEN nextLinePos ← 0;
END; -- NextLine --
NextNonNull: PROCEDURE[my:LptBufferData,currentPos:CharPos,stopPos:CharPos]
RETURNS [nextPos:CharPos,anyNonNulls:Bv ← TRUE] =
-- Returns the position of the next non-null character in the buffer, starting at 'currentPos' and searching to the position of the next attribute (for formatted buffers) or through the entire buffer (for unformatted buffers). Upon return, if 'nextPos' is equal to the location of the next attribute, then only nulls were found. IF 'anyNonNulls' is FALSE, no nulls were found. --
-- Since it is possible to have contiguous attributes bytes, *currentPos* may start out being equal to *stopPos* and must be checked first.
BEGIN
UNTIL my.buffer[currentPos] # nullChar DO
currentPos ← IncAndWrap[currentPos];
IF currentPos = stopPos THEN GOTO noneFound;
REPEAT
noneFound => anyNonNulls ← FALSE;
ENDLOOP;
nextPos ← currentPos;
END; -- NextNonNull --
NextNull: PROCEDURE[my:LptBufferData,currentPos:CharPos,stopPos:CharPos]
RETURNS [nextPos:CharPos,anyNulls:Bv ← TRUE] =
-- Returns the position of the next null character in the buffer, starting at the current buffer address and searching to the position of the next attribute (for formatted buffers) or through the entire buffer (for unformatted buffers). Upon return, 'nextPos' is equal to the location of the next attribute, if no nulls were found. IF 'anyNulls' is FALSE, no nulls were found. --
-- Since it is possible to have contiguous attributes bytes, *currentPos* may start out being equal to *stopPos* and must be checked first.
BEGIN
UNTIL my.buffer[currentPos] = nullChar DO
currentPos ← IncAndWrap[currentPos];
IF currentPos = stopPos THEN GOTO noneFound;
REPEAT
noneFound => anyNulls ← FALSE;
ENDLOOP;
nextPos ← currentPos;
END; -- NextNull --
ProgramTab: PUBLIC PROCEDURE [my:LptBufferData,bvInsertNulls: Bv]
RETURNS [bvInsertingNulls: Bv ← FALSE] =
-- This order advances the current buffer address to the address of the first character position of the next unprotected field. If the PT is issued when the current buffer address is the location of an attribute byte of an unprotected field, the buffer address advances to the next location of that field. (one location.) If 'bvInsertNulls' is TRUE nulls are inserted in the buffer from the current buffer address to the end of the field, regardless of whether or not the current field is protected. If 'bvInsertNulls' is FALSE, then the buffer content is not modified for that field. The PT order stops its search at the last location in the buffer. If an attribute character for an unprotected field is not found by this point, the buffer address is set to location 0. (If the PT order finds an attribute character for an unprotected field in the last buffer location, the buffer address is also set to zero.) 'bvInsertingNulls' is set to TRUE if the PT order was still inserting nulls in each character location when it terminated. If a 2nd PT order follows, it should continue to insert nulls from buffer location 0 to the end of the current field. (if 'bvInsertingNulls' was TRUE , then 'bvInsertNulls' should be TRUE on next call.). --
BEGIN -- ProgramTab --
WHILE ~IsAttribute[my,my.bufferAddress[hostMode]] -- null rest of 1st field --
DO
IF bvInsertNulls THEN my.buffer[my.bufferAddress[hostMode]] ← nullChar;
IncBufferAddress[my,hostMode];
IF my.bufferAddress[hostMode] = 0 THEN
BEGIN
[] ← GetAttributeParams[my,my.bufferAddress[hostMode]];
RETURN[bvInsertNulls];
END;
ENDLOOP;
SetAttributeParams[my,my.bufferAddress[hostMode]]; -- found an attribute --
DO
WHILE my.currentAttrib.protected
DO
IncBufferAddress[my,hostMode];
IF my.bufferAddress[hostMode] = 0 THEN RETURN[FALSE];
IF IsAttribute[my,my.bufferAddress[hostMode]]
THEN SetAttributeParams[my,my.bufferAddress[hostMode]];
ENDLOOP;
IncBufferAddress[my,hostMode]; -- found unprotected field --
IF my.bufferAddress[hostMode] = 0 THEN RETURN[FALSE];
IF IsAttribute[my,my.bufferAddress[hostMode]]
THEN SetAttributeParams[my,my.bufferAddress[hostMode]]
ELSE EXIT; -- found unprotected field of non-zero length --
ENDLOOP;
END; -- ProgramTab --
PutChar: PUBLIC PROCEDURE [my:LptBufferData,aChar: CharDefs.Char,inputMode:InputStatus ← systemAvailable]
RETURNS [aStatus:WriteError ← okay] =
-- This procedure is called by the keyboard input processor. Overwriting attribute chars is not allowed. Writing into protected fields is not allowed. Writing a non-numeric character into a numeric field is illegal. Upon entry of a character into the last character location of an unprotected data field, the cursor is repositioned according to the attributes of the next field. If the next field is (1) alphameric & either unprotected or protected, or (2) numeric & unprotected, the cursor skips the attribute character & is positioned to the 1st character location in that field. If the field is numeric & protected, the cursor skips that field & is postioned to the 1st character location of the next unprotected field. If legal put, then set MDT bit for field. --
BEGIN
index,nChars,lastPos,stopPos: CharPos;
anyNulls:Bv;
IF IsAttribute[my,my.bufferAddress[keyMode]] THEN RETURN [attribute];
[] ← GetAttributeParams[my,my.bufferAddress[keyMode]];
IF my.currentAttrib.protected THEN RETURN [protected];
IF my.currentAttrib.numeric AND ~IsNumeric[my,aChar]
THEN RETURN[alphaInNumericField];
IF inputMode = insertMode THEN
BEGIN
IF my.bvIsFormatted
THEN stopPos ← FindNextAttribute[my,my.bufferAddress[keyMode],my.bufferAddress[keyMode]]
ELSE stopPos ← my.bufferAddress[keyMode];
[lastPos,anyNulls] ← NextNull[my,my.bufferAddress[keyMode], stopPos];
IF ~anyNulls THEN RETURN[noRoomInField];
IF lastPos < my.bufferAddress[keyMode]
THEN nChars ← lastPos + bufferSize - my.bufferAddress[keyMode]
ELSE nChars ← lastPos - my.bufferAddress[keyMode];
FOR index IN [0..nChars)
DO
my.buffer[lastPos] ← my.buffer[DecAndWrap[lastPos]];
lastPos ← DecAndWrap[lastPos];
ENDLOOP;
my.buffer[my.bufferAddress[keyMode]] ← aChar;
DisplayBlock[my,my.bufferAddress[keyMode],
nChars+1,FALSE];--update display,not cursor --
END
ELSE -- replace mode --
BEGIN
my.buffer[my.bufferAddress[keyMode]] ← aChar;
DisplayChar[my,aChar];
END;
ClearOrSetModified[my,my.currentAttributePosition,TRUE];
IF aChar = duplicateChar THEN
BEGIN
TabKey[my]; -- updates cursor, too. --
END
ELSE
BEGIN -- auto skip --
IncBufferAddress[my,keyMode]; -- inc. pointer --
DO -- handles 1 or more attribs in a row --
IF IsAttribute[my,my.bufferAddress[keyMode]] THEN
BEGIN
SetAttributeParams[my,my.bufferAddress[keyMode]];
IncBufferAddress[my,keyMode];
IF my.currentAttrib.protected AND my.currentAttrib.numeric THEN
BEGIN
TabKey[my]; -- find next unprotected field --
RETURN;
END;
END
ELSE GOTO foundOne;
REPEAT
foundOne => SetCursor[my,my.bufferAddress[keyMode]];
ENDLOOP;
END;
END; -- PutChar --
ReDisplayBlock:PROCEDURE[my:LptBufferData,firstPos: CharPos,n: CharPos,
bvCursorMove:Bv ← TRUE] =
-- Displays a block of 'n' characters starting at 'firstPos' according to the visibility attributes. If the block wraps around the end of the buffer, two calls to VDTDefs are made. IF 'bvCursorMove' is FALSE, the cursor doesn't move. Only chars. that have changed since displayed previously are redisplayed. --
BEGIN
IF firstPos + n > bufferSize THEN
SELECT my.currentAttrib.visibility FROM
invisible =>
BEGIN
VDTDefs.EraseChars[my.lschemaVDT,firstPos,bufferSize-firstPos,bvCursorMove];
VDTDefs.EraseChars[my.lschemaVDT,0,n-(bufferSize-firstPos),bvCursorMove];
END;
intense =>
BEGIN
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,bufferSize-firstPos,bvCursorMove,TRUE];
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
0,n-(bufferSize-firstPos),bvCursorMove,TRUE];
END;
ENDCASE =>
BEGIN
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,bufferSize-firstPos,bvCursorMove,FALSE];
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
0,n-(bufferSize-firstPos),bvCursorMove,FALSE];
END
ELSE
SELECT my.currentAttrib.visibility FROM
invisible => VDTDefs.EraseChars[my.lschemaVDT,firstPos,n,bvCursorMove];
intense =>
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,n,bvCursorMove,TRUE];
ENDCASE =>
VDTDefs.RewriteBlock[my.lschemaVDT,LOOPHOLE[my.buffer,VDTDefs.LptCharSeq],
firstPos,n,bvCursorMove,FALSE];
END; -- ReDisplayBlock --
RepeatToAddress: PUBLIC PROCEDURE [my:LptBufferData,aChar: CharDefs.Char, stopAddress: CharPos] =
-- This order stores the character specified by 'aChar' in all buffer locations, starting at the current buffer address and ending at (but not including) the specified stop address. Invalid stop addresses are detected by the command processor, so no error detection is required here. When the stop address is lower than the current buffer address, this operation wraps from the bottom row of the buffer to the top row. When the stop address equals the current address, the specified character is stored in all buffer locations. Attribute characters will be overwritten if they occur before the specified stop address. --
BEGIN
index: CharPos;
IF my.bufferAddress[hostMode] = stopAddress THEN
BEGIN
FOR index IN [0..bufferSize)
DO
my.buffer[index] ← aChar;
ENDLOOP;
END
ELSE
BEGIN
UNTIL my.bufferAddress[hostMode] = stopAddress
DO
my.buffer[my.bufferAddress[hostMode]] ← aChar;
IncBufferAddress[my,hostMode];
ENDLOOP;
END;
END; -- RepeatToAddress --
ResetAllModified: PUBLIC PROCEDURE [my:LptBufferData] =
-- All the MDT bits in the attribute bytes are cleared. --
BEGIN
index: CharPos;
FOR index IN [0..bufferSize)
DO
IF IsAttribute[my,index] THEN
LOOPHOLE[my.buffer[index].chset,AttribChar].modified ← 0;
ENDLOOP;
END; -- ResetAllModified --
ResetAllUnprotectedModified: PUBLIC PROCEDURE [my:LptBufferData] =
-- All the MDT bits in the attribute bytes of unprotected fields are cleared. --
BEGIN
index: CharPos;
FOR index IN [0..bufferSize)
DO
IF IsAttribute[my,index] AND (LOOPHOLE[my.buffer[index].chset,AttribChar].protected = 0)
THEN LOOPHOLE[my.buffer[index].chset,AttribChar].modified ← 0;
ENDLOOP;
END; -- ResetAllUnprotectedModified --
RestoreAttributeParams: PROCEDURE[my:LptBufferData] = INLINE
BEGIN
my.currentAttributePosition ← my.savedAttributePosition;
my.currentAttrib ← my.savedAttrib;
END; -- RestoreAttributeParams --
SaveAttributeParams: PROCEDURE [my:LptBufferData] = INLINE
BEGIN
my.savedAttributePosition ← my.currentAttributePosition;
my.savedAttrib ← my.currentAttrib;
END; -- SaveAttributeParams --
SetAttributeParams: PROCEDURE [my:LptBufferData,currentPos: CharPos] = INLINE
BEGIN
my.currentAttributePosition ← currentPos;
my.currentAttrib ←
LOOPHOLE[my.buffer[currentPos].chset,AttributeParams];
END; -- SetAttributeParams --
SetBufferAddress: PUBLIC PROCEDURE [my:LptBufferData,newCBA: CharPos] =
-- This order specifies a new buffer address from which write operations are to start or continue. The command processor will check for invalid addresses in the command streams, and will call the buffer manager with valid addresses for 'newCBA'.
BEGIN
my.bufferAddress[hostMode] ← newCBA;
END; -- SetBufferAddress --
SetBufferAddressAndCursor: PUBLIC PROCEDURE [my:LptBufferData,newCBAAndCursor: CharPos] =
-- Sets both the CBA and cursor. --
BEGIN
SetBufferAddress[my,newCBAAndCursor];
SetCursor[my,newCBAAndCursor];
END;
SetCursor: PUBLIC PROCEDURE[my:LptBufferData,newCursor: CharPos,bvDisplayCursor:Bv ← TRUE] =
-- Sets the position of the cursor on the screen, if 'bvDisplayCursor' is TRUE, and updates the auxilliary variable 'bufferAddress[keyMode]' used to keep track of the cursor position. 'bufferAddress[keyMode]' and the actual position of the cursor on the display should always be equal. (i.e. Use 'SetCursor' always, and not 'VDTDefs.SetCursorPos' alone.) --
BEGIN
IF bvDisplayCursor THEN VDTDefs.SetCursorPos[my.lschemaVDT, newCursor];
my.bufferAddress[keyMode] ← newCursor;
END;
SetCursorToFirstUnprotected: PROCEDURE [my:LptBufferData] = INLINE
-- Sets the cursor to the first unprotected character location in the buffer. If no unprotected locations are found, the cursor is set to 0. --
BEGIN
HomeKey[my];
END; --SetCursorToFirstUnprotected --
StartField: PUBLIC PROCEDURE [my:LptBufferData,newAttrib: CHARACTER] =
-- Store attribute byte in high-order byte of word. The ESC char. is stored in the low-order byte to identify this word as an attribute. The attribute parameters are set and the buffer address is incremented. --
BEGIN
my.buffer[my.bufferAddress[hostMode]].chset ← LOOPHOLE[newAttrib,CharDefs.Chset];
my.buffer[my.bufferAddress[hostMode]].code ←
LOOPHOLE[WSStringDefs.byteAttributesEsc,CharDefs.Code];
IncBufferAddress[my,hostMode];
my.bvIsFormatted ← TRUE; -- buffer is now formatted --
END; -- StartField --
TabKey: PUBLIC PROCEDURE [my:LptBufferData] =
-- Implements the tab key. It moves the cursor to the first character location of the next unprotected data field. In a display with no unprotected fields, the cursor is repositioned to character location 0. The cursor wraps from the end of the last line on the display and continues at the beginning of the top line if necessary.--
BEGIN
bvFirstTime:Bv ← TRUE;
currentPos,stopPos: CharPos ← my.bufferAddress[keyMode];
IF ~my.bvIsFormatted THEN
BEGIN
SetCursor[my,0];
RETURN;
END;
DO
IF ~bvFirstTime AND currentPos = stopPos THEN GOTO noneFound;
currentPos ← FindNextAttribute[my,currentPos,stopPos];
IF bvFirstTime THEN bvFirstTime ← FALSE;
IF currentPos = bufferSize THEN GOTO noneFound;
SetAttributeParams[my,currentPos];
currentPos ← IncAndWrap[currentPos]; -- point to char after attrib --
IF IsAttribute[my,currentPos] THEN LOOP; -- 2 attribs in a row --
IF ~my.currentAttrib.protected THEN -- found unprotected field --
BEGIN
SetCursor[my,currentPos]; -- 1st char loc of u/p field --
RETURN;
END;
REPEAT
noneFound =>SetCursor[my,0]; -- then return --
ENDLOOP;
END; --TabKey --
UpdateStatus: PUBLIC PROCEDURE [my:LptBufferData] =
-- This procedure should be called by Command Processor at end of processing each burst of data from IBM host.
-- This procedure would update all the necessary Instance Data before someone else Reserves the buffer.
-- Currently only my.bvIsFormatted needs to be updated.
BEGIN
my.bvIsFormatted ← IsFormatted[my];
END;
WriteBlock: PUBLIC PROCEDURE [my:LptBufferData,aBlock:LptTextRun,nChars:CharPos,aMode:AccessMode] =
-- Called by the command processor. A block of characters is written into the buffer starting at the appropriate buffer address (specified by 'aMode'). The address of the block of characters is specified by 'aBlock', and the number of characters to be stored is 'nChars'. After this call, the buffer address points to the location after the last location stored into. --
BEGIN
index: CharPos ← 0;
FOR index IN [0..nChars)
DO
my.buffer[my.bufferAddress[aMode]] ← aBlock[index];
IncBufferAddress[my,aMode];
ENDLOOP;
END; -- WriteBlock --
WriteChar: PUBLIC PROCEDURE [my:LptBufferData,aChar: CharDefs.Char,aMode:AccessMode] =
-- This procedure is called by the command processor. Overwriting attribute chars. and protected fields is legal. The buffer address is incremented after writing. Update formatted status of buffer in case only existing attribute character was overwritten. --
BEGIN
my.buffer[my.bufferAddress[aMode]] ← aChar;
IncBufferAddress[my,aMode];
END; -- WriteChar --
END.
LOG
Jan. 11, 1982 - Stepak - Created, editing in progress.
Jan. 29, 1982 - Stepak - Added buffer handles to necessary procs, etc.
Feb. 1, 1982 - Stepak - Added init. value for 'predefinedZone'. Fixed up 'IsNumeric', 'Reset*Modified','SetCursorToFirstUnprotected','EraseUnprotected', "EraseUnprotectedToAddress',fixed LOOPHOLE in 'VDTDefs.WriteBlock'.
Feb 2, 1982 - Stepak - Init. zone ptrs ZoneMgrDefs.
Feb 3, 1982 - Stepak - removed all calls to display from cmds, orders,writes. Cmd processor will call 'DisplayScreen' at end of cmd seq. to update display.
Feb 4, 1982 - Stepak - modified 'DisplayBuffer' to erase null fields; changed 'DisplayChar' to handle field-mark, duplicate, null.
Feb 5, 1982 - Stepak - added DeleteKey proc.; DuplicateKey & FieldMarkKey handled in PutChar.
Feb 8, 1982 - Stepak - Initialize zone handles in pack.
Feb 10, 1982 - Stepak - Edited SetAttributeParams, InitializeBuffer, ProgramTab
Feb 17, 1982 - Stepak - Edited resetModifyMask,BackTabKey,EraseEOFKey,EraseUnprotected,EraseUnprotectedToAddress,FindNextAttribute,HomeKey,NewLineKey,NextNonNull,NextNull,ProgramTab,TabKey,WriteBlock,WriteChar.
Feb 24, 1982 - Stepak - edited BackTabKey and TabKey
March 12, 1982 - Stepak - DeleteKey: only change MDT for formatted buffer
March 13, 1982 - Stepak - "ClearOrSetModified" is a No-op for unformatted buffer,change param in VDTDefs.WriteBlock from @my.buffer to my.buffer
March 15, 1982 - Stepak - Added params to VDTDefs.(WriteBlockWriteChar,EraseChars), and DisplayBlock, DisplayChar. Mods to DeleteKey, EraseEOFKey.
March 16, 1982 - Stepak - DisplayBuffer doesn't update cursor.
March 17, 1982 - Stepak - ClearBuffer sets CBA & cursor to 0.
March 18, 1982 - Stepak - Editted 'EnumFIelds'
March 19, 1982 - Stepak - 'EnumFields':ProcessField: NextNull[startPos] changed to NextNull[IncAndWrap[startPos]] (to skip current attrib. in search), same for NextNonNull, though optional there.
March 20, 1982 - Stepak - 'EnumFields':ProcessField: Deleted 3/19/82 changes, and do IncAndWrap[startPos] right after setting attrib params, since attrib is not sent as part of field. Changed HomeKey & TabKey to deal w/ 1 or more attribs in a row.
March 22, 1982 - Stepak - 'EraseUnprotected': correctly update the cursor in 'EraseInputKey' and 'EraseAllProtected' according to subtle differences in spec. Changed 'BackTabKey', 'EraseUnprotected' , 'ProgramTab', and 'PutChar' to deal w/ 1 or more attribs in a row. 'EnumAllFieldsAndNulls': set 'stopPos' for 'FindNextAttribute' to 0.
March 23, 1982 - Stepak - 'EraseEOFKey': changed to handle unformatted buffer, 'IsNumeric': ibmFm is not legal numeric input.
March 24, 1982 - Stepak - updated comments
April 1, 1982 - Stepak - 'EnumAllFieldsAndNulls': send 'visibility' information with it call to 'pvFieldsAndNullsHit'. Made 'Visibility' a public type in 'Em3270PrivDefs'. (fixes AR #6324). Added proc. 'ReDisplayBlock' which calls 'VDTDefs.RewriteBlock'. Used in 'DisplayBuffer' to prevent re-painting chars. that have not changed. (fixes AR #6323)
'StartField': Added 'my.bufferAddress[keyMode] ← my.bufferAddress[hostMode]' (fixes AR #6326)
April 2, 1982 - Stepak - removed calls to VDTDefs.RewriteBlock to submit to 22.6. Will resubmit w/ calls to VDTDefs.RewriteBlock, when new VDTDefs/Pack have been submitted.
April 2, 1982 - Stepak - put in calls to VDTDefs.RewriteBlock to submit to 22.6/2.0c with new VDTDefs/Pack. Deleted 'my.bufferAddress[keyMode] ← my.bufferAddress[hostMode]' from 'StartField' to correctly fix AR #6326. Removed unnecessary 'mode' parameter from 'DisplayBlock', 'DisplayChar', and 'ReDisplayBlock'.
May 20, 1982 - Stepak - 'RepeatToAddress': removed RETURN statement after loop to fill entire buffer, so that 'my.bvIsFormatted' is updated always.
15-Jun-82 10:15:59 - Lui - Changed ClearOrSetModified, DecAndWrap, DecBufferAddress, IncAndWrap, IncBufferAddress, IsAttribute, RestoreAttributeParams, SaveAttributeParams, SetAttributeParams, SetCursorToFirstUnprotected to INLINE procedures.
15-Jun-82 16:33:09 - Lui - removed the testing of IsFormatted from WriteBlock and WriteChar, and added the procedure UpdateStatus. Added the test of IsFormatted to EraseAllUnprotected and EraseUnprotectedToAddress.
21-Jun-82 14:00:08 - Lui - changed NextNull, NextNonNull so that the stop address is to be pass in by caller instead of being calculated within these two proc. Thus changed proc which calls NextNull and NextNonNull.
16-Jul-82 15:48:26 - Lui - removed SetAttributeParams from StartField.
16-Jul-82 18:13:27 - Lui - removed the testing of IsFormatted from at en of RepeatToAddress. instead CommandProcessPack should call UpdateStatus to check IsFormatted.
4-Aug-82 14:51:13 - Lui - merge with Star2.1ar
1-Sep-82 11:33:28 - Lui - added hostLang to instance data.
9-Sep-82 16:54:56 - Lui - changed hostLang to lptToTransFile
30-Jun-83 15:53:15 - Lui - edited EnumFields to support Read Modified.
9-Nov-83 11:26:22 - Kernaghan - Fix a problem in NextNull & NextNonNull that assumed that contiguous attribut characters where not possible. By switch the order of two code lines it now believe they are. What bothers me is how many other places in the code assumes that contiguous attributes bytes are illegal.
5-Apr-84 15:50:04 - Caro - upgrade to new Em3270Defs
20-Apr-84 12:05:42 - Caro - Fixed duplicateChar, fieldMarkChar, nullChar for new CharDefs.
7-May-84 17:37:00 - Lui - Fixed AR 4574: NewLineKey should start search for fields in the last column of current line rather than first column of next line.
11-May-84 9:49:58 - Lui - Character set conversion.
19-Jun-84 12:32:38 - Lui - AR 8063: redefined/reinterpreted/expanded the meaning of a numeric field. IBM thinks numeric means more than 0..9, period, and hyphen. Edited IsNumeric.
13-Jul-84 15:40:27 - Lui - Undo the changes make by Kernaghan on "9-Nov-83". I couldn't figure out the purpose behind his changes. The change caused us to send garbage to the host when the screen is unformatted and the cursor address is at 0.