/*******************************************************************/
/*                                                                 */
/*   SUPERDISK - Programm                                          */
/*                                                                 */
/* last update: 11.08.1988                                         */
/*       autor: r.mundloch,leinorstr.15a,8047 karlsfeld            */
/*     version: pearl v2.0, monochrom monitor                      */
/*************************************************************ROM***/
S=3500;                     /*-L ...*/
MODULE BOSS;                /*+M ...*/
SYSTEM;                     /*+T ...*/
  DIA:A1(TFU=128,NE,AI=$00);/*+B ...*/
  COM:XC(TFU=128,NE,AI=$00);
  DATA: ED.DIRS(NE);

PROBLEM;
  SPC DIA  DATION INOUT ALPHIC CONTROL(ALL);
  SPC COM  DATION   OUT ALPHIC CONTROL(ALL);
  SPC DATA DATION INOUT ALPHIC CONTROL(ALL);
  DCL ESC  CHAR(1);
  DCL (UV,FW,N,SZ,K) FIXED;
  DCL (SO,DE)     CHAR(2);
  DCL PS     CHAR(4);
  DCL RET    CHAR(1);
  DCL ERED   CHAR(8);
  DCL ZEILE  CHAR(80);
  DCL O(110) CHAR(8);
  DCL U(110) CHAR(7);
  DCL FS     CHAR(17);
  DCL NAMEW  CHAR(8);
  SPC RAND   ENTRY;
  DCL WZ     FIXED INIT(1);
  DCL FNE(10) CHAR(8);


BOX:PROC(A FIXED,B FIXED,C FIXED,D FIXED); /* RECHTECK */
  CALL LINE(A,B,A+C,B,1);                  /* A = X    */
  CALL LINE(A,B,A,B+D,1);                  /* B = Y    */
  CALL LINE(A+C,B,A+C,B+D,1);              /* C = XLEN */
  CALL LINE(A,B+D,A+C,B+D,1);              /* D = YLEN */
END;

CURSET:PROC(ROW FIXED,COL FIXED);          /* CURSOR POS. */
  PUT ESC,'=',TOCHAR(ROW+32),TOCHAR(COL+32) TO DIA BY (4)A;
END;

CW:PROC(Q CHAR(3)) RETURNS(FIXED);         /* WANDELT CHAR-STRING */
  DCL (Z1,Z2,Z3,Z4,Z5) FIXED;              /* IN FIXED-ZAHL       */
  Z5=10;
  Z1=TOFIXED(Q.CHAR(1))-48;
  Z2=TOFIXED(Q.CHAR(2))-48;
  Z3=TOFIXED(Q.CHAR(3))-48;
  IF Q.CHAR(3) EQ ' ' THEN
    Z3=0;
    Z5=1;
  FIN;
  Z4=Z1*Z5*10+Z2*Z5+Z3;
  RETURN(Z4);
END;

UMCOP:PROC;             /* COPIERT FLOPPY-FILES > ED-FILES */
  UV=0;                 /* NACH JE 6 FILES: ED.FILES>FLOPPY*/
  FNE(WZ) = NAMEW;
  NAMEW='        ';
  IF FNE(WZ) EQ '        ' OR
     FNE(WZ) EQ ' ' THEN
     UV=WZ;
    GOTO L15;
  FIN;
  PUT 'COPY ',SO,'.',FNE(WZ),'>ED.FN',TOCHAR(WZ+48),'--SB 300' TO COM BY
  (7)A,SKIP;
  AFTER 4 SEC RESUME;
  L15:
  IF WZ EQ 6 THEN
    CALL CURSET(3,51);
    PUT 'Destination-Disk einlegen' TO DIA;
    CALL CURSET(9,51);
    GET RET FROM DIA;
    CALL CURSET(3,51);
    PUT '                         ' TO DIA;
    CALL CURSET(9,51);
    FOR Z FROM 1 TO 6 REPEAT;
       IF Z EQ UV THEN
         GOTO L16;
       FIN;
       PUT 'COPY ED.FN',TOCHAR(Z+48),'>',DE,'.',FNE(Z),'--SB 300' TO
       COM BY (7)A,SKIP;
       L16:
    END;
    WZ=0;
    AFTER 20 SEC RESUME;
    FOR Z FROM 1 TO 6 REPEAT;
       IF Z EQ UV THEN
         GOTO L18;
       FIN;
       AFTER 2 SEC RESUME;
       PUT 'ERASE ED.FN',TOCHAR(Z+48) TO COM BY A,A,SKIP;
    END;
    L18:
    CALL CURSET(3,51);
    PUT 'Source-Disk einlegen.' TO DIA;
    CALL CURSET(9,51);
    GET RET FROM DIA;
    CALL CURSET(3,51);
    PUT '                     ' TO DIA;
    CALL CURSET(9,51);
  FIN;
  WZ=WZ+1;
END;

SICHER:PROC;                  /* BACKUP-ROUTINE */
  IF PS EQ 'JA' THEN
    CALL CURSET(3,51);
    PUT 'Destination-Disk einlegen.' TO DIA;
    GET RET FROM DIA;
    CALL CURSET(9,51);
    PUT FS,'--SB 300' TO COM BY A,A,SKIP;
    AFTER 2 MIN 30 SEC RESUME;
    CALL CURSET(10,0);
    PUT '                        ' TO DIA;
    AFTER 1.5 SEC RESUME;
    CALL RAND;
    AFTER 1 SEC RESUME;
  FIN;
  CALL CURSET(3,51);
  PUT 'Source-Disk einlegen.       ' TO DIA;
  GET RET FROM DIA;
  CALL CURSET(9,51);
  FOR I FROM 3 BY 2 TO K-2 REPEAT;
     IF O(I) EQ '        ' OR
        O(I) EQ ' ' THEN
       GOTO L12;
     FIN;
     IF DE EQ SO THEN
       NAMEW=O(I);
       CALL UMCOP;
       GOTO L12;
     FIN;
     PUT 'COPY ',SO,'.',O(I),'>',DE,'.',O(I),'--SB 300' TO COM BY (9)A,
     SKIP;
     AFTER 4 SEC RESUME;
     L12:
  END;
  CALL CURSET(3,51);
  PUT 'SI-Copy ready.      ' TO DIA;
  CALL CURSET(9,51);
END;

CFILE:PROC;              /* FILE COPIEREN */
   CALL CURSET(3,51);
   PUT 'NOCH NICHT IMPLEMENTIERT !' TO DIA;
   CALL CURSET(9,51);
END;

FORMAT:PROC;             /* FORMAT EINSTELLEN */
  DCL (KT,I1,I2,I3,I4,I5,I6,I7,I8,WS,SP) FIXED;
  DCL EW CHAR(2);
  DCL TR CHAR(3);
  DCL AS CHAR(17);
  AS='FORM D F0:B5DS80 ';
  AS.CHAR(8)=DE.CHAR(1);
  AS.CHAR(9)=DE.CHAR(2);
  FS=AS;
  L2:
  IF FS EQ ' ' THEN
    FS=AS;
  FIN;
  CALL CURSET(1,2);
  PUT FS TO DIA;
  CALL CURSET(2,2);
  PUT '-------------------'TO DIA;
  CALL CURSET(3,2);
  IF FS.CHAR(6) EQ 'S' THEN
    PUT 'single density' TO DIA;
    I1 = 1;
  FIN;
  IF FS.CHAR(6) EQ 'D' THEN
    PUT 'double density' TO DIA;
    I1 = 2;
  FIN;
  EW=FS.CHAR(8) CAT FS.CHAR(9);
  CALL CURSET(5,2);
  IF EW EQ 'F0' OR
     EW EQ 'F1' THEN
     PUT 'Floppy    : ',EW TO DIA;
  FIN;
  IF EW EQ 'H0' OR
     EW EQ 'H1' THEN
     PUT 'Winchester: ',EW TO DIA;
     CALL CURSET(3,2);
     PUT 'double density' TO DIA;
     I8=1;
     I1=2;
  FIN;
  EW='';
  EW=FS.CHAR(11) CAT FS.CHAR(12);
  I2 = 128;
  IF EW EQ 'A8' THEN
     I3 = 1;
     I4 = 26;
  FIN;
  IF EW EQ 'B8' THEN
     I3 = 4;
     I4 = 8;
  FIN;
  IF EW EQ 'A5' THEN
     I3 = 1;
     I4 = 16;
  FIN;
  IF EW EQ 'B5' THEN
     I3 = 4;
     I4 = 5;
  FIN;
  IF EW EQ 'W5' THEN
     WS=256;
     GOTO L1;
  FIN;
  IF I8 EQ 1 AND
     EW EQ 'A5' THEN
     WS=512;
     GOTO L1;
  FIN;
  IF EW EQ 'X5' THEN
     WS=1024;
     GOTO L1;
  FIN;
  I5 = I1*I2*I3;
  CALL CURSET(6,2);
  PUT 'Sekt./Byte: ',I4,'x',I5 TO DIA BY A,F(2),A,F(4);
  EW=FS.CHAR(13) CAT FS.CHAR(14);
  CALL CURSET(4,2);
  IF EW EQ 'SS' THEN
    PUT 'singlesided' TO DIA;
    I6=1;
  FIN;
  IF EW EQ 'DS' THEN
    PUT 'doublesided' TO DIA;
    I6=2;
  FIN;
  TR=FS.CHAR(15) CAT FS.CHAR(16) CAT FS.CHAR(17);
  CALL CURSET(7,2);
  PUT 'Track     : ',TR TO DIA;
  I7=CW(TR)*I6-1;
  SP=ENTIER(I7 *((I4 * I5) / 1024));
  GOTO L4;
  L1:
  CALL CURSET(6,2);
  PUT 'Sektor    : ',WS,'   ' TO DIA BY A,F(4),A;
  KT=TOFIXED(FS.CHAR(14))-48;
  FS.CHAR(6)='D';
  FS.CHAR(13)='H';
  CALL CURSET(7,2);
  PUT 'Koepfe/Tr.: ',KT,'  ' TO DIA BY A,F(1),A;
  TR=FS.CHAR(15) CAT FS.CHAR(16) CAT FS.CHAR(17);
  I7 =2* CW(TR);
  CALL CURSET(8,2);
  PUT 'Track     : ',CW(TR) TO DIA BY A,F(3);
  SP=ENTIER(I7 *((KT * WS) / 1024));
  CALL CURSET(1,2);
  PUT FS TO DIA;
  L4:
  CALL CURSET(9,2);
  IF SP LT 1000 THEN
    PUT 'Free max. : ',SP,' KB' TO DIA BY A,F(3),A;
  FIN;
  IF SP GE 1000 THEN
    SP=ENTIER(SP / 1000);
    PUT 'Free max. : ',SP,' MB' TO DIA BY A,F(3),A;
  FIN;
  CALL CURSET(1,2);
  IF N EQ 1 THEN
    GET FS FROM DIA;
    N=2;
    GOTO L2;
  FIN;
  N=1;
END;

RAND:PROC;                       /* UMRANDUNG */
  CALL BOX(10,15,160,145);
  CALL BOX(8,13,164,149);
  CALL BOX(176,13,460,149);
  CALL BOX(178,15,455,145);
  CALL BOX(8,170,628,215);
  CALL BOX(10,172,623,211);
END;
                                /* MENUE ANZEIGEN */
WAHL:PROC;
  CALL CURSET(1,51);
  PUT 'Meldung: ' TO DIA;
  CALL CURSET(2,51);
  PUT '-------------------------' TO DIA;
  CALL CURSET(1,23);
  PUT '(1)  Format einstellen' TO DIA;
  CALL CURSET(2,23);
  PUT '(2)  Sicherheitscopy' TO DIA;
  CALL CURSET(3,23);
  PUT '(3)  File copieren' TO DIA;
  CALL CURSET(4,23);
  PUT '(4)  Formatieren' TO DIA;
  CALL CURSET(5,23);
  PUT '(5)  Source      : ',SO TO DIA;
  CALL CURSET(6,23);
  PUT '(6)  Destination : ',DE TO DIA;
  CALL CURSET(7,23);
  PUT '(7)  Disk format.: ',PS TO DIA;
  CALL CURSET(9,23);
  PUT '(99) ENDE' TO DIA;
END;

LADE:PROC;                   /* NAMEN AUS DER ED.DATEI: DIRS LESEN */
  DCL ZZ CHAR(60);
  DCL ZY CHAR(20);
  K=1;
  SZ=0;
  OPEN DATA BY IDF('DIRS    ');
  CALL REWIND(DATA);

  GET ZZ,ZY FROM DATA BY SKIP,A,A;

  WHILE ST(DATA) EQ 0 REPEAT;


    GET O(K),O(K+1),O(K+2),O(K+3),O(K+4),O(K+5),O(K+6),O(K+7),O(K+8),
        O(K+9) FROM DATA BY SKIP,A,A,A,A,A,A,A,A,A,A;
    K=K+10;

    AFTER 0.01 SEC RESUME;
  END;

  CALL CURSET(12,2);
  PUT ZZ TO DIA BY A,SKIP;

  FOR Y FROM 1 BY 10 TO K-10 REPEAT;
     U(Y  )=O(Y+1);
     U(Y+1)=O(Y+3);
     U(Y+2)=O(Y+5);
     U(Y+3)=O(Y+7);
     U(Y+4)=O(Y+9);
     CALL CURSET(13+SZ,2);

     PUT O(Y),U(Y),O(Y+2),U(Y+1),O(Y+4),U(Y+2),O(Y+6),U(Y+3),O(Y+8),
     U(Y+4) TO DIA BY A,A,A,A,A,A,A,A,A,A,SKIP;
     SZ=SZ+1;

     IF SZ GT 9 THEN
       SZ=0;
       GOTO L20;
     FIN;
  END;
  L20:
  CALL CURSET(9,51);
END;

ST:TASK;                 /* HAUPTTASK */
  L7:
  PUT 'ERASE ED:DIRS ' TO COM BY A,SKIP;
  ESC=TOCHAR(27);
  PUT ESC,'*' TO DIA;    /* CLS */
  FW=10;
  PS='JA';
  SO='F0';
  DE='F1';
  CALL RAND;
  CALL WAHL;
  N=2;
  CALL FORMAT;
  CALL CURSET(12,2);
  PUT 'Bitte legen Sie eine Disk in Laufwerk ',SO,' ' TO DIA;
  GET RET FROM DIA;
  CALL CURSET(12,43);

  PUT 'O ED:DIRS; DIR ',SO,';' TO COM BY A,A,A,SKIP;
  GET RET FROM DIA;
  CALL LADE;
  AFTER 0.1 SEC RESUME;
  L6:
  CALL CURSET(9,51);
  GET FW FROM DIA;
  IF FW EQ 99 THEN
    FOR I FROM 1 TO 110 REPEAT;
       O(I)='        ';
       U(I)='       ';
    END;
    PUT 'UNLOAD ST,BOSS ' TO COM BY A,SKIP;
    GOTO L10;
  FIN;
  IF FW EQ 1 THEN
    CALL FORMAT;
  FIN;
  IF FW EQ 2 THEN
    CALL SICHER;
  FIN;
  IF FW EQ 3 THEN
    CALL CFILE;
  FIN;
  IF FW EQ 4 THEN
    CALL CURSET(9,51);
    PUT FS,'--SB 300' TO COM BY A,A,SKIP;
    AFTER 2 MIN 30 SEC RESUME;
    CALL CURSET(10,0);
    PUT '                             ' TO DIA;
    AFTER 1.5 SEC RESUME;
    CALL CURSET(3,51);
    PUT 'Disk formatiert.' TO DIA;
    CALL RAND;
  FIN;
  IF FW EQ 5 THEN
    CALL CURSET(9,51);
    PUT '? ' TO DIA;
    GET SO FROM DIA;
    CALL CURSET(5,42);
    PUT SO TO DIA;
  FIN;
  IF FW EQ 6 THEN
    CALL CURSET(9,51);
    PUT '? ' TO DIA;
    GET DE FROM DIA;
    CALL CURSET(6,42);
    PUT DE TO DIA;
    N=2;
    CALL FORMAT;
  FIN;
  IF FW EQ 7 THEN
    CALL CURSET(9,51);
    PUT '? ' TO DIA;
    GET PS FROM DIA;
    CALL CURSET(7,42);
    PUT PS TO DIA;
  FIN;
  CALL CURSET(9,51);
  PUT '                 ' TO DIA;
  GOTO L6;
  L10:
END;

MODEND;