DataMuseum.dk

top - metrics - download

    Length: 10988 (0x2aec)
    Notes: pts_type(SC)
    Names: »SCREEN.SC«

└─⟦efe3a1cfc⟧ Bits:30009667 Philips computer tape "600113"
    └─⟦this⟧ »SCREEN/SCREEN.SC« 

PTS(SC)

	IDENT  SCREEN  	78-09-15  8701 380 40320 
* 
*    A STANDARD PROGRAM PACKAGE HANDLING
*    A COMPLETE PICTURE ON A DISPLAY SCREEN 
* 
*    RUNNING UNDER:  CREDIT REL 3.1 
*                    TOSS   REL 8.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 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 
* 
 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'
	RET
 PEND 
* 
 EJECT
SCREEN	PROC	$OPT
	PLIT	$OPT	OPTIO SELECTOR 

	MOVE	SPBINW2,$OPT	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,SPKTAB1,SPKTAB2,SPBINW1,		C 
		SPBINW2,SPBINW4 
 BL ERRPRT ERROR
 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 
 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,SPKTAB3,SPBINW1,		C
		SPBINW2,SPBINW4 
 BL ERRPRT ERROR
 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
 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,=W'14' REQUESTED LENGTH 
 NKIA .NE,SPDSDYKB,SPINPUT,SPKTAB1,SPBINW3,SPBINW2
 BNZ ERR100 JUMP IF NOT OK
 CBE SPBINW2,='0',RETUR JUMP IF POWER OFF 
 IB SPBINW2,ERR100,ERRCONT		C 
		ERRCONT,ERR100,ERRCONT,ERRCONT
 B ERR100 CONTINUE
* 
*    CLEAR ERROR PRINTOUT 
* 
ERRCONT 
 MOVE SPBINW3,='24' 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

	PEND 

 END