home *** CD-ROM | disk | FTP | other *** search
/ 17 Bit Software 2: Collection B / 17Bit_Collection_B.iso / files / 1545.dms / in.adf / KwikBackUp / Source / HDDisplay.mod < prev    next >
Encoding:
Modula Implementation  |  1990-03-25  |  12.8 KB  |  464 lines
  1. IMPLEMENTATION MODULE HDDisplay;
  2.  
  3. FROM SYSTEM    IMPORT ADR, LONGSET, BITSET, INLINE, ADDRESS;
  4.  
  5. FROM Arts      IMPORT Assert, BreakPoint, TermProcedure;
  6.  
  7. FROM Dos       IMPORT Delay;
  8.  
  9. FROM Exec      IMPORT UByte, WaitPort, GetMsg, ReplyMsg;
  10.  
  11. FROM Graphics  IMPORT RastPortPtr, SetDrMd, SetAPen, SetBPen, jam1, jam2,
  12.                       Move, Draw, RectFill, Text;
  13.  
  14. FROM Intuition IMPORT NewWindow, WindowPtr, ScreenFlags, ScreenFlagSet,
  15.                       WindowFlags, WindowFlagSet, Gadget, GadgetFlagSet,
  16.                       GadgetFlags, boolGadget, OpenWindow, CloseWindow,
  17.                       IDCMPFlags, IDCMPFlagSet, Image, DrawImage,
  18.                       ActivationFlags, ActivationFlagSet, strGadget,
  19.                       StringInfo, Border, RefreshGadgets, IntuiText,
  20.                       IntuiMessagePtr, IntuiMessage, GadgetPtr, DrawBorder,
  21.                       PrintIText, AutoRequest;
  22.  
  23. FROM Strings   IMPORT Length;
  24.  
  25. FROM HDImages  IMPORT Images, ImageDatas, Imgwidth, Imgheight;
  26.  
  27. FROM Beep      IMPORT Beep;
  28.  
  29. (*------  Definition:  ------
  30.  
  31. TYPE
  32.   gadgets = (HDGadg, DiskGadg, SaveAllGadg, RegardArchivedGadg,
  33.              SetArchivedGadg, StartGadg, BackUpGadg, RestoreGadg);
  34.   ReqResults = (Retry, Continue, Cancel);
  35.  
  36. VAR
  37.   Window: WindowPtr;
  38.   Gadgets: ARRAY gadgets OF Gadget;
  39.   RP: RastPortPtr;
  40.   HDName: ARRAY[0..255] OF CHAR;
  41.   DriveName: ARRAY[0..5] OF CHAR;
  42. *)
  43.  
  44. (*------  VARs:  ------*)
  45.  
  46. VAR
  47.   NuWindow: NewWindow;
  48.   GadgImages: ARRAY Images OF Image;
  49.   ImgCnt: Images;
  50.   GdgCnt: gadgets;
  51.   Undo: ARRAY[0..255] OF CHAR;
  52.   HDInfo: StringInfo;
  53.   Borders: ARRAY[0..10] OF Border;
  54.   i: CARDINAL;
  55.   Texte: ARRAY[0..8] OF IntuiText;
  56.   DiskNameText: IntuiText;
  57.   ReqWin: WindowPtr;
  58.   ReqCnt: CARDINAL;
  59.  
  60. (*------  Type Text:  ------*) (* $S- *)
  61.  
  62. PROCEDURE Type(x,y: INTEGER; String: ARRAY OF CHAR);
  63.  
  64. BEGIN
  65.   Move(RP,x,y);
  66.   Text(RP,ADR(String),Length(String));
  67. END Type;
  68.  
  69. (*------  Init IText:  ------*)
  70.  
  71. PROCEDURE SetIText(VAR iText: IntuiText;
  72.                    x,y: INTEGER;
  73.                    Str: ADDRESS;
  74.                    next: ADDRESS);
  75.  
  76. BEGIN
  77.   WITH iText DO
  78.     frontPen := 1;
  79.     backPen  := 0;
  80.     drawMode := jam2;
  81.     leftEdge := x;
  82.     topEdge  := y;
  83.     iTextFont:= NIL;
  84.     iText    := Str;
  85.     nextText := next;
  86.   END;
  87. END SetIText;
  88.  
  89. (* $S+ *)
  90.  
  91. (*------  BorderData:  ------*)
  92.  
  93. PROCEDURE BorderData(); (* $E- *) (* coors relative 16/128) *)
  94.  
  95. BEGIN
  96.   INLINE(-  1,-  1,  140,-  1,  140,  16, -  1,  16, -  1,-  1);
  97.   INLINE( 155,-  1,  296,-  1,  296,  16,  155,  16,  155,-  1);
  98.   INLINE( 311,-  1,  452,-  1,  452,  16,  311,  16,  311,-  1);
  99.   INLINE( 467,-  1,  608,-  1,  608,  16,  467,  16,  467,-  1);
  100.   INLINE( 544,- 82,  576,- 82,  576,- 70,  544,- 70,  544,- 82);
  101.   INLINE( 544,- 66,  576,- 66,  576,- 54,  544,- 54,  544,- 66);
  102.   INLINE( 480,- 50,  576,- 50,  576,- 38,  480,- 38,  480,- 50);
  103.   INLINE( 336,-104,  600,-104,  600,- 12,  336,- 12,  336,-104);
  104.   INLINE(  16,-104,  204,-104,  204,- 12,   16,- 12,   16,-104);
  105.   INLINE(-  1,  23,  608,  23,  608,  36, -  1,  36, -  1,  23);
  106.   INLINE(-  1,  43,  608,  43,  608,  56, -  1,  56, -  1,  43);
  107. END BorderData;
  108.  
  109. PROCEDURE ReqBorderData(); (* $E- *)
  110.  
  111. BEGIN
  112.   INLINE( 15,11, 368,11, 368,28,  15,28,  15,11);
  113.   INLINE( 15,35, 112,35, 112,52,  15,52,  15,35);
  114.   INLINE(143,35, 240,35, 240,52, 143,52, 143,35);
  115.   INLINE(271,35, 368,35, 368,52, 271,52, 271,35);
  116. END ReqBorderData;
  117.  
  118. (*---------------------  Redraw Window:  ----------------------------------*)
  119.  
  120. PROCEDURE Redraw();
  121.  
  122. BEGIN
  123.  
  124.   SetDrMd(RP,jam1); SetAPen(RP,0);
  125.   RectFill(RP,2,10,636,176);
  126.  
  127.   RefreshGadgets(Window^.firstGadget,Window,NIL);
  128.   SetAPen(RP,2); SetBPen(RP,1); SetDrMd(RP,jam2);
  129.  
  130. END Redraw;
  131.  
  132. (*-------------------------  Open Window:  --------------------------------*)
  133.  
  134.  
  135. PROCEDURE OpenDisplay();
  136.  
  137. BEGIN
  138.  
  139. (*------  Images:  ------*)
  140.  
  141.   FOR ImgCnt := MIN(Images) TO MAX(Images) DO
  142.     WITH GadgImages[ImgCnt] DO
  143.       leftEdge   := 0;
  144.       topEdge    := 0;
  145.       width      := Imgwidth[ImgCnt];
  146.       height     := Imgheight[ImgCnt];
  147.       depth      := 2;
  148.       imageData  := ImageDatas[ImgCnt];
  149.       planePick  := 3;
  150.       planeOnOff := 0;
  151.       nextImage  := NIL;
  152.     END;
  153.   END;
  154.  
  155. (*------  Gadgets:  ------*)
  156.  
  157.   FOR GdgCnt := MIN(gadgets) TO MAX(gadgets) DO
  158.     WITH Gadgets[GdgCnt] DO
  159.       IF GdgCnt#MAX(gadgets) THEN
  160.         nextGadget := ADR(Gadgets[gadgets(ORD(GdgCnt)+1)]);
  161.       ELSE
  162.         nextGadget := NIL;
  163.       END;
  164.       flags := GadgetFlagSet{};
  165.       activation   := ActivationFlagSet{gadgImmediate,toggleSelect,
  166.                         stringCenter};
  167.       gadgetType   := boolGadget;
  168.       gadgetRender := NIL;
  169.       selectRender := NIL;
  170.       gadgetText   := NIL;
  171.       mutualExclude:= LONGSET{};
  172.       specialInfo  := NIL;
  173.       gadgetID     := ORD(GdgCnt);
  174.     END;
  175.   END;
  176.   WITH Gadgets[HDGadg] DO
  177.     leftEdge := 47;
  178.     topEdge  := 82;
  179.     width    := 136;
  180.     height   := 8;
  181.     INCL(flags,gadgImage);
  182.     gadgetRender := ADR(GadgImages[HardDisk]);
  183.     WITH GadgImages[HardDisk] DO
  184.       leftEdge := -7;
  185.       topEdge  := -57;
  186.     END;
  187.     gadgetType := strGadget;
  188.     specialInfo:= ADR(HDInfo);
  189.     WITH HDInfo DO
  190.       buffer := ADR(HDName);
  191.       undoBuffer := ADR(Undo);
  192.       maxChars := 255;
  193.       bufferPos := 0;
  194.       dispPos := 0;
  195.       HDName := "DH0:";
  196.       Undo := "";
  197.       numChars := 3;
  198.     END;
  199.   END;
  200.   WITH Gadgets[BackUpGadg] DO
  201.     leftEdge := 224;
  202.     topEdge  := 4;
  203.     width    := Imgwidth[BackUp];
  204.     height   := Imgheight[BackUp];
  205.     flags := flags + GadgetFlagSet{gadgImage,gadgHImage,selected};
  206.     gadgetRender := ADR(GadgImages[BackUp ]);
  207.     selectRender := ADR(GadgImages[HBackUp]);
  208.   END;
  209.   WITH Gadgets[RestoreGadg] DO
  210.     leftEdge := 216;
  211.     topEdge  := 57;
  212.     width    := Imgwidth[Restore];
  213.     height   := Imgheight[Restore];
  214.     flags := flags + GadgetFlagSet{gadgImage,gadgHImage};
  215.     gadgetRender := ADR(GadgImages[Restore ]);
  216.     selectRender := ADR(GadgImages[HRestore]);
  217.   END;
  218.   WITH Gadgets[DiskGadg] DO
  219.     leftEdge := 360;
  220.     topEdge  := 30;
  221.     width    := Imgwidth[Disk];
  222.     height   := Imgheight[Disk];
  223.     flags := flags + GadgetFlagSet{gadgImage,gadgHImage};
  224.     activation := activation / ActivationFlagSet{toggleSelect,relVerify};
  225.     gadgetRender := ADR(GadgImages[Disk    ]);
  226.     selectRender := ADR(GadgImages[OpenDisk]);
  227.     gadgetText := ADR(DiskNameText);
  228.     SetIText(DiskNameText,36,23,ADR(DriveName),NIL);
  229.     DiskNameText.frontPen := 2;
  230.     DiskNameText.backPen  := 1;
  231.   END;
  232.   FOR i:=0 TO 10 DO
  233.     WITH Borders[i] DO
  234.       leftEdge  := 0;
  235.       topEdge   := 0;
  236.       frontPen  := 2;
  237.       drawMode  := jam1;
  238.       count     := 5;
  239.       xy        := ADR(BorderData);
  240.       INC(xy,20*i);
  241.       IF i<10 THEN
  242.         nextBorder := ADR(Borders[i+1]);;
  243.       ELSE
  244.         nextBorder := NIL;
  245.       END;
  246.     END;
  247.   END;
  248.   SetIText(Texte[0],480,-79,ADR("Disk:")          ,ADR(Texte[1]));
  249.   SetIText(Texte[1],480,-63,ADR("Track:")         ,ADR(Texte[2]));
  250.   SetIText(Texte[2],496,-47,ADR(" ------ ")       ,ADR(Texte[3]));
  251.   SetIText(Texte[3], 50,  4,ADR("Start")          ,ADR(Texte[4]));
  252.   SetIText(Texte[4],178,  4,ADR("Set Archives")   ,ADR(Texte[5]));
  253.   SetIText(Texte[5],322,  4,ADR("Regard Archives"),ADR(Texte[6]));
  254.   SetIText(Texte[6],506,  4,ADR("Save All")       ,ADR(Texte[7]));
  255.   SetIText(Texte[7], 16, 26,ADR("Drawer:")        ,ADR(Texte[8]));
  256.   SetIText(Texte[8], 16, 46,ADR("File:")          ,NIL);
  257.   FOR GdgCnt:=SaveAllGadg TO StartGadg DO
  258.     WITH Gadgets[GdgCnt] DO
  259.       leftEdge := 8 + 156 * (3-(ORD(GdgCnt)-ORD(SaveAllGadg)));
  260.       topEdge  := 118;
  261.       width    := 140;
  262.       height   := 16;
  263.     END;
  264.   END;
  265.   WITH Gadgets[StartGadg] DO
  266.     gadgetRender := ADR(Borders);
  267.     gadgetText   := ADR(Texte);
  268.   END;
  269.   INCL(Gadgets[SetArchivedGadg].flags,selected);
  270.   INCL(Gadgets[SaveAllGadg    ].flags,selected);
  271.  
  272.  
  273. (*------  Window:  ------*)
  274.  
  275.   WITH NuWindow DO
  276.     leftEdge   := 0;
  277.     topEdge    := 0;
  278.     width      := 640;
  279.     height     := 196;
  280.     detailPen  := 0;
  281.     blockPen   := 1;
  282.     idcmpFlags := IDCMPFlagSet{gadgetDown, gadgetUp, closeWindow};
  283.     flags      := WindowFlagSet{windowDrag, windowDepth, windowClose,
  284.                                 activate, gimmeZeroZero};
  285.     firstGadget:= ADR(Gadgets);
  286.     checkMark  := NIL;
  287.     title      := ADR("KwikBackUp -- © 1988 by Fridtjof Siebert / AMOK");
  288.     screen     := NIL;
  289.     bitMap     := NIL;
  290.     type       := ScreenFlagSet{wbenchScreen};
  291.     minWidth   := 64;
  292.     minHeight  := 32;
  293.     maxWidth   := -1;
  294.     maxHeight  := -1;
  295.   END;
  296.   Window := OpenWindow(NuWindow);
  297.   Assert(Window#NIL,ADR("OpenWindow() failed"));
  298.   RP := Window^.rPort;
  299.  
  300. (*------  Draw into Window:  ------*)
  301.  
  302.   Redraw();
  303.  
  304. END OpenDisplay;
  305.  
  306.  
  307. (*---------------------------  Requester:  --------------------------------*)
  308.  
  309. (* $S- *)
  310.  
  311. PROCEDURE HDRequest(What: ADDRESS;
  312.                     col0,col1: UByte;
  313.                     retry: BOOLEAN): ReqResults;
  314.  
  315. VAR
  316.   cnt: ReqResults;
  317.   gdg: GadgetPtr;
  318.   ReqGadgets: ARRAY ReqResults OF Gadget;
  319.   ReqBorders: ARRAY [0..3] OF Border;
  320.   ReqTexte: ARRAY[0..4] OF IntuiText;
  321.   ReqMsgPtr: IntuiMessagePtr;
  322.   ReqMsg: IntuiMessage;
  323.   NuWindow: NewWindow;
  324.   rp: RastPortPtr;
  325.  
  326. BEGIN
  327.   FOR cnt := Retry TO Cancel DO
  328.     WITH ReqGadgets[cnt] DO
  329.       IF cnt#Cancel THEN
  330.         nextGadget := ADR(ReqGadgets[ReqResults(ORD(cnt)+1)]);
  331.       ELSE
  332.         nextGadget := NIL;
  333.       END;
  334.       leftEdge    := 12+128*ORD(cnt);
  335.       topEdge     := 30;
  336.       width       := 96;
  337.       height      := 16;
  338.       flags       := GadgetFlagSet{};
  339.       activation  := ActivationFlagSet{relVerify};
  340.       gadgetType  := boolGadget;
  341.       gadgetRender:= NIL;
  342.       selectRender:= NIL;
  343.       gadgetText  := NIL;
  344.       mutualExclude := LONGSET{};
  345.       specialInfo := NIL;
  346.       gadgetID    := ORD(cnt);
  347.     END;
  348.   END;
  349.   FOR i:=0 TO 3 DO
  350.     WITH ReqBorders[i] DO
  351.       leftEdge  := -16;
  352.       topEdge   := -36;
  353.       frontPen  := 2;
  354.       drawMode  := jam1;
  355.       count     := 5;
  356.       xy        := ADR(ReqBorderData);
  357.       INC(xy,20*i);
  358.       IF i<3 THEN
  359.         nextBorder := ADR(ReqBorders[i+1]);;
  360.       ELSE
  361.         nextBorder := NIL;
  362.       END;
  363.     END;
  364.   END;
  365.   SetIText(ReqTexte[0], 8, -20,What               ,ADR(ReqTexte[1]));
  366.   IF retry THEN
  367.     SetIText(ReqTexte[1], 28, 4,ADR("Retry")     ,ADR(ReqTexte[2]));
  368.     SetIText(ReqTexte[2],152, 4,ADR("Ignore")    ,ADR(ReqTexte[3]));
  369.   ELSE
  370.     SetIText(ReqTexte[1], 40, 4,ADR("OK")        ,ADR(ReqTexte[3]));
  371.     ReqBorders[1].nextBorder := ADR(ReqBorders[3]);
  372.     ReqGadgets[Retry].nextGadget := ADR(ReqGadgets[Cancel]);
  373.   END;
  374.   SetIText(ReqTexte[3],280, 4,ADR("Cancel")      ,NIL);
  375.   FOR i:=0 TO 3 DO
  376.     WITH ReqTexte[i] DO
  377.       drawMode := jam1;
  378.       frontPen := col1;
  379.     END;
  380.   END;
  381.   ReqGadgets[Retry].gadgetText := ADR(ReqTexte[0]);
  382.   ReqGadgets[Retry].gadgetRender := ADR(ReqBorders);
  383.   WITH NuWindow DO
  384.     leftEdge   := 0;
  385.     topEdge    := 0;
  386.     width      := 384;
  387.     height     := 64;
  388.     detailPen  := col0;
  389.     blockPen   := col1;
  390.     idcmpFlags := IDCMPFlagSet{gadgetUp};
  391.     flags      := WindowFlagSet{windowDrag, windowDepth, activate,
  392.                                 gimmeZeroZero};
  393.     firstGadget:= ADR(ReqGadgets);
  394.     checkMark  := NIL;
  395.     title      := ADR("KwikBackUp:");
  396.     screen     := NIL;
  397.     bitMap     := NIL;
  398.     type       := ScreenFlagSet{wbenchScreen};
  399.     minWidth   := 64;
  400.     minHeight  := 32;
  401.     maxWidth   := 384;
  402.     maxHeight  := 64;
  403.   END;
  404.   ReqWin := OpenWindow(NuWindow);
  405.   Beep(col0=3);
  406.   IF ReqWin=NIL THEN       (* if openwindow failed try AutoRequest(): *)
  407.     SetIText(ReqTexte[0],16,16,What,NIL);
  408.     IF retry THEN
  409.       SetIText(ReqTexte[1],8,3,ADR("Retry"),NIL);
  410.     ELSE
  411.       SetIText(ReqTexte[1],8,3,ADR(" OK "),NIL);
  412.     END;
  413.     SetIText(ReqTexte[3],8,3,ADR("Cancel"),NIL);
  414.     ReqTexte[0].drawMode := jam1; ReqTexte[0].frontPen := 2;
  415.     ReqTexte[1].drawMode := jam1; ReqTexte[1].frontPen := 2;
  416.     ReqTexte[3].drawMode := jam1; ReqTexte[3].frontPen := 2;
  417.     IF AutoRequest(Window,ADR(ReqTexte[0]),ADR(ReqTexte[1]),ADR(ReqTexte[3]),
  418.                    IDCMPFlagSet{}, IDCMPFlagSet{},384,64) THEN
  419.       RETURN Retry;
  420.     ELSE
  421.       RETURN Cancel;
  422.     END;
  423.   END;
  424.   rp := ReqWin^.rPort;
  425.   SetAPen(rp,col0); SetDrMd(rp,jam1); RectFill(rp,0,0,384,64);
  426.   SetAPen(rp,col1);
  427.   DrawBorder(rp,ADR(ReqBorders[0]),-16,-40);
  428.   PrintIText(rp,ADR(ReqTexte[0]),-16,-40);
  429.   RefreshGadgets(ReqWin^.firstGadget,ReqWin,NIL);
  430.   LOOP
  431.     WaitPort(ReqWin^.userPort);
  432.     ReqMsgPtr := GetMsg(ReqWin^.userPort);
  433.     IF ReqMsgPtr#NIL THEN
  434.       ReqMsg := ReqMsgPtr^;
  435.       ReplyMsg(ReqMsgPtr);
  436.       IF ReqMsg.class=IDCMPFlagSet{gadgetUp} THEN
  437.         gdg := ReqMsg.iAddress;
  438.         CloseWindow(ReqWin);
  439.         ReqWin := NIL;
  440.         RETURN ReqResults(gdg^.gadgetID);
  441.       END;
  442.     END;
  443.   END;
  444. END HDRequest;
  445.  
  446. (* $S+ *)
  447.  
  448. (*------  CleanUp:  ------*)
  449.  
  450. PROCEDURE CleanUp();
  451.  
  452. BEGIN
  453.   IF ReqWin#NIL THEN CloseWindow(ReqWin) END;
  454.   IF Window#NIL THEN CloseWindow(Window) END;
  455. END CleanUp;
  456.  
  457. (*------  Initialization:  ------*)
  458.  
  459. BEGIN
  460.   Window := NIL; ReqWin := NIL;
  461.   TermProcedure(CleanUp);
  462.   DriveName := "DF0:";
  463. END HDDisplay.
  464.