SAY CBOX("Make your selection and press ENTER",'TEST','Abort Retry Ignore')
exit

/* FUN: display selection bar with user defined buttons */
CBOX: PROCEDURE
PARSE ARG MSG, TITLE, MENU, NOCLEAR, TIMEOUT
* 1.2 allows timeout - exit after some time if no key is pressed
* 1.12 - use NOCLEAR to leave lines above box visible
* 1.11 - Fixed problem with odd-length menu
* 1.1 - text is centered, empty lines before and after,
* box surrounds entire dialog
* 1.04 - uses PRESERVE/RESTORE
* 1.02 center box vertically
* 1.01 - disables file area display
AR=ARROW.1()      /* PRESERVE does not save ARROW */
'PRESERVE'

BG='BLU'
FG='WHI'
'EDITV PUT BG FG'
'COLOR CMDLINE' FG 'ON' BG
'SET ARROW OFF'

IF NOCLEAR='' THEN DO
   'SET PREFIX OFF'
   'SET CMDLINE BOT'
   'COLOR FILE' BG 'ON' BG
   'COLOR CURLINE' BG 'ON' BG
   'COLOR TOFEOF' BG 'ON' BG
   'COLOR CTOFEOF' BG 'ON' BG
   'COLOR BLOCK' BG 'ON' BG
   'COLOR CBLOCK' BG 'ON' BG
END
IF TIMEOUT='' THEN TIMEOUT=100000
LM=LENGTH(MENU)
LM=MAX(LM, 20) /* minimum box width */
IF LM%2*2<>LM THEN LM=LM+1
WM=WORDS(MENU)
CALL LOWBOX MSG, TITLE, LM + 2*WM + 2

CUR=1
'CURSOR CMDLINE'
'SOS FIRSTCHAR'; 'SOS TABWORDF'
DO FOREVER
   CALL MAKE
   'CMSG' CENTER(CB,79)
   IF CUR=1 THEN DO;'SOS FIRSTCHAR'; 'SOS TABWORDF'; END
   'READV KEY' /* clear buffer */
   K=READV.1
   IF K='ENTER' THEN LEAVE
   ELSE IF K='CURL' | K='S-TAB' THEN DO
      IF CUR>1 THEN DO
         'SOS TABWORDB'
         CUR=CUR-1
      END
      ELSE DO
         'SOS ENDCHAR'
         'SOS TABWORDB'
         'SOS TABWORDB'
         CUR=WM
      END
   END
   ELSE IF K='CURR' | K='TAB' THEN DO
      IF CUR<WM THEN DO
         'SOS TABWORDF'
         CUR=CUR+1
      END
      ELSE CUR=1
   END
   ELSE IF DATATYPE(READV.2,'A') THEN DO
      C=READV.2
      FOU=0
      DO I=1 TO WM
         IF UPPER(C)<>LEFT(C.I,1) THEN ITERATE
         FOU=I
         LEAVE
      END
      IF FOU>0 THEN DO
         CUR=FOU
         LEAVE
      END
   END
END
'CMSG'
'SOS FIRSTCHAR'

'SET ARROW' AR
'RESTORE'

'EDITV GET FREZER'
PARSE VAR FREZER F T
DO I=F TO T
   'NOMSG RESER' I 'OFF'
END
RETURN C.CUR
EXIT


MAKE:
CB=''
DO I=1 TO WM
   C.I= WORD(MENU,I)
   IF CUR=I THEN CB=CB UPPER(''C.I'')
   ELSE CB=CB '['C.I']'
END
CB='º 'CENTER(STRIP(CB),LM + 2*WM) 'º'
RETURN

*GET LOWBOX
*Draw BOX for use with CBOX function
LOWBOX: PROCEDURE
*1.01 - sets EDITV var FREZER, saying which lines are rserved

PARSE ARG TEXT, TITLE, LEN
IF TEXT='' THEN CALL ERR "Programmer's error in LOWBOX procedure - no text specified"
IF LEN='' THEN LEN=LENGTH(TEXT)+2
TEXT=FLOW(TEXT, LEN-2)

TEXT=TRANSLATE(TEXT, D2C(255), ' ')
TEXT=TRANSLATE(TEXT, ' ', D2C(10))
/* LF-delimited words */
TEXT='ÿ' TEXT 'ÿ'

RE=''
IF RESERVED.0()=0 THEN LA=-1
ELSE DO
   RE=RESERVED.1()
   PM=POS('-', RE)
   IF PM=0 THEN LA=-1
   ELSE DO
      RE=DELSTR(RE, 1, PM-1)
      LA=WORD(RE,1) - 1
   END
END

WT=WORDS(TEXT)
LINES=25 - WORDS(RE)
MID= -( (LINES-WT) % 2)

'EDITV GET BG FG'
DO I=LA TO MID+1 BY -1
   'RESER' I BG 'ON' BG
END

Y2=I-2
Y1=Y2 - WT - 1

LT=LEN
BEF=(80 - LT -4) % 2
BEFORE=COPIES(' ',BEF)

COLOR=FG 'ON' BG
HOR='Í'
VER='º'
IF TITLE='' THEN TP=COPIES(HOR,LT)
ELSE TP=CENTER('µ'TITLE'Æ',LT,HOR)
BT=COPIES(HOR,LT)
'RESER' Y1 COLOR BEFORE || 'É' || TP || '»'
'RESER' Y2 COLOR BEFORE || 'Ì' || BT || '¹'
'RESER' MID COLOR BEFORE || 'È' || BT || '¼'
J=1
DO I=Y1+1 TO Y2-1
   'RESER' I COLOR BEFORE || VER CENTER(WORD(TEXT,J),LEN-1) || VER
   J=J+1
END
'EDITV SETL FREZER' Y1 LA

RETURN

*GET FLOW
* FLOW(S,N) - return S split at length N (LF inserted)
* Version 1.11 ':1' bug fixed
FLOW: PROCEDURE
PARSE ARG S, LEN
'KEDIT FLOW.TMP (NEW'
'SET WORDWRAP ON'
'SET MARGINS 1' LEN
'I'
'TEXT' S
'FLOW'

'TOP'
R=''
DO FOREVER
   'NEXT'
   IF RC>0 THEN LEAVE
   R=R || CURLINE.3() || D2C(10)
END
'QQUIT'
RETURN R

*GET ERR
ERR: PROCEDURE
'ALERT' DELIMIT(CURLINE.3()) 'TITLE' DELIMIT(ARG(1))
EXIT