home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Fresh Fish 8
/
FreshFishVol8-CD1.bin
/
new
/
util
/
cdity
/
cx
/
txt
/
cx.mod
< prev
next >
Wrap
Text File
|
1994-09-19
|
39KB
|
1,175 lines
MODULE CX;
(* CX.mod - Ersatz für das "Exchange"-Programm der Workbench
* Version : $VER: CX.mod 1.2 (© 1994 Fin Schuppenhauer)
* Autor : Fin Schuppenhauer
* Braußpark 10
* 20537 Hamburg
* (Germany)
* E-Mail : schuppenhauer@informatik.uni-hamburg.de
* Erstellt am : 31 Aug 1994
* Letzte Änd. : 18 Sep 1994
*)
(*$ DEFINE Debug:=FALSE *)
IMPORT cd:CommoditiesD, cl:CommoditiesL, cp:CommoditiesPrivate,
cs:CommoditiesSupport,
ed:ExecD, el:ExecL, es:ExecSupport,
id:IntuitionD, il:IntuitionL, im:IntuiMacros,
gtd:GadToolsD, gtl:GadToolsL,
gd:GraphicsD, gl:GraphicsL,
dd:DosD, dl:DosL,
ld:LocaleD, ll:LocaleL,
iv:InputEvent,
ASCII,
lan:ListsAndNodes,
cxc:CXCatalog,
(*$ IF Debug *)
Arts,
t:Terminal,
(*$ ENDIF *)
str:String;
FROM SYSTEM IMPORT LONGSET, CAST, ADR, ADDRESS, TAG, BITSET;
FROM UtilityD IMPORT tagEnd;
(*$ IF Debug *)
FROM InOut IMPORT WriteCard;
(*$ ENDIF *)
CONST
(* Konstanten für die Gadgets: *)
LISTGADGET = 0; (* Die ID-Nummern der ersten drei Gadgets *)
SHOWGADGET = 1; (* dürfen nicht verändert werden! (siehe *)
HIDEGADGET = 2; (* ProcessMsg()) *)
ENABLEGADGET = 3;
KILLGADGET = 4;
DISABLEALLGADGET = 5; (* Diese zwei ID-Nummern dürfen ebenfalls *)
KILLALLGADGET = 6; (* nicht verändert werden! *)
GADGETCOUNT = 7;
(* Koordinaten der Bevelbox: *)
BEVELTOP = 25;
BEVELLEFT = 209;
BEVELWIDTH = 340;
BEVELHEIGHT = 28;
IVHOTKEY = 1;
(* Menü: *)
PROJEKT = 0;
ABOUTMENU = 0;
(* ~~~~~~~~~~~ = 1 *)
HIDEMENU = 2;
QUITMENU = 3;
EDIT = 1;
DISABLEALLMENU = 0;
ENABLEALLMENU = 1;
KILLALLMENU = 2;
(* nmEnd *)
MENUCOUNT = 10;
CONST
YSTEP = 2;
XSTEP = 4;
TYPE
StrPtr = POINTER TO ARRAY [0..127] OF CHAR;
UpperLowerCase = (lower, upper);
MyTime = RECORD
seconds, micros : LONGCARD;
END;
VAR
brokerport : ed.MsgPortPtr; (* über diesen Port läuft die gesamte Kommunikation *)
nb : cd.NewBroker;
broker : cd.CxObjPtr;
error : LONGCARD; (* für Errorcode von CxBroker() *)
cxsigflag : SHORTCARD; (* Signal bei eintreffenden Broker- oder Intuition-Msgs. *)
bool : BOOLEAN; (* dummy *)
msg : ed.MessagePtr;
defhotkey : ARRAY [0..127] OF CHAR;
hotkey : StrPtr;
hotkeyfilter: cd.CxObjPtr;
dummystr : StrPtr;
VAR
window : id.WindowPtr;
wintitle : ARRAY [0..127] OF CHAR;
winreplyport: ed.MsgPortPtr;
vi : ADDRESS;
glist : id.GadgetPtr;
gadget : ARRAY [0..GADGETCOUNT-1] OF id.GadgetPtr;
CycleLabels : POINTER TO ARRAY [0..2] OF ADDRESS;
allCycleLabels: POINTER TO ARRAY [0..2] OF ADDRESS;
menuStrip : id.MenuPtr;
topazfont : gd.TextFontPtr;
topaz8 : gd.TextAttr;
bevelWidth,
bevelHeight : INTEGER;
brokerlist : ed.ListPtr; (* Liste der Broker; wird gleichzeitig für das LV-Gadget genutzt *)
catalog : ld.CatalogPtr;
requester : BOOLEAN;
PROCEDURE CreateCommoditiesList (VAR blist : ed.ListPtr);
(** "Liste für Listview-Gadget erzeugen"
*)
VAR
li : LONGINT;
BEGIN
blist := el.AllocMem(SIZE(ed.List), ed.MemReqSet{ed.public});
IF blist # NIL THEN
es.NewList (blist);
(* Kopie der System-Broker-List anlegen: *)
li := cp.CopyBrokerList (blist);
END;
lan.SortExecList (blist, INTEGER(lan.CountNodes(blist)));
END CreateCommoditiesList;
(* **)
PROCEDURE FreeCommoditiesList (VAR blist : ed.ListPtr);
(** "Gibt den durch CreateCommoditiesList() belegeten speicher frei" *)
VAR
li : LONGINT;
BEGIN
IF blist # NIL THEN
li := cp.FreeBrokerList(blist);
el.FreeMem (blist, SIZE(ed.List));
blist := NIL;
END;
END FreeCommoditiesList;
(* **)
PROCEDURE UpdateCommoditiesList (VAR blist : ed.ListPtr);
(** "Erneuert die LV-Gadget-Liste" *)
VAR
dummylistptr: ADDRESS;
li : LONGINT;
taglist : ARRAY [0..7] OF LONGINT;
BEGIN
FreeCommoditiesList (blist);
CreateCommoditiesList (blist);
dummylistptr := blist;
gtl.GTSetGadgetAttrsA (gadget[LISTGADGET], window, NIL, TAG(taglist,
gtd.gtlvLabels, dummylistptr,
tagEnd));
END UpdateCommoditiesList;
(* **)
PROCEDURE CountBrokers (blist : ed.ListPtr) : CARDINAL;
(** "Berechnet die Anzahl der angezeigten Broker" *)
VAR
node : ed.NodePtr;
count : CARDINAL;
BEGIN
RETURN CARDINAL(lan.CountNodes (blist)) - 1;
(* Bemerkung:
* In der Brokerliste gibt es einen besonderen Broker, der
* die Liste abschließt (CxObj-Type = cxZero). Den wollen
* wir natürlich nicht mitzählen.
*)
END CountBrokers;
(* **)
PROCEDURE ShowWindow;
(** "Fenster öffnen, Gadgets zeichnen u.s.w." *)
VAR
screen : id.ScreenPtr;
taglist : ARRAY [0..29] OF LONGINT;
gad : id.GadgetPtr;
ng : gtd.NewGadget;
rp : gd.RastPortPtr;
mynewmenu : POINTER TO ARRAY [0..MENUCOUNT-1] OF gtd.NewMenu;
font : gd.TextAttrPtr;
buttonHeight: INTEGER;
buttonWidth : INTEGER;
listviewTop : INTEGER;
buttonTop : INTEGER;
infostr : StrPtr;
dummy : INTEGER;
innerHeight : INTEGER;
PROCEDURE ComputeWidths(VAR bevelwidth, buttonwidth : INTEGER);
(** "Berechnet den Platz des längsten Buttons": *)
VAR
userfont : gd.TextFontPtr;
BEGIN
userfont := gl.OpenFont(screen^.font);
bevelwidth := userfont^.xSize * 44;
buttonwidth := (bevelwidth - XSTEP) DIV 2;
gl.CloseFont(userfont);
END ComputeWidths;
(* **)
PROCEDURE SetShortcutAndLabel (VAR nm : gtd.NewMenu;
localMsg : ADDRESS);
(** "Für Menü Shortcut und Labeltext setzen" *)
BEGIN
WITH nm DO
commKey := localMsg;
label := localMsg + CAST(ADDRESS, 2);
IF CAST(StrPtr, localMsg)^[0] = " " THEN
commKey := NIL;
END;
END;
END SetShortcutAndLabel;
(* **)
BEGIN
IF window # NIL THEN
(* Das Fenster ist bereist geöffnet! *)
RETURN;
END;
(* Fenster soll auf dem Default(Workbench)-Screen erscheinen: *)
screen := il.LockPubScreen (NIL);
IF screen = NIL THEN
RETURN;
END;
vi := gtl.GetVisualInfoA(screen, TAG(taglist, tagEnd));
IF vi = NIL THEN
il.UnlockPubScreen (NIL, screen);
RETURN;
END;
(** Menü-Stuff: *)
mynewmenu := el.AllocMem(MENUCOUNT*SIZE(gtd.NewMenu), ed.MemReqSet{ed.public,ed.memClear});
IF mynewmenu # NIL THEN
WITH mynewmenu^[0] DO
type := gtd.nmTitle;
label := ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_MENU, ADR(cxc.MSG_PROJECT_MENUSTR));
menuFlags := BITSET{};
END;
WITH mynewmenu^[1] DO
type := gtd.nmItem;
SetShortcutAndLabel (mynewmenu^[1], ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_ABOUT, ADR(cxc.MSG_PROJECT_ABOUTSTR)));
(* label := ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_ABOUT, ADR(cxc.MSG_PROJECT_ABOUTSTR));
commKey := ADR("?");*)
END;
WITH mynewmenu^[2] DO
type := gtd.nmItem;
label := gtd.nmBarlabel;
END;
WITH mynewmenu^[3] DO
type := gtd.nmItem;
SetShortcutAndLabel (mynewmenu^[3], ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_HIDE, ADR(cxc.MSG_PROJECT_HIDESTR)));
(* label := ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_HIDE, ADR(cxc.MSG_PROJECT_HIDESTR));
commKey := ADR("H");*)
END;
WITH mynewmenu^[4] DO
type := gtd.nmItem;
SetShortcutAndLabel (mynewmenu^[4], ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_QUIT, ADR(cxc.MSG_PROJECT_QUITSTR)));
(* label := ll.GetCatalogStr(catalog, cxc.MSG_PROJECT_QUIT, ADR(cxc.MSG_PROJECT_QUITSTR));