[Inherit( 'Forms$Pas_Definitions', 
          'Sys$Library:Pascal$Str_Routines.Pen', 
          'Sys$Library:Pascal$Lib_Routines.Pen' )]

Program Forms$Demo_Phone( Input, Output );
{+
!                         Copyright (c) 1989 By
!              Digital Equipment Corporation, Maynard, Mass.
!
! This software is furnished under a license and may be used and  copied
! only  in  accordance  with  the  terms  of  such  license and with the
! inclusion of the above copyright notice.  This software or  any  other
! copies  thereof may not be provided or otherwise made available to any
! other person.  no title to and ownership of  the  software  is  hereby
! transferred.
!
! The information in this software is subject to change  without  notice
! and  should  not  be  construed  as  a commitment by Digital Equipment
! Corporation.
!
! Digital assumes no responsibility for the use or  reliability  of  its
! software on equipment which is not supplied by Digital.
-}

{+
! This program implements a rudimentry phone book application
! using DECforms.  A majority of the processing takes place in
! the form with the exception of the procedural escapes, which
! can be found in this module.  To build this demo enter the
! following DCL commands:
!
!    $ Pascal/Env Sys$Library:Forms$Pas_Definitions.Pas
!    $ Pascal Forms$Demo_Phone.Pas
!    $ Forms Translate Forms$Demo_Phone.Ifdl
!    $ Forms Extract Object/Object=Phone_Exo.Obj Forms$Demo_Phone.Form
!    $ Link Forms$Demo_Phone.Obj, Phone_Exo.Obj
!
-}

{+
! Constants used in this application.
-}

Const
    Terminal    = 'Sys$Input:';
    Form_File   = 'Phone.Form';
    Form_Name   = 'PHONE_BOOK';
    Max_Entries = 30;

{+
! Types used in this application.
-}

Type
    Parray25  = Packed Array[1..25] Of Char;
    Parray7   = Packed Array[1..7] Of Char;
    Parray3   = Packed Array[1..3] Of Char;
    PB_Entry  = Record
                    Name           : Parray25;
                    Comment        : Parray25;
                    Home_Area_Code : Parray3;
                    Home_Number    : Parray7;
                    Work_Area_Code : Parray3;
                    Work_Number    : Parray7;
                End;
    Phone_Book = Array[1..Max_Entries] Of PB_Entry;

{+
! Global variables used in this application.
-}

Var
    Listing         : Phone_Book;
    Session_Id      : Packed Array[1..16] Of Char := '         ';
    Print_File_Name : [VOLATILE] Packed Array[1..36] Of Char :=
                                    'Sys$Scratch:Forms$Demo_PhoneBook.Txt';
    Write_File      : Char;
    Form_Status     : Integer;


Procedure Check_Status( Form_Status : Integer );
{+
! This procedure checks for an even status.  If the status is even, signifying
! an error, Lib$Signal is called to display the error message and the
! program terminates.
-}
Begin
    If Not( Odd( Form_Status )) Then
    Begin
        Lib$Signal( Form_Status );
        Halt;
    End;
End;  { Procedure Check_Status }


Procedure Forms$$Demo_Phone_Enable;
{+
!    This procedure will enable the phone book form.
-}

Var 
    Item_List : Array[1..3] Of Forms$Item_List_Type;

Begin

    {+
    ! Set up the item list.
    !
    ! - Turn off tracing.
    ! - Define a print file
    !
    ! The Item List must be zero terminated.
    -}

    Item_List[1].Code      := Forms$K_Trace;
    Item_List[1].Length    := 0;
    Item_List[1].Buff_Addr := False;  
    Item_List[2].Code      := Forms$K_PrintFile;
    Item_List[2].Length    := 36;
    Item_List[2].Buff_Addr := Address( Print_File_Name );
    Item_List[3].Code      := 0;
    Item_List[3].Length    := 0;
    Item_List[3].Buff_Addr := 0;

    {+
    ! Call the Form Manager to enable this form.  
    -}

    Form_Status := Forms$Enable( Forms$AR_Form_Table, Terminal, Session_Id,
                                 Form_File, Form_Name, , , , , , , Item_List );
    Check_Status( Form_Status );    
End;  { Procedure Forms$$Demo_Phone_Enable }


Procedure Forms$$Demo_Phone_Disable( Var Write : Char );
{+
! This procedure will Disable the phone book form.  The returned Control 
! text is checked to determine if we should upate the phone data base on disk.
-}

Var
    Receive_Control_Text : Packed Array[1..25] Of Char;
    CT_Count             : Integer;
    Index                : Integer;
    Sub_Index            : Integer;

Begin

    {+
    ! Initialize the local variables.
    -}

    Receive_Control_Text := '                         ';
    CT_Count := 0;
    Index := 1;

    {+
    ! Disable the Form.
    -}

    Form_Status := Forms$Disable( Session_Id, Receive_Control_Text, CT_Count );
    Check_Status( Form_Status );

    {+
    ! Search for the returned control text (' FWRT')
    -}

    If ( Str$Find_First_SubString( Receive_Control_Text, Index, Sub_Index, ' FWRT' ) > 0 ) Then 
        Write := 'T'
    Else 
        Write := ' '
End;  { Procedure Forms$$Demo_Phone_Disable }


Procedure Forms$$Demo_Phone_Transceive;
{+
! This procedure will send then receive the phone book list of entries.
-}
Begin

    {+
    ! Transceive the Phone Book list.
    -}

    Form_Status := Forms$Transceive( Session_Id, 'Phone_Book_Record', , 'Phone_Book_Record', 
                                     , , , , , , , , Listing, , Listing, );
    Check_Status( Form_Status );
End;  { Procedure Forms$$Demo_Phone_Transceive }


Procedure Forms$$Demo_Phone_Read_File;
{+
! This procedure will read phonebook information from a file into an array 
! to be passed to the form.
-}

Var
    Phone_File : Text;
    Count      : Integer;
    I,ST       : Integer;

Begin

    {+
    ! Open the phone file
    -}
    
    Open( Phone_File, 
          File_Name := 'Forms$Demo_Phone_File', 
          History   := ReadOnly,
          Default   := 'Sys$Scratch:.Dat',
          Error     := Continue );

    Count := 0;
    ST := Status( Phone_File );
    If ( St <= 0 ) Then
    Begin
        Reset( Phone_File );      
 
        {+
        ! While there are more entries, and we haven't exceeded the bounds of
        ! the array, read the entries.
        -}

        While Not( EOF( Phone_File )) And ( Count < Max_Entries ) Do
        Begin
            Count := Count + 1;

            ReadLn( Phone_File, Listing[Count].Name, Listing[Count].Comment, 
                                Listing[Count].Home_Number, Listing[Count].Home_Area_Code,
                                Listing[Count].Work_Number, Listing[Count].Work_Area_Code );
        End;

        Close( Phone_File );
    End;

    {+
    ! Initialize the remainder of the phone book list in the event that
    ! there were less than the maximum amount of entries read from the file.
    -}

    Count := Count + 1;
    For I := Count to Max_Entries Do
    Begin
        Listing[I].Name           := '                         ';
        Listing[I].Comment        := '                         ';
        Listing[I].Home_Area_Code := '   ';
        Listing[I].Home_Number    := '       ';
        Listing[I].Work_Area_Code := '   ';
        Listing[I].Work_Number    := '       ';
    End;
End;  { Procedure Forms$$Demo_Phone_Read_File }


Procedure Forms$$Demo_Phone_Write_File;
{+
! This procedure will update the phonebook databse by simply rewritting the 
! hole array to the file.
-}

Var
    Phone_File : Text;
    Count      : Integer;

Begin

    {+
    ! Open the phone file
    -}
    
    Open( Phone_File, 
          File_Name := 'Forms$Demo_Phone_File', 
          History   := New, 
          Default   := 'Sys$Scratch:.Dat',
          Error     := Continue );

    {+
    ! Check the status of the file.  If we can't write to the file, then
    ! issue a message and do not try to update the phonebook values.
    -}    

    If ( Status( Phone_File ) > 0 ) Then
    Begin
        WriteLn( 'Unable to write to Phone Book Data File.' );
    End
    Else
    Begin

        ReWrite( Phone_File );  

        {+
        ! Write each entry to the file.
        -}

        For Count := 1 To Max_Entries Do
            WriteLn( Phone_File, Listing[Count].Name, Listing[Count].Comment, 
                                 Listing[Count].Home_Number, Listing[Count].Home_Area_Code,
                                 Listing[Count].Work_Number, Listing[Count].Work_Area_Code );

        WriteLn( 'Phone Book data file has been updated.' );

        Close( Phone_File );
    End;

End;  { Procedure Forms$$Demo_Phone_Write_File }


[Global, Asynchronous] Procedure Forms$$Demo_Add_To_List( Name, Comment  : [VOLATILE] Parray25;
                                                          Home_Area_Code : [VOLATILE] Parray3;
                                                          Home_Number    : [VOLATILE] Parray7;
                                                          Work_Area_Code : [VOLATILE] Parray3;
                                                          Work_Number    : [VOLATILE] Parray7;
                                                      Var Listing        : [VOLATILE] Phone_Book;
                                                      Var Entry          : [VOLATILE] Integer );
{+
! This procedure will add an entry alphabetically to the list, returning 
! the list and a value, entry, pointing to the added entry.
-}

Var
    I          : Integer;
    Found      : Boolean;
    Temp_Entry : PB_Entry;

Begin

    I := 1;
    Found := False;

    {+
    ! Loop through the list of entries to determine where to add the new
    ! entry (alphabetically).  We don't have to worry about mixed case since
    ! the name field is forced to uppercase by the form interface.
    -}

    While ( I <= Max_Entries ) And Not( Found ) Do
    Begin

        If ( Listing[I].Name = '                         ' ) Or
           ( Name <= Listing[I].Name ) Then
        Begin
            Found := True;
            Entry := I;
        End
        Else
            I := I + 1;
    End;

    {+
    ! If we couldn't insert it (list is full), then add it to the end of the 
    ! list, effectively losing the last entry of the list.
    -}

    If Not( Found ) Then Entry := Max_Entries;

    If ( Listing[I].Name <> Name ) And ( Entry <> Max_Entries ) Then
    Begin

        {+
        ! Scroll the contents of the list
        -}

        For I := Max_Entries Downto ( Entry + 1 ) Do
            Listing[I] := Listing[I-1];

    End;

    {+
    ! Copy the new entry to it's new location in the phone book list.
    -}

    Listing[Entry].Name           := Name;
    Listing[Entry].Comment        := Comment;
    Listing[Entry].Home_Area_Code := Home_Area_Code;
    Listing[Entry].Home_Number    := Home_Number;
    Listing[Entry].Work_Area_Code := Work_Area_Code;
    Listing[Entry].Work_Number    := Work_Number;
End;  { Procedure Forms$$Demo_Add_To_List }


[Global, Asynchronous] Procedure Forms$$Demo_Remove_From_List( Var Listing : [VOLATILE] Phone_Book;
                                                                   Entry   : [VOLATILE] Integer );
{+  
! This procedure will remove the entry specified by parameter 'entry'.
-}

Var
    I : Integer;

Begin

    {+
    ! Scroll the remainder of the list backwards, starting at the entry which
    ! we wish to delete.
    -}

    For I := Entry To ( Max_Entries - 1 ) Do
        Listing[I] := Listing[I+1];

    {+
    ! Blank out the last entry.
    -}

    Listing[Max_Entries].Name           := '                         ';
    Listing[Max_Entries].Comment        := '                         ';
    Listing[Max_Entries].Home_Area_Code := '   ';
    Listing[Max_Entries].Home_Number    := '       ';
    Listing[Max_Entries].Work_Area_Code := '   ';
    Listing[Max_Entries].Work_Number    := '       ';
End;  { Procedure Forms$$Demo_Remove_From_List }


[Global] Function Forms$$Demo_Phone_Add( Value1, Value2 : UnSigned ): UnSigned;
{+
! This function will return the sum of the two inputs.
-}

Begin
    Forms$$Demo_Phone_Add := Value1 + Value2;
End;  { Function Forms$$Demo_Phone_Add }


[Global] Function Forms$$Demo_Phone_Sub( Value1, Value2 : UnSigned ): UnSigned;
{+
! This function will return the difference of the two inputs.
-}

Begin
    Forms$$Demo_Phone_Sub := Value1 - Value2;
End;  { Function Forms$$Demo_Phone_Sub }


Begin  { main program }
    
    {+
    ! Enable the form
    -}

    Forms$$Demo_Phone_Enable;

    {+
    ! Read the phone book file.
    -}

    Forms$$Demo_Phone_Read_File;

    {+
    ! Transceive the information.
    -}

    Forms$$Demo_Phone_Transceive;

    {+
    ! Transceive the information.
    -}

    Forms$$Demo_Phone_Disable( Write_File );

    If ( Write_File = 'T' ) Then
        Forms$$Demo_Phone_Write_File;
    
End.  { program phone }