Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/103.lha/select.mod

Text File | 1986-11-21 | 4.8 KB | 216 lines

MODULE Select;


(*
  © 1987, 1988 by Kevin Kelm ...
    Public Domain... Free to all, not to be sold for profit.

  Written with TDI's Modula-2. (Ok, HAPPY guys!?! *)

*)


FROM SYSTEM    IMPORT NULL, ADR, BYTE;
FROM Libraries IMPORT OpenLibrary, CloseLibrary;
FROM Intuition IMPORT NewWindow, WindowPtr, IntuitionBase, IntuitionName,
    ScreenFlagSet, ScreenFlags, WindowFlagSet, WindowFlags, IDCMPFlagSet,
    IDCMPFlags, SmartRefresh;
FROM Pens            IMPORT SetAPen, SetBPen, Draw, Move, RectFill, SetDrMd;
FROM Windows         IMPORT OpenWindow, CloseWindow;
FROM GraphicsLibrary IMPORT GraphicsBase, GraphicsName, DrawingModeSet,
    DrawingModes;
FROM Text            IMPORT Text;
FROM Rasters         IMPORT RastPort;
FROM Strings         IMPORT Length;
FROM CommandLine     IMPORT GetCL, CLStrings;
FROM CIAHardware     IMPORT CIAA;
FROM DOSLibrary IMPORT DOSName, DOSBase;
FROM DOSCodeLoader IMPORT Execute;


VAR window  : WindowPtr;
  newWindow : NewWindow;
  rp        : RastPort;
  title, exstr     : ARRAY [0..109] OF CHAR;
  i         : CARDINAL;
  NOps      : CARDINAL;
  ysize     : CARDINAL;
  tnum      : CARDINAL;
  argnum    : CARDINAL;
  x, y      : CARDINAL;
  Exit, ok  : BOOLEAN;
  args      : ARRAY [0..14] OF CLStrings;

  str       : ARRAY [0..79] OF CHAR;
  message1, message2   : ARRAY [0..130] OF CHAR;


PROCEDURE OpenLibs () : BOOLEAN;
BEGIN
 IntuitionBase := OpenLibrary(IntuitionName,0);
 IF IntuitionBase = 0 THEN
       (* HEY! Who stole the *#$$#@! Intuition library?!?! *)
  RETURN FALSE;
 END (* if *);

 GraphicsBase := OpenLibrary(GraphicsName,0);
 IF GraphicsBase = 0 THEN
       (* WHAT?  An overdue Library File?! *)
  CloseLibrary ( IntuitionBase );
  RETURN FALSE;
 END (* if *);

 RETURN TRUE;

END OpenLibs;


PROCEDURE MakeWindow;
BEGIN
 title :=
" Dneishe Start © 1987 by Kevin Kelm.                                             ";
 WITH newWindow DO
  LeftEdge := 0;  TopEdge := 0;
  Width := 640;  Height := ysize;
  DetailPen := BYTE(0);
  BlockPen := BYTE(1);
  Title := ADR(title);
  Flags := WindowFlagSet{Activate} + SmartRefresh;
  IDCMPFlags := IDCMPFlagSet{};
  Type := ScreenFlagSet{WBenchScreen};
  FirstGadget := NULL;
  CheckMark := NULL;
  Screen := NULL;
  BitMap := NULL;
  MinWidth := 0;  MinHeight := 0;
  MaxWidth := 0;  MaxHeight := 0;
 END (* with *);

 window := OpenWindow(newWindow);
 rp := window^.RPort^;

END MakeWindow;


PROCEDURE Gad ( x, y : CARDINAL; VAR s : ARRAY OF CHAR );

VAR len : CARDINAL;
BEGIN
 len := Length ( s );
 IF len > 26 THEN
  s[26] := 0C;
  len := 25;
 END (* if *);

 (* draw outline *)
 SetAPen ( rp, 2 );
 RectFill ( rp, x, y, x + 190, y + 15 );
 SetAPen ( rp, 1 );
 RectFill ( rp, x+3, y+1, x + 188, y + 14 );
 SetAPen ( rp, 3 );
 RectFill ( rp, x+5, y+2, x + 186, y + 13 );

 SetDrMd ( rp, DrawingModeSet { Jam2 } );
 SetBPen ( rp, 3 );
 SetAPen ( rp, 2 );

 Move ( rp, x + ( 190 - (len * 8 )) DIV 2,  y + 10 );
 Text ( rp, s, len );
 SetDrMd ( rp, DrawingModeSet {} );
 SetBPen ( rp, 3 );
 SetAPen ( rp, 1 );

 Move ( rp, x + ( 190 - (len * 8 )) DIV 2 - 1,  y + 11 );
 Text ( rp, s, len );

END Gad;


BEGIN
 message1 := "Dneishe Start © 1987 by Kevin Kelm...'Dneishe' is simply a perversion of 'Nice,' and must be";
 message2 := " pronounced with teeth clenched and a manic grin.";

 IF OpenLibs() THEN

  IF GetCL ( NOps, args ) THEN END;

  ysize := 50;

  IF NOps # 0 THEN
   ysize := 67 + ((NOps-1) DIV 3 ) * 18;
  END (* if *);

  MakeWindow;

  SetAPen ( rp, 2 );
  RectFill ( rp, 2, 10, 636, ysize - 2 );

  SetAPen ( rp, 1 );
  RectFill ( rp, 5, 11, 634, ysize - 3 );

  SetAPen ( rp, 2 );
  SetBPen ( rp, 1 );
  Move ( rp, 196, 19 );

  Text ( rp, "Please Select a Boot Sequence :", 31);

  Gad ( 223, 26, "CANCEL" );

  (* build `gadgets' *)
  i := 0;
  WHILE i < NOps DO
   Gad ( 20 + (i MOD 3 ) * 203, 46 + (i DIV 3 ) * 18, args[i] );
   INC ( i );
  END (* while *);

  (* read `gadgets' *)

  argnum := 1000;
  Exit := FALSE;

  WHILE NOT Exit DO
   (* see if in a legal region *)
   x := window^.MouseX; y := window^.MouseY;
   (* check CANCEL button *)
   IF (y > 26) AND (y < 42) THEN
    IF (x > 223) AND (x < 412) AND NOT (6 IN CIAA.ciapra) THEN
     tnum := 1000;
     Exit := TRUE;
    END (* if *);
   ELSE

    tnum := ((y - 46) DIV 18) * 3 + (x-20) DIV 203;
    IF ((x-20) MOD 203 > 189) OR ((y - 46) MOD 18 > 15) THEN
     tnum := 1000;
    END (* if *);
    IF (tnum < NOps) AND NOT (6 IN CIAA.ciapra) THEN
     Exit := TRUE;
    END (* if *);
   END (* if *);
  END (* while *);

  CloseWindow ( window^ );

  DOSBase := OpenLibrary ( DOSName, 0);

  IF tnum # 1000 THEN
   exstr := "Execute ";
   FOR i := 0 TO Length ( args[tnum] ) DO
    exstr[8 + i] := args[tnum][i];
   END (* for *);
   exstr[8+i] := 0C;
   ok := Execute ( exstr, 0, 0 );
  END (* if *);

  CloseLibrary(DOSBase);
  CloseLibrary(GraphicsBase);
  CloseLibrary(IntuitionBase);

 END (* if *);

END Select.