with Common, OS, UserIO, Controls, Windows;
use  Common, OS, UserIO, Controls, Windows;

procedure scrollable is

  procedure ScrollTest is
    line    : aliased aStaticLine;
    ok      : aliased aSimpleButton;
    up      : aliased aSimpleButton;
    down    : aliased aSimpleButton;
    left    : aliased aSimpleButton;
    right   : aliased aSimpleButton;
    list     : aliased aStaticList;

    DT    : aDialogTaskRecord;
    DisplayInfo : ADisplayInfoRec;
  begin
    GetDisplayInfo( DisplayInfo );

    OpenWindow( "Window Scrolling Test", 0, 0, DisplayInfo.H_Res-1, DisplayInfo.V_Res-1, normal, true );

    Init( line, 22, 18, 40, 18 );
    SetText( line, "Click OK to quit." );
    AddControl( line'unchecked_access );

    Init( ok, 2, 18, 10, 18, 'o' );
    SetText( ok, "OK" );
    AddControl( ok'unchecked_access );

    Init( up, 12, DisplayInfo.V_Res-4, 20, DisplayInfo.V_Res-4, 'u' );
    SetText( up, "Up" );
    Scrollable( up, false );
    AddControl( up'unchecked_access );

    Init( down, 22, DisplayInfo.V_Res-4, 30, DisplayInfo.V_Res-4, 'o' );
    SetText( down, "Down" );
    Scrollable( down, false );
    AddControl( down'unchecked_access );

    Init( left, 32, DisplayInfo.V_Res-4, 40, DisplayInfo.V_Res-4, 'l' );
    SetText( left, "Left" );
    Scrollable( left, false );
    AddControl( left'unchecked_access );

    Init( right, 42, DisplayInfo.V_Res-4, 50, DisplayInfo.V_Res-4, 'r' );
    SetText( right, "Right" );
    Scrollable( right, false );
    AddControl( right'unchecked_access );

    Init( list, 2, 1, 30, 16 );
    AddControl( list'unchecked_access );

    loop
      SetInfoText( "Offset:" & GetWindowXScroll( CurrentWindow )'img &
         "," & GetWindowYScroll( CurrentWindow )'img );
      DoDialog( DT );
      case DT.control is
      when 2 => exit;
      when 3 => ScrollWindow( 0, -1 );  -- move the control's up 1 vertically
                DrawWindow( whole );    -- erase and redraw whole window
      when 4 => ScrollWindow( 0, +1 );  -- move the control's down 1 vertically
                DrawWindow( whole );    -- erase and redraw whole window
      when 5 => ScrollWindow( -2, 0 );  -- move the control's left 2
                DrawWindow( whole );    -- erase and redraw whole window
      when 6 => ScrollWindow( +2, 0 );  -- move the control's right 2
                DrawWindow( whole );    -- erase and redraw whole window
      when others => null;
      end case;
    end loop;

    CloseWindow;

  end ScrollTest;

  procedure ScrollTest2 is
    line    : aliased aStaticLine;
    ok      : aliased aSimpleButton;
    hbar    : aliased aScrollBar;
    vbar    : aliased aScrollBar;
    list    : aliased aStaticList;

    DT          : aDialogTaskRecord;
    DisplayInfo : ADisplayInfoRec;

    VirtualWidth  : constant integer := 20; -- amount of scrolling
    VirtualHeight : constant integer := 20; -- amount of scrolling
    NewScroll     : integer;

  begin
    GetDisplayInfo( DisplayInfo );

    OpenWindow( "Window Scrolling Using Scroll Bars Test", 0, 0, DisplayInfo.H_Res-1, DisplayInfo.V_Res-1, normal, true );

    Init( line, 22, 18, 40, 18 );
    SetText( line, "Click OK to quit." );
    AddControl( line'unchecked_access );

    Init( ok, 2, 18, 10, 18, 'o' );
    SetText( ok, "OK" );
    AddControl( ok'unchecked_access );

    Init( hbar, 1, DisplayInfo.V_Res-4, DisplayInfo.H_Res-4, DisplayInfo.V_Res-4 );
    SetThumb( hbar, VirtualWidth/2 );
    SetMax( hbar, VirtualWidth );
    Scrollable( hbar, false );
    AddControl( hbar'unchecked_access );

    Init( vbar, DisplayInfo.H_Res-3, 1, DisplayInfo.H_Res-3, DisplayInfo.V_Res-5, 'u' );
    SetThumb( vbar, VirtualHeight/2 );
    SetMax( vbar, VirtualHeight );
    Scrollable( vbar, false );
    AddControl( vbar'unchecked_access );

    Init( list, 2, 1, 30, 16 );
    AddControl( list'unchecked_access );

    loop
      SetInfoText( "Offset:" & GetWindowXScroll( CurrentWindow )'img &
         "," & GetWindowYScroll( CurrentWindow )'img );
      DoDialog( DT );
      case DT.control is
      when 2 => exit;
      when 3 => -- move the control horizontally
                -- erase and redraw whole window
                NewScroll := GetThumb( hbar ) - VirtualWidth/2;
                NewScroll :=  NewScroll - GetWindowXScroll( CurrentWindow );
                ScrollWindow (NewScroll, 0 );
                DrawWindow( whole );
      when 4 => -- move the control vertically
                -- erase and redraw whole window
                NewScroll := GetThumb( vbar ) - VirtualHeight/2;
                NewScroll :=  NewScroll - GetWindowYScroll( CurrentWindow );
                ScrollWindow( 0,  NewScroll);
                DrawWindow( whole );
      when others => null;
      end case;
    end loop;

    CloseWindow;

  end ScrollTest2;

  line1 : aliased AStaticLine;
  line2 : aliased AStaticLine;
  ok    : aliased ASimpleButton;
  DT    : aDialogTaskRecord;

begin
  StartupCommon( "TIA", "tia" );
  StartupOS;
  StartupUserIO;
  StartupControls;
  StartupWindows;

  OpenWindow( "Window Scrolling Test", 0, 0, 60, 20, normal, false );

  Init( line1, 2, 2, 58, 2 );
  SetText( line1, "This a demonstration of ScrollWindow." );
  AddControl( line1'unchecked_access );

  Init( line2, 2, 3, 58, 3 );
  SetText( line2,  "It scrolls a window's controls." );
  AddControl( line2'unchecked_access );

  Init( ok, 2, 18, 30, 18, 'o' );
  SetText( ok, "OK" );
  AddControl( ok'unchecked_access );

  DoDialog( DT );

  ScrollTest;
  ScrollTest2;

  CloseWindow;

  ShutdownWindows;
  ShutdownControls;
  ShutdownUserIO;
  ShutdownOS;
  ShutdownCommon;

end scrollable;

