|
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: 14116 (0x3724)
Notes: pts_type(SC)
Names: »DEMSCR.SC«
└─⟦35fda6e03⟧ Bits:30009701 Philips computer tape "BARCLAY"
└─⟦this⟧ »DEMO6800/DEMSCR.SC«
└─⟦e276fd206⟧ Bits:30009696 Philips computer tape "600413"
└─⟦this⟧ »DEMO6800/DEMSCR.SC«
IDENT DEMSCR PTSDEMO SCREEN MANAGEMENT * * SPECIAL PTS6800 DEMONSTRATION VERSION * * CHANGES HAVE BEEN INDICATED BY: 'PTSDEMO SPECIAL' * FURTHERMORE THE KEYTABLES USED HAVE BEEN PARAMETERIZED !! * * A STANDARD PROGRAM PACKAGE HANDLING * A COMPLETE PICTURE ON A DISPLAY SCREEN * * RUNNING UNDER: CREDIT REL 3.1 * TOSS REL 8.1 * DDUM DEMODD 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 * 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 ************************************************************************ * PTSDEMO SPECIAL EXT XCLAMP EXT XFERR1 EXT QHSPKY * INCLUDE SPLITT,LIST HAS BEEN DELETED ************************************************************************ EJECT * * CLEAR ALL VARIABLE FIELD BEFORE HANDLING THE PICTURE * SPCLRA PROC PSPKTAB1,PSPKTAB2,PSPKTAB3 PKTAB PSPKTAB1 PKTAB PSPKTAB2 PKTAB PSPKTAB3 PERF SCREEN,=W'1',PSPKTAB1,PSPKTAB2,PSPKTAB3 RET PEND * * CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * SPCLRS PROC PSPKTAB1,PSPKTAB2,PSPKTAB3 PKTAB PSPKTAB1 PKTAB PSPKTAB2 PKTAB PSPKTAB3 PERF SCREEN,=W'2',PSPKTAB1,PSPKTAB2,PSPKTAB3 RET PEND * * CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * SPCLRN PROC PSPKTAB1,PSPKTAB2,PSPKTAB3 PKTAB PSPKTAB1 PKTAB PSPKTAB2 PKTAB PSPKTAB3 PERF SCREEN,=W'3',PSPKTAB1,PSPKTAB2,PSPKTAB3 RET PEND * * HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE * SPERR PROC PSPKTAB1,PSPKTAB2,PSPKTAB3 PKTAB PSPKTAB1 PKTAB PSPKTAB2 PKTAB PSPKTAB3 PERF SCREEN,=W'0',PSPKTAB1,PSPKTAB2,PSPKTAB3 RET PEND * EJECT SCREEN PROC POPT,PSPKTAB1,PSPKTAB2,PSPKTAB3 PLIT POPT OPTIO SELECTOR PKTAB PSPKTAB1 PKTAB PSPKTAB2 PKTAB PSPKTAB3 MOVE SPBINW2,POPT MOVE TO VARIABLE TO ALLOW INSTR.S CMP AND IB CMP SPBINW2,='0' "SPERR" ENTRY ? BE ERRPRINT YES ! MOVE SPBINW1,='1' SET INITIAL VALUE TBT SPPROMPT,ENTIRE JUMP IF ENTIRE FORMAT SHOULD BE DISPLAYED * * ONLY VARIABLE FIELDS * IB SPBINW2,CLEARA,CLEARS,CONT JUMP ON ROUTINE INDEX * CLEARA ERASE 2,SPBINW1,='0' ERASE ALL FROM 1 AND UP B CONT * CLEARS ERASE 5,SPBINW1,='0' ERASE SOME FROM 1 AND UP B CONT EJECT * * DISPLAY ENTIRE FORMAT * ENTIRE IB SPBINW2,ECLRA,ECLRS,ECLRN JUMP ON ROUTINE INDEX * * CLEAR ALL VARIABLES * ECLRA ERASE 3,SPBINW1,='0' CLEAR ALL FROM 1 AND UP IN MEMORY B ECLRN CONTINUE * * CLEAR SOME VARIABLES * ECLRS ERASE 6,SPBINW1,='0' CLEAR SOME FIELDS FROM 1 AND UP IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN DISPLAY 0,SPBINW1,='0' DISPLAY ENTIRE FORM EJECT * 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 * EJECT * * SET CURSOR AND READ KEYBOARD * SETCREAD SETCUR SET CURSOR ON CURRENT FIELD * * READ TO CURRENT FIELD ON DISPLAY * READIN DYKI SPINPUT,PSPKTAB1,PSPKTAB2,SPBINW1, C SPBINW2,SPBINW4 BL ERRPRT ERROR ************************************************************************ * PTSDEMO SPECIAL PERF QHSPKY,SPBINW2,KWSPEOI,KWSPKTB ADAPT SPBINW2 ************************************************************************ CBNG SPBINW2,='0',RETUR JUMP IF POWER OFF OR KEY SWITCHES DYKOUT 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 EJECT * * 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,UPD100,UPD070,ERRPRINT * * CONDITIONAL DISPLAYING * UPD050 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,UPD260,SETCREAD,ERRPRINT B UPD400 * * OK AFTER APPL CONTROL * UNCONDITIONAL DISPLAYING * UPD260 UPDFLD 1,SPINPUT UPDATE FIELD WITH DISPLAYING UPD300 SET SPCHANGE INDICATE CHANGED ITEM UPD350 * 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 * EJECT 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 SETCREAD NOT FOUND BOFL SETCREAD EMPTY COMPULSORY FIELD * * * CONDITIONAL TABULATION * PERF SPTCHK CBE SPBINW3,='0',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 EJECT KCOPY HARD COPY ************************************************************************ * PTSDEMO SPECIAL CBNE RDPRTTYP,=D'2',SETCREAD ONLY HARDCOPY FOR GTP EDWRT SPDSPRT,FMTSKIP ************************************************************************ MOVE SPBINW3,='1' PRINT SPDSPRT,SPBINW3,='0' B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE SPBINW2,='3' INDICATE COMMON EOI-KEY DUPL SPINPUT DUPLICATION BZ UPD260 DUPL ALLOWED MOVE SPBINW4,='4' INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED EJECT * * EDIT FIELD * KEDIT GETCTL 1,SPBINW3 GET MAXL CBNE SPBINW3,='0',KED100 EDWRT SPDSSCRN,BELL ACOUSTIC ALARM B SETCREAD KED100 EDFLD SPINPUT,PSPKTAB3,SPBINW1, C SPBINW2,SPBINW4 BL ERRPRT ERROR ************************************************************************ * PTSDEMO SPECIAL PERF QHSPKY,SPBINW2,KWSPEOI,KWSPKTB3 ADAPT SPBINW2 FOR KB34 ************************************************************************ CBNG SPBINW2,='0',RETUR POWER OFF OR KEY SWITCH CBNE SPBINW1,='0',DYKOUT LENGTH NOT ZERO SET SPCHANGE ITEM CLEARED BY EDFLD B DYKOUT CONTINUE AS FOR DYKI * * ENTER KEY * KENTER 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 B ERRPRINT EJECT 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 CBE SPBINW4,='0',ERRC20 JUMP IF NO PRINTOUT ************************************************************************ * PTSDEMO SPECIAL PERF XFERR1,SPBINW4,KW0 DISPLAY ERROR ************************************************************************ * * READ AFTER ERROR * ERREAD SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD ERR100 MOVE SPBINW3,=W'14' REQUESTED LENGTH NKI .NE,SPDSDYKB,SPINPUT,PSPKTAB1,SPBINW3,SPBINW2 BNZ ERR100 JUMP IF NOT OK ************************************************************************ * PTSDEMO SPECIAL MOVE SPBINW3,KWSPEOI ADD SPBINW3,=W'1' ADJUST INDEX PERF QHSPKY,SPBINW2,SPBINW3,KWSPKTB ADAPT SPBINW2 FOR KB34 ************************************************************************ CBE SPBINW2,='0',RETUR JUMP IF POWER OFF IB SPBINW2,ERR100,ERRCONT C ERRCONT,ERR100,ERRCONT,ERRCONT B ERR100 CONTINUE * * CLEAR ERROR PRINTOUT * ERRCONT ************************************************************************ * PTSDEMO SPECIAL PERF XCLAMP,KW3,KW0 ERROR LAMP OFF PERF XCLAMP,KW1,KW1 READY LAMP ON MOVE SPBINW3,SPLSTLNE INDICATE LAST LINE ****************************************************************** ERASE 0,SPBINW3,SPBINW3 ERASE LAST LINE 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 B SETCREAD CONTINUE * CLEAR2 CBE SPBINW1,='0',CLEA20 JUMP IF LENGTH 0 MOVE :FMTITEM,SPINPUT RESTORE CURRENT CONTENTS CLEA20 GETABX SPBINW4 GET CURRENT TAB INDEX DISPLAY 1,SPBINW4,SPBINW4 DISPLAY FIELD B SETCREAD CONTINUE * BELL FRMT FSL FILLR X'07',1 FMEND ************************************************************************ * PTSDEMO SPECIAL FMTSKIP FRMT FTEXT '00' SKIP 2 LINES FMEND ************************************************************************ PEND END