UNIT TextMenu;

{ Oct 9 1991 Tony Bigras }
{
 made wide max and better centering on large menus and 20 items nov 20
 wider still with error traping of to wide  feb 4 92
 raised menu a little higher with more than 10 items

 added alpha keying   feb 8 92
 1.001 bug fix in alpha keying feb 25 92
 1.010 added 1 space white space on right side of menu txt
}

{$D-,S-}

INTERFACE

USES Crt,SysSup,Win;

CONST
  mxmenustrlen=74;
  mxmenuwidth=mxmenustrlen+7;
  mxonmenu=21;
TYPE
  txtctrltype = (normal,
		 reverse,
		 flashing);

  menuctrltype= RECORD
                  sort: BOOLEAN;
                  wrap: BOOLEAN;
                  escape: BOOLEAN;
                  alphakey: BOOLEAN;
                END;
  keysettype = SET OF CHAR;

  menustr = STRING[mxmenuwidth-4];
  txtmenux = 0..76;
  txtmenuy = 0..22;
  txtmenunum = 0..mxonmenu; { 0 = esc }
  modetype = (wipe,replace);

  winrec = record
    state: winstate;
    buffer: POINTER;
  END;

  winrecptr = ^winrec;
  menutype = RECORD
	       title: menustr;
            item: ARRAY[1..mxonmenu] OF menustr;
	       numitem: txtmenunum;
	       x: txtmenux;
	       y: txtmenuy;
            w: 1..mxmenuwidth;
	       oldselect: txtmenunum;
	       mode: modetype;
            wn: winrecptr;
            titlehelp:helpstr;
            itemhelp: ARRAY[1..mxonmenu] OF helpstr;
            ctrl: menuctrltype;
	     END;

  frametype = (single,double);

VAR
  txtmode: txtctrltype;
  txtcur: txtctrltype;
  menuactive: BOOLEAN;  { set by caller to FALSE and set bye menu to TRUE
                          as soon as user starts moving on menu.
                          Intended to be read by concurent processes }

  PROCEDURE getxy(VAR x,y: INTEGER);
  PROCEDURE txtwr(x,y: INTEGER; str: STRING);
  PROCEDURE txtmenuinit( VAR menu: menutype;
	          x: txtmenux;         { if 0 centre }
		     y: txtmenuy);        { if 0 centre }
  PROCEDURE txtmenukill(VAR menu: menutype);
  PROCEDURE openwindow(X1, Y1, X2, Y2: Byte;VAR w: winrecptr);
  PROCEDURE closewindow(VAR w: winrecptr);
  FUNCTION  txtmenu( VAR menu: menutype): INTEGER;
			{ 0 = escaped  else selection }

IMPLEMENTATION

  VAR
    background,foreground: INTEGER;

    txtupdownetc,updownetc,arrowetc: keysettype;
  PROCEDURE getxy(VAR x,y: INTEGER);
  BEGIN { getxy }
    X:= wherex;
    y:= wherey;
  END; { getxy }

  PROCEDURE txtwr(x,y: INTEGER; str: STRING);
  BEGIN { txtwr }
    gotoxy(x,y);
    write(str);
    gotoxy(x,y);
  END; { txtwr }

  PROCEDURE openwindow(x1, y1, x2, y2: BYTE;VAR w: winrecptr);
  BEGIN
    NEW(w);
    WITH w^ DO
    BEGIN
      savewin(state);
      window(x1, y1, x2, y2);
      GETMEM(buffer, winsize);
      readwin(buffer^);
    END;
  END;

  PROCEDURE closewindow(VAR w: winrecptr);
  BEGIN
    WITH w^ DO
    BEGIN
      writewin(buffer^);
      FREEMEM(buffer, winsize);
      restorewin(state);
    END;
    DISPOSE(w);
  END;

  PROCEDURE showone(num: INTEGER; menuitem: STRING; reverse: BOOLEAN);
  BEGIN { showone }
    IF reverse= TRUE THEN
    BEGIN
      IF lastmode=mono THEN
      BEGIN
	   background:=lightgray;
        foreground:=black;
      END
      ELSE
      BEGIN
        background:=lightgray;
        foreground:=blue;
      END;
    END
    ELSE
    BEGIN
      IF lastmode=mono THEN
      BEGIN
       background:=black;
       foreground:=white;
      END
      ELSE
      BEGIN
        background:=blue;
        foreground:=white;
      END;
    END;
    writestr(1,num+2,menuitem,foreground +background * 16);
  END; { showone }

  FUNCTION  txtmenu( VAR menu: menutype): INTEGER;

  VAR
    i:  INTEGER;

    FUNCTION  select: INTEGER;
    VAR
      key: CHAR;
      tmenu: menutype;
      i,j,cnt: INTEGER;
      alpha: STRING[80];
      nonalpha,matched: BOOLEAN;
    BEGIN { select }
      IF menu.ctrl.alphakey THEN
      BEGIN
        nonalpha:= TRUE;
        tmenu:= menu;
        FOR i:= 1 TO tmenu.numitem DO
        BEGIN
          FOR j:= 1 to LENGTH(tmenu.item[i]) DO
            tmenu.item[i][j]:= upcase(tmenu.item[i][j]);
          tmenu.item[i]:=COPY(tmenu.item[i],4,LENGTH(tmenu.item[i])-3);
          { strip pretty bar from front of item }
        END;
      END; { alphakey }
      showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
      REPEAT
        key:= allowkey(txtupdownetc,-1);
        menuactive:= TRUE; { somebody is moving around on menu }
        CASE key OF
          CHR(up):
          BEGIN
            nonalpha:= TRUE;
            showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
            IF (menu.oldselect = 1) AND menu.ctrl.wrap THEN
               menu.oldselect:= menu.numitem
            ELSE
              menu.oldselect:= max(1,menu.oldselect-1);
           showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
         END; { up }

         CHR(down):
         BEGIN
           nonalpha:= TRUE;
           showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
           IF (menu.oldselect = menu.numitem) AND menu.ctrl.wrap THEN
             menu.oldselect:= 1
           ELSE
             menu.oldselect:= min(menu.numitem,menu.oldselect+1);
           showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
          END; { down }

          CHR(32)..CHR(127):
          BEGIN
            showone(menu.oldselect,menu.item[menu.oldselect],FALSE);
            IF nonalpha THEN
            BEGIN
              nonalpha:= FALSE;
              alpha:= '';
            END; { start alpha keying again as it was interupted }
            alpha:= CONCAT(alpha,upcase(key));
            matched:= FALSE;
            cnt:= 0;
            REPEAT
             cnt:= cnt+1;
             { 1.001 matched from <>0 to =1   }
             matched:= POS(alpha,COPY(tmenu.item[cnt],1,LENGTH(alpha)+1))=1;
            UNTIL (matched OR (cnt > menu.numitem));

            IF NOT matched THEN
            BEGIN
              nonalpha:= TRUE;
              sound(300);
              delay(100);
              nosound;
            END; { NOT matched }
            IF matched THEN
              menu.oldselect:=cnt;
            showone(menu.oldselect,menu.item[menu.oldselect],TRUE);
          END; { alpha }

        END; { CASE key }
        IF menu.itemhelp[menu.oldselect]<>'' THEN
          curhelp:=menu.itemhelp[menu.oldselect]
        ELSE
          curhelp:=menu.titlehelp;
      UNTIL key IN [CHR(esc),CHR(return)];
      IF key = CHR(esc) THEN
        select:= 0
      ELSE
      select:= menu.oldselect
    END; { select }

  BEGIN { txtmenu }
    { 0 = escaped  ELSE 1..x = selection }
    txtmenu:= select;
  END; { txtmenu }

  PROCEDURE txtmenuinit( VAR menu: menutype;
	          x: txtmenux;
		     y: txtmenuy);
  VAR
    maxstrlen,i: INTEGER;

    PROCEDURE showall;
    VAR
      i: INTEGER;
    BEGIN { showall }
      IF lastmode=mono THEN
      BEGIN
        splitbox(doubleframe,white + black * 16,3);
        writestr(1,1,menu.title,white + black * 16);
      END
      ELSE
      BEGIN
        splitbox(doubleframe,yellow + blue * 16,3);
        writestr(1,1,menu.title,white + blue * 16);
      END;
      FOR i:= 1 to menu.numitem DO
        showone(i,menu.item[i],FALSE);
    END; { showall }

  BEGIN { txtmenuinit }
     txtupdownetc:=updownetc;
     IF menu.ctrl.escape THEN
       txtupdownetc:=txtupdownetc+[CHR(esc)];
     IF menu.ctrl.alphakey THEN
       txtupdownetc:=txtupdownetc+[CHR(32)..CHR(127)];
      FOR i:= 1 to menu.numitem DO
       IF LENGTH(menu.item[i])>mxmenustrlen THEN
         menu.item[i][0]:=CHR(mxmenustrlen);
     IF LENGTH(menu.title)>mxmenustrlen THEN
       menu.title[0]:=CHR(mxmenustrlen);
     menu.w:=1;
     { 1.010 added space to menu items length }
     FOR i:= 1 TO menu.numitem DO
       menu.w:=max(LENGTH(menu.item[i])+1,menu.w);
     IF (LENGTH(menu.title) MOD 2)=0 THEN
       menu.title:= CONCAT(' ',menu.title);
     menu.w:=max(LENGTH(menu.title),menu.w);
     FOR i:= 1 TO menu.numitem DO
       menu.item[i]:=
       CONCAT(' ³ ',menu.item[i],COPY(blanks,1,menu.w-LENGTH(menu.item[i])));
     menu.title:=
     CONCAT(COPY(blanks,1,((menu.w-LENGTH(menu.title)) DIV 2)+1),menu.title);
     menu.w:= menu.w+4;
     IF x<>0 THEN
       menu.x:= x
     ELSE
       menu.x:=((80-menu.w) DIV 2) + 1;
     IF y<>0 THEN
       menu.y:= y
     ELSE
       menu.y:=max(1,(25-(menu.numitem+4)) DIV 2);
     openwindow(menu.x,menu.y,menu.x+menu.w,menu.y+menu.numitem+3,menu.wn);
     IF lastmode=mono THEN
       fillwin(#32,lightgray+black*16)
     ELSE
       fillwin(#32,cyan + blue * 16);
     showall;
  END; { txtmenuinit }

  PROCEDURE txtmenukill(VAR menu: menutype);
  BEGIN
    unframewin;
    closewindow(menu.wn);
  END;

BEGIN { TextMenu }
  arrowetc:=
    [CHR(esc),CHR(return),CHR(space),CHR(up),CHR(down),CHR(left),CHR(right)];
  updownetc:=
    [CHR(return),CHR(up),CHR(down)];
  menuactive:= FALSE;
END. { TextMenu }