High Voltage Shareware

home *** CD-ROM | disk | FTP | other *** search

/ High Voltage Shareware / high1.zip / high1 / DIR36 / C7101.ZIP / REPEAT.CLA < prev next >

Wrap

Text File | 1994-02-07 | 39KB | 594 lines

PROGRAM OMIT('┘') ┌────────────────────────────────────────────────────────────────────────────┐ │ │ │ REPEAT.CLA - The Repeat Support Module │ │ │ │ The Repeat Support Module manages the process of scrolling records │ │ through a POINT/REPEAT structure. Repeat support is conducted in a │ │ session that is initiated by the BeginRepeat procedure and │ │ terminated by the EndBrowse procedure. Multiple repeat sessions │ │ may be conducted at the same time (e.g. a repeat procedure calls a │ │ form which calls a lookup procedure). The current status of a │ │ repeat session is stored in a Session queue. The repeat process │ │ uses a position queue which contains a POSITION() string used to │ │ access displayed records. │ │ │ │ BeginRepeat(PointField,PointRows,LocatorField,ImmediateFlag, | │ │ IncrementFlag) │ │ │ │ Initiate a repeat session and append a new element to the │ │ Session queue. PointField is the field number of a point field │ │ that displays a scrolling area of records. PointRows is the │ │ total number of scrolling regions in the REPEAT area. │ │ LocatorField is an optional parameter that contains the field │ │ number of a locator field. Typing any displayable character │ │ activates the locator field. The USE variable of the locator │ │ field is a key component, so completing the locator field │ │ scrolls the scroll area to the first matching record. │ │ ImmediateFlag is an optional parameter that contains a 1 if │ │ the selected record is to be accessed each time the selector │ │ bar moves over a new record. IncrementFlag is an optional │ │ parameter that contains a 1, 2, 3, or 4 to request an │ │ incremental locator field that automatically locates a │ │ matching record after a pause in typing. Increment values │ │ of 2, 3, and 4 request upper case, lower case, and │ │ capitalized locator fields. An increment value of 1 uses │ │ the case entered by the operator. │ │ │ │ RepeatAction(File,Key,Index) │ │ │ │ Manages the behavior of the scroll area, locator field, and │ │ hot fields. File is the FILE to be scrolled. Key is KEY to │ │ be used to access the file. Index is the current position of │ │ the selector bar within the scroll area. Index is passed by │ │ address, because RepeatAction may change the value of Index. │ │ RepeatAction returns a code requesting one of the following │ │ actions: │ │ │ │ Set the first record and set the last record of a limited │ │ range of consecutive records. │ │ │ │ Reject a record by issueing GET(File,0) to dereference the │ │ record or indicate that a record is out of range by issueing │ │ NEXT(File) or PREVIOUS(File) to move the record position. │ │ │ │ Process the record under the selector bar │ │ │ │ Process a field or key that the repeat manager does not │ │ recognize. The selected record has been accessed from the │ │ file and display queue. │ │ │ │ Take action if there are no records to display. │ │ │ │ Clear the key fields subordinate to the locator field. │ │ │ │ EndRepeat │ │ │ │ Terminate the repeat session. Free position elements for this │ │ session from the Position queue. Free the last element from │ │ the Session queue. │ │ │ └────────────────────────────────────────────────────────────────────────────┘ INCLUDE('KEYCODES.EQU') MAP BeginRepeat(BYTE,BYTE,<BYTE>,<BYTE>,<BYTE>) RepeatAction(FILE,KEY,*BYTE),BYTE EndRepeat END RptSession QUEUE !Repeat session queue Action BYTE ! Caller action Process BYTE ! Internal process Point BYTE ! Point field number Immediate BYTE ! Process selected record Locator BYTE ! Locator field number Location STRING(40) ! Locator field contents Length BYTE ! Locator contents length Increment BYTE ! Incremental locator flag Count BYTE ! Scroll item count Item BYTE ! Current item (1 to Count) Choice BYTE ! Selector bar position LastChoice BYTE ! Last Selector position Row BYTE ! Point field screen row Col BYTE ! Point field screen column Rows BYTE ! Point field rows Cols BYTE ! Point field column width Page STRING(1) ! Current page (F,L,blank) FirstPage BYTE ! First page request flag Base SHORT ! Base for RptPosition queue Selected STRING(256) ! Selected record position END RptPosition QUEUE !Record position queue STRING(256) ! Record Position END !Caller actions NoAction EQUATE(0) ! No caller action ProcessField EQUATE(2) ! Process another field NoRecords EQUATE(3) ! No records to display FilterRecord EQUATE(4) ! Filter a record ResetFirst EQUATE(5) ! Set to first of a range ResetLast EQUATE(6) ! Set to last of a range ProcessSelected EQUATE(7) ! Process selected record ClearRestOfKey EQUATE(8) ! Clear low fields of key !Internal processes InitSession EQUATE(1) ! Initialize repeat session ProcessForward EQUATE(2) ! Process records forward ProcessBackward EQUATE(3) ! Process records backward ProcessSingle EQUATE(4) ! Process a single record AcceptInput EQUATE(5) ! Accept keyboard input LoChar EQUATE(32) !Lowest displayable char HiChar EQUATE(127) !Highest displayable char CODE !Dummy program BeginRepeat PROCEDURE(PointField,PointRows,LocatorField,ImmediateFlag, | IncrementFlag) CODE IF RECORDS(RptSession) THEN PUT(RptSession). !Save any current session CLEAR(RptSession) !Clear the session record Action = NoAction !Set no caller action Process = InitSession !Initialize a repeat session Point = PointField !Set Point field number Locator = LocatorField !Set locator field number Immediate = ImmediateFlag !Set immediate process flag IF Locator THEN Increment = IncrementFlag. !If there is a locator field Count = PointRows !Set item count Row = ROW(Point) !Set point row Col = COL(Point) !Set point column Rows = PointRows * ROWS(Point) !Set point rows Cols = COLS(Point) !Set point columns Choice = 1 !Set top choice LastChoice = 1 !Set top last choice Base = RECORDS(RptPosition) !Set base position ADD(RptSession,RECORDS(RptSession)+1) !Add the session record RETURN !Return to caller RepeatAction FUNCTION(File,Key,Index) Delay EQUATE(50) !Time delay (1/2 second) SpaceKey EQUATE(32) !Space bar keycode TimeOut LONG,AUTO !Deadline time (.01 seconds) CODE CASE Action !Process caller's action OF FilterRecord !Caller filtered the record CASE POSITION(Key) !Check callers action OF '' !The record is rejected IF Process = ProcessSingle ! And previously accepted GET(RptPosition,Base+Choice) ! Get the position element DELETE(RptPosition) ! And delete it Process = ProcessForward ! Display a new last Item = RECORDS(RptPosition) - Base + 1 ! record forward GET(RptPosition,RECORDS(RptPosition)) ! Get last display record RESET(Key,RptPosition) ! Reset to last display NEXT(File) ! Retrieve last record END ! End IF OF RptPosition !The record is accepted CASE KEYCODE() ! While scrolling OF DownKey ! with the DownKey OROF PgDnKey ! or the PgDnKey SCROLL(ROW,COL,ROWS,COLS,ROWS(Point)) ! Scroll forward OF UpKey ! with the UpKey OROF PgUpKey ! or the PgUpKey SCROLL(ROW,COL,ROWS,COLS,-(ROWS(Point)))! Scroll backward Index = 1 ! Point to top record END ! End CASE CASE Process ! Jump to current process OF ProcessForward ! On forward processing ADD(RptPosition,RECORDS(RptPosition)+1) ! Add new last position IF RECORDS(RptPosition)-Base > Count ! If the page overflows GET(RptPosition,Base+1) ! Get the first position DELETE(RptPosition) ! And delete it END ! End IF DISPLAY Item += 1 ! Increment current item IF Index < Count ! If not bottom item Index += 1 ! Increment index END ! End IF OF ProcessBackward ! On backward processing ADD(RptPosition,Base+1) ! Add new first position IF RECORDS(RptPosition) > Count ! If the page overflows GET(RptPosition,RECORDS(RptPosition)) ! GET the last position DELETE(RptPosition) ! And delete it END ! End IF DISPLAY Item -= 1 ! Decrement current item IF Index > 1 ! While not top item Index -= 1 ! Decrement index END ! End IF OF ProcessSingle ! On a single record SELECT(Point) ! Select the point field Process = AcceptInput ! Get keyboard input Selected = '' ! Clear selected position END ! End CASE ELSE !The record is out of range SELECT(Point) ! Select the point field Selected = '' ! Clear selected position Process = AcceptInput ! Get keyboard input END !End CASE OF ProcessSelected !Caller processed a record Selected = POSITION(Key) ! Set selected position OF ProcessField !Caller processed a field IF FIELD() <> Locator !For non-locator field IF Increment ! If incremental locator DO ClearLocator ! Clear locator END ! End IF IF INRANGE(FIELD(),1,Point-1) ! From a prior field FirstPage = 1 ! Request the first page END ! End IF END !End IF IF SELECTED() = Point !If point field is selected IF FirstPage !If first page is requested DO FirstPage ! Display the first page Action = ResetFirst ! Ask caller to first RETURN(Action) ! record in range ELSIF FIELD() <> Locator !From any field but a locator CASE POSITION(Key) !Check the record OF '' !If record was dereferenced DO GetChoice ! Get selected record IF POSITION(Key) = RptPosition ! If record is still there Process = ProcessSingle ! Display one record Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller ELSE ! If record was deleted DELETE(RptPosition) ! Delete its position IF RECORDS(RptPosition) - Base = 0 ! If queue is now empty DO LastPage ! Display the last page Action = ResetLast ! Ask caller to reset to RETURN(Action) ! last record in range ELSE ! Otherwise Do NewPage ! Display a new page END ! End IF END ! End IF OF RptPosition !If record didn't move Action = FilterRecord ! Ask caller to Process = ProcessSingle ! filter one record RETURN(Action) ! Return to caller ELSE !If record moved DO NewPage ! Display the new page END !End CASE END !End IF ELSE !Else another field selected IF FIELD() <> SELECTED() ! If selecting a new field Process = AcceptInput ! Accept keyboard input END ! End IF END !End IF OF NoRecords !Caller added a record IF SELECTED() = Point !And selected the point field DO FirstPage ! Display the first page Action = ResetFirst ! Ask caller to reset to RETURN(Action) ! first record in range END ! End IF OF ClearRestOfKey !Clear locator subfields SELECT(Locator) ! Select the locator field Process = AcceptInput ! Accept keyboard input END !End CASE LOOP CASE Process !Jump to current process OF InitSession !Start repeat session Process = AcceptInput !Accept keyboard input OF ProcessForward !Process records forward IF Item <= Count ! If page is not full NEXT(File) ! Read the next record IF ~ERRORCODE() ! If a record was found RptPosition = POSITION(Key) ! Save its position Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller END ! End IF ELSE ! Else through filling page Index = 1 ! Reselect top item END ! End IF SELECT(Point) ! Select the point bar Selected = '' ! Clear selected position IF KEYCODE() = CtrlPgUp or Page = 'F' ! On CtrlPgUp or first page Index = 1 ! Point to top record END ! End IF Process = AcceptInput ! Get keyboard input OF ProcessBackward !Process records backward IF Item >= 1 ! If page is not full PREVIOUS(File) ! Read the prior record IF ~ERRORCODE() ! If a record was found RptPosition = POSITION(Key) ! Save its position Action = FilterRecord ! Ask caller to filter RETURN(Action) ! Return to caller END ! End IF END ! End IF SELECT(Point) ! Select the point bar Selected = '' ! Clear selected position IF KEYCODE() = CtrlPgDn ! On CtrlPgDn key Index = Count ! Point to last record END ! End IF Process = AcceptInput ! Get keyboard input OF AcceptInput !Get keyboard input IF SELECTED() = Point !When selecting point field IF RECORDS(RptPosition) - Base = 0 ! If there are no records CASE Page ! Which page is displayed OF 'F' ! On the first page GET(File,0) ! Clear the current record Action = NoRecords ! Ask caller for records OF 'N' ! On a new page DO LastPage ! Display the last page Action = ResetLast ! Ask for last record ELSE ! On any other page DO FirstPage ! Display the first page Action = ResetFirst ! Ask for first record END ! End CASE RETURN(Action) ! Return to caller END !End IF IF Immediate !For immediate processing GET(RptPosition,Base+Index) ! Get selected position IF Selected <> RptPosition ! If selector moved DO GetChoice ! Get selected record IF RptPosition = POSITION(Key) ! If deleted record Action = ProcessSelected ! Ask to process record RETURN(Action) ! Return to caller ELSE ! Else DO NewPage ! Rebuild the Queue Action = ProcessField ! Ask to process record RETURN(Action) ! Return to caller END ! End IF END ! End IF END !End IF IF Locator !If there is a locator field ERASE(Locator) ! Erase locator contents IF Increment ! If incremental locator DO ShowLocator ! Show locator field END ! End IF END !End IF IF Index > Count !If past bottom item Index = Count ! Set to bottom item ELSIF Index < 1 !Else If before top item Index = 1 ! Set to top item END !End IF LastChoice = Index !Save selector position END !End IF ACCEPT !Enable the keyboard CASE FIELD() !Jump to field edit routine OF Locator !Process the locator field IF CONTENTS(Locator) ! If locator is requested IF Increment ! If incremental locator Location = CONTENTS(Locator) ! Save location Length = LEN(CLIP(Location)) ! Save location length END ! End IF SELECT(Point) ! Select the point field DO NewPage ! Display a new page IF KEYCODE() = DownKey ! If completed with DownKey SETKEYCODE(0) ! Clear the keycode END ! End IF Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END ! End IF OF Point !Process the point field Choice = Index ! Save selector bar position IF SELECTED() <> Point THEN CYCLE. ! Process any new fields CASE KEYCODE() ! Jump to key edit routine OF LoChar TO HiChar ! For any locator character OROF BSKey OROF SpaceKey ! or backspace or space IF Locator ! If there is a locator IF Increment ! On incremental locator DO GatherKeys ! Gather keystrokes IF Location ! If not blank PRESS(SUB(Location,1,Length)) ! Press the string PRESS(DownKey) ! Complete the field SELECT(Locator) ! Select locator END ! End IF ELSE ! On standard locator PRESS(KEYCODE()) ! Press in the keycode SELECT(Locator) ! Select locator field END ! End IF Action = ClearRestOfKey ! Ask caller to clear RETURN(Action) ! subordinate fields END ! End IF OF CtrlPgUp !Process the Ctrl-PgUp key Index = 1 ! Reset index to top record BLANK(Row,Col,Rows,Cols) ! Clear the screen DO FirstPage ! Display the first page IF Increment ! If incremental locator DO ClearLocator ! Clear locator field END ! End IF Action = ResetFirst ! Ask caller to reset to RETURN(Action) ! first record in range OF PgUpKey !Process the PgUp key IF LastChoice <> 1 ! If not at the top Choice = 1 ! Selector bar to top Index = 1 ! Selector bar to top ELSE ! From the top Page = '' ! Clear page flag Process = ProcessBackward ! Display a new page Item = Count ! of records backward GET(RptPosition,Base+1) ! Reset to the top RESET(Key,RptPosition) ! record displayed PREVIOUS(File) ! Point to prior record END ! End IF OF UpKey !Process the up arrow IF Index = 1 ! From the top line Page = '' ! Clear page flag Process = ProcessBackward ! Display a single Item = 1 ! record backward GET(RptPosition,Base+1) ! Reset to the top RESET(Key,RptPosition) ! record displayed PREVIOUS(File) ! Point to prior record END ! End IF OF DownKey !Process the down arrow IF Index = Count ! From the bottom line Page = '' ! Clear page flag Process = ProcessForward ! Display a single Item = Count ! record forward GET(RptPosition,RECORDS(RptPosition)) ! Reset to the bottom RESET(Key,RptPosition) ! record displayed NEXT(File) ! Point to the next record END ! End IF OF PgDnKey !Process the PgDn key IF LastChoice <> Count ! If not at the bottom IF RECORDS(RptPosition) > Base ! For a partial screen Index = RECORDS(RptPosition) - Base! Set index to bottom ELSE ! Else Index = Count ! Set index to bottom END ! End IF Choice = Index ! Set the choice ELSE ! From the bottom Page = '' ! Clear page flag Process = ProcessForward ! Display a new page Item = 1 ! of records forwards GET(RptPosition,RECORDS(RptPosition)) ! Reset to the bottom RESET(Key,RptPosition) ! record displayed NEXT(File) ! Point to next record END ! End IF OF CtrlPgDn !Process the Ctrl-PgDn Key IF RECORDS(RptPosition) > Base ! For a partial screen Index = RECORDS(RptPosition) - Base ! Set index to last record ELSE ! Else Index = Count ! Set index to bottom END ! End IF BLANK(Row,Col,Rows,Cols) ! Clear the scroll area DO LastPage ! Display the last page IF Increment ! If incremental locator DO ClearLocator ! Clear locator field END ! End IF Action = ResetLast ! Ask caller to reset to RETURN(Action) ! last record in range OF LeftKey !For left arrow key, OROF Rightkey ! right arrow key, OROF Homekey ! Home key, OROF Endkey ! End key, OROF MouseLeft !And a mouse click ! Don't do anything ELSE !For any other key DO GetChoice ! Get selected record Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END !End CASE KEYCODE() IF Increment !If incremental locator DO ClearLocator ! Clear locator field END !End ELSE !Process any other field IF FIELD() >= Point OR FIELD() < 0 ! If menu or after point DO GetChoice ! Get selected record END ! End IF Action = ProcessField ! Ask caller to process RETURN(Action) ! Return to caller END !End CASE FIELD() END !End CASE repeatProcess END !End LOOP GetChoice ROUTINE !Get selected record GET(RptPosition,Base+Choice) ! Get selected position RESET(Key,RptPosition) ! Reset to that record NEXT(File) ! Read the record FirstPage ROUTINE !Display first page FirstPage = 0 ! Clear first page request Page = 'F' ! Set first page flag DO DeletePage ! Delete the old page Choice = 1 ! Reset selector bar Process = ProcessForward ! Display a new page Item = 1 ! of records forward SET(Key) ! Set to the first record LastPage ROUTINE !Display last page Page = 'L' ! Set last page flag DO DeletePage ! Delete the old page Choice = Count ! Reset selector bar Process = ProcessBackward ! Display a new page Item = Count ! of records backward SET(Key) ! Set to the last record Index = Count ! Set to the last row NewPage ROUTINE !Display a new page Page = 'N' ! Set new page flag DO DeletePage ! Delete the old page BLANK(Row,Col,Rows,Cols) ! Blank screen for next page SET(Key,Key) ! Set to the new record Choice = 1 ! Selector bar to top Process = ProcessForward ! Display a new page Item = 1 ! of records forward Index = 1 ! from the top record DeletePage ROUTINE !Delete the current page LOOP WHILE RECORDS(RptPosition) > Base ! Delete all position GET(RptPosition,RECORDS(RptPosition)) ! elements after the DELETE(RptPosition) ! base position END ! End LOOP GatherKeys ROUTINE !Gather locator keystrokes DO AppendKey ! Append pending keystroke TimeOut = CLOCK() + Delay ! Set the time delay LOOP UNTIL CLOCK() > TimeOut !Loop until time out IF KEYBOARD() ! If there is a keystroke ASK ! Read the keystroke DO AppendKey ! Append the keystroke DO ShowLocator ! Show the user TimeOut = CLOCK() + Delay ! Reset the time delay END ! End IF END !End LOOP AppendKey ROUTINE !Append keystroke to locator CASE KEYCODE() ! Process the keystroke OF LoChar TO HiChar OROF SpaceKey ! For a character IF Length < COLS(Locator) ! If it will fit Location = SUB(Location,1,Length) & CHR(KEYCODE()) ! Add it on Length += 1 ! Increment the length END ! End IF OF BSKey ! For a backspace IF Length > 0 THEN Length -= 1. ! Decrement the length Location = SUB(Location,1,Length) ! Shorten the string EXECUTE Increment - 1 ! For locator case Location = UPPER(Location) ! Upper case location Location = LOWER(Location) ! Lower case location Location = UPPER(SUB(Location,1,1)) | ! Capitalize location & LOWER(SUB(Location,2,SIZE(Location)-1)) END ! End EXECUTE END ! End CASE ClearLocator ROUTINE !Clear locator field Location = '' ! Clear field string Length = 0 ! Zero field length DO ShowLocator ! Show locator field ShowLocator ROUTINE !Show locator field contents SHOW(ROW(Locator),COL(Locator),SUB(Location,1,COLS(Locator))) EndRepeat PROCEDURE CODE LOOP WHILE RECORDS(RptPosition) > Base !Delete all position GET(RptPosition,RECORDS(RptPosition)) ! elements after the DELETE(RptPosition) ! base position END !End LOOP DELETE(RptSession) !Delete the current session IF RECORDS(RptSession) !For any prior session GET(RptSession,RECORDS(RptSession)) ! Get the session element END !End IF RETURN !Return to caller