Columbia Kermit/kermit.zip/perqb/pq2mbu.pas

Pascal/Delphi Source File | 2020-01-01 | 10KB | 361 lines

program MenuBuild;

imports MenuUtils from MenuUtils;
imports Memory from Memory;
imports System from System;
imports FileSystem from FileSystem;
imports CmdParse from CmdParse;
imports Perq_String from Perq_String;

{ Abstract:  This program build a menu structure in a user defined
  data segment.  The data segment is written to a user specified
  .MSEG file.
  Such .MSEG files may subsequently be utilized by the MenuUtils.GetMenu
  procedure to load the menues for a given application in a high-speed
  fashion.  ( Using MultiRead. )

  In parallel with the generation of the data segment, a .HLP-file is
  generated, which will contain the helptext from the menu text file.
  The .MSEG-file will contain blocknumbers referencing this .HLP-file,
  and the .HLP-file will NOT be loaded when the menues are loaded by the
  application, just read for the wanted information when HELP is requested
  from any menu.

  Usage:  BuildMenu <input .MENU file>
                        [~ <output .MSEG file>[,<output .HLP file ]

}

exception FullMenuSeg;  {   Will be raised if menu structure needs more than
                            32 K words }
exception InvHelpFile;  { Will be raised if any of the filenames given }
exception InvSegFile;   { are invalid  (or nonexistent input file) }
exception InvMenuFile;

exception BadArgs;

VAR
    Root                : pMenuEntry;
    Mnu, MSeg, Help     : PathName;
    Comm                : CString;
    IsSwitch            : Boolean;
    Inputs, Outputs     : pArgRec;
    Switches            : pSwitchRec;
    Err                 : String;
    Sep                 : Char;

procedure   MakeMenues( MenuFName, SegFName, HelpFName : PathName );

VAR MenuFile    : Text;
    SegF,HelpF  : FileID;
    Blk, Bits   : Integer;
    Line        : String;
    LineNo      : Integer;
    Indent      : Integer;
    ShowMenues  : boolean;

    HelpFree    : HelpAddress;

    MenuSeg     : SegmentNumber;
    FreePtr     : MMPointer;

    DiskBuff    : pDirBlk;


    procedure WriteSegment(     SegFName:   PathName;
                                EndPtr:     MMPointer);
    var NumBlocks, i    : integer;
        SegF            : FileID;
    begin
        NumBlocks := (EndPtr.Offset+255) div 256;
        SegF := FSEnter( SegFName );
        if SegF=0 then raise InvSegFile;
        for i := 0 to NumBlocks -1 do
            FSBlkWrite( SegF, i, MakePtr( EndPtr.Segmen, i*256, pDirBlk ));
        FSClose( SegF, NumBlocks, (EndPtr.Offset mod 256)*16 );
    end;


    procedure CreateHelpFile( HelpFName: PathName );
    begin
        HelpF := FSEnter( HelpFName );
        if HelpF=0 then raise InvHelpFile;
        with HelpFree do begin
            BlockNo := 0;
            Offset := 0;
        end;
        new( DiskBuff );
    end;

    procedure PutInBuffer( c : char );
    begin
        with HelpFree do begin
            DiskBuff^.ByteBuffer[ Offset ] := ord(c);
            Offset := Offset + 1;
            if Offset>511 then begin
                FSBlkWrite( HelpF, BlockNo, DiskBuff );
                Offset := 0;
                BlockNo := BlockNo + 1;
            end;
        end;
    end;

    procedure PutHelp( Txt : String );
    var I:integer;
    begin
        for I := 1 to length( Txt ) do
            PutInBuffer( Txt[I]);
        PutInBuffer( chr(13) );
    end;


    procedure CloseHelpFile;
    begin
        with HelpFree do begin
            if HelpFree.Offset>0 then begin { last buffer partially full }
                FSBlkWrite( HelpF, BlockNo, DiskBuff );
                FSClose( HelpF, BlockNo+1, Offset*8 );
            end else                        { last buffer is empty }
                FSClose( HelpF, BlockNo, 0 );
        end;
    end;


    procedure Allocate( s : integer );
    begin
        if (MMMaxExtSize div 2) > ((FreePtr.offset+S+255) div 256) then
            FreePtr.Offset := FreePtr.Offset + S
        else
            raise FullMenuSeg;
    end;


    function NewMenuEntry( NType : NodeType; NumComm : integer ):pMenuEntry;
    var ret     : pMenuEntry;
        fixed   : integer;
    begin
        Fixed := WordSize( HelpAddress )+
                        WordSize( String )+ WordSize( NodeType);
        Ret := MakePtr( FreePtr.Segmen, FreePtr.Offset, pMenuEntry );
        case NType of
            ParmNode:   Allocate( Fixed );
            EndNode :   Allocate( Fixed );
            MenuNode:   Allocate( Fixed + WordSize( pNameDesc )
                                  +  NumComm*WordSize( pMenuEntry ) );
        end;
        ret^.Node := NType;
        NewMenuEntry := ret;
    end;


    function NewNameDesc( NumComm : integer ):pNameDesc;
    var ret:pNameDesc;
    begin
        Ret := MakePtr( FreePtr.Segmen, FreePtr.Offset, pNameDesc );
        Allocate( WordSize( Integer ) + (NumComm+1)*WordSize( S25 ) );
        Ret^.NumCommands := NumComm;
        NewNameDesc := ret;
    end;


    function GetMenu : pMenuEntry;
    VAR ME  : pMenuEntry;
        NC  : integer;
        CI  : integer;
    begin
        indent := indent+4;
        readln( MenuFile, NC );
        ReadLn( MenuFile, Line );

    { determine what kind of a node has been encountered }
        if NC=0 then
            ME := NewMenuEntry( EndNode, 0 )
        else
        if NC<0 then
            ME := NewMenuEntry( ParmNode, 0 )
        else
            ME := NewMenuEntry( MenuNode, NC+1 );


    { build node }
        with ME^ do begin
            if Node=MenuNode then
            begin
                MPtr := NewNameDesc( NC+1 );
                if Line<>'>' then begin
                    MPtr^.Header := Line;
                    ReadLn( MenuFile, Line );
                end else
                    MPtr^.Header := '';
                MPtr^.Commands[1] := 'HELP';   { Always a HELP entry }
            end;
            if Line<>'>' then begin
                Prompt := Line;
                ReadLn( MenuFile, Line );
            end else
                Prompt := '';

            Help := HelpFree;
            while line<>'>' do begin
               PutHelp( Line );
               ReadLn( MenuFile, Line );
            end;
            PutHelp( Line );

            if Node=MenuNode then
                for CI := 2 to NC+1 do begin
                    ReadLn( MenuFile, Line );
                    if ShowMenues then
                        writeln( '':indent, Line );
                    {$range-}
                    MPtr^.Commands[ CI ] := Line;
                    NextLevel[ CI ] := GetMenu;
                    {$range+}
                end;
        end;

        GetMenu := ME;
        Indent := Indent-4;
    end;


begin
            { Open menu source file }
    if FSLookUp( MenuFName, Blk, Bits )=0 then
        raise InvMenuFile
    else begin
        reset( MenuFile, MenuFName);

            { Allocate a BIG segment to build menues in }
            { Use half of max. size to avoid trouble with }
            { two's complement integer arithmetic }
        CreateSegment( MenuSeg, MMMaxExtSize div 2, 1, MMMaxExtSize div 2 );
        with FreePtr do begin
            Offset := WordSize( Integer );
            Segmen := MenuSeg;
        end;

        CreateHelpFile( HelpFName );
        LineNo := 0;
        Indent := 0;
        ReadLn( MenuFile, Line );
        ShowMenues := Line<>'';

            { Now go for it!! }
        Root := GetMenu;
        CloseHelpFile;
        WriteSegment( SegFName, FreePtr );
    end;
end;


function StripOff( InStr, Tail : Pstring ):Pstring;
{ Strip <Tail> from <InStr> if the last characters of <InStr> matches <Tail> }
var InL,TailL : integer;
    T1, T2    : String;
begin
    InL := Length( InStr );
    while InStr[InL]=' ' do begin
        InL := InL - 1;
        Adjust( InStr, InL );
    end;
    TailL := Length( Tail );
    if TailL>InL then begin
        StripOff := InStr
    end else begin
        T1 := SubStr( InStr,InL+1-TailL,TailL );
        ConvUpper( T1 );
        T2 := Tail;
        ConvUpper( T2 );
        if  T1=T2 then begin
            StripOff := SubStr( InStr, 1, InL-TailL )
        end else begin
            StripOff := InStr;
        end;
    end;
end;


procedure ParseArgs;

    handler InvMenuFile;
    begin
        writeln('Menu file: ',Mnu,' is invalid name or does not exist!');
        exit( ParseArgs );
    end;

    handler InvSegFile;
    begin
        writeln('Segment file name: ',Mseg,' is invalid name!');
        exit( ParseArgs );
    end;

    handler InvHelpFile;
    begin
        writeln('Help file name: ',Help,' is invalid name!');
        exit( ParseArgs );
    end;

    handler BadArgs;
    begin
        exit( ParseArgs );
    end;

begin
    Sep := NextId( Comm, isSwitch );
    if ParseCmdArgs( Inputs, Outputs, Switches, Err )  then begin
        Mnu := '';
        Mseg := '';
        Help := '';

        if Inputs<>NIL then Mnu := StripOff( Inputs^.Name, '.MENU' );
        if Outputs<>NIL then begin
            Mseg := StripOff( Outputs^.Name, '.MSEG' );
            if Outputs^.Next<>NIL then begin
                Help := StripOff( Outputs^.Next^.Name, '.HLP' );
            end;
        end;
        if Mnu='' then
            Mnu := StripOff( LastFileName, '.MENU' );
        if Mnu='' then
            if Mseg='' then begin
                if Help='' then begin
                    writeln('No filename given!');
                    Raise BadArgs;
                end else begin
                    Mseg := Help;
                    Mnu := Help;
                end;
            end else begin
                Mnu := Mseg;
            end;
        if Mseg='' then
            Mseg := Mnu;
        if Help='' then
            Help := Mseg;

        Mnu := Concat( Mnu, '.MENU' );
        Mseg := Concat( Mseg, '.MSEG' );
        Help := Concat( Help, '.HLP' );
        Writeln( 'Reading: ',Mnu, ',');
        Writeln( '  ==> ', MSeg, ', ', Help );
        MakeMenues( Mnu, Mseg, Help );
    end
    else begin
        writeln(Err);
        writeln;
        writeln
         ('Usage:  MenuBuild <.MENU file> [~<.MSEG file> [,<.HLP file>] ]');
    end;
end;

begin
    Inputs := NIL;
    Outputs := NIL;
    Switches := NIL;
    ParseArgs;
    DstryArgRec( Inputs );
    DstryArgRec( Outputs );
    DstrySwitchRec( Switches );
end.