RevMedia

0001    SUBROUTINE RTEXT(A,B,IVAL,D,LEFT,F,TOP,WIDTH,I,TITLE,K,L,M)
0002    *
0003    *    Author    AmcA
0004    *    Date      December 1989
0005    *    Purpose   To provide RTEXT replacement for use with V16
0006    *    Copyright Sprezzatura Ltd 1989 Permission is granted for REVMEDIA
0007    *              subscribers to use this program for any purpose.  No
0008    *              liability accepted for use.  Dummy variables used in call
0009    *              as they are passed and must therefore be accepted.
0010    *
0011    DECLARE SUBROUTINE VIDEO.RW, SCRIBE, BORDER.UP, MESSAGE
0012    DEPTH = 21 ; RIGHT = 79 ; BOTTOM = 21
0013    * Save screen, clear it, put up box and title
0014    VIDEO.RW(0,0,79,21,"R",IMAGE)
0015    VIDEO.RW(0,0,79,21,"C","")
0016    BORDER.UP(0,0,79,21,1,CURATR())
0017    MESSAGE(INT((80-LEN(TITLE))/2),0,TITLE,CURATR(),"UP",DUMMY)
0018    * Set up SCRIBE parameters
0019    STATE = ""; PROTECTED=0 ; EXIT=CHAR(27) :@FM: CHAR(0):CHAR(67)
0020    EXCEPT = "" ; COL = 1 ; ROW = 1 ; DLEN = 78
0021    COLOR = @XW<8> : @FM : @XW<5> : @FM : @XW<4>
0022    FLAGS = '' ; FLAGS<4> = TITLE ; FLAGS<5> = 1
0023    FLAGS<7> = 1 ; FLAGS<8> = 1
0024    CHANGE = "" ; MV.DEPTH = 20 ; KEY = "" ; IPAT = "" ; OPAT = ""
0025    JUST = 'L' ; DELIM = @FM ; MASK = "" ; CHAR.COUNT= 0
0026    * Get info until user presses F9 or <Esc>, note that down
0027    * arrow causes SCRIBE to exit so reinvoke SCRIBE 'til exit
0028    LOOP
0029    UNTIL INDEX(EXIT,KEY,l)
0030      SCRIBE(IVAL,PROTECTED,EXIT,EXCEPT,COL,ROW,DLEN,COLOR,FLAGS,CHANGE,
0031      -----> MV.DEPTH,KEY,IPAT,OPAT,JUST,DELIM,MASK,CHAR.COUNT,STATE)
0032    REPEAT
0033    * If <Esc> restore data to old form
0034    IF KEY = CHAR(27) THEN IVAL = STATE[I,@RM]
0035    * Restore screen and clear it with spaces
0036    VIDEO.RW(LEFT,TOP,RIGHT,BOTTOM,'W',IMAGE)
0037    PRINT @(0,0) . STR(SPACE(80),21)
0038    RETURN