MODULE TreasuresCopy;



(*****************************************************************************)
(*                                                                           *)
(*   Ein einfaches DOS-Copy geschrieben als Demo für die Routinen aus dem    *)
(*   Modul "DiskIOLib" des Modulpakets "FileTreasures" und für die           *)
(*   "AmigaTreasures"                                                        *)
(*                                                                           *)
(*   Für AMSoft M2Amiga Modula-2 von Paul Lukowicz  /  (c) Copyright 1988    *)
(*                                                                           *)
(*****************************************************************************)

(* $F-, $N-, $R-, $V- *)

FROM  Arts         IMPORT  TermProcedure;

FROM  DiskIOLib    IMPORT  MakeTDDevice, CloseTDDevice, DrivePtr, AllocSBuffer, 
                           FormatTrack, DiskPresent, ReadSector, WriteBuffer, 
                           SetTDErrMode, halt, FreeSBuffer, AssertTDDevice, 
                           DiskProtected, noHalt;
                         
FROM  Intuition    IMPORT  WindowPtr;

FROM  MenuLib      IMPORT  SimpleItem, SetMenu, reverseHi, noSub, checkOff, 
                           SetExclude, ReportMenu, InspMenu, SetTextItem,noMenu;

FROM  SYSTEM       IMPORT  ADDRESS, LONGSET, ADR;

FROM  WindowInOut  IMPORT  InitForIO, FinishIO, WReadInt, WWriteInt, 
                           WWriteString, WWriteLn, WReadLn;

FROM  WinIOControl IMPORT  WCls, WGotoXY, WDeleteChars, WFlashScreen,
                           WTextColors, WInsertLine, WInverseText, WCursorDown,
                           WCursorVisible, WCursorInvisible, WCursorUp;

FROM  WindowLib   IMPORT   ScrWin, CloseWin, noSize, noMove, noBorder, noBack,
                           GetWinMouse, backdrop;

FROM  WinIOLib    IMPORT   ReportClose, InspClose, ReportMButtons, wait, old,
                           InspMButtons;

FROM  WinGraphics IMPORT   Rectangle, Line, Ellipse;


VAR  i,j, sd,dd, Start, Number   : INTEGER;
     Menu, Item, Sub             : CARDINAL;                       
     Win                         : WindowPtr;

 
PROCEDURE DrawDisplay ( Win : WindowPtr );

(*  Baut die Anzeige neu auf  *)

VAR  i,j   : INTEGER;
     DName : ARRAY[0..5] OF CHAR;     
     
BEGIN
 
 WCls();
 (* WInverseText(); *) WCursorDown(1);
 WWriteString("             TreasuresCopy              "); WWriteLn; 
 WWriteString("     von Paul Lukowicz August 1989      "); WWriteLn;
 
 Rectangle(Win,0,50,80,40,3,FALSE);
 Rectangle(Win,80,50,80,40,3,FALSE);
 Rectangle(Win,160,50,80,40,3,FALSE);
 Rectangle(Win,240,50,79,40,3,FALSE);
 Line(Win,00,70,320,70,3);
 
 
 WGotoXY(2,7);  WWriteString("Source ");
 WGotoXY(13,7); WWriteString("Dest ");
 WGotoXY(22,7); WWriteString("Start ");
 WGotoXY(32,7); WWriteString("Number ");
 
 DName := "DFX:";
 DName[2] := CHR(48+sd);
 WGotoXY(2,9);  WWriteString(DName);
 DName[2] := CHR(48+dd);
 WGotoXY(13,9); WWriteString(DName);
 WGotoXY(22,9); WWriteInt(Start,3);
 WGotoXY(32,9); WWriteInt(Number,3);

 Ellipse(Win,160,118,60,16,1,TRUE);
 WGotoXY(16,14);
 WTextColors(2,1); 
 WWriteString("Start Copy ");
 WTextColors(1,0);
 
 FOR i := 19 TO 300 BY 14 DO
  Line(Win,i,149,i,189,1);
 END;
 FOR i := 149 TO 189 BY 10 DO
  Line(Win,19,i,299,i,1);
  
 END; 
 
 Rectangle(Win,0,205,319,40,3,FALSE);
 WGotoXY(5,27); WWriteString("Use menu to change options");WWriteLn;
 WGotoXY(5,28); WWriteString("Use mouse to start copy ");WWriteLn;
 
 
END DrawDisplay;



PROCEDURE InitDisplay () : WindowPtr;

(*  Öffnet das Fenster und baut die Menüs auf  *)

VAR Win   : WindowPtr;
    i,j   : INTEGER;
    DName : ARRAY[0..5] OF CHAR;

BEGIN

 (*  Fenster auf einem eigenen Screen öffnen  *)
 Win := ScrWin("TreasuresCopy",0,0,320,250,1,2,noBorder+noMove+noSize+noBack+
                                               backdrop);
 
 (*  Menüs einrichten  *)
 SetMenu(Win,0,"Project",0,80);
 SetMenu(Win,1,"Source",90,50);
 SetMenu(Win,2,"Dest",150,50);
 
 (*  Menüpunkte für Project-Menü  *)
 SimpleItem(Win,"Starttrack","S",0,0,100,10,0,0,noSub);
 SimpleItem(Win,"Endtrack","E",0,15,100,10,0,1,noSub);
 SimpleItem(Win,"Copy","C",0,30,100,10,0,2,noSub);
 SimpleItem(Win,"Quit","C",0,45,100,10,0,3,noSub);
 
 (*  Menüpunkte für Source und Destination drive Menüs  *)
 DName := "DFX:";
 FOR j := 1 TO 2 DO
  FOR i := 0 TO 4 DO
   DName[2] := CHR(48+i);
   SetTextItem(Win,DName,"",0,i*15,50,10,checkOff,reverseHi,0C,0,1,NIL,
               j,i,noSub);
   SetExclude(Win,j,i,noSub,LONGSET{0,1,2,3,4}/LONGSET{i})              
  END
 END;

 InitForIO(Win);
 DrawDisplay(Win);

 RETURN Win;
 
END InitDisplay;


PROCEDURE WaitDisk ( Source,Dest: DrivePtr );

(*  Wartet auf <RETURN> und prüft ob im Quell- und Ziellaufwerk eine   *)
(*  Diskette eingelegt ist                                             *)


VAR c: ARRAY[0..0] OF CHAR;
    
    
BEGIN
 
 REPEAT
  WReadLn; WCursorUp(1);
 UNTIL DiskPresent(Source) AND DiskPresent(Dest)
 
END WaitDisk; 

PROCEDURE ClearStatus ();

BEGIN

 WGotoXY(2,26); WWriteString("                                     "); 
 WGotoXY(2,27); WWriteString("                                     ");
 WGotoXY(2,28); WWriteString("                                     ");
 WGotoXY(2,29); WWriteString("                                     ");

END ClearStatus;



PROCEDURE Copy ( Win : WindowPtr; sd, dd, Start, Number : INTEGER );

(*  Die eigentliche Kopierprozedur  *)

VAR  Buffer                      : ADDRESS;
     Source, Dest                : DrivePtr;
     i,j, k, u, Tracks,Actual, 
     AtOnce, High, Step, col     : INTEGER;  

BEGIN

 Source := MakeTDDevice(sd);               (*  TDDevice für Source-Disk       *)
 AssertTDDevice(Source);

 IF sd = dd THEN
  Dest := Source
 ELSE  
  Dest   := MakeTDDevice(dd);              (*  TDDevice für Destination-Disk   *)
  AssertTDDevice(Dest);
 END;

 Buffer := AllocSBuffer(Number*11*2,Actual);              (* Buffer, der ein *)
 IF Actual >= 11 THEN
  AtOnce := Actual DIV 11;            (*  Vielefaches von 11 Blocks faßt     *)
  Step := AtOnce DIV 11;               (*  Anzahl der Tracks die auf ein mal  *)
                                      (*  eingelesen werden können           *)
  IF dd # sd THEN 
   ClearStatus();
   WGotoXY(5,26); 
   WWriteString(" Insert source disk in df"); WWriteInt(sd,1); 
   WGotoXY(5,27); 
   WWriteString(" and destination disk in df"); WWriteInt(dd,1);
   WGotoXY(8,28); 
   WWriteString("     press <RETURN> ! "); 
   WaitDisk(Source,Dest)
  END; 
 
  i := Start*2;                  (*  Tracks auf beiden Seiten sollen          *)
  High := (Start + Number)*2;    (*  kopiert werden !                         *)
  SetTDErrMode(noHalt);          (*  Fehler werden automatisch abgefangen     *)
  WHILE i < High DO             (*  Alle gewünschten Tracks kopieren         *)
   IF dd = sd THEN             (*  Bei einem Laufwerk auf Diskwechsel warten  *) 
    ClearStatus();
    WGotoXY(5,27);
    WWriteString(" Insert source disk in df"); WWriteInt(sd,1);
    WGotoXY(8,29);
    WWriteString(" press <RETURN>! "); 
    WaitDisk(Source,Dest)
   END;  
   
   FOR k := i TO i + AtOnce -1 DO
    IF k MOD 2 # 0 THEN
     u := k DIV 2;
     Rectangle(Win,19+(u MOD 20) * 14+1,149+(u DIV 20)*10+1,12,8,1,TRUE)
    END; 
   END;
   (*  Tracks lesen *)
   ClearStatus();
   WGotoXY(8,28);
   WWriteString("Reading tracks "); WWriteInt(i DIV 2,-1);
   WWriteString(" to "); WWriteInt((i+AtOnce-1) DIV 2,-1);
   ReadSector(Source,k,0,AtOnce*11,Buffer,NIL,FALSE,Actual);
       
   IF dd = sd THEN             (*  Bei einem Laufwerk auf Diskwechsel warten  *) 
    ClearStatus();
    WGotoXY(5,27);
    WWriteString(" Insert destination disk in df"); WWriteInt(sd,1);
    WGotoXY(5,28);
    WWriteString(" press <RETURN> "); 
    WaitDisk(Source,Dest)
   END;  
  
   WHILE DiskProtected(Dest) DO
    ClearStatus();
    WGotoXY(9,27);
    WWriteString("Disk write protected !!!");
    WaitDisk(Source,Dest)
   END; 
   
   FOR k := i TO i + AtOnce -1 DO
    IF k MOD 2 # 0 THEN
     u := k DIV 2;
     Rectangle(Win,19+(u MOD 20) * 14+1,149+(u DIV 20)*10+1,12,8,2,TRUE)
    END; 
   END;
   
   ClearStatus();
   WGotoXY(9,27);
   WWriteString("Writing track  "); WWriteInt(i DIV 2,-1);
   WWriteString(" to "); WWriteInt((i+AtOnce-1) DIV 2,-1);
   FormatTrack(Dest,k,AtOnce,Buffer,FALSE);   (*  Tracks schreiben   *)
   WriteBuffer(Dest,FALSE);                   (*  Pufferinhalt schreiben  *)
  
   IF (High - i < 2*AtOnce) AND (AtOnce#High-i) THEN
    INC(i,AtOnce);
    AtOnce := High -i;
   ELSE 
    INC(i,AtOnce)
   END 
  END; 
 
  FreeSBuffer(Buffer,Actual);           (*  Bufferspeicher wieder freigeben  *)
  ClearStatus(); WGotoXY(5,27); WWriteString("    Kopiervorgang beendet !!"); 
 END;

 CloseTDDevice(Source);                (*  Alles Schließen                   *)
 IF sd # dd THEN
  CloseTDDevice(Dest)
 END

END Copy;


PROCEDURE Clo;

BEGIN

 CloseWin(Win);

END Clo; 


BEGIN

TermProcedure(Clo);

sd := 0;                            (*  Initialisere mit Defaultwerten  *)
dd := 1;
Start := 0;
Number := 80;
Win := InitDisplay();

ReportMenu(Win,TRUE);               (*  Menüwahl-,                      *)
ReportMButtons(Win,TRUE,FALSE);     (*  Maustasten- und                 *)
ReportClose(Win,TRUE);              (*  Close- Events melden            *)

LOOP                                (*  Programmschleife                *)

 WCursorInvisible();
 InspMenu(Win,wait,Menu,Item,Sub);
 WCursorVisible();
 CASE Menu OF
  0: CASE Item OF
      0: WGotoXY(22,9);
         WReadInt(Start);
         Start := ABS(Start) MOD 80 |
      1: WGotoXY(32,9);
         WReadInt(Number);
         Number := ABS(Number) MOD (80 - Start) |
         
      2: Copy(Win,sd,dd,Start,Number) |
      3: EXIT
     END |
   1: sd := Item |
   2: dd := Item 
  ELSE
   IF InspMButtons(Win,old) = 1 THEN
    GetWinMouse(Win,i,j);
    IF (i > 130) AND (i < 190) AND (j > 115) AND (j < 130) THEN
     Copy(Win,sd,dd,Start,Number)
    END
   END  
  END;
 
 DrawDisplay(Win);

END


END TreasuresCopy.

