DataMuseum.dk

top - metrics - download

    Length: 14162 (0x3752)
    Notes: pts_type(SC)
    Names: »SCREEN.SC«

└─⟦173d42e04⟧ Bits:30009663 Philips computer tape "600105"
    └─⟦this⟧ »SCREEN/SCREEN.SC« 

PTS(SC)

	IDENT SCREEN	REL=10.0,800314,870138041000
* 
*    A STANDARD PROGRAM PACKAGE HANDLING
*    A COMPLETE PICTURE ON A DISPLAY SCREEN 
* 
*    RUNNING UNDER:  CREDIT REL 10.0
*                    TOSS   REL 10.0
* 
 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. 
 ENTRY SPERR2 DISPLAY ERROR MESSAGE, UPDATE 
			.. CURRENT FIELD & RETURN. 
* 
 EXPROC SPCHK1 STANDARD CHECK ROUTINE NO. 1 
 EXPROC SPCHK2 STANDARD CHECK ROUTINE NO. 2 
 EXPROC SPCHK3 STANDARD CHECK ROUTINE NO. 3 
 EXPROC SPCHK4 STANDARD CHECK ROUTINE NO. 4 
 EXPROC SPCHK5 STANDARD CHECK ROUTINE NO.5
 EXPROC SPCHK6 STANDARD CHECK ROUTINE NO. 6 
 EXPROC SPCHK7 STANDARD CHECK ROUTINE NO. 7 
 EXPROC SPAPPL USER ROUTINE TO HANDLE 
			APPL VALUES
 EXPROC SPTCHK USER ROUTINE TO EVALUATE 
			CONDITIONAL TABULATION 
			APPL VALUES
			CONDITIONAL TABULATION 
* 
	EXT	EMPTYT	ASSEMBLY SUBROUTINE EMPTYT  - 
			TEST IF DATA ITEM IS EMPTY 
* 
 EJECT
 INCLUDE SPLITT,LIST
 EJECT
* 
*    CLEAR ALL VARIABLE FIELD BEFORE HANDLING THE PICTURE 
* 
SPCLRA PROC 
	PERF	SCREEN,=W'1'
	RET
 PEND 
* 
*    CLEAR SOME VARIABLE FIELDS BEFORE HANDLING THE PICTURE 
* 
SPCLRS PROC 
	PERF	SCREEN,=W'2'
	RET
 PEND 
* 
*    CLEAR NO VARIABLE FIELDS BEFORE HANDLING THE PICTURE 
* 
SPCLRN PROC 
	PERF	SCREEN,=W'3'
	RET
 PEND 
* 
*    HANDLE ERRORS DETECTED OUTSIDE THE PACKAGE 
* 
SPERR PROC
 PERF SCREEN,=W'0' SPERR WITHOUT DIRECT RETURN
 RET
 PEND 
* 
SPERR2 PROC 
 SET SPERCALL INDICATE SPERR CALL 
 PERF SCREEN,=W'0' SPERR WITH DIRECT RETURN 
 CLEAR SPERCALL 
	RET
 PEND 
* 
 EJECT
SCREEN	PROC	OPTION
	PLIT	OPTION	OPTIONS SELECTOR 

	MOVE	SPBINW2,OPTION	MOVE TO VARIABLE 
			TO ALLOW INSTR.S CMP AND IB
 CMP SPBINW2,='0' "SPERR" CALL? 
 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 NOT-"NCLR" FIELDS 
			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 VARIABLES WITHOUT THE "NCLR" FLAG SET
* 
ECLRS 
 ERASE 6,SPBINW1,='0' CLEAR NOT-"NCLR" FIELDS 
			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,SPKTAB1,SPKTAB2,SPBINW1,		C 
		SPBINW2,SPBINW4 
 BL ERRPRT ERROR
 CBNG SPBINW2,='0',RETUR JUMP IF POWER OFF OR 
			KEY SWITCHES 
DYKOUT
 CBNE SPBINW2,='7',DYK100 IF KEY = TBWD & ... 
 CMP SPBINW1,='0' ... 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
	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			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
* 
 EJECT
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 
 MOVE SPBINW3,='1'
 PRINT SPDSPRT,SPBINW3,='0' 
 TBT SPERCALL,RETUR RETURN IF "SPERR"-CALL
 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 
* 
KEDERR			EDIT AFTER ERROR 
 CBE SPBINW1,='0',KEDIT 
KEDBWD			EDIT AFTER TBWD
 MOVE SPBINW1,='1'
KEDIT			NORMAL EDIT 
 GETCTL 1,SPBINW3 GET MAXL
 CBNE SPBINW3,='0',KED100 
 EDWRT SPDSSCRN,BELL ACOUSTIC ALARM 
 B SETCREAD 
KED100
 EDFLD SPINPUT,SPKTAB3,SPBINW1,		C
		SPBINW2,SPBINW4 
 BL ERRPRT ERROR
 CBNG SPBINW2,='0',POWEROFF POWER OFF OR KEY SWITCH 
 CBNE SPBINW1,='0',KED150 LENGTH NOT ZERO 
 SET SPCHANGE ITEM CLEARED BY EDFLD 
KED150
 B DYKOUT CONTINUE AS FOR DYKI
	EJECT
* 
*    ENTER KEY
* 
KENTER
 MOVE SPBINW4,='5' INDICATE COMP.FIELD FOUND
 MOVE SPBINW1,='0' INDICATE NO CLEARING 
 MOVE SPBINW2,='0' 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,='3' INDICATE ENTER KEY DEPRESSED 
 RET
* 
*    EMPTY COMPULSORY FIELD FOUND 
* 
KENT10
 GETFLD 0,SPBINW3,SPBINW2 GET THE COMPULSORY FIELD
 B ERRPRINT 
 EJECT
POWEROFF
 B RETUR
ERRPRT
 CBE SPBINW2,='16',KEDIT	JUMP IF EDIT 
 CBE SPBINW2,='4',CANC JUMP IF CANCEL1
 CBE SPBINW2,='5',CANC JUMP IF CANCEL2
 CBE SPBINW2,='7',KEDBWD JUMP IF TBWD 
* 
*    ERROR HANDLING 
* 
ERRPRINT
 CMP SPBINW4,='0' 
 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,='1' REQUESTED LENGTH 
* 
 NKI .NE,SPDSDYKB,SPSTRGW1,SPKTAB1,SPBINW3,SPBINW2
 BNZ ERR100 JUMP IF NOT OK
 CBE SPBINW2,='0',POWEROFF JUMP IF POWER OFF
 IB SPBINW2,ERR100,ERRCONT		C 
		ERRCONT,ERR100,ERRCONT,ERRCONT
 CBNE SPBINW2,='17',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,='17',KEDERR EDIT KEY
 SUB SPBINW2,='1' ADJUST KEY INDEX
CANC
 CBE SPBINW1,='0',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,='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 
* 
BELL FRMT 
 FSL
 FILLR X'07',1
 FMEND

	PEND 

 END