(* SCRGEM.PAS     4 JAN 86 - 15 MAY 86         R.E. Swem & Bill Hodges      *)
(*                       Version #1.02 - 22 July 86                         *)
(*             Released into the Public Domain on 3 January 1986.           *)

PROGRAM Scrunch_Gem(INPUT,OUTPUT);

CONST
        {$I A:\INCLUDE\gemconst.pas}
        Max_Size        =    10000;
        Buf_Size        =     9216;

TYPE
        {$I A:\INCLUDE\gemtype.pas}
        Path_Chars      =       PACKED ARRAY[1..80]OF CHAR;
        Buf             =       PACKED ARRAY[1..Max_Size]OF Byte;
        Fn_Range = 1..14 ;
        Fname_Type = PACKED ARRAY [ Fn_Range ] OF CHAR ;
        Frec = PACKED RECORD
             Reserved : PACKED ARRAY [ 0..19 ] OF Byte ;
             Resvd2 : Byte ;
             Attrib : Byte ;
             Time_Stamp : INTEGER ;
             Date_Stamp : INTEGER ;
             Size : Long_Integer ;
             Name : Fname_Type ;
        END ;
        Diskinfobuffer = RECORD
             Freespace   : Long_Integer;
             Clusters    : Long_Integer;
             Sectorsize  : Long_Integer;
             Clustersize : Long_Integer;
        END;


VAR
        R : Frec ;
        I : Fn_Range ;
        Path_String : STRING ;
        Yes_Or_No, Hell_Freezes : BOOLEAN;
        Fname, Out_Str, R_String, W_String : Str255;
        Path, F_Fname : Path_Chars;
        A_Menu :   Menu_Ptr;
        Info_Box  :  Dialog_Ptr;

        Title1,Title2,Title3,Title4,Title5,Item11,Item12,Item13,
        Item21,Item22,Item23,Item31,Item32,Item33,Item41,Item42,
        Item43,Item51,Item52,Item53,Sf,Info_Item,Ok_Button,Button,
        Event, A1, A2, A3, T10, T11, U_Source, U_Dest, S_Source,
        Hundred_Thousands, Ten_Thousands, Thousands, Hundreds,
        Tens, Ones, S_Dest : INTEGER;

        {$I A:\INCLUDE\gemsubs.pas}

FUNCTION Rwabs(Rwflag : INTEGER; VAR Buffer_Address : Buf;
               Number_Of_Sectors, Log_Secnum, Device : INTEGER) :
               INTEGER;
 Bios($4);

FUNCTION Getbpb(Device : INTEGER) : Long_Integer;
 Bios($7);

FUNCTION Mediach(Device : INTEGER) : Long_Integer;
 Bios($9);

FUNCTION Floprd(VAR Buffer_Address : Buf; Filler : Long_Integer;
                Device, Sec_Number, Track_Number, Side_Number,
                Count_Number : INTEGER):INTEGER;
 Xbios($8);

FUNCTION Flopwr(VAR Buffer_Address : Buf; Filler : Long_Integer;
                Device, Sector,Track_Number, Side_Number, Count_Number :
                INTEGER):INTEGER;
 Xbios($9);

FUNCTION Flopfmt(VAR Buffer_Address : Buf; Filler : Long_Integer;
                 Device, Sectors_Per_Track, Track, Side,
                 Interleave : INTEGER; Magic : Long_Integer;
                 Virgin : INTEGER):INTEGER;
 Xbios($A);

PROCEDURE Protobt(VAR Buffer_Address : Buf; Serial_Number : Long_Integer;
                  Disk_Type, Exec_Flag : INTEGER);
 Xbios($12);

FUNCTION Setdrv(Device : Long_Integer) : INTEGER;
 Gemdos($0e);

PROCEDURE Set_Dta( VAR Buf : Frec ) ;
 Gemdos($1a) ;

PROCEDURE Get_Data(VAR Buf: Diskinfobuffer; Drive : INTEGER);
 Gemdos($36);

FUNCTION F_Create(VAR F_Name : Path_Chars; Attributes : INTEGER):INTEGER;
 Gemdos($3c);

FUNCTION F_Open(VAR F_Name : Path_Chars; Mode : INTEGER) : INTEGER;
 Gemdos($3d);

FUNCTION F_Close(Han : INTEGER):INTEGER;
 Gemdos($3e);

FUNCTION F_Read(Han : INTEGER; Counter  : Long_Integer;
                VAR Bfr : Buf):Long_Integer;
 Gemdos($3f);

FUNCTION F_Write(Han : INTEGER; Counter  : Long_Integer;
                 VAR Bfr : Buf):Long_Integer;
 Gemdos($40);

FUNCTION Get_First( VAR Path : Path_Chars ; Search_Attrib :INTEGER):INTEGER;
 Gemdos($4e) ;

FUNCTION Get_Next : INTEGER ;
 Gemdos($4f) ;

PROCEDURE Init;
BEGIN
  Menu_Check(A_Menu,Item31,FALSE);
  Menu_Check(A_Menu,Item32,FALSE);
  Menu_Check(A_Menu,Item41,FALSE);
  Menu_Check(A_Menu,Item42,FALSE);

  U_Source := 99;  U_Dest := 99;
  S_Source := 99;  S_Dest := 99;
  T10 := 0;        T11 := 0;
  Hundred_Thousands := 0; Ten_Thousands := 0;
  Thousands := 0; Hundreds := 0;
  Tens := 0; Ones := 0;
END;

PROCEDURE Make_Path(VAR Ps : Str255; VAR Cs : Path_Chars);
    VAR I : INTEGER;
BEGIN
    FOR I := 1 TO LENGTH(Ps) DO
     Cs[I] := Ps[I];
    Cs[LENGTH(Ps)+1] := CHR(0);
END;

PROCEDURE Figure_Bytes(Numbytes : Long_Integer);
BEGIN
  Hundred_Thousands := 0; Ten_Thousands := 0; Thousands := 0;
  Hundreds := 0; Tens := 0; Ones := 0;

   IF Numbytes >100000 THEN
    REPEAT
      Hundred_Thousands := Hundred_Thousands + 1;
      Numbytes := Numbytes - 100000
    UNTIL Numbytes < 100000;

   IF Numbytes > 10000 THEN
    REPEAT
     Ten_Thousands := Ten_Thousands + 1;
     Numbytes := Numbytes - 10000
    UNTIL Numbytes < 10000;

   IF Numbytes > 1000 THEN
    REPEAT
     Thousands := Thousands + 1;
     Numbytes := Numbytes - 1000
    UNTIL Numbytes < 1000;

   IF Numbytes > 100 THEN
    REPEAT
     Hundreds := Hundreds + 1;
     Numbytes := Numbytes - 100
    UNTIL Numbytes < 100;

   IF Numbytes >10 THEN
    REPEAT
     Tens := Tens + 1;
     Numbytes := Numbytes - 10
    UNTIL Numbytes < 10;

   IF Numbytes > 0 THEN
    REPEAT
     Ones := Ones + 1;
     Numbytes := Numbytes - 1
    UNTIL Numbytes = 0;

END;

PROCEDURE Media_Change(Src : INTEGER);
 VAR Tl1,Tl2 : Long_Integer;
     T1  : INTEGER;
BEGIN
 Tl1 := Src;
 Tl2 := Mediach(Src);
 T1  := Setdrv(Tl1);
 Tl1 := Getbpb(Src);
END;

(*----------------------------------SCRUNCH----------------------------------*)

FUNCTION Scrunch(Source : INTEGER;
                 Dest   : Str255) : INTEGER;

VAR
    Ibuf, Obuf : Buf;
    Isub, Osub, File_Handle, Sides,
     T1, T2, T3, I, Count, Max_Sectors, Sector : INTEGER;
    Key, Cur, A, B : Byte;
    E_O_D : BOOLEAN;
    Tli, Tli2,Tli3, Total_Written : Long_Integer;

       PROCEDURE Stuff_Buffer;
        BEGIN
         IF (Count > 4) OR (Cur = Key) THEN BEGIN
           Obuf[Osub] := Key;
           Obuf[Osub + 1] := Cur;
           A := Count DIV 256;
           B := Count MOD 256;
           Obuf[Osub + 2] := A;
           Obuf[Osub + 3] := B;
           Osub := Osub + 4;
          END
         ELSE
          WHILE Count > 0 DO
           BEGIN
            Obuf[Osub] := Cur;
            Osub := Osub + 1;
            Count := Count - 1
           END;
         Count := 1;
       END;

  PROCEDURE Test_Sides;
  BEGIN
   Media_Change(S_Source);
   Media_Change(S_Dest);
   T10 := Rwabs(2,Ibuf,1,Sector,S_Source);
   A := Ibuf[28];
   B := Ibuf[27];
   T10 := (A*256) + B;
   IF T10 = 2 THEN
    BEGIN
     Max_Sectors := 1440;
     Sides := 1;
     Obuf[1] := 1;
    END
   ELSE
    BEGIN
     Max_Sectors := 720;
     Sides := 0;
     Obuf[1] := 0;
    END;
  END;

  PROCEDURE S_Init;
  BEGIN
    Key := 229;
    Set_Mouse(M_Bee);
    Make_Path(Fname,F_Fname);
    File_Handle := F_Create(F_Fname,0);
    Isub := 1;
    Osub := 2;
    Cur := 0;
    E_O_D := FALSE;
    Count := 1;
    T10 := 0;
    Tli := 0;
    Sector := 0;
    Test_Sides;
  END;

BEGIN
  S_Init;
  WHILE Sector < Max_Sectors DO BEGIN
   FOR T3 := 1 TO Max_Size DO Ibuf[T3] := 229;
   T10 := Rwabs(2,Ibuf,18,Sector,S_Source);
   Isub := 1;

     IF Sector = 0 THEN
        BEGIN
         Sector := 18;
         Count := 1;
         Cur := Ibuf[Isub];
         Isub := Isub + 1;
        END
     ELSE
        Sector := Sector + 18;

  WHILE Isub < Buf_Size + 1 DO BEGIN

    IF (Ibuf[Isub] = Cur) AND (Count < 32760) THEN
       Count := Count + 1
    ELSE
     BEGIN
       Stuff_Buffer;
       Cur := Ibuf[Isub];
     END;
    Isub := Isub + 1;
    IF Osub > Buf_Size THEN
       BEGIN
         Tli := Osub - 1;
         Total_Written := Total_Written + Tli;
         Tli2 := F_Write(File_Handle,Tli,Obuf);
         FOR T3 := 1 TO Max_Size DO Obuf[T3] := 229;
         Osub := 1;
       END;

    END;(*WHILE2*)

   IF Sector = Max_Sectors THEN BEGIN
      Stuff_Buffer;
      Tli := Osub;
      Total_Written := Total_Written + Tli;
      IF Tli <> 0 THEN
         Tli2 := F_Write(File_Handle,Tli,Obuf);
   END;
  END;(*WHILE1*)
  Set_Mouse(M_Arrow);
  Menu_Disable(A_Menu,Item33);
  T10 := F_Close(File_Handle);
  Out_Str := '[0][   Scrunching  Complete   |  |   000000 bytes written   | ';
  Out_Str := CONCAT(Out_Str,' ][  OK  ]');
  Figure_Bytes(Total_Written);
  Out_Str[38] := CHR(Hundred_Thousands + 48);
  Out_Str[39] := CHR(Ten_Thousands + 48);
  Out_Str[40] := CHR(Thousands + 48);
  Out_Str[41] := CHR(Hundreds + 48);
  Out_Str[42] := CHR(Tens + 48);
  Out_Str[43] := CHR(Ones + 48);
  Scrunch := Do_Alert(Out_Str,0);
 END;(*SCRUNCH*)

(*---------------------------------UNSCRUNCH---------------------------------*)

FUNCTION Unscrunch(Source : Str255;
                   Dest   : INTEGER) : INTEGER;

VAR

    Ibuf, Obuf : Buf;
    Isub, Osub, File_Handle, Sector,
     T1, T2, T3, I, Count, Max_Sectors : INTEGER;
    File_Size, Buffer_Size, Tli: Long_Integer;
    Key, Cur, A, B : Byte;
    E_O_F : BOOLEAN;


  PROCEDURE Fill_Buffer;
   VAR T4 : INTEGER;
  BEGIN
   IF File_Size < Buffer_Size THEN
     Buffer_Size := File_Size;
   IF File_Size > Buffer_Size THEN
    BEGIN
        File_Size := File_Size - Buffer_Size;
        Tli := F_Read(File_Handle, Buffer_Size,Ibuf);
    END
   ELSE
    BEGIN
        IF Sector = 0 THEN Isub := 2 ELSE Isub := 1;
        FOR T4 := 1 TO Max_Size DO Ibuf[T4] := 229;
        Tli := F_Read(File_Handle, Buffer_Size,Ibuf);
        T10 := INT(Buffer_Size);
        E_O_F := TRUE;
    END;
  END;

  PROCEDURE Inc_Isub;
  BEGIN
   Isub := Isub + 1;
   IF (Isub > Buffer_Size) AND (E_O_F = FALSE) THEN
    BEGIN
     Fill_Buffer;
     Isub := 1;
    END;
  END;

  FUNCTION U_Init : INTEGER;
  BEGIN
    Key := 1;
    Set_Mouse(M_Bee);
    Cur := 0;
    E_O_F := FALSE;
    Buffer_Size := Buf_Size;
    File_Size := 0;
    Isub := 2;
    Osub := 1;
    Sector := 0;
    Count := 1;
    Make_Path(Fname,F_Fname);
    Set_Dta( R ) ;
    IF Get_First( F_Fname,0) = 0 THEN File_Size := R.Size;
    File_Handle := F_Open(F_Fname,0);
    T3 := 0;
    Fill_Buffer;

    IF Ibuf[1] = Key THEN
      Max_Sectors := 1440
    ELSE
      Max_Sectors := 720;

    Media_Change(U_Source);
    Media_Change(U_Dest);

    T10 := Rwabs(2,Obuf,1,0,U_Dest);
    B := Obuf[27];
    IF ((B = 2) AND (Max_Sectors = 720)) OR
       ((B = 1) AND (Max_Sectors = 1440)) THEN
      BEGIN
        Out_Str := '[3][ Disk Format Incompatable | with Scrunched file! ';
        Out_Str := CONCAT(Out_Str,'|  [ Abort ]');
        T3 := Do_Alert(Out_Str,0);
      END;
    Key := 229;
    U_Init := T3;
  END;

BEGIN
 IF U_Init = 0 THEN BEGIN
  REPEAT
   Cur := Ibuf[Isub];
   Inc_Isub;
   IF Cur <> Key THEN Count := 1
   ELSE
     BEGIN
      Cur := Ibuf[Isub];
      Inc_Isub;
      A := Ibuf[Isub];
      Inc_Isub;
      B := Ibuf[Isub];
      Count := (A * 256) + B;
      Inc_Isub;
     END;

   WHILE Count > 0 DO
    BEGIN
     Count := Count - 1;
     Obuf[Osub] := Cur;
     IF Osub >= Buf_Size THEN
      BEGIN
       T10 := Rwabs(3,Obuf,18,Sector,U_Dest);
       Sector := Sector + 18;
       Osub := 1;
      END
     ELSE
      Osub := Osub + 1;
  END;

  UNTIL (Isub = Buffer_Size) AND (E_O_F);

  Set_Mouse(M_Arrow);
  Menu_Disable(A_Menu,Item43);
  T10 := F_Close(File_Handle);
  Out_Str := '[0][ Unscrunching Complete. |  |  ][  OK  ]';
  Unscrunch := Do_Alert(Out_Str,1);
 END;
END;

(*---------------------------------DO_FORMAT---------------------------------*)

PROCEDURE Do_Format;

 VAR T4,T5, Sides, Track_Cnt, Which_Drive : INTEGER;
     Fbuf : Buf;

BEGIN
  Out_Str := '[2][    Format Which Drive?    |  |  ][  A  |  B  ]';
  Which_Drive := Do_Alert(Out_Str,0);
  Out_Str := '[2][    Select Type of Disk    |  |  ][  SS  |  DS  | Abort ]';
  Sides := Do_Alert(Out_Str,0);
  Which_Drive := Which_Drive - 1;
  Sides := Sides -1;
  IF Sides <> 2 THEN
   BEGIN
    Set_Mouse(M_Bee);
    FOR Track_Cnt := 0 TO 79 DO
     BEGIN
       T10 := Flopfmt(Fbuf, 0, Which_Drive, 9,
                      Track_Cnt,0,1,$87654321,$E5e5);
       T4 := T4 + T10;
       IF Sides = 1 THEN BEGIN
         T10 := Flopfmt(Fbuf, 0, Which_Drive, 9,
                        Track_Cnt,1,1,$87654321,$E5e5);
         T4 := T4 + T10;
       END;
    END;
    IF T4 <> 0 THEN
      Out_Str := '[0][  Format Errors.  | Try another disk. |  ][  OK  ]'
    ELSE
     BEGIN
      FOR T5:= 1 TO Max_Size DO Fbuf[T5] := 0;
      Protobt(Fbuf,$01111111,2+Sides,0);
      T10 := Flopwr(Fbuf,0,Which_Drive,1,0,0,9);
      Out_Str := '[0][ Formatting Complete. |  |  ][  OK  ]';
     END;
    Set_Mouse(M_Arrow);
    T10 := Do_Alert(Out_Str,1);
    Media_Change(Which_Drive);
  END;
 Menu_Normal(A_Menu,Title2);
END;

PROCEDURE Disk_Dir;
 VAR T1, T2 : Str255;
BEGIN
 T2 := '            ';
 T1 := Fname;
 Yes_Or_No := Get_In_File(T1,T2);
 Menu_Normal(A_Menu,Title2);
END;

PROCEDURE Set_Ss;
BEGIN
 Out_Str := '[0][    Select Source Drive    |  ][  A  |  B  | ABORT ]';
 S_Source := Do_Alert(Out_Str,0);
 IF S_Source <> 3 THEN
  BEGIN
   S_Source := S_Source - 1;
   Menu_Check(A_Menu,Item31,TRUE);
  END;
 Menu_Normal(A_Menu,Title3);
END;

PROCEDURE Set_Sd;
BEGIN
 IF Get_Out_File(' Output file name? ',Fname) THEN
  IF Filename(Fname) THEN
   BEGIN
    S_Dest := (ORD(Fname[1]) - 65);
    Menu_Check(A_Menu,Item32,TRUE);
   END;
  Menu_Normal(A_Menu,Title3);
END;

PROCEDURE Set_Us;
 VAR Ts1 : Str255;
BEGIN
 Ts1 := Fname;
 IF Get_In_File(Ts1,Fname) THEN
  BEGIN
   U_Source := (ORD(Fname[1]) - 65);
   Menu_Check(A_Menu,Item41,TRUE);
  END;
 Menu_Normal(A_Menu,Title4);
END;

PROCEDURE Set_Ud;
BEGIN
 Out_Str := '[0][   Select Destination Drive   |  ][  A  |  B  | Abort ]';
 U_Dest := Do_Alert(Out_Str,0);
 IF U_Dest <> 3 THEN
  BEGIN
   U_Dest := U_Dest - 1;
   Menu_Check(A_Menu,Item42,TRUE);
 END;
 Menu_Normal(A_Menu,Title4);
END;

FUNCTION S_Ready : INTEGER;
BEGIN
 Out_Str := '[0][ Put Source Disk in Drive A, |';
 IF S_Dest > 1 THEN
  BEGIN
   Out_Str[32] := '.';
   Out_Str := CONCAT(Out_Str,'                                 ');
  END
 ELSE
  BEGIN
   Out_Str := CONCAT(Out_Str,' and Dest Drive in Drive B.');
   Out_Str[60] := CHR(S_Dest + 65);
  END;
 Out_Str := CONCAT(Out_Str,' |  ][ Ready | Abort ]');
 Out_Str[31] := CHR(S_Source + 65);
 S_Ready := Do_Alert(Out_Str,0);
END;

FUNCTION U_Ready : INTEGER;
BEGIN
 IF U_Source < 2 THEN
  BEGIN
   Out_Str := '[0][ Put Source Disk in Drive A, | and Dest Disk in Drive B.';
   Out_Str[59] := CHR(U_Dest + 65);
   Out_Str[31] := CHR(U_Source + 65);
  END
 ELSE
  BEGIN
   Out_Str := '[0][ Put Dest Disk in Driva A. |  ';
   Out_Str[29] := CHR(U_Dest + 65);
  END;
 Out_Str := CONCAT(Out_Str,' |  ][ Ready | Abort ]');
 U_Ready := Do_Alert(Out_Str,0);
END;

PROCEDURE Get_Info;
  VAR Gdi : Diskinfobuffer;
      Drv, T5 : INTEGER;
      Tl14, Tl15, Tl16 : Long_Integer;
 BEGIN
  Out_Str := '[0][       Which Drive?       |  |  ][ A | B | C ]';
  Drv := Do_Alert(Out_Str,0);
  Out_Str := '[0][  Non-Standard Disk,  |  | Free Bytes => 000000 |  ][ OK ]';
  Get_Data(Gdi,Drv);
  Tl14 := Gdi.Freespace;
  Tl16 := Gdi.Clusters;
  Tl15 := (Tl14 * 512) * 2;
  IF Tl15 > 0 THEN
     BEGIN
      Figure_Bytes(Tl15);
      Out_Str[46] := CHR(Hundred_Thousands + 48);
      Out_Str[47] := CHR(Ten_Thousands + 48);
      Out_Str[48] := CHR(Thousands + 48);
      Out_Str[49] := CHR(Hundreds + 48);
      Out_Str[50] := CHR(Tens + 48);
      Out_Str[51] := CHR(Ones + 48);
     END;
  IF Tl16 = 711 THEN
     BEGIN
            Out_Str[7]  := 'D';
            Out_Str[8]  := 'o';
            Out_Str[9]  := 'u';
            Out_Str[10] := 'b';
            Out_Str[11] := 'l';
            Out_Str[12] := 'e';
            Out_Str[13] := ' ';
            Out_Str[14] := 'S';
            Out_Str[15] := 'i';
            Out_Str[16] := 'd';
            Out_Str[17] := 'e';
            Out_Str[18] := 'd';
     END;
  IF Tl16 = 351 THEN
     BEGIN
            Out_Str[7]  := 'S';
            Out_Str[8]  := 'i';
            Out_Str[9]  := 'n';
            Out_Str[10] := 'g';
            Out_Str[11] := 'l';
            Out_Str[12] := 'e';
            Out_Str[13] := ' ';
            Out_Str[14] := 'S';
            Out_Str[15] := 'i';
            Out_Str[16] := 'd';
            Out_Str[17] := 'e';
            Out_Str[18] := 'd';
     END;
  T5 := Do_Alert(Out_Str,0);
  Menu_Normal(A_Menu,Title2);
 END;

PROCEDURE Build_Menu;
BEGIN
 A_Menu := New_Menu(30,' about ST-SCRUNCH ');
 Title1 := Add_Mtitle(A_Menu, ' Exit ');
 Title2 := Add_Mtitle(A_Menu, ' Utility ');
 Title3 := Add_Mtitle(A_Menu, ' Scrunch ');
 Title4 := Add_Mtitle(A_Menu, ' UnScrunch ');

 Item11 := Add_Mitem(A_Menu,Title1,'  Exit  ');

 Item21 := Add_Mitem(A_Menu,Title2,'  Directory  ');
 Item22 := Add_Mitem(A_Menu,Title2,'  Disk Info  ');
 A1     := Add_Mitem(A_Menu,Title2,'-------------');
 Item23 := Add_Mitem(A_Menu,Title2,'   Format    ');

 Item31 := Add_Mitem(A_Menu,Title3,'  Set Source  ');
 Item32 := Add_Mitem(A_Menu,Title3,'   Set Dest   ');
 A2     := Add_Mitem(A_Menu,Title3,'--------------');
 Item33 := Add_Mitem(A_Menu,Title3,'   SCRUNCH!   ');

 Item41 := Add_Mitem(A_Menu,Title4,'  Set Source  ');
 Item42 := Add_Mitem(A_Menu,Title4,'   Set Dest   ');
 A3     := Add_Mitem(A_Menu,Title4,'--------------');
 Item43 := Add_Mitem(A_Menu,Title4,'  UNSCRUNCH!  ');

 Menu_Disable(A_Menu,Item33);
 Menu_Disable(A_Menu,Item43);
 Menu_Disable(A_Menu,A1);
 Menu_Disable(A_Menu,A2);
 Menu_Disable(A_Menu,A3);

 Draw_Menu(A_Menu);
END;

PROCEDURE Info_Dialog;
BEGIN
 Sf := System_Font;
 Info_Box := New_Dialog(15,0,0,40,18);
 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,1,36,1,0,$1180);
 Out_Str := 'ST-SCRUNCH Version 1.02';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,3,36,1,0,$1180);
 Out_Str := 'by Bill Hodges and Rob Swem';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,5,36,1,0,$1180);
 Out_Str := '1986 Cherry Software';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,9,36,1,0,$1180);
 Out_Str := 'Portions of this product are';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,11,36,1,0,$1180);
 Out_Str := 'Copyright (c) 1986, OSS & CCD.';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Info_Item := Add_Ditem(Info_Box,G_Text,None,2,13,36,1,0,$1180);
 Out_Str := 'Used by permission of OSS.';
 Set_Dtext(Info_Box,Info_Item,Out_Str,Sf,Te_Center);

 Ok_Button := Add_Ditem(Info_Box,G_Button,Selectable|exit_Btn|default,
                        16,15,8,2,2,$1180);
 Set_Dtext(Info_Box, Ok_Button,' OK ',Sf,Te_Center);
 Center_Dialog(Info_Box);
 Button := Do_Dialog(Info_Box,0);
 End_Dialog(Info_Box);
 Delete_Dialog(Info_Box);
END;

PROCEDURE Event_Rtn;
 VAR Dummy : INTEGER;
     Msg   : Message_Buffer;
BEGIN
 Dummy := 0;
 Event := Get_Event(E_Message,0,0,0,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
                    Msg,Dummy,Dummy,Dummy,Dummy,Dummy,Dummy);
 IF (Event & E_Message) <> 0 THEN
  IF Msg[0] = Mn_Selected THEN
   BEGIN
    IF Msg[3] = 3 THEN Info_Dialog;
    IF Msg[4] = Item11 THEN HALT;
    IF Msg[4] = Item21 THEN Disk_Dir;
    IF Msg[4] = Item22 THEN Get_Info;
    IF Msg[4] = Item23 THEN Do_Format;
    IF Msg[4] = Item31 THEN Set_Ss;
    IF Msg[4] = Item32 THEN Set_Sd;
    IF Msg[4] = Item33 THEN
     BEGIN
      IF S_Ready = 1 THEN
       T10 := Scrunch(S_Source,Fname);
      Init;
      Menu_Normal(A_Menu,Title3);
     END;
    IF Msg[4] = Item41 THEN Set_Us;
    IF Msg[4] = Item42 THEN Set_Ud;
    IF Msg[4] = Item43 THEN
     BEGIN
      IF U_Ready = 1 THEN
       T10 := Unscrunch(Fname,U_Dest);
      Init;
      Menu_Normal(A_Menu,Title4);
     END;
    IF (S_Source <> 99) AND (S_Dest <> 99) THEN
     BEGIN
      Menu_Enable(A_Menu,Item33);
     END;
    IF (U_Source <> 99) AND (U_Dest <> 99) THEN
     BEGIN
      Menu_Enable(A_Menu,Item43);
     END;
   END;
END;

BEGIN
  IF Init_Gem >= 0 THEN
    BEGIN
      Fname := 'A:\*.*';
      Hell_Freezes := FALSE;
      Init_Mouse;
      Hide_Mouse;
      Build_Menu;
      Init;
      Show_Mouse;
      Info_Dialog;
      REPEAT
       Event_Rtn
      UNTIL Hell_Freezes;
    END;
END.