Topspeed_JPI/TS-V3/EXAMPLES/ITEMS.MOD

IMPLEMENTATION MODULE Items;
(*
        Copyright (C) 1988,1989 Jensen & Partners International
*)

IMPORT Globals, Window, IO, Str, Misc, Btree;
FROM Globals IMPORT GetMenu, ItemIndex, ItemData;

VAR
  ItemWin, lastWin : Window.WinType;
  OnScreen : BOOLEAN;
  EmptyItem, BlankItem : ItemRec;
  keyPressed : CHAR;

PROCEDURE PressAKey( txt : ARRAY OF CHAR);
VAR
  ch : CHAR;
BEGIN
    Window.TextColor(Globals.PromptFore);
    Window.TextBackground(Globals.DisplayBack);
    Globals.WriteAt(9,1,txt);
    Window.GotoXY(30,9);
    ch := IO.RdKey();
    Window.GotoXY(1,9);
    Window.ClrEol();
    keyPressed := CAP(ch);
END PressAKey;


PROCEDURE MakeKey( keyA, myItemA : ADDRESS );
VAR
  key : POINTER TO Globals.FileKey;
  myItem : POINTER TO ItemRec;
BEGIN
    key := keyA;
    myItem := myItemA;
    Str.Copy(key^,myItem^.INum);
END MakeKey;

PROCEDURE Display( anItem : ItemRec );
(*
        This procedure displays the item record on the screen.
*)
VAR
  S : ARRAY[0..10] OF CHAR;
  ok : BOOLEAN;
BEGIN
    Window.TextColor(Globals.DataFore);
    Window.TextBackground(Globals.DataBack);
    WITH anItem DO
         Globals.WriteAt(1,15,INum);
         Globals.WriteAt(2,15,Description);
         Globals.WriteAt(3,15,Mfgr);
         Globals.WriteAt(3,55,PartNum);
         Globals.WriteAt(7,15,Supplier);
         Window.GotoXY(15,5);  IO.WrCard(QOHand,-10);
         Window.GotoXY(55,5);  IO.WrCard(QOOrder,-10);
         Str.FixRealToStr(Cost,2,S,ok);
         Globals.WriteAt(6,15,"          ");
         IF ok = FALSE THEN
            Globals.WriteAt(6,15,"???");
         ELSE
            Globals.WriteAt(6,15,S);
         END;
         Str.FixRealToStr(Retail,2,S,ok);
         Globals.WriteAt(6,55,"          ");
         IF ok = FALSE THEN
            Globals.WriteAt(6,55,"???");
         ELSE
            Globals.WriteAt(6,55,S);
         END;
    END;
END Display;

PROCEDURE Clear( );
(*
        This procedure clears the previous item information.
*)
BEGIN
    Display(BlankItem);
END Clear;

PROCEDURE Template( );
(*
        This procedure un-hides the item display window and displays
        the field names.
*)
BEGIN
    lastWin := Window.Used();
    Window.Use(ItemWin);
    Window.PutOnTop(ItemWin);
    Clear();
    OnScreen := TRUE;
END Template;

PROCEDURE Input( VAR anItem : ItemRec;  Clear : BOOLEAN );
(*
        This procedure inputs the item information from the user.
        If Clear is TRUE, then the information is cleared before the
        user enters new information.  If Clear is FALSE, Display() is
        called first to show the current information, and it is then
        edited.
*)
VAR
    ok,
    Continue : BOOLEAN;
    Field    : CARDINAL;
    ch       : CHAR;
    S        : ARRAY[0..10] OF CHAR;
BEGIN
    IF Clear THEN
       anItem := EmptyItem;
       Display(BlankItem);
    END;
    Display(anItem);
    Continue := TRUE;
    Field := 1;
    WITH anItem DO
        WHILE (Continue) DO
           CASE Field OF
                1: Window.GotoXY(15,1); Misc.InputStr(INum,10);
              | 2: Window.GotoXY(15,2); Misc.InputStr(Description,25);
              | 3: Window.GotoXY(15,3); Misc.InputStr(Mfgr,20);
              | 4: Window.GotoXY(55,3); Misc.InputStr(PartNum,10);
              | 5: Window.GotoXY(15,5);
                   Str.CardToStr(LONGCARD(QOHand),S,10,ok);
                   Misc.InputStr(S,10);
                   QOHand := CARDINAL(Str.StrToCard(S,10,ok));
              | 6: Window.GotoXY(55,5);
                   Str.CardToStr(LONGCARD(QOOrder),S,10,ok);
                   Misc.InputStr(S,10);
                   QOOrder := CARDINAL(Str.StrToCard(S,10,ok));
              | 7: Window.GotoXY(15,6);
                   Str.FixRealToStr(Cost,2,S,ok);
                   Misc.InputStr(S,10);
                   Cost := Str.StrToReal(S,ok);
              | 8: Window.GotoXY(55,6);
                   Str.FixRealToStr(Retail,2,S,ok);
                   Misc.InputStr(S,10);
                   Retail := Str.StrToReal(S,ok);
              | 9: Window.GotoXY(15,7); Misc.InputStr(Supplier,10);
           END;  (* case *)
           INC(Field);
           IF Field >= 10 THEN
              Window.TextColor(Globals.PromptFore);
              Window.TextBackground(Globals.DisplayBack);
              Globals.WriteAt(9,1,"Are these ok? ");
              Window.GotoXY(15,9);
              ch := IO.RdKey();
              Globals.WriteAt(9,1,"                  ");
              IF CAP(ch) = 'Y' THEN
                 Continue := FALSE;
              ELSE
                 Field := 1;
                 Window.TextColor(Globals.DataFore);
                 Window.TextBackground(Globals.DataBack);
              END;  (* if *)
           END;  (* if *)
        END;  (* while *)
    END;  (* with *)
END Input;

PROCEDURE Search( VAR anItem : ItemRec ) : BOOLEAN ;
(*
        The key fields from anItem are checked for data.  If they
        are filled, that information is used to search.  Otherwise,
        this procedure asks the user for search information, and then
        searches for the given record.  If it is found, it is copied to
        anItem, and TRUE is returned.  If it is not found, FALSE is
        returned.
*)
VAR
  searchStr : Globals.FileKey;
  ch : CHAR;
BEGIN
    Clear();
    IF anItem.INum[0] > ' ' THEN
       Str.Copy(searchStr,anItem.INum);
    ELSE
       Window.GotoXY(15,1);
       searchStr := "";
       Misc.InputStr(searchStr,10);
    END;
    IF searchStr[0] <= ' ' THEN
       Clear();
       RETURN FALSE;
    END;
    Str.Caps(searchStr);
    (*  WriteAt(sx, sy, "Searching...");  *)
    IF Btree.Find(ItemIndex,searchStr,anItem) THEN
       Display(anItem);
       (* WriteAt(sx, sy, "            ");  *)
    ELSE
       IF Btree.Search(ItemIndex,searchStr,anItem) THEN
          Display(anItem);
          REPEAT
             GetMenu("N)ext P)revious or T)his One? ",
                      Globals.CharSet{'N','P','T'}, ch);
             CASE ch OF
                  'N' : IF Btree.Next(ItemIndex,anItem) THEN
                           Clear();
                           Display(anItem);
                        ELSE
                           Globals.Beep();
                        END;
                | 'P' : IF Btree.Prev(ItemIndex,anItem) THEN
                           Clear();
                           Display(anItem);
                        ELSE
                           Globals.Beep();
                        END;
                | 'T' : ;
             ELSE
                Globals.Beep();
             END;
          UNTIL ch = 'T';
       ELSE
          Globals.WriteAt(8,1,"Failed Search!");
          PressAKey("Press Any Key to Continue... ");
          Window.TextColor(Globals.PromptFore);
          Window.TextBackground(Globals.DisplayBack);
          Globals.WriteAt(8,1,"              ");
          RETURN FALSE;
       END;
    END;
    PressAKey("E)dit, D)elete, or Q)uit? ");
    IF keyPressed = 33C THEN
       RETURN FALSE;
    ELSIF keyPressed = 'E' THEN
       Btree.Delete(ItemData);
       Input(anItem,FALSE);
       Btree.Add(ItemData,anItem,SIZE(anItem));
       RETURN TRUE;
    ELSIF keyPressed = 'D' THEN
       Btree.Delete(ItemData);
       RETURN FALSE;
    ELSE
       RETURN TRUE;
    END;
END Search;

PROCEDURE Close( );
(*
        This procedure removes the item display window from the screen.
*)
BEGIN
    Window.Hide(ItemWin);
    Window.Use(lastWin);
    Window.PutOnTop(lastWin);
    OnScreen := FALSE;
END Close;

BEGIN
    ItemWin := Window.Open( Window.WinDef( 0, 4, 79, 14,
            Window.White,Window.Black,TRUE,FALSE,TRUE,TRUE,
            Window.SingleFrame,Window.White,Window.Black) );
    Window.SetFrame(ItemWin,Window.SingleFrame,Globals.DisplayBorder,
            Globals.DisplayBack);
    Window.Use(ItemWin);
    Window.TextColor(Globals.DisplayFore);
    Window.TextBackground(Globals.DisplayBack);
    Window.Clear();
    Globals.WriteAt(1,1,"Item Number:");
    Globals.WriteAt(2,1,"Description:");
    Globals.WriteAt(3,1,"Manufacturer:");
    Globals.WriteAt(3,40,"Part Number:");
    Globals.WriteAt(5,1,"On Hand:");
    Globals.WriteAt(5,40,"On Order:");
    Globals.WriteAt(6,1,"Cost:");
    Globals.WriteAt(6,40,"Retail:");
    Globals.WriteAt(7,1,"Supplier:");

    WITH BlankItem DO
         Str.Copy(INum,"          ");
         Str.Copy(Description,"                         ");
         Str.Copy(PartNum,"          ");
         Str.Copy(Mfgr,"                    ");
         Str.Copy(Supplier,"          ");
         QOHand := 0;
         QOOrder := 0;
         Cost := 0.0;
         Retail := 0.0;
    END;

    WITH EmptyItem DO
         INum := "";
         Description := "";
         PartNum := "";
         Mfgr := "";
         Supplier := "";
         QOHand := 0;
         QOOrder := 0;
         Cost := 0.0;
         Retail := 0.0;
    END;

    OnScreen := FALSE;
END Items.