unit Step88;
//******************************************************************/
//                (c)                     */
//*                -, 1991, 1996                     */
//*                 -   5.x                      */
//******************************************************************/
//*                                              */
//*                      
//*                                                                */
//******************************************************************/

interface
 uses  Windows, SysUtils, LtDefine, LibTool, LDefin2D;

 procedure  LIBRARYENTRY( comm: WORD  ); Pascal;
 function   LIBRARYID   : Cardinal;      Pascal;
 procedure FuncTypeAttr;
 procedure DelTypeAttr;
 procedure ShowTypeAttr;
 procedure ChangeType;
 procedure NewAttr;
 procedure DelObjAttr;
 procedure ReadObjAttr;
 procedure ShowObjAttr;
 procedure ShowLib;
 procedure ShowType;
 procedure WalkFromObjWithAttr;
 procedure ShowCol(par : ColumnInfo; iCol : integer; fl:boolean );
 procedure ShowColumns( pCol : reference; fl : boolean );

 implementation

// uses  Sysutils, LtDefine, LibTool;

//----------------------------------------------------------------------------------------
//
//---
function   LIBRARYID : Cardinal;  pascal;
begin
  LIBRARYID:=100;
end;


//----------------------------------------------------------------------------------------
//
//---
procedure  LIBRARYENTRY( comm : Word  );  pascal;
begin
  case  ( comm ) of
   1:begin //  
     FuncTypeAttr();
     end;
  2:begin //   
     DelTypeAttr();
     end;
  3:begin //   
     ShowTypeAttr();
     end;
  4:begin //   
     ChangeType();
     end;
  5:begin //   
     NewAttr();
     end;
  6:begin // 
     DelObjAttr();
     end;
  7:begin // 
     ReadObjAttr();
     end;
  8:begin // 
     ShowObjAttr();
     end;
  9:begin // 
     ShowLib();
     end;
  10:begin // 
     ShowType();
     end;
  11:begin // 
     WalkFromObjWithAttr();
     end;
  end;
end;


//-------------------------------------------------------------------------
//     
//  
// struct {
//   double       ;//   123456789
//   char[MAX_TEXT_LENGTH]   ;//   "string"
//   long        ;//   1000000
// }
//-------------------------------------------------------------------------
procedure FuncTypeAttr;
var
  pCol      : reference ; //    ,    
  parStruct : ColumnInfo;
  attrType  : ksAttributeType ;
  nameFile  : array [0..128] of char;
  numbType  : double;
  buf       : string;
begin
//    3 

  pCol := CreateArray( ATTR_COLUMN_ARR, nil );

   //    
    StrCopy(parStruct.header, 'double');   // o- 
    parStruct._type := DOUBLE_ATTR_TYPE;    //     - .
    parStruct.key   := 0;                    //  ,        
    StrCopy(parStruct.def,'123456789');    //   
    parStruct.flagEnum  :=0;                 //   ,    
                                          //       1  0 
    parStruct.fieldEnum := 0;              //     ()
    parStruct.columns   := 0;                //        

    AddArrayItem( pCol, -1, Addr(parStruct), SizeOf(parStruct) );

   //   
    StrCopy(parStruct.header, 'str');   // o- 
    parStruct._type :=STRING_ATTR_TYPE;      //     - .
    parStruct.key   := 0;                   //  ,        
    StrCopy(parStruct.def,'string');     //   
    parStruct.flagEnum  :=0;                //   ,    
                                         //       1  0 
    parStruct.fieldEnum := 0;             //     ()
    parStruct.columns   := 0;               //        

    AddArrayItem( pCol, -1, Addr(parStruct), SizeOf(parStruct) );

   //   
    StrCopy(parStruct.header, 'long');   // o- 
    parStruct._type := LINT_ATTR_TYPE;;     //     - .
    parStruct.key   := 0;                   //  ,        
    StrCopy(parStruct.def,'1000000');     //   
    parStruct.flagEnum  :=0;                //   ,    
                                         //       1  0 
    parStruct.fieldEnum := 0;             //     ()
    parStruct.columns   := 0;               //        

    AddArrayItem( pCol, -1, Addr(parStruct), SizeOf(parStruct) );

  MessageBoxResult();  //     

//   
  StrCopy(attrType.header,'double_str_long');   // o- 
  attrType.rowsCount        := 1;                // -   
  attrType.flagVisible      := 1;                // ,     
  StrCopy(attrType.password,'');            // ,      -     
  attrType.columns          := pCol;             //      
  attrType.key1 := 10;
  attrType.key2 := 20;
  attrType.key3 := 30;
  attrType.key4 := 0;
//  
 if( ksChoiceFile( '*.lat',nil, nameFile,128,0 ) = 0 )then
   strCopy(nameFile,'');  //   
//  
 numbType :=  ksCreateAttrType( Addr(attrType),   //    
                                     nameFile ); //    
  if ( numbType > 1 )  then
  begin
    buf := Format( 'numbType=%f', [numbType] );
    ksMessage(PChar(buf));
  end else
    MessageBoxResult();  //     

 //   
 DeleteArray( pCol );

end;


//--------------------------------------------------------------------------
//   
//--------------------------------------------------------------------------
procedure DelTypeAttr;
var
 numb : double;
 j : integer;
 nameFile : array [0..128] of char;
 password : array [0..11] of char;

begin
 //  
 if( ksChoiceFile( '*.lat',nil, nameFile,128,0 ) = 0 ) then
   strCopy(nameFile,''); //   
 repeat
   j := ReadDouble( '   ', 1000.,0, 1e12, numb);
   if( j > 0) then
   begin
     j := ReadString( '   ', password, 10 );
     if ( j>0 )  then
     begin
       if( DeleteAttrType( numb, nameFile, password ) = 0) then
         MessageBoxResult  //     
       else
         ksMessage('    ');
     end;
   end;
 until( j=0 );
end;

//----------------------------------------------------------------------------
//
procedure  ShowCol(par : ColumnInfo; iCol : integer; fl:boolean );
var
  s : array [0..10] of char;
  n1, i1 : integer;
  s1 : array[0..128] of char;
  buf : string;
begin
  if ( fl ) then
    StrCopy(s, '' )
  else
    StrCopy(s,'');

  //    
   buf := Format( '%s i=%d header=%s type=%d def=%s flagEnum=%d',[s,iCol,par.header,
                           par._type, par.def, par.flagEnum]);
  ksMessage( PChar(buf) );
  if( par._type = RECORD_ATTR_TYPE ) then //
    ShowColumns( par.columns,TRUE )
  else begin
    if ( par.flagEnum >0 ) then //  
    begin
      n1 := GetArrayCount( par.fieldEnum );
      ksMessage( ' ' );
      for i1:=0 to n1-1 do
      begin
       if(GetArrayItem( par.fieldEnum , i1, Addr(s1), 128) =0) then
          MessageBoxResult()  //     
        else
          ksMessage( s1 );
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------
//
procedure ShowColumns( pCol : reference; fl : boolean );
var
  par : ColumnInfo;
  n, i : integer;
begin
  par.columns := CreateArray( ATTR_COLUMN_ARR, nil );
  par.fieldEnum := CreateArray( CHAR_STR_ARR, nil );
  n := GetArrayCount( pCol );

  for i := 0 to n-1 do
  begin
    if( GetArrayItem( pCol, i, Addr(par), SizeOf(par) ) = 0 ) then
      MessageBoxResult  //     
    else
      ShowCol(par,i, fl );
  end;
  DeleteArray( par.columns );
  DeleteArray( par.fieldEnum );

end;

//--------------------------------------------------------------------------
//   
//--------------------------------------------------------------------------
procedure ShowTypeAttr;
var
 numb : double ;
 buf : string;
 nameFile : array [0..128] of char;
 attrType : ksAttributeType ;

begin
 attrType.columns := CreateArray( ATTR_COLUMN_ARR, nil );

 //  
 if( ksChoiceFile( '*.lat', nil, nameFile,128, 0 )=0 ) then
   strcopy(nameFile,'');//   
 repeat
   numb := ChoiceAttrTypes ( nameFile );
   if( numb > 0 ) then
   begin
     if ( ksGetAttrType( numb, nameFile, Addr(attrType) ) = 0 )then
       MessageBoxResult()  //     
     else begin
       buf := Format( 'key1 = %d key2 =%d key3 = %d key4 =%d',
                [attrType.key1,attrType.key2,attrType.key3,attrType.key4]);
       ksMessage( PChar(buf) );
       buf := Format( 'header=%s rowsCount=%d flagVisible=%d password=%s',
                [attrType.header,attrType.rowsCount,attrType.flagVisible,attrType.password]);
       ksMessage( PChar(buf) );
       ShowColumns( attrType.columns, FALSE ); // 
     end;
   end;
 until( numb = 0);

 //   
 DeleteArray( attrType.columns );

end;
//--------------------------------------------------------------------------
//   
//--------------------------------------------------------------------------
procedure ChangeType;
var
  numb : double ;
  j : integer;
  nameFile : array [0..128] of char;
  password : array [0..11] of char;
  attrType : ksAttributeType ;
  par1 : ColumnInfo ;  //   
  parN : ColumnInfo ;   //   
  n : integer;
  numbType : double;
  buf : string;
begin

  attrType.columns := CreateArray( ATTR_COLUMN_ARR,nil );

  //     

  par1.columns := CreateArray( ATTR_COLUMN_ARR,nil );
  par1.fieldEnum := CreateArray( CHAR_STR_ARR,nil );

  parN.columns := CreateArray( ATTR_COLUMN_ARR,nil );
  parN.fieldEnum := CreateArray( CHAR_STR_ARR,nil );


  //  
  if( ksChoiceFile( '*.lat',nil, nameFile,128,0 ) =0 ) then
    strcopy(nameFile,''); //   
  repeat
    j := ReadDouble( '   ', 1000.,0, 1e12, numb);
    if( j <> 0 ) then
    begin
      j := ReadString( '   ', password, 10 );
      if ( j <> 0 )  then
      begin
        //  
        if ( ksGetAttrType( numb, nameFile, Addr(attrType) )=0 ) then
          MessageBoxResult  //     
        else begin
          StrCopy(attrType.password,password);
          //  
          n := GetArrayCount( attrType.columns );
          //  
          GetArrayItem( attrType.columns, 0, Addr(par1), SizeOf(par1) );
          //  
          GetArrayItem( attrType.columns, n-1, Addr(parN), SizeOf(parN) );
          //  
          SetArrayItem( attrType.columns, 0, Addr(parN), sizeof(parN) );
          //  
          SetArrayItem( attrType.columns, n-1, Addr(par1), sizeof(par1) );

          //      
          numbType := ksSetAttrType( numb, nameFile, Addr(attrType), password );
          if ( numbType > 1 )  then
          begin
            buf := Format( 'numbType=%f ',[numbType] );
            ksMessage(PChar(buf));
          end else
            MessageBoxResult();  //   -     
        end;
      end;
    end;
  until( j=0 );
  //   
  DeleteArray( par1.columns );
  DeleteArray( par1.fieldEnum );

  DeleteArray( parN.columns );
  DeleteArray( parN.fieldEnum );

  DeleteArray( attrType.columns );
end;

//----------------------------------------------------------------------------
//  ,   FuncTypeAttr
//----------------------------------------------------------------------------
procedure NewAttr;
type
BufSRec = record
  a : double ;
  c : array [0..MAX_TEXT_LENGTH-1] of char;
  b : longint;
end;

var
 attrPar : Attribute;
 bufS    : BufSRec;
 fV      : array[0..3] of char;
 x, y    : double;
 pObj    : reference;
 info    : RequestInfo;
 j       : integer;
 nameFile: array [0..128] of char;
 numb    : double ;
 attr    : reference;


begin
bufS.a := 987654321.0;
bufS.b := 99999;
StrCopy(bufS.c,'qwerty');

  fV[0]:= '1'; fV[1]:= '1'; fV[2]:= '1';
  attrPar.key1 := 1;                          // .   
  attrPar.key2 := 10;                         // .   
  attrPar.key3 := 100;                        // .   
  attrPar.key4 := 0;                          //   
                                             //   0  1000 
                                             //   ""
  attrPar.flagVisible := fV;                  //,    
                                             //  -
                                             //0 -  1-  
  attrPar.values := Addr(bufS);                    //     
                                             //     1- ,
                                             //     2-   ..
  attrPar.valSize := SizeOf(bufS);
  StrCopy(attrPar.password,'111');            //,      -       


   FillChar(info, sizeof(info), 0);
   info.prompt := ' ';

  j := ksCursor( Addr(info), x ,y, nil );
  if ( j <>0 ) then
  begin
    pObj := FindObj( x, y, 1e6 );
    if( ExistObj(pObj)>0 )then
    begin
      LightObj( pObj, 1 );
      //  
      if(ksChoiceFile( '*.lat',nil, nameFile, 128,0 ) = 0) then
        strcopy(nameFile,''); //   
      j := ReadDouble( '   ', 1000.,0, 1e12,numb);
      if( j>0 ) then
      begin

        attr := CreateAttr( pObj, Addr(attrPar), numb, nameFile );
        if( attr=0 ) then
          MessageBoxResult  //   -     
      end;
      LightObj( pObj, 0 );

    end;
  end;
end;

//--------------------------------------------------------------------------
//       
//---------------------------------------------------------------------------
procedure DelObjAttr;
var
  x, y : double ;
  pObj : reference ;
  password :array [0..11] of char;
  j : integer;
  info : RequestInfo ;
  iter,p : reference;
  attr : reference;

begin
  FillChar( info, sizeof(info),0); 
  info.prompt := ' ';
  repeat
    j := ksCursor( Addr(info), x ,y, nil );
    if ( j<>0 ) then
    begin
      pObj := FindObj( x, y, 1e6 );
      if( ExistObj(pObj)>0 ) then
      begin
        LightObj( pObj, 1 );
        //      

        iter := CreateAttrIterator( pObj, 0,0,0,0,0 );
        //   
        attr := MoveAttrIterator( iter, 'F', p );
        if ( attr > 0) then
        begin
          j := ReadString( '   ', password, 10 );
          if ( j>0 )  then
          begin
            // 
            if( DeleteAttr (pObj, attr, password)=0 ) then
              MessageBoxResult();  //   -     
          end;
        end else
          Error( '  ' );
        LightObj( pObj, 0 );
      end;
    end;
  until ( j=0 );
end;
//--------------------------------------------------------------------------
//      double_str_long
//---------------------------------------------------------------------------
procedure ReadObjAttr;
type
BufSRec = record
  d : double ;
  s : array [0..MAX_TEXT_LENGTH-1] of char;
  l : longint;
end;

var
  sBuf : BufSRec;
  x, y : double ;
  pObj : reference ;
  j,i : integer;
  buf : string;
  info :RequestInfo;
  iter,p, attr : reference;
  k1,k2,k3,k4  : Cardinal;
  numb : double;
  col, row : Cardinal;
  par : ColumnInfo ;  //   


begin
  FillChar( info, sizeof(info),0);
  info.prompt := ' ';

  repeat
    j := ksCursor( Addr(info), x ,y, nil );
    if ( j<>0 ) then
    begin
      pObj := FindObj( x, y, 1e6 );
      if( ExistObj(pObj)>0 ) then
      begin
        LightObj( pObj, 1 );
        //      

        iter := CreateAttrIterator( pObj, 0,0,0,0,0 );
        //   
        attr := MoveAttrIterator( iter, 'F', p );
        if ( attr>0 ) then
        begin

          ksMessage('   ');
          GetAttrKeysInfo( attr,k1,k2,k3,k4,numb );
          buf :=Format( 'k1=%d k2=%d k3=%d k4=%d numb=%f',[k1,k2,k3,k4,numb] );
          ksMessage( PChar(buf) );

          ksMessage(' ');
          GetAttrTabInfo( attr, row, col );
          buf := Format ( 'column=%d row =%d',[col, row] );
          ksMessage( Pchar(buf) );

          ksMessage('  ');
          par.columns := CreateArray( ATTR_COLUMN_ARR, nil );
          par.fieldEnum := CreateArray( CHAR_STR_ARR,nil );
          for  i:=0 to col-1 do
          begin
            GetAttrColumnInfo ( attr, i, Addr(par) );
            ShowCol(par,i, FALSE );
          end;
          DeleteArray(par.columns);
          DeleteArray(par.fieldEnum);

          ksMessage(' ');
          GetAttrRow ( attr, 0, nil, Addr(sBuf), sizeof(sBuf));
          buf := Format ('d=%f s=%s l=%d',[sBuf.d, sBuf.s, sBuf.l] );
          ksMessage( PChar(buf) );

          ksMessage('  ');
          sBuf.d := numb;
          StrCopy(sBuf.s,'1234567\nasdfgh\nzxcvb');
          sBuf.l := 88888;
          SetAttrRow( attr, 0, nil, Addr(sBuf), sizeof(sBuf), '111');
          GetAttrRow ( attr, 0, nil, Addr(sBuf), sizeof(sBuf));
          buf := Format ( 'd=%f s=%s l=%d',[sBuf.d, sBuf.s, sBuf.l] );
          ksMessage( PChar(buf) );


        end else
          Error( '  ' );
        LightObj( pObj, 0 );
      end;
    end;
  until ( j=0 );
end;

//--------------------------------------------------------------------------
//   
//---------------------------------------------------------------------------
procedure ShowObjAttr;
var
  x, y : double ;
  pObj : reference ;
  j    : integer;
  info :RequestInfo;
Begin
  FillChar( info, sizeof(info),0);
  info.prompt := ' ';
  repeat
    j := ksCursor( Addr(info), x ,y, nil );
    if ( j<>0 ) then
    Begin
      pObj := FindObj( x, y, 1e6 );
      if( ExistObj(pObj)>0 ) then
      begin
        LightObj( pObj, 1 );
        ChoiceAttr ( pObj );
        LightObj( pObj, 0 );
      end;
    end;
  until( j=0 );
end;

//--------------------------------------------------------------------------
//     
//---------------------------------------------------------------------------
procedure ShowLib;
var
  nameFile : array [0..128]of char;
  numb : double;
  buf : string;
begin
  if( ksChoiceFile( '*.lat',nil, nameFile,128,0 )=0 )then
    strCopy(nameFile,''); //   

  numb := ChoiceAttrTypes ( nameFile);

  if ( numb > 1 )  then
  begin
    buf := Format( 'numbType=%f ',[numb] );
    ksMessage(PChar(buf));
  end;
end;

//----------------------------------------------------------------------------------------
//         
//---
procedure ShowType;
var
  nameFile : array [0..128] of char;
  password : array [0..10] of char;
  j : integer;
  numb : double ;
begin
  if( ksChoiceFile( '*.lat',nil, nameFile,128,0 )=0 ) then
    StrCopy(nameFile,''); //   
  j := ReadDouble( '   ', 1000.,0, 1e12, numb);
  if ( j>0 )  then
  Begin
    password := '0';
    j := ReadString( '   ', password, 10 );
    if ( j >0 )  then
      ViewEditAttrType ( nameFile, 2, numb, password );
  end;
end;

//---------------------------------------------------------------------------
//     ,    
// key1=10          
//---------------------------------------------------------------------------
procedure WalkFromObjWithAttr;
var
 x, y  : double;
 j     : integer;
 pObj  : reference ;
 info  : RequestInfo ;
 iter  : reference;
 count : integer;
 buf : string;
 rowsCount, columnsCount : Cardinal;
 pAttr,p : reference;

begin
 // 
  FillChar( info, sizeof(info),0);
  info.prompt := ' ';
  repeat
    j := ksCursor( Addr(info), x ,y, nil );
    if ( j<>0 ) then
    begin
      pObj := FindObj( x, y, 1e6 );
      if( ExistObj(pObj)>0 ) then
      begin
      //        10
        iter := CreateAttrIterator( pObj, 10, 0,0,0,0 );
        count := 0;
        LightObj( pObj, 1 );

        pAttr :=  MoveAttrIterator(  iter, 'F', p );
        if ( pAttr>0 ) then
        begin
          repeat
            Inc(count);
            //    
            if( GetAttrTabInfo ( pAttr, rowsCount, columnsCount )>0 ) then
            begin
              buf := Format(' = %d rowsCount=%d columnsCount=%d', [count,rowsCount,columnsCount] );
              ksMessage( PChar(buf) );
            end else
              MessageBoxResult();  //   -     
            pAttr := MoveAttrIterator(  iter, 'N', p );
          until( pAttr=0 );
        end;
        LightObj( pObj, 0 );
      end;
    end;
  until(j=0);
end;


end.
