
{*****************************************************************************
*                                                                            *
*           Disk Definition program Version 1.0, (c) 1989 J. Lamac           *
*                                                                            *
*****************************************************************************}

{$a-}

Const MaxX = 79;
      MaxY = 23;

Type Screen = array[ 0..MaxX, 0..MaxY ] of char;
     ScreenPointer = ^RamScreen;
     RamScreen = record
                   Dat : Screen;
                   Ptr : ScreenPointer;
                 end;
     TextLine = String[ 255 ];

Var CurScr : Screen;
    Key : Char;
    ScrPtr : ScreenPointer;
    Drive,
    Mode,
    SectorsNumber,
    BlockSize,
    DirSize,
    SystemTrack : Byte;
    DPH, DPB,
    DriveSize : Integer;

procedure InvVideo;

  begin
    Bios( 3, 27 ); Bios( 3, 48 );
  end { InvVideo };

procedure NormVideo;

  begin
    Bios( 3, 27 ); Bios( 3, 49 );
  end { NormVideo };

procedure ScrInit;

var X, Y : Byte;

  begin
    ClrScr; ScrPtr := nil;
    for Y := 0 to MaxY do
      for X := 0 to MaxX do
        CurScr[ X, Y ] := ' ';
  end { ScrInit };

procedure View( Xo, Yo, Xe, Ye : Byte );

var X, Y : Byte;

  begin
    for Y := Yo to Ye do
      begin
        Bios( 3, 27 ); Bios( 3, $3d );
        Bios( 3, Y + $20 ); Bios( 3, Xo + $20 );
        for X := Xo to Xe do
          if CurScr[ X, Y ] < #$c0
            then Bios( 3, ord( CurScr[ X, Y ] ) )
            else begin
                   InvVideo;
                   Bios( 3, ord( CurScr[ X, Y ] ) and $7f );
                   NormVideo;
                 end;
      end;
  end { View };

procedure Store;

var ScrPtr2 : ScreenPointer;

  begin
    new( ScrPtr2 ); ScrPtr2^.Dat := CurScr; ScrPtr2^.Ptr := ScrPtr;
    ScrPtr := ScrPtr2;
  end { Store };

procedure Recall( Xo, Yo, Xe, Ye : Byte );

var ScrPtr2 : ScreenPointer;

  begin
    if ScrPtr <> nil then
      begin
        CurScr := ScrPtr^.Dat; ScrPtr2 := ScrPtr; ScrPtr := ScrPtr^.Ptr;
        Dispose( ScrPtr2 );
        View( Xo, Yo, Xe, Ye );
      end;
  end { Recall };

procedure Window( Xo, Yo, Xe, Ye : Byte );

var X, Y : Byte;

  begin
    for Y := succ(Yo) to pred(Ye) do
      begin
        CurScr[ Xo, Y ] := #$99;
        CurScr[ Xe, Y ] := #$9b;
        for X := succ(Xo) to pred(Xe) do
          CurScr[ X, Y ] := ' ';
      end;
    for X := Xo to Xe do
      begin
        CurScr[ X, Yo ] := #$8e;
        CurScr[ X, Ye ] := #$8c;
      end;
    View( Xo, Yo, Xe, Ye );
  end { Window };

procedure Print( X, Y : Byte; Text : TextLine );

var I : Byte;

  begin
    for I := 1 to Length( Text ) do
      CurScr[ pred( X + I ), Y ] := Text[ I ];
    View( X, Y, X + Length( Text ), Y );
  end { Print };

procedure GetKey;

  begin
    Key := chr( Bios( 2 ) );
  end { GetKey };

procedure Menu( Xo, Yo : Byte; Text : TextLine; var Opt : Byte );

var I, J, K, MaxLen : Byte;

  begin
    MaxLen := 0; J := 3; K := 0;
    for I := 1 to Length( Text ) do
      if Text[ I ] = #0
        then begin
               if J > MaxLen then MaxLen := J;
               J := 3; K := succ( K );
             end
        else J := succ( J );
    Window( Xo, Yo, Xo + MaxLen + 4, Yo + K + K + 2 );
    repeat
      I := 0; J := 0;
      repeat
        if I = Opt then InvVideo;
        GoToXY( Xo + 2, Yo + I + I + 3 );
        write( '   ' ); K := 0;
        repeat
          J := succ( J ); K := succ( K );
          write( Text[ J ] );
        until Text[ J ] = #0;
        for K := K to MaxLen do write( ' ' );
        I := succ( I ); NormVideo;
      until J >= Length( Text );
      write( ^H ); GetKey;
      case  Key of
        ' ',^X: if Opt < pred( I )
                  then Opt := succ( Opt )
                  else Opt := 0;
        #08,^E: if Opt > 0
                  then Opt := pred( Opt )
                  else Opt := pred( I );
        else I := 0; J := 0;
             while ( I < Length( Text ) ) and ( Text[ I ] <> UpCase( Key ) ) do
               begin
                 if Text[ I ] = #0 then J := succ( J );
                 I := succ( I );
               end;
             if I < Length( Text ) then Opt := J;
      end;
    until Key = #13;
  end { Menu };

procedure SectorsSet;

  begin
    Store;
    Menu( 48, 8, '8 sectors/track'#0'9 sectors/track'#0'10 sectors/track'#0, SectorsNumber );
    Recall( 48, 8, 71, 16 );
  end { SectorsSet };

procedure BlockSet;

  begin
    Store;
    Menu( 52, 8, '1 K byte'#0'2 K bytes'#0'4 K bytes'#0, BlockSize );
    Recall( 52, 8, 68, 16 );
  end { BlockSet };

procedure DirSet;

  begin
    Store;
    Menu( 49, 8, '1 alloc. block'#0'2 alloc. blocks'#0, DirSize );
    Recall( 49, 8, 71, 14 );
  end { DirSet };

procedure SystemSet;

  begin
    Store;
    Menu( 53, 9, '0 track'#0'1 track'#0'2 track'#0'3 track'#0'4 track'#0, SystemTrack );
    Recall( 53, 9, 67, 21 );
  end { SystemSet };

procedure Quit;

var QuitMode : Byte;
    BlockNumber : Integer;

  begin
    Store; QuitMode := 0;
    Menu( 44, 12, 'Update operating system'#0'Quit with no update'#0'Quit this menu'#0, QuitMode );
    if QuitMode = 0 then
      begin
        Mem[ DPB ] := ( SectorsNumber + 8 ) * 4;
        Mem[ DPB + 2 ] := BlockSize + 3;
        case BlockSize of
          0 : Mem[ DPB + 3 ] :=  7;
          1 : Mem[ DPB + 3 ] := 15;
          2 : Mem[ DPB + 3 ] := 31;
        end;
        Mem[ DPB + 4 ] := pred( succ( Mem[ DPB + 3 ] ) div 8 );
        BlockNumber := pred( ( DriveSize - Mem[ DPB ] * SystemTrack ) div
                         succ( Mem[ DPB + 3 ] ) );
        if BlockNumber > 255
          then Mem[ DPB + 4 ] := pred( succ( Mem[ DPB + 4 ] ) div 2 );
        Mem[ DPB + 5 ] := Lo( BlockNumber );
        Mem[ DPB + 6 ] := Hi( BlockNumber );
        Mem[ DPB + 7 ] := pred( succ( Mem[ DPB + 3 ] ) * 4 );
        Mem[ DPB + 9 ] := $80;
        if DirSize = 1 then
          begin
            Mem[ DPB + 7 ] := pred( succ( Mem[ DPB + 7 ] ) * 2 );
            Mem[ DPB + 9 ] := $c0;
          end;
        Mem[ DPB + 11 ] := succ( Mem[ DPB + 3 ] ) * succ( DriveSize );
        Mem[ DPB + 13 ] := SystemTrack;
      end;
    if QuitMode < 2 then begin GoToXY( 1, MaxY ); Halt; end;
    Recall( 44, 12, 74, 20 );
  end { Quit };

BEGIN
  ScrInit;
  Window( 0, 0, 79, 22 );
  Window( 4, 2, 75, 6 );
  Print( 8, 4, 'D I S K D E F   Version 1.0' );
  Print( 60, 4, '(c) 1988 LEC' );
  Window( 31, 11, 75, 19 );
  Print( 35, 13, '*****  Select required option !' );
  Print( 35, 15, 'HELP: Use arrows, SPACE or other keys' );
  Print( 35, 17, 'to select item and push CR to execute.' );
  Drive := 1;
  repeat
    Menu( 4, 9, 'Drive A:'#0'Drive B:'#0'Drive C:'#0'Drive D:'#0, Drive );
    InLine( $3a/Drive/$4f/$2a/1/0/$2e/27/$11/*+4/$d5/$e9/$22/DPH );
  until DPH <> 0;
  DPB := Mem[ DPH + 10 ] + ( Mem[ DPH + 11 ] shl 8 );
  SectorsNumber := Mem[ DPB ] div 4 - 8;
  BlockSize := Mem[ DPB + 2 ] - 3;
  SystemTrack := Mem[ DPB + 13 ];
  DriveSize := succ( Mem[ DPB + 5 ] + ( Mem[ DPB + 6 ] shl 8 ) ) *
                succ( Mem[ DPB + 3 ] ) + Mem[ DPB ] * SystemTrack;
  DirSize := ord( Mem[ DPB + 11 ] <> $80 );
  Mode := 0;
  repeat
    Menu( 19, 8, 'Sectors per track'#0'Block size'#0'Directory size'#0'System track'#0'Quit'#0, Mode );
    case Mode of
      0 : SectorsSet;
      1 : BlockSet;
      2 : DirSet;
      3 : SystemSet;
      4 : Quit;
    end;
  until false;
END.
