(*------------------------------------------------------------------------- :Program. GadgetEd.mod :Contents. Editor zum Aufbau einer Gadget-Struktur. (Hauptprogramm) :Contents. Erstellt Modula-Quellcode :Author. Hubert Bildstein :Address. Gehenbühlstr.5, W7000 Stuttgart 31, Germany :Phone. 0711/83 18 32 :Copyright. Public Domain :Language. Modula-2 :Translator. M2Amiga V3.3d :History. V1.0 5.12.1990 Hubert Bildstein :Support. Menugenerator Amok#37 [S. Kraus]: Grundaufbau des Menüs :Imports. ARPFileReq Amok#31 [B. Preusing] :Bugs. bisher nicht bekannt :Usage. GadgetEd [Filename] :Remark. "GetExtension" aus "FileNames" funktioniert bei mir nicht. :Remark. Deshalb Verwendung von eigenem "FileNames1". -------------------------------------------------------------------------*) MODULE GadgetEd; (*--------------------------------------------------------------------------*) (* Aufbau einer Programmoberfläche aus Gadgets. Erstellt MODULA-Code zur *) (* Verwendung in eigenen Programmen. *) (* Angefangen: 07.08.1990 letzte Änderung: 03.12.1990 *) (* Autor: Hubert Bildstein *) (* Compiler: M2Amiga V3.3d *) (*--------------------------------------------------------------------------*) FROM SYSTEM IMPORT ADR, ADDRESS; FROM Arguments IMPORT NumArgs, GetArg; FROM ARPFileReq IMPORT FileReq; FROM Arts IMPORT Assert, TermProcedure; FROM ASCII IMPORT nul; FROM CreateModule IMPORT Create; FROM DataStruct IMPORT GadgDefType, WindowDefType, CHeight,CWidth, Bord1x, Bord1y, Bord2x, Bord2y, BorderType, StringAttrType, FileNameType, GTextType, DefaultExt; FROM FileMessage IMPORT StrPtr, ResponseText; FROM FileNames IMPORT GetPath; FROM FileNames1 IMPORT GetExtension; FROM FileSystem IMPORT Response; FROM Gadgets IMPORT DefineWindow, MakeBoolGadget, GadgetText, GadgetBorder, MakeStrGadget, DeleteGadget, ReadStrGadget, SetStrGadget, PropType, PropTypeSet, MakePropGadget, DeleteBorder, DeleteText; FROM Graphics IMPORT SetRast, ViewModes, ViewModeSet; FROM IntuiMacros IMPORT MenuNum, ItemNum, SubNum; FROM Intuition IMPORT (* Window: *) NewWindow, OpenWindow, CloseWindow, WindowFlags, WindowFlagSet, WindowPtr,IDCMPFlags,IDCMPFlagSet, ActivateWindow, SetWindowTitles, MoveWindow, SizeWindow, RefreshWindowFrame, selectUp, selectDown, (* Screen: *) NewScreen, ScreenPtr, CloseScreen, customScreen, DisplayBeep, ScreenFlags, ScreenFlagSet, OpenScreen, ScreenToFront, (* Menu: *) MenuPtr, ClearMenuStrip, (* Gadgets: *) GadgetPtr, RefreshGadgets, GadgetFlagSet, GadgetFlags, ActivationFlagSet, ActivateGadget, boolGadget, strGadget, propGadget, ActivationFlags,StringInfoPtr,OnGadget,OffGadget, ModifyProp, PropInfoFlagSet, PropInfoFlags, IntuiText, IntuiTextPtr; FROM Io IMPORT Load, Save; FROM Menu IMPORT InitMenu; FROM Message IMPORT WaitForMsg; FROM MoveAndSet IMPORT SetRect, SelectGadget, PlaceRect; FROM Requester IMPORT SetScreen,InitPropRequest,TextRequest,StrAttrRequest, BoolAttrRequest, FileNameRequest, Request; FROM Str IMPORT Length, CopyPos, Copy; FROM TextWindows IMPORT Copyright, Help; (* Konstanten *) (*------------*) CONST Title = "GadgetEd V1.0 -- "; GFSet = GadgetFlagSet{}; MaxGadgets = 50; (* max. Anzahl von Gadgets *) (* Globale Variablen: *) (*--------------------*) VAR SPtr : ScreenPtr; WPtr : WindowPtr; selectedBorder : BorderType; StringAttr : StringAttrType; NumbOfGadgets : INTEGER[0..MaxGadgets]; Line : ARRAY [1..80] OF CHAR; FileName : FileNameType; Modified : BOOLEAN; (* Flag für Änderung *) (* Felder zur Aufnahme aller Gadgetinformationen *) GadgDefs, GDCopy : ARRAY [0..MaxGadgets] OF GadgDefType; WDef, WDefCopy : WindowDefType; (*--------------------------------------------------------------------------*) (* Initialisierungen; kleine, häufig benutzte Prozeduren *) (*--------------------------------------------------------------------------*) PROCEDURE Init; (* Aufbau von Screen, Window und Menu *) VAR ScrDef : NewScreen; WinDef : NewWindow; BEGIN (* Screen aufbauen *) WITH ScrDef DO leftEdge := 0; topEdge := 0; width := 640; height := 256; depth := 2; detailPen := 0; blockPen := 1; viewModes := ViewModeSet{hires}; type := customScreen; font := NIL; defaultTitle := ADR(Title); gadgets := NIL; customBitMap := NIL; END; (*WITH*) SPtr := OpenScreen(ScrDef); (* Screen öffnen *) Assert (SPtr#NIL,ADR("OpenScreen failed!")); (* Window aufbauen *) WITH WinDef DO leftEdge := 0; topEdge := 0; width := 640; height := 250; detailPen := 0; blockPen := 1; idcmpFlags := IDCMPFlagSet{menuPick,gadgetDown,gadgetUp,closeWindow, mouseMove,mouseButtons,rawKey}; flags := WindowFlagSet{windowSizing,windowDrag,windowClose,reportMouse, activate}; firstGadget := NIL; checkMark := NIL; title := ADR(Title); screen := SPtr; bitMap := NIL; minWidth := 80; minHeight := 30; maxWidth := 640; maxHeight := 256; type := customScreen; END; (*WITH*) WPtr := OpenWindow (WinDef); (* Window öffnen *) Assert (WPtr#NIL,ADR("OpenWindow failed!")); DefineWindow (WPtr); (* Für Gadgets vorbereiten *) SetScreen (SPtr,WPtr); (* Requester vorbereiten *) InitMenu (WPtr); (* Menu aufbauen *) END Init; (*--------------------------------------------------------------------------*) PROCEDURE InitVar; (* Variablen setzen *) BEGIN selectedBorder := Single; StringAttr := Left; NumbOfGadgets := 0; FileName := nul; Modified := FALSE; END InitVar; (*--------------------------------------------------------------------------*) PROCEDURE CloseAll; (* Löschen von Menu, Window und Screen *) BEGIN IF (WPtr # NIL) THEN ClearMenuStrip (WPtr); CloseWindow (WPtr); WPtr := NIL; END; (*IF*) IF (SPtr # NIL) THEN CloseScreen (SPtr); SPtr := NIL; END; (*IF*) END CloseAll; (*--------------------------------------------------------------------------*) PROCEDURE RefreshAll; (* Neuaufbau des Displays *) BEGIN SetRast (WPtr^.rPort,0); (* Window löschen *) RefreshWindowFrame (WPtr); (* Rahmen neu zeichnen *) RefreshGadgets (WPtr^.firstGadget,WPtr,NIL); (* Gadgets neu zeichnen *) END RefreshAll; (*--------------------------------------------------------------------------*) PROCEDURE Show (Text : ARRAY OF CHAR); (* Zeigt den übergebenen Text in Screen- und WindowTitle an *) BEGIN Copy (Line, Text); SetWindowTitles (WPtr,ADR(Line),ADR(Line)); END Show; (*--------------------------------------------------------------------------*) PROCEDURE ShowNorm; (* Zeigt Standard-Titel an *) BEGIN Line := Title; CopyPos (Line,FileName,17); Show (Line); END ShowNorm; (*--------------------------------------------------------------------------*) PROCEDURE SingleBorder (GPtr : GadgetPtr; w, h : INTEGER); (* Versieht Gadget mit einfachem Rahmen *) BEGIN GadgetBorder (GPtr,-Bord1x,-Bord1y,w+2*Bord1x-1,h+2*Bord1y-1,FALSE,0,0,1); END SingleBorder; (*--------------------------------------------------------------------------*) PROCEDURE DoubleBorder (GPtr : GadgetPtr; w, h : INTEGER); (* Versieht Gadget mit doppeltem Rahmen *) BEGIN GadgetBorder (GPtr,-Bord1x,-Bord1y,w+2*Bord1x-1,h+2*Bord1y-1,TRUE, Bord2x,Bord2y,1); END DoubleBorder; (*--------------------------------------------------------------------------*) (* Index-Prozeduren für GadgDefs-Feld *) (*--------------------------------------------------------------------------*) PROCEDURE GetIndex (GPtr : GadgetPtr) : INTEGER; (* liefert den Index im Feld GadgDefs für das Gadget mit GPtr *) VAR i : INTEGER; BEGIN FOR i:=0 TO NumbOfGadgets - 1 DO IF (GadgDefs[i].gPtr = GPtr) THEN RETURN i; END; (*IF*) END; (*FOR*) Assert (FALSE,ADR("Error in internal Gadget-List")); END GetIndex; (*--------------------------------------------------------------------------*) PROCEDURE RemoveElt (GPtr : GadgetPtr); (* Entfernt ein Gadget aus der Liste *) VAR i, Pos : INTEGER; BEGIN Pos := GetIndex(GPtr); FOR i:=Pos TO NumbOfGadgets - 2 DO GadgDefs[i] := GadgDefs[i+1]; END; (*FOR*) END RemoveElt; (*--------------------------------------------------------------------------*) (* Prozeduren für Project-Menu *) (*--------------------------------------------------------------------------*) PROCEDURE GadgLoad (SelectName : BOOLEAN); (* Laden einer GadgetStruktur *) VAR ok : BOOLEAN; len : LONGINT; Pos, i : INTEGER; res : Response; Status : StrPtr; FName : FileNameType; BEGIN FName := FileName; IF (SelectName) THEN ok := FileReq (FName,WPtr,"Load",TRUE); IF (Modified AND ok) THEN (* Sicherheits-Abfrage *) ok := Request (ADR("Overwrite existing Gadget-Structure?")); IF (NOT ok) THEN Show ("Load aborted ... nothing changed"); RETURN END; (*IF*) END; (*IF*) ELSE ok := TRUE; END; (*IF*) IF ok THEN Show ("Loading Gadget-Structure..."); res := Load (FName,GDCopy,WDefCopy,len); (* Laden *) ScreenToFront (SPtr); IF (res = done) THEN (* neue Struktur aufbauen, alte Löschen *) FileName := FName; FOR i:=0 TO NumbOfGadgets - 1 DO (* Gadgets entfernen *) DeleteGadget (GadgDefs[i].gPtr); END; (*FOR*) GadgDefs := GDCopy; (* neue Strukturen übernehmen *) WDef := WDefCopy; NumbOfGadgets := len DIV SIZE(GadgDefType); FOR i:=0 TO NumbOfGadgets-1 DO (* neue Gadgets aufbauen *) WITH GadgDefs[i] DO IF (type = boolGadget) THEN MakeBoolGadget (gPtr,0,lEdge,tEdge,width,height,GFSet, aFlags,ok); ELSIF (type = strGadget) THEN MakeStrGadget (gPtr,0,lEdge,tEdge,width,height,maxChars, GFSet,aFlags,ok); ELSE MakePropGadget (gPtr,0,lEdge,tEdge,width,height,aFlags,pType, hSteps,vSteps,ok); END; (*IF*) GadgetText (gPtr,xText,yText,text,fPen,bPen); IF (type # propGadget) THEN IF (border = Single) THEN SingleBorder (gPtr,width,height); ELSIF (border = Double) THEN DoubleBorder (gPtr,width,height); END; (*IF*) END; (*IF*) END; (*WITH*) END; (*FOR*) (* Fenstergröße/position aktualisieren *) WITH WDef DO IF (WPtr^.leftEdge+width > 639) OR (WPtr^.topEdge+height > 255) THEN MoveWindow (WPtr,x - WPtr^.leftEdge,y - WPtr^.topEdge); SizeWindow (WPtr,width - WPtr^.width,height - WPtr^.height); ELSE SizeWindow (WPtr,width - WPtr^.width,height - WPtr^.height); MoveWindow (WPtr,x - WPtr^.leftEdge,y - WPtr^.topEdge); END; (*IF*) END; (*WITH*) RefreshAll; ShowNorm; Modified := FALSE; ELSIF (SelectName) THEN DisplayBeep (SPtr); END; (*IF*) IF (NOT SelectName) AND (res = notFound) THEN Show ("File not Found -> new File"); ELSE ResponseText (res,Status); Show (Status^); END; (*IF*) END; (*IF*) END GadgLoad; (*--------------------------------------------------------------------------*) PROCEDURE SaveIt (FName : FileNameType) : BOOLEAN; (* Speichern der Gadgetstruktur *) VAR res : Response; Status : StrPtr; BEGIN Show ("Saving Gadget-Structure..."); WDef.x := WPtr^.leftEdge; (* Fenstergröße/position *) WDef.y := WPtr^.topEdge; WDef.width := WPtr^.width; WDef.height := WPtr^.height; res := Save (FName,ADR(WDef),SIZE(WDef),ADR(GadgDefs), SIZE(GadgDefType)*NumbOfGadgets); ScreenToFront (SPtr); ResponseText (res,Status); Show (Status^); IF (res # done) THEN DisplayBeep (SPtr); RETURN FALSE; ELSE Modified := FALSE; RETURN TRUE; END; (*IF*) END SaveIt; (*--------------------------------------------------------------------------*) PROCEDURE SaveAs; (* Speichern der GadgetStruktur unter neuem Namen *) VAR ok : BOOLEAN; FName : FileNameType; BEGIN FName := FileName; ok := FileReq (FName,WPtr,"Save As",TRUE); IF ok THEN ok := SaveIt(FName); IF (ok) THEN FileName := FName; END; (*IF*) END; (*IF*) END SaveAs; (*--------------------------------------------------------------------------*) PROCEDURE GadgSave; (* Speichern der GadgetStruktur unter bekanntem Namen *) VAR ok : BOOLEAN; BEGIN IF (FileName[1] # nul) THEN ok := SaveIt(FileName); ELSE SaveAs; END; (*IF*) END GadgSave; (*--------------------------------------------------------------------------*) PROCEDURE New; (* Löschen der Gadget-Struktur *) VAR ok : BOOLEAN; i : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN IF (Modified) THEN ok := Request (ADR("Delete existing Gadget-Structure?")); ELSE ok := TRUE; END; (*IF*) IF (ok) THEN FOR i:=0 TO NumbOfGadgets - 1 DO DeleteGadget (GadgDefs[i].gPtr); END; (*FOR*) NumbOfGadgets := 0; Modified := FALSE; FileName := nul; RefreshAll; ShowNorm; END; (*IF*) END; (*IF*) END New; (*--------------------------------------------------------------------------*) PROCEDURE MakeModule; (* Erstellen des MODULA-Quelltextes *) VAR NameCopy,ext,path : FileNameType; change : BOOLEAN; len : INTEGER; res : Response; Status : StrPtr; BEGIN IF (NumbOfGadgets # 0) THEN Show ("Create Module"); NameCopy := FileName; GetExtension (NameCopy,ext,len); FileNameRequest (NameCopy,change); IF change THEN WDef.x := WPtr^.leftEdge; (* Fenstergröße/position *) WDef.y := WPtr^.topEdge; WDef.width := WPtr^.width; WDef.height := WPtr^.height; Show ("Creating now Module ... "); res := Create (NameCopy,NumbOfGadgets,GadgDefs,WDef); (* erstellen *) ScreenToFront (SPtr); ResponseText (res,Status); Show (Status^); ELSE ShowNorm; END; (*IF*) END; (*IF*) END MakeModule; (*--------------------------------------------------------------------------*) (* Prozeduren für EDIT-Menu *) (*--------------------------------------------------------------------------*) PROCEDURE DelGadget; (* Löschen eines Gadgets aus dem Window *) VAR GPtr : GadgetPtr; Pos : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN Show ("Delete: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN (* Gadget vorhanden? *) RemoveElt (GPtr); (* aus Liste entfernen *) DEC (NumbOfGadgets); DeleteGadget (GPtr); (* löschen *) RefreshAll; Modified := TRUE; END; (*IF*) END; (*IF*) END DelGadget; (*--------------------------------------------------------------------------*) PROCEDURE MoveGadget; (* Verschieben eines Gadgets *) VAR GPtr : GadgetPtr; i,w,h,x,y : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN Show ("MoveGadget: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN i := GetIndex(GPtr); (* alte Werte *) w := GadgDefs[i].width - 1; h := GadgDefs[i].height - 1; (* Gesamtgröße des Gadgets ermitteln (inkl. Rahmen) *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Single) THEN INC (w,2*Bord1x); INC (h,2*Bord1y); ELSIF (GadgDefs[i].border = Double) THEN INC (w,2*Bord2x+2*Bord1x); INC (h,2*Bord2y+2*Bord1y); END; (*IF*) END; (*IF*) PlaceRect (WPtr,w,h,x,y); (* neue Position ermitteln *) (* Größe des Gadgets ohne Rahmen ermitteln *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Double) THEN INC (x,Bord2x+Bord1x); INC (y,Bord2y+Bord1y); ELSIF (GadgDefs[i].border = Single) THEN INC (x,Bord1x); INC (y,Bord1y); END; (*IF*) END; (*IF*) GPtr^.leftEdge := x; (* Gadget neu positionieren *) GPtr^.topEdge := y; GadgDefs[i].lEdge := x; GadgDefs[i].tEdge := y; RefreshAll; Modified := TRUE; END; (*IF*) END; (*IF*) END MoveGadget; (*--------------------------------------------------------------------------*) PROCEDURE CopyGadget; (* Kopieren eines Gadget *) VAR GPtr, GPtr1 : GadgetPtr; i,w,h,x,y : INTEGER; ok : BOOLEAN; BEGIN IF (NumbOfGadgets # 0) THEN Show ("CopyGadget: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN i := GetIndex(GPtr); w := GadgDefs[i].width - 1; h := GadgDefs[i].height - 1; (* Gesamtgröße des Gadgets ermitteln (inkl. Rahmen) *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Single) THEN INC (w,2*Bord1x); INC (h,2*Bord1y); ELSIF (GadgDefs[i].border = Double) THEN INC (w,2*Bord2x+2*Bord1x); INC (h,2*Bord2y+2*Bord1y); END; (*IF*) END; (*IF*) PlaceRect (WPtr,w,h,x,y); (* Position des neuen Gadgets *) (* Größe des Gadgets ohne Rahmen ermitteln *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Double) THEN INC (x,Bord2x+Bord1x); INC (y,Bord2y+Bord1y); ELSIF (GadgDefs[i].border = Single) THEN INC (x,Bord1x); INC (y,Bord1y); END; (*IF*) END; (*IF*) WITH GadgDefs[i] DO (* neues Gadget erstellen *) IF (type = boolGadget) THEN MakeBoolGadget (GPtr1,0,x,y,width,height,GFSet, aFlags,ok); ELSIF (type = strGadget) THEN MakeStrGadget (GPtr1,0,x,y,width,height,maxChars, GFSet,aFlags,ok); ELSE MakePropGadget (GPtr1,0,x,y,width,height,aFlags,pType,hSteps, vSteps,ok); END; (*IF*) GadgetText (GPtr1,xText,yText,text,fPen,bPen); IF (type # propGadget) THEN IF (border = Single) THEN SingleBorder (GPtr1,width,height); ELSIF (border = Double) THEN DoubleBorder (GPtr1,width,height); END; (*IF*) END; (*IF*) END; (*WITH*) GadgDefs[NumbOfGadgets] := GadgDefs[i]; WITH GadgDefs[NumbOfGadgets] DO gPtr := GPtr1; lEdge := x; tEdge := y; END; (*WITH*) INC (NumbOfGadgets); Modified := TRUE; END; (*IF*) END; (*IF*) END CopyGadget; (*--------------------------------------------------------------------------*) PROCEDURE SizeGadget; (* Verändern der Gadgetgröße *) VAR GPtr : GadgetPtr; i,w,h,x,y : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN Show ("SizeGadget: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN i := GetIndex(GPtr); x := GadgDefs[i].lEdge; y := GadgDefs[i].tEdge; (* Gesamtgröße des Gadgets ermitteln (inkl. Rahmen) *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Single) THEN DEC (x,Bord1x); DEC (y,Bord1y); ELSIF (GadgDefs[i].border = Double) THEN DEC (x,Bord1x+Bord2x); DEC (y,Bord1y+Bord2y); END; (*IF*) END; (*IF*) SetRect (WPtr,TRUE,x,y,w,h); (* neue Größe bestimmen *) (* Größe des Gadgets ohne Rahmen ermitteln *) IF (GadgDefs[i].type # propGadget) THEN IF (GadgDefs[i].border = Single) THEN INC (x,Bord1x); INC (y,Bord1y); DEC (w,2*Bord1x); DEC (h,2*Bord1y); ELSIF (GadgDefs[i].border = Double) THEN INC (x,Bord1x+Bord2x); INC (y,Bord1y+Bord2y); DEC (w,2*(Bord1x+Bord2x)); DEC (h,2*(Bord1y+Bord2y)); END; (*IF*) END; (*IF*) (* Position der linken oberen Ecke darf sich nicht ändern *) IF (x # GadgDefs[i].lEdge) OR (y # GadgDefs[i].tEdge) OR (w <= 1) OR (h <= 1) THEN Show ("Size-Error - No change"); ELSE IF (GadgDefs[i].type # propGadget) THEN (* neuer Rahmen *) IF (GadgDefs[i].type = strGadget) THEN h := CHeight; END; (*IF*) IF (GadgDefs[i].border = Single) THEN SingleBorder (GPtr,w,h); ELSIF (GadgDefs[i].border = Double) THEN DoubleBorder (GPtr,w,h); END; (*IF*) END; (*IF*) GPtr^.width := w; (* Gadget neue Größe geben *) GPtr^.height := h; GadgDefs[i].width := w; GadgDefs[i].height := h; RefreshAll; Modified := TRUE; END; (*IF*) END; (*IF*) END; (*IF*) END SizeGadget; (*--------------------------------------------------------------------------*) (* Prozeduren für GADGETS-Menu *) (*--------------------------------------------------------------------------*) PROCEDURE Boolean (Mode : BOOLEAN); (* Erstellen eines BOOLEAN-Gadgets *) VAR x, y, w, h : INTEGER; AFlags : ActivationFlagSet; ok : BOOLEAN; GPtr : GadgetPtr; BEGIN IF (NumbOfGadgets >= MaxGadgets) THEN Show ("Too much Gadgets."); RETURN; END; (*IF*) AFlags := ActivationFlagSet{gadgImmediate,relVerify}; (* toggleSelect? *) IF (Mode) THEN INCL (AFlags,toggleSelect) END; Show ("Create BOOLEAN-Gadget:"); SetRect (WPtr,FALSE,x,y,w,h); (* Position und Größe bestimmen *) ShowNorm; IF (selectedBorder = Single) THEN (* Von Gesaamtgröße Rahmen abziehen *) INC (x,Bord1x); INC (y,Bord1y); DEC (w,2*Bord1x); DEC (h,2*Bord1y); ELSIF (selectedBorder = Double) THEN INC (x,Bord1x+Bord2x); INC (y,Bord1y+Bord2y); DEC (w,2*Bord1x+2*Bord2x); DEC (h,2*Bord1y+2*Bord2y); END; (*IF*) (* zu klein? *) IF (w <= 1) OR (h <= 1) THEN Show ("Gadget too small!"); RETURN; END; (*IF*) (* Gadget erstellen *) MakeBoolGadget (GPtr,0,x,y,w,h,GFSet,AFlags,ok); (* Werte in Liste eintragen *) WITH GadgDefs[NumbOfGadgets] DO gPtr := GPtr; lEdge := x; tEdge := y; width := w; height := h; aFlags := AFlags; border := selectedBorder; text := nul; fPen := 1; bPen := 0; type := boolGadget; END; (*WITH*) INC (NumbOfGadgets); (* Rahmen? *) IF (selectedBorder = Single) THEN SingleBorder (GPtr,w,h); ELSIF (selectedBorder = Double) THEN DoubleBorder (GPtr,w,h); END; (*IF*) Modified := TRUE; END Boolean; (*--------------------------------------------------------------------------*) PROCEDURE String (Mode : BOOLEAN); (* Erstellen eines String-Gadgets *) VAR x, y, w, h : INTEGER; AFlags : ActivationFlagSet; ok : BOOLEAN; GPtr : GadgetPtr; BEGIN IF (NumbOfGadgets >= MaxGadgets) THEN Show ("Too much Gadgets."); RETURN; END; (*IF*) AFlags := ActivationFlagSet{gadgImmediate,relVerify}; (* longint? *) IF (Mode) THEN INCL (AFlags,longint) END; (* Bündigkeit: *) IF (StringAttr = Center) THEN INCL (AFlags,stringCenter); ELSIF (StringAttr = Right) THEN INCL (AFlags,stringRight); END; (*IF*) Show ("Create STRING-Gadget: Select width of Gadget"); (* Breite bestimmen *) SetRect (WPtr,FALSE,x,y,w,h); (* Größe bestimmen *) h := CHeight; (* Einheitshöhe = 8*) IF (selectedBorder = Single) THEN INC (h,2*Bord1y); ELSIF (selectedBorder = Double) THEN INC (h,2*(Bord1y+Bord2y)); END; (*IF*) IF (w <= 10) THEN Show ("Gadget too small!"); RETURN; END; (*IF*) Show ("Create STRING-Gadget: Select position of Gadget"); (* Position *) PlaceRect (WPtr,w-1,h-1,x,y); (* Position bestimmen *) ShowNorm; (* Breite ohne Rahmen bestimmen *) IF (selectedBorder = Single) THEN INC (x,Bord1x); INC (y,Bord1y); DEC (w,2*Bord1x); ELSIF (selectedBorder = Double) THEN INC (x,Bord1x+Bord2x); INC (y,Bord1y+Bord2y); DEC (w,2*Bord1x+2*Bord2x); END; (*IF*) (* Gadget erstellen *) MakeStrGadget (GPtr,0,x,y,w,CHeight,80,GFSet,AFlags,ok); (* Werte in Liste eintragen *) WITH GadgDefs[NumbOfGadgets] DO gPtr := GPtr; lEdge := x; tEdge := y; width := w; height := CHeight; aFlags := AFlags; border := selectedBorder; text := nul; fPen := 1; bPen := 0; type := strGadget; maxChars := 80; END; (*WITH*) INC (NumbOfGadgets); (* Rahmen? *) IF (selectedBorder = Single) THEN SingleBorder (GPtr,w,CHeight); ELSIF (selectedBorder = Double) THEN DoubleBorder (GPtr,w,CHeight); END; (*IF*) Modified := TRUE; END String; (*--------------------------------------------------------------------------*) PROCEDURE Prop (Mode : PropTypeSet); (* Erstellen eines Proportional-Gadgets *) VAR GPtr : GadgetPtr; AFlags : ActivationFlagSet; x, y, w, h : INTEGER; ok,change : BOOLEAN; Wert1, Wert2 : LONGINT; BEGIN IF (NumbOfGadgets >= MaxGadgets) THEN Show ("Too much Gadgets."); RETURN; END; (*IF*) AFlags := ActivationFlagSet{gadgImmediate,relVerify}; Show ("Create PROPORTIONAL-Gadget:"); SetRect (WPtr,FALSE,x,y,w,h); (* Position und Größe bestimmen *) ShowNorm; IF (w <= 5) OR (h <= 3) THEN Show ("Gadget too small!"); RETURN; END; (*IF*) Wert1 := 16; Wert2 := 16; (* Defaultwerte *) InitPropRequest (Mode,Wert1,Wert2,change); (* Schrittweiten bestimmen *) IF NOT change THEN Wert1 := 16; Wert2 := 16 END; (* Werte müssen da sein *) (* Gagdet erstellen: *) MakePropGadget (GPtr,0,x,y,w,h,AFlags,Mode,CARDINAL(Wert1),CARDINAL(Wert2) ,ok); (* Werte in Liste eintragen *) WITH GadgDefs[NumbOfGadgets] DO gPtr := GPtr; lEdge := x; tEdge := y; width := w; height := h; aFlags := AFlags; border := selectedBorder; text := nul; fPen := 1; bPen := 0; type := propGadget; pType := Mode; hSteps := CARDINAL(Wert1); vSteps := CARDINAL(Wert2); END; (*WITH*) INC (NumbOfGadgets); Modified := TRUE; END Prop; (*--------------------------------------------------------------------------*) (* Prozeduren für ATTRIBUTES-Menu *) (*--------------------------------------------------------------------------*) PROCEDURE TextGadget; (* Gadget mit Text versehen *) VAR GPtr : GadgetPtr; ok, change : BOOLEAN; center : BOOLEAN; Text : GTextType; h,w,tw : INTEGER; FCol,BCol : INTEGER; x,y,xG,yG : INTEGER; i : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN Show ("GadgetText: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN i := GetIndex(GPtr); (* alte Werte *) FCol := GadgDefs[i].fPen; BCol := GadgDefs[i].bPen; Text := GadgDefs[i].text; TextRequest (Text,FCol,BCol,change,center); (* neue Werte abfragen *) IF change THEN (* closeWindow -> keine Änderung *) h := GPtr^.height; w := GPtr^.width; tw := Length(Text) * CWidth; xG := GPtr^.leftEdge; yG := GPtr^.topEdge; IF (tw = 0) THEN DeleteText (GPtr); ELSE IF center THEN (* Zentrieren (für BOOLEAN-Gadgets) *) x := (w DIV 2) - (tw DIV 2); y := (h DIV 2) - (CHeight DIV 2) + 1; GadgetText (GPtr,x,y,Text,FCol,BCol); ELSE (* von Hand positionieren *) PlaceRect (WPtr,tw,CHeight,x,y); x := x - xG; y := y - yG; GadgetText (GPtr,x,y,Text,FCol,BCol); END; (*IF*) END; (*IF*) RefreshAll; (* Neuaufbau *) GadgDefs[i].fPen := FCol; GadgDefs[i].bPen := BCol; GadgDefs[i].text := Text; GadgDefs[i].xText := x; GadgDefs[i].yText := y; Modified := TRUE; END; (*IF*) END; (*IF*) END; (*IF*) END TextGadget; (*--------------------------------------------------------------------------*) PROCEDURE ChangeAttributes; (* Verändern der Attribute eines beliebigen Gadgets *) VAR GPtr : GadgetPtr; change,ok : BOOLEAN; i : INTEGER; SVert, SHoriz : CARDINAL; horizBody, vertBody : CARDINAL; Mode : PropTypeSet; PFlags : PropInfoFlagSet; AnzVert, AnzHoriz : LONGINT; AFlags : ActivationFlagSet; maxChars : INTEGER; Borders : BorderType; Pos : INTEGER; x,y,w,h : INTEGER; BEGIN IF (NumbOfGadgets # 0) THEN Show ("Change Attributes: Please select Gadget:"); GPtr := SelectGadget(WPtr); (* Gadget wählen *) ShowNorm; IF (GPtr # NIL) THEN (* Gadget gewählt? *) i := GetIndex(GPtr); (* Index des Gadgets holen *) IF (GPtr^.gadgetType = propGadget) THEN (* Prop-Gadget gewählt *) Mode := GadgDefs[i].pType; AnzVert := LONGINT (GadgDefs[i].vSteps); AnzHoriz := LONGINT (GadgDefs[i].hSteps); InitPropRequest (Mode,AnzHoriz,AnzVert,change); IF change THEN (* Veränderung *) IF (AnzHoriz <= 1) THEN (* Werte für PropInfo neu *) horizBody := MAX(CARDINAL); (* berechnen *) AnzHoriz := 1; ELSE horizBody := CARDINAL(65535 DIV AnzHoriz) + 1; END; (*IF*) IF (AnzVert <= 1) THEN vertBody := MAX(CARDINAL); AnzVert := 1; ELSE vertBody := CARDINAL(65535 DIV AnzVert) + 1; END; (*IF*) PFlags := PropInfoFlagSet{autoKnob}; IF (Horiz IN Mode) THEN INCL(PFlags,freeHoriz); END; (*IF*) IF (Vert IN Mode) THEN INCL(PFlags,freeVert); END; (*IF*) ModifyProp (GPtr,WPtr,NIL,PFlags,0,0, (* Gadget ändern *) horizBody,vertBody); GadgDefs[i].pType := Mode; (* Liste aktualisieren *) GadgDefs[i].hSteps := AnzHoriz; GadgDefs[i].vSteps := AnzVert; Modified := TRUE; END; (*IF*) ELSIF (GPtr^.gadgetType = strGadget) THEN (* String-Gadget gewählt *) AFlags := GadgDefs[i].aFlags; maxChars := GadgDefs[i].maxChars; Borders := GadgDefs[i].border; StrAttrRequest (maxChars,AFlags,Borders,change); IF change THEN x := GPtr^.leftEdge; y := GPtr^.topEdge; w := GPtr^.width; h := GPtr^.height; DeleteGadget (GPtr); (* Gadget ganz löschen, um Neben- wirkungen zu vermeiden *) MakeStrGadget (GPtr,0,x,y,w,h,maxChars,GFSet, AFlags,ok); (* neu erstellen *) WITH GadgDefs[i] DO (* Text neu erstellen *) IF (text[1] # nul) THEN GadgetText (GPtr,xText,yText,text,fPen,bPen); END; (*IF*) END; (*WITH*) IF (Borders = No) THEN (* Rahmen neu erstellen *) GPtr^.gadgetRender := NIL; ELSIF (Borders = Single) THEN SingleBorder (GPtr,w,h); ELSIF (Borders = Double) THEN DoubleBorder (GPtr,w,h); END; (*IF*) RefreshAll; GadgDefs[i].gPtr := GPtr; (* Liste aktualisieren *) GadgDefs[i].maxChars := maxChars; GadgDefs[i].aFlags := AFlags; GadgDefs[i].border := Borders; Modified := TRUE; END; (*IF*) ELSIF (GPtr^.gadgetType = boolGadget) THEN (* Bool-Gadget gewählt *) AFlags := GadgDefs[i].aFlags; Borders := GadgDefs[i].border; BoolAttrRequest (AFlags,Borders,change); IF change THEN GPtr^.activation := AFlags; EXCL (GPtr^.flags,selected); w := GadgDefs[i].width; h := GadgDefs[i].height; IF (Borders = No) THEN (* Rahmen aktualisieren *) DeleteBorder (GPtr); ELSIF (Borders = Single) THEN SingleBorder (GPtr,w,h); ELSIF (Borders = Double) THEN DoubleBorder (GPtr,w,h); END; (*IF*) RefreshAll; GadgDefs[i].aFlags := AFlags; (* Liste aktualisieren *) GadgDefs[i].border := Borders; Modified := TRUE; END; (*IF*) ELSE END; (*IF gadgetType*) END; (*IF GPtr # NIL*) END; (*IF NumbOfGadgets # 0*) END ChangeAttributes; (*--------------------------------------------------------------------------*) (* HAUPTPROGRAMM *) (*--------------------------------------------------------------------------*) CONST ESC = 045H; (* RAW-Key Codes *) F1 = 050H; F2 = 051H; F3 = 052H; F4 = 053H; F9 = 058H; F10 = 059H; HELP = 05FH; B = 035H; S = 021H; X = 032H; Y = 031H; T = 014H; I = 017H; Z = 015H; VAR class : IDCMPFlagSet; code : CARDINAL; Ptr : GadgetPtr; ArgLen : INTEGER; len : INTEGER; ext,fc : FileNameType; ok : BOOLEAN; BEGIN TermProcedure (CloseAll); (* Für den Fehlerfall *) Init; (* Screen, Window und Menu aufbauen *) InitVar; (* Variablen setzen *) Show ("Press HELP for Infos and Function-Keys"); Copyright (SPtr); (* Wurde Filename als Argument übergeben? *) IF (NumArgs() > 0) THEN GetArg (1,FileName,ArgLen); fc := FileName; (* sichern *) GetExtension (FileName,ext,len); IF (ext[1] = nul) THEN (* keine Extension angegeben? *) CopyPos (FileName,DefaultExt,len); ELSE FileName := fc; END; (*IF*) GadgLoad (FALSE); END; (*IF*) (* Hauptschleife, Abfrage des Menüs und der Tasten *) (*-------------------------------------------------*) LOOP WaitForMsg (WPtr,class,code,Ptr); (* auf Meldung warten *) (* Menu: *) (*-------*) IF (menuPick IN class) THEN CASE MenuNum(code) OF | 0: CASE ItemNum(code) OF (* erstes Menu: PROJECT *) | 0: GadgLoad (TRUE) (* Prozedur fuer Load *) | 1: GadgSave (* Prozedur fuer Save *) | 2: SaveAs (* Prozedur fuer Save As *) | 3: New (* Prozedur fuer New *) | 5: MakeModule (* Prozedur fuer Make Module *) | 7: IF (Modified) THEN (* Prozedur fuer QUIT *) ok := Request(ADR("Do you really want to quit?")); IF (ok) THEN EXIT END; ELSE EXIT END; (*IF*) ELSE END (* CASE ItemNum *); | 1: CASE ItemNum(code) OF (* zweites Menu: EDIT *) | 0: DelGadget (* Prozedur fuer Delete *) | 1: MoveGadget (* Prozedur fuer Move *) | 2: CopyGadget (* Prozedur fuer Copy *) | 3: SizeGadget (* Prozedur fuer Size *) ELSE END (* CASE ItemNum *); | 2: CASE ItemNum(code) OF (* drittes Menu: GADGETS *) | 0: CASE SubNum(code) OF (* BOOLEAN *) | 0: Boolean (FALSE) (* Prozedur fuer Normal*) | 1: Boolean (TRUE) (* Prozedur fuer ToggleSelect*) ELSE END (* CASE SubNum *); | 1: CASE SubNum(code) OF (* STRING *) | 0: String (FALSE) (* Prozedur fuer Normal*) | 1: String (TRUE) (* Prozedur fuer Integer*) ELSE END (* CASE SubNum *); | 2: CASE SubNum(code) OF (* Proportional *) | 0: Prop(PropTypeSet{Horiz}) (* Prozedur fuer Horiz*) | 1: Prop(PropTypeSet{Vert}) (* Prozedur fuer Vert*) | 2: Prop(PropTypeSet{Horiz,Vert}) (* Prozedur fuer Both*) ELSE END (* CASE SubNum *); ELSE END (* CASE ItemNum *); | | 3: CASE ItemNum(code) OF (* viertes Menu: ATTRIBUTES *) | 0: TextGadget (* Prozedur fuer Text *) | 2: selectedBorder := No; (* CheckIt-Item No Border *) Show ("No Border selected"); | 3: selectedBorder := Single; (* CheckIt-Item Single Border *) Show ("Single Border selected"); | 4: selectedBorder := Double; (* CheckIt-Item DoubleBorder *) Show ("Double Border selected"); | 6: StringAttr := Left; (* CheckIt-Item String Left *) Show ("String-Left selected"); | 7: StringAttr := Center; (* CheckIt-Item String Center *) Show ("String-Center selected"); | 8: StringAttr := Right; (* CheckIt-Item String Right *) Show ("String-Right selected"); | 10: ChangeAttributes; (* Prozedur fuer ChangeAttributes *) ELSE END (* CASE ItemNum *); | ELSE END (* CASE MenuNum *) (* Tasten: *) (*---------*) ELSIF (rawKey IN class) THEN (* Taste gedrückt *) CASE code OF | ESC: IF (Modified) THEN ok := Request(ADR("Do you really want to quit?")); IF (ok) THEN EXIT END; ELSE EXIT END; (*IF*) | F1 : DelGadget; | F2 : MoveGadget; | F3 : CopyGadget; | F4 : SizeGadget; | F9 : TextGadget; | F10: ChangeAttributes; | B : Boolean(FALSE); | T : Boolean(TRUE); | S : String(FALSE); | I : String(TRUE); | X : Prop(PropTypeSet{Horiz}); | Y : Prop(PropTypeSet{Vert}); | Z : Prop(PropTypeSet{Vert,Horiz}); | HELP : Help (SPtr); ELSE END; (*CASE Raw-Key Code*) ELSIF (closeWindow IN class) THEN IF (Modified) THEN ok := Request(ADR("Do you really want to quit?")); IF (ok) THEN EXIT END; ELSE EXIT END; (*IF*) ELSIF (mouseButtons IN class) AND (code = selectDown) THEN RefreshAll; ShowNorm; END (* IF *); END; (*LOOP*) (* Ende, wird automatisch ausgeführt (TermProcedure) *) (* CloseAll; *) END GadgetEd.