home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
103.lha
/
select.mod
< prev
next >
Wrap
Text File
|
1986-11-21
|
5KB
|
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.