|
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: 14272 (0x37c0)
Notes: pts_type(SC)
Names: »SCREEN.SC«
└─⟦7b35573c9⟧ Bits:30009690 Philips computer tape "600402"
└─⟦this⟧ »A:AF/SCREEN.SC«
IDENT SCREEN REL.9.1 ARBEJDSFORMIDLINGEN * * A STANDARD PROGRAM PACKAGE HANDLING * A COMPLETE PICTURE ON A DISPLAY SCREEN * * RUNNING UNDER: CREDIT REL 4.1 * TOSS REL 9.1 * DDUM SPDDIV PDIV * ENTRY SPCLRA CLEAR ALL VARIABLE FIELDS ENTRY SPCLRS CLEAR SOME VARIABLE FIELDS ENTRY SPCLRN CLEAR NO VARIABLE FIELDS ENTRY SPERR DISPLAY ERROR MESSAGE, UPDATE .. CURRENT FIELD & CONTINUE IN .. .. FORMAT. EXT EMPTYT INCLUDE SPLITT,LIST * * CLEAR ALL VARIABLE FIELD BEFORE HANDLING THE PICTURE * SPCLRA PROC PERF SCREEN,W1 RET PEND * * CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE * SPCLRS PROC PERF SCREEN,W2 RET PEND * * CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE * SPCLRN PROC PERF SCREEN,W3 RET PEND * * HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE * SPERR PROC PERF SCREEN,W0 RET PEND * SPERR2 PROC SET SPERCALL INDICATE SPERR CALL PERF SCREEN,W0 CLEAR SPERCALL RET PEND * SCREEN PROC OPT PBIN OPT MOVE SPBINW2,OPT MOVE TO BARIABLE TO ALLOW INSTR.S CMP AND IB CMP SPBINW2,W0 "SPERR" CALL? BE ERRPRINT YES! MOVE SPBINW1,W1 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,W0 ERASE ALL FROM 1 AND UP B CONT * CLEARS ERASE 5,SPBINW1,W0 ERASE NOT-"NCLR" FIELDS FROM 1 AND UP B CONT * * DISPLAY ENTIRE FORMAT * ENTIRE IB SPBINW2,ECLRA,ECLRS,ECLRN JUMP ON ROUTINE INDEX * * CLEAR ALL VARIABLES * ECLRA ERASE 3,SPBINW1,W0 CLEAR ALL FROM 1 AND UP IN MEMORY B ECLRN CONTINUE * * CLEAR VARIABLES WITHOUT THE "NCLR" FLAG SET * ECLRS ERASE 6,SPBINW1,W0 CLEAR NOT-"NCLR" FIELDS IN MEMORY * * CLEAR NO VARIABLES IN MEMORY * ECLRN DISPLAY 0,SPBINW1,W0 DISPLAY ENTIRE FORM * 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 DYKI SPINPUT,SPKTAB1,SPKTAB2,SPBINW1, C SPBINW2,SPBINW4 BL ERRPRT ERROR CBNG SPBINW2,W0,RETUR JUMP IF POWER OFF OR KEY SWITCHES DYKOUT CBNE SPBINW2,W7,DYK100 IF KEY = TBWD & ... CMP SPBINW1,W0 ... POSITION > 0, ... BNE KEDBWD ... START EDIT DYK100 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,W0,UPD350 JUMP IF LENGTH = 0 GETCTL 3,SPBINW4 GET SCHK-NUMBER CBE SPBINW4,W0,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,W1 INDICATE COND. DISPL B UPD200 UPD070 GETCTL 0,SPBINW3 GET APPL-VALUE CBNE SPBINW3,W0,UPD210 JUMP IF APPL VALUE B SETCREAD * * UNCONDITIONAL DISPLAYING * UPD100 MOVE SPBINW4,W2 INDICATE UNCONDITIONAL DISPLAY UPD200 GETCTL 0,SPBINW3 GET APPL-VALUE CBE SPBINW3,W0,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 UPDATE CURRENT INPUT ... UPDFLD 1,SPINPUT ... FIELD & DISPLAY IT UPD300 SET SPCHANGE INDICATE CHANGED ITEM UPD350 CBE SPBINW2,=X'E',KCOPY TO ALLOW "COPY"-KEY ... ... IN "SPERR2"-CALL TBT SPERCALL,RETUR RETURN IF "SPERR2"-CALL * * JUMP ON FUNCTION KEY INDEX * IB SPBINW2,READIN,DUMMY, C KEOI,DUMMY,DUMMY,KTFWD, C KTBWD,KTHOME,KTLDOWN,KTLEFT,KTRIGHT, C KTDOWN,KTUP,DUMMY,DUMMY,DUMMY,KENTER SUB SPBINW2,=W'14' ADJUST EOI-KEY INDEX DUMMY RETUR RET * UPD400 CBE SPBINW4,W2,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 SETCREAD NOT FOUND BOFL SETCREAD EMPTY COMPULSORY FIELD * * CONDITIONAL TABULATION * PERF SPTCHK CBE SPBINW3,W0,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 SET PRBUSY BOK KCOPY1 PRINTER NOT BUSY MOVE SPBINW3,=W'50' VENT 5 SEKUNDER DELAY SPBINW3 B KCOPY OG PROV IGEN KCOPY1 MOVE SPBINW3,W1 PRINT SPDSPRT,SPBINW3,W0 CLEAR PRBUSY FRIGIV PRINTER TBT SPERCALL,RETUR RETURN IF "SPERR"-CALL B SETCREAD SET CURSOR AND READ * KDUPL DUPLICATION MOVE SPBINW2,W3 INDICATE COMMON EOI-KEY DUPL SPINPUT DUPLICATION BZ UPD260 DUPL ALLOWED MOVE SPBINW4,W4 INDICATE ILLEGAL EOI-KEY B ERRPRINT DUPL NOT ALLOWED * * EDIT FIELD * KEDERR EDIT AFTER ERROR CBE SPBINW1,W0,KEDIT KEDBWD EDIT AFTER TBWD MOVE SPBINW1,W1 KEDIT NORMAL EDIT GETCTL 1,SPBINW3 GET MAXL CBNE SPBINW3,W0,KED100 EDWRT SPDSSCRN,BELL ACOUSTIC ALARM B SETCREAD KED100 EDFLD SPINPUT,SPKTAB3,SPBINW1, C SPBINW2,SPBINW4 BL ERRPRT ERROR CBNG SPBINW2,W0,POWEROFF POWER OFF OR KEY SWITCH CBNE SPBINW1,W0,KED150 LENGTH NOT ZERO SET SPCHANGE ITEM CLEARED BY EDFLD KED150 B DYKOUT CONTINUE AS FOR DYKI * * ENTER KEY * KENTER MOVE SPBINW4,W5 INDICATE COMP.FIELD FOUND MOVE SPBINW1,W0 INDICATE NO CLEARING MOVE SPBINW2,W0 SET INDEX TO LAST FIELD IN FORMAT GETFLD 0,SPBINW2,SPBINW3 SEARCH FOR EMPTY COMP. FIELDS BOFL KENT10 EMPTY COMP. FIELD FOUND TSTCTL 2 LAST FIELD COMPULSORY? BZ KENT05 NO! CALL EMPTYT,:FMTITEM EMPTY? BP KENT10 YES! KENT05 MOVE SPBINW2,W3 INDICATE ENTER KEY DEPRESSED RET * * EMPTY COMPULSORY FIELD FOUND * KENT10 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD B ERRPRINT POWEROFF B RETUR ERRPRT CBE SPBINW2,W16,KEDIT JUMP IF EDIT CBE SPBINW2,W4,CANC JUMP IF CANCEL1 CBE SPBINW2,W5,CANC JUMP IF CANCEL2 CBE SPBINW2,W7,KEDBWD JUMP IF TBWD * * ERROR HANDLING * ERRPRINT CMP SPBINW4,W0 BE SETCREAD JUMP IF NO PRINTOUT EDWRT SPDSSCRN,BELL ACOUSTIC ALARM MOVE SPBINW3,=X'1801' ROW 24 COL. 1 DSC1 SPDSSCRN,6,SPBINW3 SET CURSOR ON LAST ROW EDWRT SPDSSCRN,SPFTBERR(SPBINW4) * * READ AFTER ERROR * ERREAD SETCUR SET CURSOR AT THE BEGINNING OF THE CURRENT FIELD ERR100 MOVE SPBINW3,W1 REQUESTED LENGTH * NKI .NE,SPDSDYKB,SPSTRGW1,SPKTAB1,SPBINW3,SPBINW2 BNZ ERR100 JUMP IF NOT OK CBE SPBINW2,W0,POWEROFF JUMP IF POWER OFF IB SPBINW2,ERR100,ERRCONT C ERRCONT,ERR100,ERRCONT,ERRCONT CBNE SPBINW2,W17,ERR100 TRY AGAIN IF NOT EDIT KEY! * * CLEAR ERROR PRINTOUT * ERRCONT MOVE SPBINW3,='24' INDICATE LAST LINE ERASE 0,SPBINW3,SPBINW3 ERASE LAST LINE CBE SPBINW2,W17,KEDERR EDIT KEY SUB SPBINW2,W1 ADJUST KEY INDEX CANC CBE SPBINW1,W0,ERRC10 JUMP IF LENGTH = 0 MOVE SPINPUT,:FMTITEM SAVE CURRENT CONTENTS MOVE SPSTRGW1,=X'3100' MOVE :FMTITEM,SPSTRGW1 PUT SOMETHING IN THE FIELD GETABX SPBINW4 GET CURRENT INDEX ERASE 10,SPBINW4,SPBINW4 CLEAR FIELD ERRC10 IB SPBINW2,CLEAR1,CLEAR2,DUMMY SUB SPBINW2,W3 ADJUST FOR CANCEL1,CANCEL2 RET CLEAR1 CBE SPBINW1,W0,ERRC20 JUMP IF LENGTH = 0 SET SPCHANGE INDICATE CHANGED FIELD ERRC20 B SETCREAD CONTINUE * CLEAR2 CBE SPBINW1,W0,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 * BELL FRMT FSL FILLR X'07',1 FMEND PEND XSTAT SPDSSCRN,TBIN5 EJECT SPTCHK PROC RET PEND SPCHK1 PROC RET PEND SPCHK2 PROC RET PEND SPCHK3 PROC RET PEND SPCHK4 PROC RET PEND SPCHK5 PROC RET PEND SPCHK6 PROC RET PEND SPCHK7 PROC RET PEND SPAPPL PROC RET PEND END