Topspeed_JPI/TS/SRC/MENULIB.MOD

(* Release 3.10 *)
(*-------------------------------------------------------------------------*
*                                                                          *
*  MENULIB.MOD - COMMS Toolkit menu support                                *
*                                                                          *
*  COPYRIGHT (C) 1988..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

IMPLEMENTATION MODULE MenuLib;
  IMPORT IO,Lib,Window;
  FROM Window           IMPORT Color;

  CONST
    MenuFrame           = Window.FrameStr('Õ͸³³Ô;');
    MenuTemplate        = Window.WinDef(0,0,0,0,White,Black,FALSE,FALSE,FALSE,TRUE,MenuFrame,LightGray,Black);

  TYPE
    switch              = (on,off);
    FuncKeys            = (NotRecognised,Escape,Cup,Cdown,Cleft,Cright,PageUp,PageDown,FKey1,AltKey);

  VAR
    gotcha              : BOOLEAN;
    FuncKeyTyped        : FuncKeys;

(*......................................*)

  PROCEDURE SetColor(NewColor:SHORTCARD);
    BEGIN
      Window.TextColor(VAL(Window.Color,NewColor MOD 16));
      Window.TextBackground(VAL(Window.Color,NewColor DIV 16));
    END SetColor;

(*.............................................*)

  PROCEDURE Read(VAR c:CHAR);
    BEGIN
      FuncKeyTyped := NotRecognised;
      c := IO.RdKey();
      IF (c=CHR(27)) OR (c=0C) THEN
        IF c=0C THEN
          c := IO.RdKey();
          CASE ORD(c) OF
            72          : FuncKeyTyped:=Cup;     |
            80          : FuncKeyTyped:=Cdown;   |
            75          : FuncKeyTyped:=Cleft;   |
            77          : FuncKeyTyped:=Cright;  |
            73          : FuncKeyTyped:=PageUp;  |
            81          : FuncKeyTyped:=PageDown;|
            59          : FuncKeyTyped:=FKey1;   |
          ELSE
            FuncKeyTyped := AltKey;
          END
        ELSE
          FuncKeyTyped := Escape
        END;
      END;
    END Read;

(*........................................*)

  PROCEDURE DeAltify(VAR Ch:CHAR);
    VAR
      c                 : CARDINAL;
      Numrow,Qrow,Arow,
      Zrow              : ARRAY[0..11] OF CHAR;
    BEGIN
      Numrow:='1234567890-=';
      Qrow:='QWERTYUIOP';
      Arow:='ASDFGHJKL';
      Zrow:='ZXCVBNM';
      IF FuncKeyTyped=AltKey THEN
        c := ORD(Ch);
        IF (c>=120) AND (c<=131) THEN
          Ch := Numrow[c-120]
        ELSIF (c>=16) AND (c<=25) THEN
          Ch := Qrow[c-16]
        ELSIF (c>=30) AND (c<=38) THEN
          Ch := Arow[c-30]
        ELSIF (c>=44) AND (c<=50) THEN
          Ch := Zrow[c-44]
        END;
        FuncKeyTyped := NotRecognised;
      ELSE
        Ch := CAP(Ch)
      END;
    END DeAltify;

(*..................................................*)

  PROCEDURE InitMenu(VAR menu:MenuRec;menutitle:ARRAY OF CHAR;MenuX,MenuY,menuwidth:CARDINAL);
    VAR
      i,Lnth            : CARDINAL;
    BEGIN
      menu.MenuX:=MenuX;
      menu.MenuY:=MenuY;
      WITH menu DO
        Lnth := Lib.ScanR(ADR(menutitle),HIGH(menutitle)+1,0C);
        IF Lnth>menuwidth THEN
          Lnth:=menuwidth;
        END;
        Lib.Move(ADR(menutitle),ADR(Title),Lnth+1);
        Width:=menuwidth;
        Normal   := SHORTCARD(MenuColors.NormFore)+SHORTCARD(MenuColors.NormBack)*16;
        Selected := SHORTCARD(MenuColors.SelFore)+SHORTCARD(MenuColors.SelBack)*16;
        Highlite := SHORTCARD(MenuColors.HighFore)+SHORTCARD(MenuColors.HighBack)*16;
        SHighlite := SHORTCARD(MenuColors.HSelFore)+SHORTCARD(MenuColors.HSelBack)*16;
        EscapeOK := FALSE;
        ExitOnChar := FALSE;
        HelpOK := FALSE;
        PageKeysOK := FALSE;
        ExitSideWays := FALSE;
        IF Width>30 THEN
          Width:=30;
        END;
        Selection:=0;
        NumUsed:=0;
        winptr:=NIL;
      END;
    END InitMenu;

(*......................................*)

  PROCEDURE AddOption(VAR menu:MenuRec; menutext:ARRAY OF CHAR);
    VAR
      curlen            : CARDINAL;
    BEGIN
      WITH menu DO
        IF NumUsed<=MaxOption THEN
          WITH Option[NumUsed] DO
            curlen := Lib.ScanR(ADR(menutext),HIGH(menutext)+1,0C);
            IF curlen>Width THEN
              curlen:=Width;
            END;
            Lib.Move(ADR(menutext),ADR(Name),curlen+1);
            Lib.Fill(ADR(Name[curlen]),Width-curlen,' ');
            FirstNonSpace := Lib.ScanNeR(ADR(Name),Width,' ');
            IF FirstNonSpace # Width THEN
              Name[FirstNonSpace] := CAP(Name[FirstNonSpace]);
            END;
          END;
          INC(NumUsed);
        END
      END;
    END AddOption;

(*......................................*)

  PROCEDURE KillMenu(VAR menu:MenuRec);
    BEGIN
      IF menu.winptr <> NIL THEN
        Window.Close(menu.winptr);
        menu.winptr:=NIL;
      END;
    END KillMenu;

(*......................................*)

  PROCEDURE ShowSelectChars(VAR menu:MenuRec; onoff:switch);
    VAR
      i                 : CARDINAL;
      c                 : CHAR;
    BEGIN
      IF NOT menu.ExitOnChar THEN
        RETURN;
      END;
      i:=0;
      WHILE i<menu.NumUsed DO
        WITH menu.Option[i] DO
          c := Name[FirstNonSpace];
          IF onoff=on THEN
            IF i=menu.Selection THEN
              SetColor(menu.SHighlite)
            ELSE
              SetColor(menu.Highlite)
            END
          ELSE
            IF i=menu.Selection THEN
              SetColor(menu.Selected)
            ELSE
              SetColor(menu.Normal)
            END;
          END;
          Window.DirectWrite(XPos+FirstNonSpace+1,YPos+1,ADR(c),1);
        END;
        INC(i);
      END;
    END ShowSelectChars;

(*......................................*)

  PROCEDURE HighLight(VAR menu:MenuRec; onoff:switch; opno:CARDINAL);
    VAR
      c                 : CHAR;
    BEGIN
      WITH menu.Option[opno] DO
        IF onoff=on THEN
          SetColor(menu.Selected)
        ELSE
          SetColor(menu.Normal)
        END;
        Window.DirectWrite(XPos+1,YPos+1,ADR(Name),menu.Width);
        c := Name[FirstNonSpace];
        IF menu.ExitOnChar THEN
          IF onoff=on THEN
            SetColor(menu.SHighlite)
          ELSE
            SetColor(menu.Highlite)
          END;
          Window.DirectWrite(XPos+FirstNonSpace+1,YPos+1,ADR(c),1);
        END;
      END;
    END HighLight;

(*......................................*)

  PROCEDURE ChCheck(VAR menu:MenuRec; ch:CHAR);
    VAR
      start             : CARDINAL;
      found             : BOOLEAN;

(*. . . . . . . . . . . . . . . . . . . . .*)

    PROCEDURE CharPresent():BOOLEAN;
      BEGIN
        WITH menu DO
          WITH Option[Selection] DO
            RETURN Name[FirstNonSpace] = ch;
          END;
        END;
      END CharPresent;

(*. . . . . . . . . . . . . . . . . . . . .*)

    BEGIN (* ChCheck *)
      IF (ORD(ch)=32) OR (ORD(ch)=13) THEN
        RETURN;
      END;
      WITH menu DO
        found:=FALSE;
        start:=Selection;
        REPEAT
          Selection := (Selection+1) MOD NumUsed;
          found := CharPresent();
        UNTIL (Selection=start) OR (found);
        IF Selection<>start THEN
          HighLight(menu,off,start);
          HighLight(menu,on,Selection);
        END;
        gotcha := ExitOnChar AND found;
      END;
    END ChCheck;

(*......................................*)

  PROCEDURE DisplayPopUp(VAR menu:MenuRec; MenuX,MenuY:CARDINAL);
    VAR
      i                 : CARDINAL;
      Def               : Window.WinDef;
    BEGIN
      WITH menu DO
        IF winptr=NIL THEN
          Def := MenuTemplate;
          WITH Def DO
            X1:=MenuX;
            Y1:=MenuY;
            X2:=X1+Width+1;
            Y2:=Y1+NumUsed+1;
            Foreground := MenuColors.NormFore;
            Background := MenuColors.NormBack;
            FrameFore  := MenuColors.FrameFore;
            FrameBack  := MenuColors.FrameBack;
          END;
          winptr := Window.Open(Def);
          IF Title[0]<>0C THEN
            Window.SetTitle(winptr,Title,Window.LeftUpperTitle);
          END
        END;
        SetColor(Normal);
        FOR i:=0 TO NumUsed-1 DO
          WITH menu.Option[i] DO
            XPos:=0;
            YPos:=i;
            Window.DirectWrite(XPos+1,YPos+1,ADR(Name),Width);
          END;
        END;
        Window.PutOnTop(winptr);
      END;
    END DisplayPopUp;

(*......................................*)

  PROCEDURE PopUpMenu(VAR menu:MenuRec):INTEGER;
    VAR
      ch                : CHAR;
    BEGIN
      WITH menu DO
        Window.Use(winptr);
        ShowSelectChars(menu,on);
        HighLight(menu,on,Selection);
        REPEAT
          Read(ch);
          DeAltify(ch);
          CASE FuncKeyTyped OF
            Escape      : IF EscapeOK THEN
                            RETURN(-1);
                          END;                                            |
            PageUp      : IF PageKeysOK THEN
                            RETURN(-2);
                          END;                                            |
            PageDown    : IF PageKeysOK THEN
                            RETURN(-3);
                          END;                                            |
            FKey1       : IF HelpOK THEN
                            RETURN(-4);
                          END;                                            |
            Cright,Cdown: IF (FuncKeyTyped=Cright) AND (ExitSideWays) THEN
                            RETURN(-5);
                          ELSE
                            HighLight(menu,off,Selection);
                            Selection:=(Selection+1) MOD NumUsed;
                            HighLight(menu,on,Selection);
                          END;                                            |
            Cleft,Cup   : IF (FuncKeyTyped=Cleft) AND (ExitSideWays) THEN
                            RETURN(-6);
                          ELSE
                            HighLight(menu,off,Selection);
                            IF Selection=0 THEN
                              Selection:=NumUsed;
                            END;
                            DEC(Selection);
                            HighLight(menu,on,Selection);
                          END;                                            |
          ELSE
            ChCheck(menu,ch)
          END;
        UNTIL (ch=CHR(13)) OR (gotcha);
        ShowSelectChars(menu,off);
        RETURN Selection;
      END;
    END PopUpMenu;

(*......................................*)

  PROCEDURE DispMenu(VAR menu:MenuRec);
    BEGIN
      WITH menu DO
        DisplayPopUp(menu,MenuX,MenuY)
      END;
    END DispMenu;

(*......................................*)

  PROCEDURE RepaintMenu(VAR menu:MenuRec);
    VAR
      i                 : CARDINAL;
      onoff             : switch;
    BEGIN
      menu.Selection := 0;
      i:=0;
      WHILE i<menu.NumUsed DO
        IF i=menu.Selection THEN
          onoff := on;
        ELSE
          onoff := off;
        END ;
        HighLight(menu,onoff,i);
        INC(i);
      END;
    END RepaintMenu;

(*......................................*)

  PROCEDURE MenuDrive(VAR menu:MenuRec):INTEGER;
    BEGIN
      gotcha:=FALSE;
      RETURN PopUpMenu(menu);
    END MenuDrive;

(*......................................*)
  BEGIN
    WITH MenuColors DO (* default for color *)
      NormFore  := LightCyan;
      NormBack  := Black;
      FrameFore := LightGray;
      FrameBack := Black;
      HighFore  := Yellow;
      HighBack  := Black;
      SelFore   := White;
      SelBack   := Blue;
      HSelFore  := Yellow;
      HSelBack  := Blue;
    END;
  END MenuLib.