home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 037.lha / DU / MyWindow.mod < prev    next >
Text File  |  1987-05-16  |  11KB  |  399 lines
  1. IMPLEMENTATION MODULE MyWindow;
  2.  
  3.  
  4. (*$S-*)(*$T-*)(*$A+*)
  5. (*
  6.         PART OF Windowed Development program for Modula 2
  7.  
  8.         This creates, opens and maintains the DirUtil window.
  9.         It contains a couple of other importable routines for
  10.         user alterations.
  11.  
  12.         Written: 3/21/87 by Greg Browne
  13.  
  14.         Compiles on TDI's Modula-2 Compiler version 2.20a
  15.  
  16.  
  17. *)
  18.  
  19. FROM SYSTEM             IMPORT  ADR, BYTE, ADDRESS, NULL,TSIZE,CODE;
  20. FROM Intuition          IMPORT  PropInfo,IntuitionName,IntuitionBase,
  21.                                 WindowFlags,WindowPtr,NewWindow,Border,
  22.                                 IDCMPFlags,IDCMPFlagSet,WindowFlagSet,
  23.                                 WBenchScreen,SmartRefresh,ScreenFlagSet,
  24.                                 Image,SimpleRefresh;
  25. FROM GraphicsLibrary    IMPORT  GraphicsName, GraphicsBase,Jam1;
  26. FROM Libraries          IMPORT  OpenLibrary,CloseLibrary;
  27. FROM Windows            IMPORT  OpenWindow,CloseWindow;
  28. FROM Gadgets            IMPORT  HighNone,HighComplement,
  29.                                 ModifyProp,BoolGadget,PropGadget,StrGadget;
  30.  
  31. (*--------------------------------------------------------------------*)
  32.  
  33. (* ALL CONSTANTS  AND MOST VARIABLES/TYPES DEFINED IN MyGlobals.def FILE
  34.    FOR IMPORTATION
  35. *)
  36.  
  37. FROM MyGlobals      IMPORT  StringBufSize,RegFlags,StringFlags,SliderFlags,
  38.                             WBColors,GadgetNames,IOStringInfo,MyWindowPtr,
  39.                             IOString,GadTxt,MyGads,NullReqPtr;
  40.  
  41. (*   REALLY Defined in MyGlobals.def
  42.  
  43.   GadgetNames   = (df0,df1,df2,dh0,dh1,ram,vd0,
  44.                    up1,down1,
  45.                    filewindow,
  46.                    arc,bytes,copy,copydel,deldir,delete,
  47.                    dofr,dorf,edit,hprint,htype,info,link,makedir,
  48.                    modula,move,parent,print,rename,
  49.                    retag,root,show,stod,swap,tagall,type,untag,
  50.                    slider,
  51.                    brun,bsource,bdest, (* relative order of these six *)
  52.                    run,source,dest,    (* IS IMPORTANT *)
  53.                    msg);
  54.  
  55. *)
  56.  
  57. TYPE
  58.   BorderTypes   = (filewind,rsd,device,command,message);
  59.  
  60. VAR
  61.   SlideImage    : Image;
  62.   Borders       : ARRAY BorderTypes OF Border;
  63.   SlideInfo     : PropInfo;
  64.  
  65. (* ---------------------------*)
  66. (*  INTERNAL ONLY PROCEDURES  *)
  67. (* ---------------------------*)
  68.  
  69. PROCEDURE InitWindow(VAR text:ARRAY OF CHAR;FirstGad:ADDRESS):WindowPtr;
  70. VAR w : NewWindow;
  71. BEGIN
  72.   WITH w DO
  73.     LeftEdge := 0; TopEdge := 0;
  74.     Width := 558; Height := 132;
  75.     DetailPen := BYTE (ORD(Blue)); BlockPen := BYTE (ORD(White));
  76.     Title := ADR(text);
  77.     Flags := WindowFlagSet{WindowSizing,WindowDepth,WindowDrag,RMBTrap,
  78.                         Activate,WindowClose} + SmartRefresh;
  79.     IDCMPFlags := IDCMPFlagSet{CloseWindowFlag,MouseButtons,GadgetUp,
  80.                                ResfreshWindow};
  81.     Type := ScreenFlagSet{WBenchScreen};
  82.     CheckMark := NULL;
  83.     FirstGadget := FirstGad;
  84.     Screen := NULL; BitMap := NULL;
  85.     MinWidth :=  80; MinHeight :=  40;
  86.     MaxWidth := 558; MaxHeight := 132;
  87.   END;
  88.   RETURN OpenWindow(w)
  89. END InitWindow;
  90.  
  91. (* ---------------------------*)
  92. (* Entry/exit code off to create "static" border structures with CODE *)
  93. (* This method saves size since I am keeping it under 32767 for $A+   *)
  94. (* ---------------------------*)
  95.  
  96. (*$P-*)
  97.  
  98. PROCEDURE CBorder;
  99. BEGIN
  100.   CODE(0FFFFH,0FFFFH,61,0FFFFH,61,9,0FFFFH,9,0FFFFH,0FFFFH);
  101. END CBorder;
  102.  
  103. (*$P-*)
  104.  
  105. PROCEDURE DBorder;
  106. BEGIN
  107.   CODE(0FFFFH,0FFFFH,39,0FFFFH,39,9,0FFFFH,9,0FFFFH,0FFFFH);
  108. END DBorder;
  109.  
  110. (*$P-*)
  111.  
  112. PROCEDURE MBorder;
  113. BEGIN
  114.   CODE(0FFFEH,0FFFEH,277,0FFFEH,277,0FFF4H,277,0FFFEH);
  115.   CODE(512,0FFFEH,512,8,0FFFEH,8,0FFFEH,0FFFEH);
  116. END MBorder;
  117.  
  118. (*$P-*)
  119.  
  120. PROCEDURE RBorder;
  121. BEGIN
  122.   CODE(0FFFEH,0FFFEH,232,0FFFEH,232,8,0FFFEH,8,0FFFEH,0FFFEH);
  123. END RBorder;
  124.  
  125. (*$P-*)
  126.  
  127. PROCEDURE FBorder;
  128. BEGIN
  129.   CODE(0FFFFH,0FFFFH,307,0FFFFH,283,0FFFFH,283,97,0FFFFH,97,0FFFFH,0FFFFH);
  130. END FBorder;
  131.  
  132. (*$P+*)
  133.  
  134. (* ---------------------------*)
  135.  
  136. PROCEDURE SetIText(it           :GadgetNames;
  137.                    VAR text     :ARRAY OF CHAR;
  138.                    Left         :INTEGER);
  139. BEGIN
  140.   WITH GadTxt[it] DO
  141.     FrontPen := BYTE(ORD(White));
  142.     BackPen := BYTE(ORD(Blue));
  143.     DrawMode := BYTE(Jam1);
  144.     LeftEdge := Left;   TopEdge := 1;
  145.     ITextFont := NULL;  IText := ADR(text);
  146.     NextText := NULL;
  147.   END;
  148. END SetIText;
  149.  
  150. (* ---------------------------*)
  151.  
  152. PROCEDURE OneGadget(gadg:GadgetNames;                   L,T,W,H:INTEGER;
  153.                         textptr:ADDRESS;                Bdr:ADDRESS;
  154.                         spinfoptr:ADDRESS;              GadType:CARDINAL);
  155.   BEGIN
  156.     WITH MyGads[gadg] DO
  157.       NextGadget := NULL;
  158.       LeftEdge := L; TopEdge := T;
  159.       Width := W; Height := H;
  160.       Flags := HighComplement; Activation := RegFlags;
  161.       GadgetType := GadType; GadgetRender := Bdr;
  162.       SelectRender := NULL; GadgetText := textptr;
  163.       MutualExclude := 0; SpecialInfo := spinfoptr;
  164.       GadgetID := CARDINAL(ORD(gadg));
  165.       UserData := NULL;
  166.     END
  167.   END OneGadget;
  168.  
  169. (* ---------------------------*)
  170.  
  171. PROCEDURE InitGadgets():ADDRESS;
  172. (*
  173.    Procedure to initialize all the gadgets and related structures
  174.    internal to the module only
  175. *)
  176.   VAR i,m:GadgetNames; j,k: CARDINAL;
  177.   BEGIN
  178.   WITH Borders[command] DO                      (* Point to the borders  *)
  179.     LeftEdge := 0; TopEdge := 0;                (* And define color/type *)
  180.     FrontPen := BYTE(ORD(White)); BackPen := BYTE(ORD(Blue));
  181.     DrawMode := BYTE(Jam1); Count := BYTE(5);
  182.     XY := ADDRESS(CBorder); NextBorder := NULL
  183.   END;
  184.   Borders[device] := Borders[command];          (* all same except sizes *)
  185.   Borders[device].XY := ADDRESS(DBorder);
  186.   Borders[message] := Borders[command];
  187.   Borders[message].XY := ADDRESS(MBorder);
  188.   Borders[message].Count := BYTE(8);
  189.   Borders[rsd] := Borders[command];
  190.   Borders[rsd].XY := ADDRESS(RBorder);
  191.   Borders[filewind] := Borders[command];
  192.   Borders[filewind].XY := ADDRESS(FBorder);
  193.   Borders[filewind].Count := BYTE(6);
  194.  
  195.         (* This section sets up the gadget text and colors/rendering *)
  196.  
  197.   SetIText(df0, "df0:",4);
  198.   SetIText(df1, "df1:",4);
  199.   SetIText(df2, "df2:",4);
  200.   SetIText(dh0, "dh0:",4);
  201.   SetIText(dh1, "dh1:",4);
  202.   SetIText(ram, "ram:",4);
  203.   SetIText(vd0, "vd0:",4);
  204.  
  205.   SetIText(up1,  "+",5);
  206.   SetIText(down1,"-",5);
  207.  
  208.   SetIText(run,    "R",     -14);
  209.   SetIText(source, "S",     -14);
  210.   SetIText(dest,   "D",     -14);
  211.   SetIText(msg,    "M",     -14);
  212.  
  213.   SetIText(filewindow,"",     0);
  214.  
  215.   SetIText(arc,    "ARC",    18);
  216.   SetIText(bytes,  "BYTES",  10);
  217.   SetIText(copy,   "COPY",   14);
  218.   SetIText(copydel,"CPYDEL",  6);
  219.   SetIText(deldir, "DELDIR",  6);
  220.   SetIText(delete, "DELETE",  6);
  221.   SetIText(dofr,   "DO f+R",  6);
  222.  
  223.   SetIText(dorf,   "DO R+f",  6);
  224.   SetIText(edit,   "EDIT",   14);
  225.   SetIText(hprint, "HPRINT",  6);
  226.   SetIText(htype,  "HTYPE",  10);
  227.   SetIText(info,   "INFO",   14);
  228.   SetIText(link,   "LINK",   14);
  229.   SetIText(makedir,"MAKDIR",  6);
  230.  
  231.   SetIText(modula, "MODULA",  6);
  232.   SetIText(move,   "MOVE",   14);
  233.   SetIText(parent, "PARENT",  6);
  234.   SetIText(print,  "PRINT",  10);
  235.   SetIText(rename, "RENAME",  6);
  236.   SetIText(retag,  "RETAG",  10);
  237.   SetIText(root,   "ROOT",   14);
  238.  
  239.   SetIText(show,   "SHOW",   14);
  240.   SetIText(stod,   "S->D",   14);
  241.   SetIText(swap,   "SWAP",   14);
  242.   SetIText(tagall, "TAGALL",  6);
  243.   SetIText(type,   "TYPE",   14);
  244.   SetIText(untag,  "UNTAG",  10);
  245.  
  246.   WITH SlideInfo DO             (* Define the slider information *)
  247.     Flags := SliderFlags;
  248.     VertPot := 8000H;
  249.     VertBody := 0FFFFH;
  250.   END;
  251.  
  252.   FOR i := run TO msg DO         (* Setup and null all IOStringInfos *)
  253.     GadTxt[i].FrontPen := BYTE(ORD(Green));
  254.     GadTxt[i].TopEdge := 0;
  255.     IOString[i] := "";
  256.     WITH IOStringInfo[i] DO
  257.       Buffer := ADR(IOString[i]); UndoBuffer := NULL;
  258.       BufferPos := 0; MaxChars := StringBufSize;
  259.       DispPos := 0; NumChars := 0;
  260.     END;
  261.   END;
  262.  
  263. (*  THIS SECTION NOW DEFINES THE GADGETS AND LINKS UP THE STRUCTURES *)
  264.  
  265. (*Device gadgets*)
  266.   j := 6;
  267.   FOR i := df0 TO vd0 DO
  268.     GadTxt[i].FrontPen := BYTE(ORD(Black));
  269.     OneGadget(i, j, 14, 38, 9,ADR(GadTxt[i]),ADR(Borders[device]),
  270.                 NULL, BoolGadget);
  271.     INC(j,40)
  272.   END;
  273.  
  274.  
  275. (* String gadgets *)
  276.   j := 93;
  277.   FOR i := run TO dest DO
  278.     OneGadget(i,324,j, 232, 10,ADR(GadTxt[i]), ADR(Borders[rsd]),
  279.                 ADR(IOStringInfo[i]), StrGadget);
  280.     INC(j,10);
  281.   END;
  282.  
  283. (* Blanking gadgets *)
  284.  
  285.   j := 92;
  286.   FOR i := brun TO bdest DO
  287.     OneGadget(i,307,j, 15, 9,ADR(GadTxt[i]), NULL,
  288.                 NULL, BoolGadget);
  289.     INC(j,10);
  290.   END;
  291.  
  292. (* Message gadget *)
  293.  
  294.   OneGadget(msg,28,123,512,10,ADR(GadTxt[msg]),ADR(Borders[message]),
  295.                 ADR(IOStringInfo[msg]), StrGadget);
  296.  
  297. (* Filewindow gadget *)
  298.  
  299.   OneGadget(filewindow,5,24,281,97,NULL,ADR(Borders[filewind]),
  300.                 NULL,BoolGadget);
  301.  
  302.   MyGads[filewindow].Flags := HighNone;
  303.  
  304. (* Command gadgets *)
  305.   j := 14; k := 306;
  306.   FOR i := arc TO untag DO
  307.     OneGadget(i, k, j, 60, 9,ADR(GadTxt[i]),ADR(Borders[command]),
  308.                 NULL, BoolGadget);
  309.     INC(j,10);
  310.     IF j>74 THEN
  311.       j := 14;
  312.       INC(k,63);
  313.     END;
  314.   END;
  315.  
  316.  
  317. (* Slider gadget *)
  318.  
  319.   OneGadget(slider, 288, 33, 18, 79,NULL,ADR(SlideImage),
  320.                 ADR(SlideInfo), PropGadget);
  321.  
  322. (* Up/Down gadgets *)
  323.  
  324.   OneGadget(up1, 288, 24, 17, 9,ADR(GadTxt[up1]),NULL,
  325.                 NULL,BoolGadget);
  326.  
  327.   OneGadget(down1, 288, 112, 17, 9,ADR(GadTxt[down1]),NULL,
  328.                 NULL, BoolGadget);
  329.  
  330.   FOR i := df0 TO dest DO
  331.     m := i; INC(m);
  332.     MyGads[i].NextGadget := ADR(MyGads[m])
  333.   END;
  334.   RETURN ADR(MyGads[df0])
  335. END InitGadgets;
  336.  
  337.  
  338. (* ---------------------------*)
  339. (*     EXTERNAL PROCEDURES    *)
  340. (* ---------------------------*)
  341.  
  342.  
  343. PROCEDURE SlidePot():CARDINAL;
  344. (*
  345.   Function returns the current value of the slider VertPot)
  346. *)
  347. BEGIN
  348.   RETURN CARDINAL(SlideInfo.VertPot);
  349. END SlidePot;
  350.  
  351.  
  352. PROCEDURE ResetSlider(bod:CARDINAL);
  353. (*
  354.    Resets slide gadget size to the size passed in
  355. *)
  356. BEGIN
  357.   ModifyProp(MyGads[slider],MyWindowPtr,NullReqPtr^,SliderFlags,0,0,0,bod);
  358. END ResetSlider;
  359.  
  360. (* ---------------------------*)
  361.  
  362. PROCEDURE CloseMyWindow;
  363. (*
  364.   Closes the window and intuition and graphics bases if they are open
  365. *)
  366.  
  367. BEGIN
  368.   IF (MyWindowPtr # NULL) THEN CloseWindow (MyWindowPtr^) END;
  369.   IF IntuitionBase <> 0 THEN CloseLibrary(IntuitionBase) END;
  370.   IF GraphicsBase <> 0  THEN CloseLibrary(GraphicsBase) END;
  371. END CloseMyWindow;
  372.  
  373. (* ---------------------------*)
  374.  
  375. PROCEDURE OpenMyWindow(VAR name:ARRAY OF CHAR):BOOLEAN;
  376.  
  377. (*
  378.         The external primary procedure - sets up and opens the window
  379. *)
  380.  
  381. BEGIN
  382.   IF (GraphicsBase <> 0) AND (IntuitionBase <> 0) THEN
  383.    MyWindowPtr :=  InitWindow(name,InitGadgets());
  384.    RETURN (MyWindowPtr # NULL)
  385.   ELSE
  386.    RETURN FALSE
  387.   END
  388. END OpenMyWindow;
  389.  
  390.  
  391.                 (********)
  392.                 (* MAIN *)
  393.                 (********)
  394.  
  395. BEGIN
  396.   IntuitionBase := OpenLibrary (IntuitionName,0);
  397.   GraphicsBase := OpenLibrary (GraphicsName,0);
  398. END MyWindow.
  399.