VALM4 ;ALB/MJK - Screen Malipulation Utilities ;02:36 PM 16 Dec 1992
;;1;List Manager;;Aug 13, 1993
;
NEXT ; -- display next screen (NX)
D START
N VALMLSTO,I,LN
I VALMBG+VALM("LINES")>VALMCNT W *7 G NEXTQ
S VALMBG=VALMBG+VALM("LINES")
S VALMLSTO=VALMLST
I VALMCC D LST,SCROLL D
.S DY=VALM("BM")-1 D IOXY(0,.DY)
.S I=VALMLSTO+1 F LN=1:1:VALM("LINES") D WRITE(I,1,1,.DY) S I=I+1
.D PLUS,RESET
D PGUPD
NEXTQ D FINISH Q
;
PREV ; -- display previous screen (BU)
D START
N I,LN,X,Y,VALMBGO
I VALMBG=1 W *7 G PREVQ
S Y=VALMBG-VALM("LINES")
S VALMBGO=VALMBG,VALMBG=$S(Y<1:1,1:Y)
I VALMCC D LST,SCROLL D
.S DY=VALM("TM")-1
.S I=VALMBGO-1 F LN=1:1:VALM("LINES") D IOIL(0,.DY),WRITE(I,0,1,.DY) Q:I=1 S I=I-1
.D PLUS,RESET
D PGUPD
PREVQ D FINISH Q
;
FIRST ; -- display first screen (FS)
D START
I VALMBG=1 W *7 G FIRSTQ
S VALMBG=1
I VALMCC D LST,PAINT
D PGUPD
FIRSTQ D FINISH Q
;
LAST ; -- display last screen (LS)
D START
N Y,I
I VALMCNT'>VALM("LINES") W *7 G LASTQ
; first line of the last screen :=
; (# of full screens less 1 if last screen is also full) x # lines per screen) + 1 line
S Y=(((VALMCNT\VALM("LINES"))-'(VALMCNT#VALM("LINES")))*VALM("LINES"))+1
I Y=VALMBG W *7 G LASTQ
S VALMBG=Y
I VALMCC D LST,PAINT
D PGUPD
LASTQ D FINISH Q
;
START ; -- start action tasks
S:VALMMENU VALMDY=""
W VALMCOFF
Q
;
FINISH ; -- finish action tasks
S VALMBCK=$S(VALMCC:"",1:"R")
W VALMCON
Q
;
PAINT ;
N I,LN,X D SCROLL
I $E(IOST,1,4)="C-VT" S DY=VALM("TM")-1 D IOXY(0,.DY) W *27,*91,VALM("LINES"),*77
S I=VALMBG F LN=1:1:VALM("LINES") S DY=VALM("TM")+LN-2 D IOIL(0,.DY),WRITE(I,0,1,.DY) S I=I+1
D PLUS,RESET
Q
;
IOIL(DX,DY) ; -- position cursor ; insert line ; cr
W ! X IOXY W IOIL,$C(13)
Q
;
IOXY(DX,DY) ; -- position cursor and tell os
X IOXY ;,VALMIOXY
Q
;
RE ; -- re-display current screen (RE)
D REFRESH^VALM S VALMBCK=""
Q
;
RESET ; -- reset scrolling region to bottom of screen
I '$D(VALMDY) D IOXY(0,VALM("BM")+1) W IOEDEOP
S IOTM=VALM("BM")+2,IOBM=IOSL W IOSC W @IOSTBM W IORC
D UND($$LOWER^VALM1($$NOW^VALM1),31+((VALMWD-80)/2),1,21,.IOUON,.IOUOFF,0)
I $D(VALMBCK) D IOXY(0,VALM("BM"))
Q
;
SCROLL ; -- set scrolling region to list area
S IOTM=VALM("TM"),IOBM=VALM("BM") W IOSC W @IOSTBM W IORC
Q
;
LST ; -- compute last line on screen
N I
S I=VALMBG+VALM("LINES")-1,VALMLST=$S($D(@VALMAR@(I,0)):I,1:VALMCNT)
Q
;
WRITE(LINE,LF,CTRL,DY) ;
N TEXT
;S LINE=+$$GET(LINE)
S TEXT=$$EXTRACT($G(@VALMAR@(LINE,0))),DX=VALMWD
W:LF !
; -- write text if no formatting needed or allowed
I 'CTRL!('$O(^TMP("VALM VIDEO",$J,VALMEVL,LINE,0)))!('VALMCC) W TEXT G WRITEQ
;
D:VALM("FIXED") FORMAT(.LINE,.TEXT,0,0,1,VALM("FIXED"),.DY)
D FORMAT(.LINE,.TEXT,VALM("FIXED"),VALM("FIXED"),VALMLFT,VALMWD,.DY)
WRITEQ Q
;
FORMAT(LINE,TEXT,FIXED,PREVCOL,TXTLEFT,RMAR,DY) ;
N ATR,WIDTH,COL,LASTCOL,FIN,CRTLCOL
S COL=0,FIN=0
; -- scan for attributes
F Q:FIN S COL=$O(^TMP("VALM VIDEO",$J,VALMEVL,LINE,COL)) Q:'COL S WIDTH="" F S WIDTH=$O(^TMP("VALM VIDEO",$J,VALMEVL,LINE,COL,WIDTH)) Q:WIDTH="" S ATR=^(WIDTH) D Q:FIN
.I TXTLEFT>(COL+WIDTH-1) Q
.S CTRLCOL=COL-TXTLEFT+FIXED
.S:CTRLCOL<(PREVCOL+1) CTRLCOL=PREVCOL
.S:CTRLCOL'<RMAR CTRLCOL=RMAR,FIN=1
.W $E(TEXT,PREVCOL+1,CTRLCOL) S PREVCOL=CTRLCOL
.W $C(13)_ATR_$C(13) D IOXY(.CTRLCOL,.DY)
I PREVCOL<RMAR W $E(TEXT,PREVCOL+1,RMAR)
W $C(13)_VALMSGR_$C(13) D IOXY(.RMAR,.DY)
FORMATQ Q
;
Q $S(X="":X,1:$E($E(X,1,+VALM("FIXED"))_$E(X,VALMLFT,VALMLFT+VALMWD-1-VALM("FIXED"))_$J("",VALMWD),1,VALMWD))
;
GET(LNUM) ; -- get actual line number (may be different if indexed)
Q $S(VALM(0)["I":$G(@VALMIDX@(LNUM)),1:LNUM)
;
PLUS ; -- add plus indicators to screen
N UP,DN
;
W $C(13) ; -- needed to prevent extra LF's after FORMAT loops
;
S UP=(VALMBG'=1),DN=$S('$D(VALMLST):0,VALM(0)["I":$O(@VALMIDX@(+VALMLST))>0,1:$O(@VALMAR@(+VALMLST))>0)
;
I UP'=VALMUP S VALMUP=UP D UND($S(UP:"+",1:" "),1,VALM("TM")-1,1,.IOUON,.IOUOFF,0)
I DN'=VALMDN S VALMDN=DN D UND($S(DN:"+",1:" "),1,VALM("BM")+1,1,.IORVON,.IORVOFF,0)
Q
;
PGUPD ; -- update page var and screen
N P
S P=$$PAGE(VALMBG,VALM("LINES")) G PGUPDQ:P=VALMPGE
S VALMPGE=P
D:VALMCC UND($J(P,4),VALMWD-12,1,4,.IOUON,.IOUOFF,0)
PGUPDQ Q
;
PAGE(BEG,LINES) ; -- calc page #
S BEG=$S($D(@VALMAR@(BEG,0)):BEG,1:0)
Q (BEG\LINES)+((BEG#LINES)>0)
;
UND(STR,X,Y,LEN,ON,OFF,ERASE) ;
W $C(13)_ON_$C(13) D INSTR^VALM1(STR,X,Y,LEN,+$G(ERASE)) W $C(13)_OFF_$C(13)
Q
VALM4 ;ALB/MJK - Screen Malipulation Utilities ;02:36 PM 16 Dec 1992
+1 ;;1;List Manager;;Aug 13, 1993
+2 ;
NEXT ; -- display next screen (NX)
+1 DO START
+2 NEW VALMLSTO,I,LN
+3 IF VALMBG+VALM("LINES")>VALMCNT
WRITE *7
GOTO NEXTQ
+4 SET VALMBG=VALMBG+VALM("LINES")
+5 SET VALMLSTO=VALMLST
+6 IF VALMCC
DO LST
DO SCROLL
Begin DoDot:1
+7 SET DY=VALM("BM")-1
DO IOXY(0,.DY)
+8 SET I=VALMLSTO+1
FOR LN=1:1:VALM("LINES")
DO WRITE(I,1,1,.DY)
SET I=I+1
+9 DO PLUS
DO RESET
End DoDot:1
+10 DO PGUPD
NEXTQ DO FINISH
QUIT
+1 ;
PREV ; -- display previous screen (BU)
+1 DO START
+2 NEW I,LN,X,Y,VALMBGO
+3 IF VALMBG=1
WRITE *7
GOTO PREVQ
+4 SET Y=VALMBG-VALM("LINES")
+5 SET VALMBGO=VALMBG
SET VALMBG=$SELECT(Y<1:1,1:Y)
+6 IF VALMCC
DO LST
DO SCROLL
Begin DoDot:1
+7 SET DY=VALM("TM")-1
+8 SET I=VALMBGO-1
FOR LN=1:1:VALM("LINES")
DO IOIL(0,.DY)
DO WRITE(I,0,1,.DY)
IF I=1
QUIT
SET I=I-1
+9 DO PLUS
DO RESET
End DoDot:1
+10 DO PGUPD
PREVQ DO FINISH
QUIT
+1 ;
FIRST ; -- display first screen (FS)
+1 DO START
+2 IF VALMBG=1
WRITE *7
GOTO FIRSTQ
+3 SET VALMBG=1
+4 IF VALMCC
DO LST
DO PAINT
+5 DO PGUPD
FIRSTQ DO FINISH
QUIT
+1 ;
LAST ; -- display last screen (LS)
+1 DO START
+2 NEW Y,I
+3 IF VALMCNT'>VALM("LINES")
WRITE *7
GOTO LASTQ
+4 ; first line of the last screen :=
+5 ; (# of full screens less 1 if last screen is also full) x # lines per screen) + 1 line
+6 SET Y=(((VALMCNT\VALM("LINES"))-'(VALMCNT#VALM("LINES")))*VALM("LINES"))+1
+7 IF Y=VALMBG
WRITE *7
GOTO LASTQ
+8 SET VALMBG=Y
+9 IF VALMCC
DO LST
DO PAINT
+10 DO PGUPD
LASTQ DO FINISH
QUIT
+1 ;
START ; -- start action tasks
+1 IF VALMMENU
SET VALMDY=""
+2 WRITE VALMCOFF
+3 QUIT
+4 ;
FINISH ; -- finish action tasks
+1 SET VALMBCK=$SELECT(VALMCC:"",1:"R")
+2 WRITE VALMCON
+3 QUIT
+4 ;
PAINT ;
+1 NEW I,LN,X
DO SCROLL
+2 IF $EXTRACT(IOST,1,4)="C-VT"
SET DY=VALM("TM")-1
DO IOXY(0,.DY)
WRITE *27,*91,VALM("LINES"),*77
+3 SET I=VALMBG
FOR LN=1:1:VALM("LINES")
SET DY=VALM("TM")+LN-2
DO IOIL(0,.DY)
DO WRITE(I,0,1,.DY)
SET I=I+1
+4 DO PLUS
DO RESET
+5 QUIT
+6 ;
IOIL(DX,DY) ; -- position cursor ; insert line ; cr
+1 WRITE !
XECUTE IOXY
WRITE IOIL,$CHAR(13)
+2 QUIT
+3 ;
IOXY(DX,DY) ; -- position cursor and tell os
+1 ;,VALMIOXY
XECUTE IOXY
+2 QUIT
+3 ;
RE ; -- re-display current screen (RE)
+1 DO REFRESH^VALM
SET VALMBCK=""
+2 QUIT
+3 ;
RESET ; -- reset scrolling region to bottom of screen
+1 IF '$DATA(VALMDY)
DO IOXY(0,VALM("BM")+1)
WRITE IOEDEOP
+2 SET IOTM=VALM("BM")+2
SET IOBM=IOSL
WRITE IOSC
WRITE @IOSTBM
WRITE IORC
+3 DO UND($$LOWER^VALM1($$NOW^VALM1),31+((VALMWD-80)/2),1,21,.IOUON,.IOUOFF,0)
+4 IF $DATA(VALMBCK)
DO IOXY(0,VALM("BM"))
+5 QUIT
+6 ;
SCROLL ; -- set scrolling region to list area
+1 SET IOTM=VALM("TM")
SET IOBM=VALM("BM")
WRITE IOSC
WRITE @IOSTBM
WRITE IORC
+2 QUIT
+3 ;
LST ; -- compute last line on screen
+1 NEW I
+2 SET I=VALMBG+VALM("LINES")-1
SET VALMLST=$SELECT($DATA(@VALMAR@(I,0)):I,1:VALMCNT)
+3 QUIT
+4 ;
WRITE(LINE,LF,CTRL,DY) ;
+1 NEW TEXT
+2 ;S LINE=+$$GET(LINE)
+3 SET TEXT=$$EXTRACT($GET(@VALMAR@(LINE,0)))
SET DX=VALMWD
+4 IF LF
WRITE !
+5 ; -- write text if no formatting needed or allowed
+6 IF 'CTRL!('$ORDER(^TMP("VALM VIDEO",$JOB,VALMEVL,LINE,0)))!('VALMCC)
WRITE TEXT
GOTO WRITEQ
+7 ;
+8 IF VALM("FIXED")
DO FORMAT(.LINE,.TEXT,0,0,1,VALM("FIXED"),.DY)
+9 DO FORMAT(.LINE,.TEXT,VALM("FIXED"),VALM("FIXED"),VALMLFT,VALMWD,.DY)
WRITEQ QUIT
+1 ;
FORMAT(LINE,TEXT,FIXED,PREVCOL,TXTLEFT,RMAR,DY) ;
+1 NEW ATR,WIDTH,COL,LASTCOL,FIN,CRTLCOL
+2 SET COL=0
SET FIN=0
+3 ; -- scan for attributes
+4 FOR
IF FIN
QUIT
SET COL=$ORDER(^TMP("VALM VIDEO",$JOB,VALMEVL,LINE,COL))
IF 'COL
QUIT
SET WIDTH=""
FOR
SET WIDTH=$ORDER(^TMP("VALM VIDEO",$JOB,VALMEVL,LINE,COL,WIDTH))
IF WIDTH=""
QUIT
SET ATR=^(WIDTH)
Begin DoDot:1
+5 IF TXTLEFT>(COL+WIDTH-1)
QUIT
+6 SET CTRLCOL=COL-TXTLEFT+FIXED
+7 IF CTRLCOL<(PREVCOL+1)
SET CTRLCOL=PREVCOL
+8 IF CTRLCOL'<RMAR
SET CTRLCOL=RMAR
SET FIN=1
+9 WRITE $EXTRACT(TEXT,PREVCOL+1,CTRLCOL)
SET PREVCOL=CTRLCOL
+10 WRITE $CHAR(13)_ATR_$CHAR(13)
DO IOXY(.CTRLCOL,.DY)
End DoDot:1
IF FIN
QUIT
+11 IF PREVCOL<RMAR
WRITE $EXTRACT(TEXT,PREVCOL+1,RMAR)
+12 WRITE $CHAR(13)_VALMSGR_$CHAR(13)
DO IOXY(.RMAR,.DY)
FORMATQ QUIT
+1 ;
+1 QUIT $SELECT(X="":X,1:$EXTRACT($EXTRACT(X,1,+VALM("FIXED"))_$EXTRACT(X,VALMLFT,VALMLFT+VALMWD-1-VALM("FIXED"))_$JUSTIFY("",VALMWD),1,VALMWD))
+2 ;
GET(LNUM) ; -- get actual line number (may be different if indexed)
+1 QUIT $SELECT(VALM(0)["I":$GET(@VALMIDX@(LNUM)),1:LNUM)
+2 ;
PLUS ; -- add plus indicators to screen
+1 NEW UP,DN
+2 ;
+3 ; -- needed to prevent extra LF's after FORMAT loops
WRITE $CHAR(13)
+4 ;
+5 SET UP=(VALMBG'=1)
SET DN=$SELECT('$DATA(VALMLST):0,VALM(0)["I":$ORDER(@VALMIDX@(+VALMLST))>0,1:$ORDER(@VALMAR@(+VALMLST))>0)
+6 ;
+7 IF UP'=VALMUP
SET VALMUP=UP
DO UND($SELECT(UP:"+",1:" "),1,VALM("TM")-1,1,.IOUON,.IOUOFF,0)
+8 IF DN'=VALMDN
SET VALMDN=DN
DO UND($SELECT(DN:"+",1:" "),1,VALM("BM")+1,1,.IORVON,.IORVOFF,0)
+9 QUIT
+10 ;
PGUPD ; -- update page var and screen
+1 NEW P
+2 SET P=$$PAGE(VALMBG,VALM("LINES"))
IF P=VALMPGE
GOTO PGUPDQ
+3 SET VALMPGE=P
+4 IF VALMCC
DO UND($JUSTIFY(P,4),VALMWD-12,1,4,.IOUON,.IOUOFF,0)
PGUPDQ QUIT
+1 ;
PAGE(BEG,LINES) ; -- calc page #
+1 SET BEG=$SELECT($DATA(@VALMAR@(BEG,0)):BEG,1:0)
+2 QUIT (BEG\LINES)+((BEG#LINES)>0)
+3 ;
UND(STR,X,Y,LEN,ON,OFF,ERASE) ;
+1 WRITE $CHAR(13)_ON_$CHAR(13)
DO INSTR^VALM1(STR,X,Y,LEN,+$GET(ERASE))
WRITE $CHAR(13)_OFF_$CHAR(13)
+2 QUIT
