|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 17246 (0x435e)
Notes: pts_type(SC)
Names: »SCREEN.SC«
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
└─⟦this⟧ »REMIT2/SCREEN.SC«
IDENT SCREEN 03.01.XXX.1 1.1,78-04-20,870138040310 * * A STANDARD PROGRAM PACKAGE HANDLING * A COMPLETE PICTURE ON A DISPLAY SCREEN * * RUNNING UNDER: CREDIT REL 3.1 * TOSS REL 8.1 * DDUM KMD08 PDIV * ENTRY SPCLRA CLEAR ALL VARIABLE FIELDS ENTRY SPCLRS CLEAR SOME VARIABLE FIELDS ENTRY SPCLRN CLEAR NO VARIABLE FIELDS ENTRY SPERR DISPLAY ERROR PRINTOUT AND CONTINUE HANDLING ENTRY SPLIN8 MESSAGE ON LINE 8 ENTRY SPCA AS SPCLRA-- ENTRY SPCN AS SPCLRN-- SPCA AND SPCN ARE ONLY ACTIVE BETWEEN LINES SPLINTOP AND SPLINLOW ENTRY SCREEN ENTRY SPINF1 INFORMATION ON LINE 1 ENTRY SPINF8 INFORMATION ON LINE 8 ENTRY BELL * EXT SPCHK1 STANDARD CHECK ROUTINE NO. 1 EXT SPCHK2 STANDARD CHECK ROUTINE NO. 2 EXT SPCHK3 STANDARD CHECK ROUTINE NO. 3 EXT SPCHK4 STANDARD CHECK ROUTINE NO. 4 EXT SPCHK5 STANDARD CHECK ROUTINE NO.5 EXT SPCHK6 STANDARD CHECK ROUTINE NO. 6 EXT SPCHK7 STANDARD CHECK ROUTINE NO. 7 EXT SPAPPL USER ROUTINE TO HANDLE APPL VALUES EXT SPTCHK USER ROUTINE TO EVALUATE CONDITIONAL TABULATION * EXT EMPTYT ASSEMBLY SUBROUTINE EMPTYT - TEST IF DATA ITEM IS EMPTY EXT CLEAR8 * INCLUDE KEY461,LIST * FIRST INCLUDE KEY VALUES, * THEN INCLUDE SPECIAL SCREEN FORMATS INCLUDE SL461,LIST SPCLRA PROC * * SPCLRA - CLEAR ALL VARABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'1' RET PEND SPCLRS PROC * * SPCLRS - CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'2' RET PEND SPCLRN PROC * * SPCLRN - CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * MOVE SPERASE,=W'0' MOVE SPLINTOP,=W'1' WHOLE SCREEN MOVE SPLINLOW,=W'0' PERF SCREEN,=W'3' RET PEND SPERR PROC * * HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE * PERF SCREEN,=W'0' RET PEND SPCA PROC * * SPCA - AS SPCLRA, BUT ONLY BETWEEN LINES SPLINTOPAND SPLINLOW * MOVE SPERASE,=W'4' PERF SCREEN,=W'1' RET PEND SPCN PROC * * SPCN - AS SPCLRN, BUT ONLY BETWEEN LINES SPLINTOP AND SPLINLOW * MOVE SPERASE,=W'4' PERF SCREEN,=W'3' RET PEND SCREEN PROC $OPT * * SCREEN SCREEN HANDLING MODULE * * CALL: PERF SCREEN,<$OPT> * PLIT $OPT OPTIO SELECTOR CLEAR SPWARNFL CLEAR WARNING FLAG MOVE SPBINW2,$OPT MOVE TO VARIABLE TO ALLOW INSTR.S CMP AND IB CMP SPBINW2,='0' "SPERR" ENTRY ? BE ERRPRINT YES ! TBT SPPROMPT,ENTIRE JUMP IF ENTIRE FORMAT SHOULD BE DISPLAYED * * ONLY VARIABLE FIELDS * IB SPBINW2,CLEARA,CLEARS,CONT JUMP ON ROUTINE INDEX * CLEARA ERASE 10,SPLINTOP,SPLINLOW ERASE ALL FROM 1 AND UP THOME B CONT * CLEARS ERASE 5,SPLINTOP,SPLINLOW ERASE SOME FROM 1 AND UP B CONT * * DISPLAY ENTIRE FORMAT * ENTIRE IB SPBINW2,ECLRA,ECLRS,ECLRN JUMP ON ROUTINE INDEX * * CLEAR ALL VARIABLES * ECLRA ERASE 11,SPLINTOP,SPLINLOW CLEAR ALL IN MEMORY B ECLRN * * CLEAR SOME VARIABLES * ECLRS ERASE 6,SPLINTOP,SPLINLOW CLEAR SOME FIELDS FROM 1 AND UP IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN IB SPERASE,ECLRN1,ECLRN2,ECLRN3,ECLRN4 DISPLAY 0,SPLINTOP,SPLINLOW B CONT ECLRN1 DISPLAY 1,SPLINTOP,SPLINLOW B CONT ECLRN2 DISPLAY 2,SPLINTOP,SPLINLOW B CONT ECLRN3 DISPLAY 3,SPLINTOP,SPLINLOW B CONT ECLRN4 DISPLAY 4,SPLINTOP,SPLINLOW B CONT CONT GETABX SPBINW4 GET CURRENT INDEX BL KTHOME JUMP IF NO CURRENT FIELD CONT5 GETFLD 0,SPBINW4,SPBINW3 SEARCH CURRENT POSITION BZ SETCREAD JUMP IF FOUND BL KTHOME POSITION NOT FOUND * * COMPULSORY FIELD FOUND * MOVE SPBINW4,SPBINW3 CHANGE INDEX B CONT5 SEARCH AGAIN * * * SET CURSOR AND READ KEYBOARD * SETCREAD SETCUR SET CURSOR ON CURRENT FIELD * * READ TO CURRENT FIELD ON DISPLAY * READIN * SET FLAG IF AUTODUP * USES VERIF-FIELD MOVE SPBINW2,=W'3' MOVE SPBINW1,=W'1' TSTCTL 6 BOK DYKIN SET GTADUPFL B DYK20 * DYKIN IB SPKEY,DYK05,DYK10,DYK15 DYK05 DYKI SPINPUT,SPKTAB1,SPKTAB2,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT DYK10 DYKI SPINPUT,SPKTAB12,SPKTAB22,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT DYK15 DYKI SPINPUT,SPKTAB13,SPKTAB23,SPBINW1, C SPBINW2,SPBINW4 DYKOUT BL ERRPRT ERROR CLEAR SPDUPL CBNG SPBINW2,='0',RETUR JUMP IF POWER OFF OR * DYK20 * * KEY SWITCHES IB SPBINW2,UPD300,CLEA20 JUMP ON C UPDATE,CANC,CANC, C UPDATE,UPDATE,UPDATE,UPDATE CONVERTED C UPDATE,UPDATE,UPDATE,UPDATE END-OF-ITEM-KEY C UPDATE,KDUPL,KEDIT * * HANDLE THE RESPECTIVE KEY AS EOI-KEY FIRST * UPDATE CBE SPBINW1,='0',UPD350 JUMP IF LENGTH = 0 GETCTL 3,SPBINW4 GET SCHK-NUMBER CBE SPBINW4,='0',UPD050 JUMP IF NOT STANDARD CHECK PERFI SPBINW4,SPCHK1,SPCHK2,SPCHK3 C SPCHK4,SPCHK5,SPCHK6,SPCHK7 IB SPBINW3,UPD050,UPD070,ERRPRINT * * CONDITIONAL DISPLAYING * UPD050 TBT SPDUPL,UPD100 MOVE SPBINW4,='1' INDICATE COND. DISPL B UPD200 UPD070 GETCTL 0,SPBINW3 GET APPL-VALUE CBNE SPBINW3,='0',UPD210 JUMP IF APPL VALUE B SETCREAD * * UNCONDITIONAL DISPLAYING * UPD100 MOVE SPBINW4,='2' INDICATE UNCONDITIONAL DISPLAY UPD200 GETCTL 0,SPBINW3 GET APPL-VALUE CBE SPBINW3,='0',UPD400 JUMP IF NO APPL VALUE * * APPL-VALUE DIFFERENT FROM ZERO * UPD210 PERF SPAPPL IB SPBINW3,UPD400,SETCREAD,ERRPRINT B UPD400 * * OK AFTER APPL CONTROL * UNCONDITIONAL DISPLAYING * UPD260 UPDFLD 1,SPINPUT UPDATE FIELD WITH DISPLAYING UPD300 CBE SPBINW1,='0',UPD350 SKIP NEXT IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED ITEM UPD350 * TAKE CARE OF WARNING TBF SPWARNFL,UPD360 MOVE SPBINW1,SPBINW2 STORE KEY VALUE MOVE SPBINW4,=W'26' SET MESSAGE PERF SPERR CBNE SPBINW2,CBIN2,UPD360 KOR-KEY ? MOVE SPBINW2,SPBINW1 RESET OLD KEYVALUE UPD360 * JUMP ON FUNCTION KEY INDEX IB SPBINW2,READIN,DUMMY, C KEOI,DUMMY,DUMMY,KTFWD, C KTBWD,KTHOME,KTLDOWN,KTLEFT,KTRIGHT, C KTDOWN,KTUP,KCOPY,DUMMY,DUMMY,KENTER SUB SPBINW2,=W'14' ADJUST EOI-KEY INDEX DUMMY RETUR RET * UPD400 CBE SPBINW4,='2',UPD260 JUMP IF UNCONDITIONAL DISPL UPDFLD 0,SPINPUT UPDATE FIELD DISPL. COND. B UPD300 * KEOI COMMON END-OF-ITEM KEY KTFWD TAB. FORWARD 1 STEP TFWD B TSTTAB * KTBWD TABULATION 1 STEP BACKW. TBWD B TSTTAB * KTHOME TAB. TO HOME POSITION THOME B TSTTAB * KTLDOWN TAB. TO FIRST ON NEXT LINE TLDOWN B TSTTAB * KTLEFT TAB. TO LEFTMOST TLEFT B TSTTAB * KTRIGHT TAB. TO RIGHTMOST TRIGHT B TSTTAB * KTDOWN TAB 1 DOWN TDOWN B TSTTAB * KTUP TAB 1 UP TUP TSTTAB TEST TAB OUTPUT BE READIN OK BL READIN NOT FOUND BOFL SETCREAD EMPTY COMPULSORY FIELD * * * CONDITIONAL TABULATION * PERF SPTCHK CMP SPBINW3,='0' BE SETCREAD IB SPBINW2,DUMMY,DUMMY, C KTFWD,DUMMY,DUMMY,KTFWD, C KTBWD,KTFWD,KTFWD,KTFWD, C KTBWD,KTFWD,KTBWD * BRANCH LIST EXHAUSTED - SPBINW2 CLOBBERED BY SPTCHK B SETCREAD KCOPY HARD COPY MOVE SPBINW3,='1' TBT GTGTPFLG,KCOPY05 TBT GTLPFLG,KCOPY08 B KCOPY10 KCOPY05 EDWRT DSHCGP,FFEED PRINT DSHCGP,SPBINW3,='0' GTP B KCOPY10 KCOPY08 EDWRT DSHCLP,FFEED PRINT DSHCLP,SPBINW3,='0' LP B KCOPY10 KCOPY10 B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE SPBINW2,='3' INDICATE COMMON EOI-KEY DUPL SPINPUT DUPLICATION BNZ KDUPL2 COPY GSWSTR1,CBIN0,CBIN1,SPINPUT,CBIN1 GET BYTE 1 CBE GSWSTR1,=X'00',KDUPL2 MOVE SPBINW1,='10' SET LENGTH IN DUPFIELD SET SPDUPL B UPDATE DUPL ALLOWED KDUPL2 MOVE SPBINW4,='4' INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED * * EDIT FIELD * KEDIT GETCTL 1,SPBINW3 GET MAXL CBNE SPBINW3,='0',KED100 PERF BELL B SETCREAD KED100 EDFLD SPINPUT,SPKTAB3,SPBINW1, C SPBINW2,SPBINW4 B DYKOUT CONTINUE AS FOR DYKI * * ENTER KEY * KENTER TBT SPCHANGE,KENT00 NO TESTS ON ME TBF SPME,KENT05 FIELDS ? KENT00 MOVE SPBINW4,='5' INDICATE COMP.FIELD FOUND MOVE SPBINW1,='0' INDICATE NO CLEARING MOVE SPBINW2,='0' SET INDEX TO SEARCHED FIELD GETFLD 0,SPBINW2,SPBINW3 SEARCH FOR EMPTY COMP. FIELDS BOFL KENT10 EMPTY COMP. FIELD FOUND TSTCTL 2 LOOK IF COMPULSORY FIELD BZ KENT05 NO! CALL EMPTYT,:FMTITEM LOOK IF EMPTY FIELD BP KENT10 YES! KENT05 MOVE SPBINW2,='3' INDICATE ENTER KEY DEPRESSED RET * * EMPTY COMPULSORY FIELD FOUND * KENT10 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD ERRPRT CBE SPBINW2,='16',KEDIT JUMP IF EDIT CBE SPBINW2,='4',CANC JUMP IF CANCEL1 CBE SPBINW2,='5',CANC JUMP IF CANCEL2 * * ERROR HANDLING * ERRPRINT * MOVE SPBINW2,=X'40' XSTAT KEYB,SPBINW3 CBNE SPBINW2,SPBINW3,ERRPRT20 TIMEOUT EDWRT SCREEN,ERAFMT ERASE SCREEN B ERRC20 ERRPRT20 CBE SPBINW4,='0',ERRC20 PERF BELL MOVE SPBINW3,=X'0801' ROW 24 COL. 1 DSC1 SCREEN,6,SPBINW3 SET CURSOR ON LAST ROW MOVE GSWBCD4,SPBINW4 ERRORCODE * EDWRT SCREEN,SPFTBERR(SPBINW4) TBF SPKEYFLG,SPERRRET * * READ AFTER ERROR * ERREAD SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD ERR100 MOVE SPBINW3,=W'14' REQUESTED LENGTH IB SPKEY,ERR105,ERR110,ERR115 ERR105 NKI .NE,KEYB,SPINPUT,SPKTAB1,SPBINW3,SPBINW2 B ERR120 ERR110 NKI .NE,KEYB,SPINPUT,SPKTAB12,SPBINW3,SPBINW2 B ERR120 ERR115 NKI .NE,KEYB,SPINPUT,SPKTAB13,SPBINW3,SPBINW2 ERR120 BNZ ERR100 JUMP IF NOT OK CMP SPBINW2,='0' JUMP IF POWER OFF BE RETUR IB SPBINW2,ERR100,ERRCONT C ERRCONT,ERR100,ERRCONT,ERRCONT B ERR100 CONTINUE * * CLEAR ERROR PRINTOUT * ERRCONT PERF CLEAR8 ERASE LAST LINE CBNL SPBINW4,=W'26',CANC IF WARNING SUB SPBINW2,='1' ADJUST KEY INDEX CANC CBE SPBINW1,='0',ERRC10 JUMP IF LENGTH = 0 MOVE SPINPUT,:FMTITEM SAVE CURRENT CONTENTS MOVE :FMTITEM,=C'1' PUT SOMETHING IN THE FIELD GETABX SPBINW4 GET CURRENT INDEX ERASE 10,SPBINW4,SPBINW4 CLEAR FIELD ERRC10 IB SPBINW2,CLEAR1,CLEAR2,DUMMY SUB SPBINW2,='3' ADJUST FOR CANCEL1,CANCEL2 RET CLEAR1 CBE SPBINW1,='0',ERRC20 JUMP IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED FIELD ERRC20 MOVE SPBINW5,$OPT CHECHK IF SPERR CBE SPBINW5,=W'0',SPERRRET B SETCREAD CONTINUE * CLEAR2 MOVE :FMTITEM,SPINPUT RESTORE CURRENT CONTENTS CLEA20 GETABX SPBINW4 GET CURRENT TAB INDEX DISPLAY 1,SPBINW4,SPBINW4 DISPLAY FIELD MOVE SPBINW5,$OPT CHECK IF SPERR CBE SPBINW5,=W'0',SPERRRET B SETCREAD CONTINUE * SPERRRET RET * PEND * BELL PROC * ACUSTIC ALARM EDWRT SCREEN,BELLFMT RET * BELLFMT FRMT FSL FILLR X'07',1 FMEND PEND * ERAFMT FRMT FILLR '1',2 FMEND * FFEED FRMT FILLR '1',2 FMEND * * SPLIN8 PROC WRTMES,WRTTYP ******************** * * SPLIN8 - WRITE ON LINE 8 * * MESSAGE DEFINED AS FORMAT NUMBER WRTMES * IN FORMAT TABLE SPFTBMES * * WRTTYP: =0 NO WAIT * =1 WAIT * =2 RETURN * ******************* MOVE SPBINW1,=X'0801' DSC1 SCREEN,6,SPBINW1 SET CURSOR ON LAST ROW MOVE SPBINW1,CBIN0 CBE WRTMES,CBIN0,LIN800 EDWRT SCREEN,SPFTBMES(WRTMES) LIN800 CBE WRTTYP,=W'0',LIN8NW CBE WRTTYP,=W'2',LINRET * READ LIN8IN MOVE SPBINW1,=W'3' REQUESTED LENGTH IB SPKEY,LIN805,LIN810,LIN815 LIN805 NKI KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 B LIN820 LIN810 NKI KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2 B LIN820 LIN815 NKI KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2 LIN820 BNOK LIN8IN JUMP IF NOT OK IB SPBINW2,LIN8IN,LIN8CT,LIN8IN B LIN8IN * CLEAR LINE LIN8CT PERF CLEAR8 ERASE LAST LINE RET * READ WITH NO WAIT LIN8NW MOVE SPBINW1,=W'3' REQUESTED LENGTH IB SPKEY,LIN855,LIN860,LIN865 LIN855 NKI .NW,KEYB,SPINPUT,SPKTAB1,SPBINW1,SPBINW2 B LIN870 LIN860 NKI .NW,KEYB,SPINPUT,SPKTAB12,SPBINW1,SPBINW2 B LIN870 LIN865 NKI .NW,KEYB,SPINPUT,SPKTAB13,SPBINW1,SPBINW2 LIN870 LINRET RET PEND SPINF1 PROC ******************** * * SPINF1 - WRITE INF ON FIRST LINE * ******************** MOVE SPBINW1,=X'0117' DSC1 SCREEN,6,SPBINW1 SET CURSOR ON FIRST LINE MOVE SPBINW1,CBIN0 EDWRT SCREEN,SPFTBMES(CBIN7) WRITE MESSAGE 7 RET PEND * * * SPINF8 PROC ******************** * * SPINF8 - WRITE INF ON LAST LINE * ******************** PERF SPLIN8,CBIN4,CBIN2 RET PEND * * * END