MODULE TexDraw ; (* Žnderungen ---------- 03/02/91 10:18 Version 1.75 beta 1 06/02/91 09:28 Version 1.75 beta 2 09/02/91 11:31 Version 1.75 beta 3 12/02/91 13:47 Version 1.75 beta 4 05/03/91 11:48 Version 1.76 beta 09/03/91 22:13 Version 1.77 04/04/91 00:53 Version 1.78 11/05/91 15:09 Version 1.85 09/06/91 09:15 Anpassung an MM2 *) FROM SYSTEM IMPORT ADDRESS , ADR ; FROM Storage IMPORT ALLOCATE , DEALLOCATE (** , CreateHeap **) ; IMPORT mtAlerts; IMPORT Diverses; IMPORT mtAppl; IMPORT mtRsc; IMPORT MagicAES; IMPORT MagicConvert; IMPORT MagicDOS; IMPORT MagicStrings; IMPORT MagicSys; IMPORT MagicVDI; IMPORT MagicBIOS; IMPORT MagicXBIOS; IMPORT MathLib0; IMPORT VectorFont; IMPORT Undo; IMPORT WinUtils; FROM Types IMPORT DrawObjectTyp, TextPosTyp, ObjectSet, JputMarker, Draw3D, LineMode, LineType, CodeAryTyp, CharPtrTyp, ObjectPtrTyp, LatexSpecials, sourceformat, targetformat; FROM CommonData IMPORT WindowHandle, ClipXY, FileName, WindowTitle, LineWidth, TextPosition, XPosx, XPosy, YPosx, YPosy, DXPosx, DXPosy, DYPosx, DYPosy, FatherXOffset, FatherYOffset, WholeArea, ZeroX, ZeroY, SnapX, SnapY, XSnap, YSnap, SnapMode, Usespecial, ZoomNumerator, ZoomDenominator, LimitedDisk, InternalResolution, LTDPath, IMGPath, STADPath, TeXPath, HPGLPath, FontPath, MetaPath, LaTeXPath, GFPKPath, PiCTeXPath, GEMPath, PostPath, FIGPath, HelpPath, CSGPath, IncludePath, CurrentVectorFont, OwnHPGLFont, MetaLThin, MetaLThick, MetaLVThick, MetaPAscii, MajorRelease, MinorRelease, SubRelease, ShowBezLine, ObjectCreated, Extensions, MaxExtension; FROM CSspecial IMPORT ImportCSspecial; FROM Dialoge IMPORT RSC, DeselectIcon, SelectIcon, SetPicsize, ChangeObjSize, SetFont, SetGridSize, GetUnitLength, Info, OverFaktor, SetMetaOptions, SetSpecialOptions, SetSystem, MoveResize, ChooseImport, ChooseExport, BusyStart, BusyEnd, AdjustIt, PicConvert; FROM File IMPORT Load, Merge, LoadFile, Save, SaveAs ; FROM FileIO IMPORT Reset, Rewrite, Close, EOF, WriteLn, ReadLn; FROM GetFile IMPORT ReplacePath, ReplaceFilename, StdPath, RemovePath, FileExists; FROM ObjectUtilities IMPORT ChangeDrawArea, ChangeArea, ShowRaster, ShowSelectRects, RasterFlag, Redraw, MakeAllDirty, ShowSelection, FillObject, ObjectExist, TextInPic; FROM OwnBoxes IMPORT GetMKState; FROM HelpModule IMPORT DisplayStatus, HelpMessage, HelpForIcon; FROM SelectModule IMPORT SelObs, SelPics, Select, Move, Copy, DeselectTree, SelectTree, MergeSelection, SplitSelection, BringSelectionFront, BringSelectionBack, getsurround, GetSurround, DeleteSelection, InvertSelection, MirrorSelection, AdjustSelection, ChangeIt, ChangeAll, TurnSelection, LockSelection, UnLockSelection, MoveSelection, CopySelection, SplitLines, MergeLines; FROM Variablen IMPORT FirstObject, LastObject, CheckConsistency, NewObject, DeleteObject, DeleteWholeTree, Position, PicToPix, ZoomMode, PicDistance, MergeToSubpic, NumberToStr; IMPORT Bezier ; IMPORT Circles ; IMPORT Compile ; IMPORT Epic ; IMPORT FIG ; IMPORT HPGL ; (** IMPORT Lines ; **) IMPORT Metafont; IMPORT Parse ; IMPORT Pictex ; IMPORT PicToMeta; IMPORT RSCindices; IMPORT TextBox ; (* Frs Debuggen *) (** IMPORT Debug; **) (* Versionsstring, sollte immer die gleiche L„nge haben, zumindestens nicht viele Zeichen mehr oder weniger *) CONST Version = 'TeX-Draw-Beta-Test # (04/09/1991)'; InfoFile = 'texdraw.inf'; FontFile = 'texdraw.fnt'; ExtensFile = 'texdraw.ext'; InfoIDRaw = 'TD# (C) 1991 by Jens Pirnay'; NoMemory = '[4][ No Memory ?!][ [Abort ]'; NoRSC = '[4][ Where is TEXDRAW.RSC ?][[Abort]'; MaxShortcuts = 100; UseShiftShortcut = FALSE; TYPE ShortCutRec = RECORD CtrlCut : BITSET; Index : INTEGER; Menu : INTEGER; CutChar : CHAR; END; VAR shortcuts : INTEGER; ShortCutArray : ARRAY [1..MaxShortcuts] OF ShortCutRec; AddText : BOOLEAN ; ColorFlag : BOOLEAN ; End : BOOLEAN ; IgnoreRedraw : BOOLEAN ; MenuTree : ADDRESS ; ALTER : BOOLEAN ; SHIFT, CTRL : BOOLEAN ; EventFlag : BITSET ; ButtonClicks : INTEGER ; ButtonMask : BITSET ; ButtonState : BITSET ; M1Flag : INTEGER ; M1rect, M2rect : ARRAY [0..3] OF INTEGER; M2Flag : INTEGER ; LoCount,HiCount : INTEGER ; XSliders, YSliders : INTEGER ; FillState : INTEGER ; Draw : INTEGER ; EpicLinestyle : INTEGER ; Arrowstyle : INTEGER ; Mode3D : INTEGER ; TextMode : INTEGER ; FontMode : INTEGER ; UseUndo : BOOLEAN ; zoommode : BOOLEAN ; ThinCrossMouse : BOOLEAN ; ZStorex, ZStorey : INTEGER ; WinHeight, WinWidth : INTEGER ; DefaultWidth, DefaultHeight, DefaultRes, DefaultUnit : INTEGER ; DClickSpeed : INTEGER ; VerTxt, InfoID : ARRAY [0..79] OF CHAR; PROCEDURE DoOwnRedraw; BEGIN Redraw(0, 0, 30000, 30000); IgnoreRedraw := TRUE; END DoOwnRedraw; PROCEDURE LoescheQueue; (* Schamlos aus dem GME geklaut ;-) *) VAR localEvents : BITSET; MoX,MoY : INTEGER ; MoButton : BITSET ; MoKState : BITSET ; KBtaste : INTEGER ; KBscan : INTEGER ; KBascii : CHAR ; MoClicks : INTEGER ; MessagePipe : ARRAY [ 0..15 ] OF INTEGER ; BEGIN (* UpdateWindow (FALSE); *) REPEAT (* KeyBoardEvent (key); *) (* hm... wie soll das gehen, ehe ich nicht weiž, ob noch KeyBoardEvents anh„ngig sind??? *) localEvents:= MagicAES.EvntMulti ( BITSET{MagicAES.MUKEYBD, MagicAES.MUTIMER}, 0, BITSET{}, BITSET{}, M1Flag, M1rect, M2Flag, M2rect, MessagePipe, 0, 0, (* MUSS NULL SEIN, sonst geht Autorepeat nicht!? *) MoX, MoY, MoButton, KBtaste, MoKState, KBscan, KBascii, MoClicks) ; UNTIL NOT (MagicAES.MUKEYBD IN localEvents); (* UpdateWindow (TRUE); *) END LoescheQueue; (* ---------------------------------------------------------- *) (* --------- Verwaltung von Objekten, Menus etc. ------------ *) (* ---------------------------------------------------------- *) PROCEDURE AnimateWindowTitle(Menu : MagicSys.sINTEGER); (* mdesk = 3; mdrawing = 4; mauswahl = 5; moptions = 6; mdiverse = 7; *) BEGIN MagicAES.MenuTnormal (MenuTree , Menu , MagicAES.Reset) ; END AnimateWindowTitle; PROCEDURE DeAnimateWindowTitle(Menu : MagicSys.sINTEGER); BEGIN MagicAES.MenuTnormal (MenuTree , Menu , MagicAES.Set) ; END DeAnimateWindowTitle; PROCEDURE SetResetCheck(MenuItem : INTEGER; mode : INTEGER); VAR Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; BEGIN Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.menu) ; MagicAES.MenuIcheck (Tree , MenuItem , mode) ; END SetResetCheck; (* ---------------------------- *) PROCEDURE NewIcon(OldIndex, NewIndex : INTEGER); VAR Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; Tree1 : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; BEGIN Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.desktop) ; Tree1 := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.icons) ; Tree^[ OldIndex ].ImagePtr := Tree1^[ NewIndex ].ImagePtr ; DeselectIcon (OldIndex) ; (* Notwenig, damit neues Bild erscheint... *) END NewIcon; (* ---------------------------- *) PROCEDURE ChangeCheck(index : INTEGER; status : BOOLEAN); VAR mode : INTEGER; BEGIN IF status THEN mode := MagicAES.Reset; ELSE mode := MagicAES.Set; END; SetResetCheck(index, mode) ; END ChangeCheck; (* ---------------------------- *) PROCEDURE MenuItemStatus(Index : INTEGER; Enable : BOOLEAN); VAR mode : INTEGER; Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; BEGIN IF Enable THEN mode := MagicAES.Set; ELSE mode := MagicAES.Reset; END; Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.menu) ; MagicAES.MenuIenable (Tree , Index , mode) ; END MenuItemStatus; (* ---------------------------- *) PROCEDURE EnableSelectMenus(enabl : BOOLEAN); BEGIN MenuItemStatus (RSCindices.mauswsav, enabl) ; MenuItemStatus (RSCindices.mawsize , enabl) ; MenuItemStatus (RSCindices.mawfront, enabl) ; MenuItemStatus (RSCindices.mawnone , enabl) ; MenuItemStatus (RSCindices.mawback , enabl) ; MenuItemStatus (RSCindices.madjust , enabl) ; MenuItemStatus (RSCindices.ply2spl , enabl) ; MenuItemStatus (RSCindices.plysplit, enabl) ; MenuItemStatus (RSCindices.plymerge, enabl) ; END EnableSelectMenus; (* ---------------------------- *) PROCEDURE EnableCompileMenus (enabl : BOOLEAN); BEGIN MenuItemStatus (RSCindices.mcompile , enabl) ; MenuItemStatus (RSCindices.msaveas , enabl) ; MenuItemStatus (RSCindices.mauswall , enabl) ; MenuItemStatus (RSCindices.mawinv , enabl) ; END EnableCompileMenus; (* ---------------------------- *) PROCEDURE DisableNotReadyFunctions; PROCEDURE DisableObj(obj, tree : INTEGER); VAR mode : INTEGER; Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; BEGIN Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , tree) ; INCL(Tree^[obj].obState, MagicAES.DISABLED); END DisableObj; BEGIN (* Zur Zeit nichts drastisches *) (** DisableObj(RSCindices.compile4, RSCindices.compile); (* Compile -> FIG *) DisableObj(RSCindices.compile5, RSCindices.compile); (* Compile -> PS *) DisableObj(RSCindices.import5 , RSCindices.import); (* Import <- GEM *) DisableObj(RSCindices.import3 , RSCindices.import); (* Import <- FIG *) DisableObj(RSCindices.csource3, RSCindices.convert); (* Convert <- GEM *) DisableObj(RSCindices.csource4, RSCindices.convert); (* Convert <- CVG *) DisableObj(RSCindices.csource5, RSCindices.convert); (* Convert <- PS *) DisableObj(RSCindices.ctarget3, RSCindices.convert); (* Convert -> GFPK *) **) END DisableNotReadyFunctions; (* ---------------------------- *) PROCEDURE NewVal(VAR i : INTEGER; down, up : INTEGER); BEGIN IF SHIFT THEN DEC(i, 1); ELSE INC(i, 1); END; IF i up THEN i := down; END; END NewVal; PROCEDURE ChangeTextposIcon; VAR i, j : INTEGER; BEGIN i := ORD(TextPosition); NewVal(i, ORD(LeftTop), ORD(RightBot)); TextPosition := VAL(TextPosTyp, i); NewIcon(RSCindices.textpos, RSCindices.lt + i - 1); END ChangeTextposIcon; (* ---------------------------- *) PROCEDURE InvertFlag(VAR flag : BOOLEAN; menu : INTEGER); BEGIN ChangeCheck(menu, flag); flag := NOT flag; END InvertFlag; PROCEDURE InvertAreaStatus; VAR help : BOOLEAN; BEGIN WholeArea := NOT WholeArea; ChangeCheck(RSCindices.wholepic, WholeArea) ; ChangeDrawArea(0, 0); Redraw (0, 0, 30000, 30000); END InvertAreaStatus; (* ---------------------------- *) PROCEDURE InvertSnapMode; BEGIN SnapMode := NOT SnapMode; IF SnapMode THEN NewIcon(RSCindices.snap, RSCindices.snapon); ELSE NewIcon(RSCindices.snap, RSCindices.snapoff); END; END InvertSnapMode; (* ---------------------------- *) PROCEDURE ChangeMarkerStatusIcon; VAR i : INTEGER; BEGIN i := ORD(Epic.CurrentMarker); NewVal(i, ORD(None), ORD(PutOtimes)); Epic.CurrentMarker := VAL(JputMarker, i); Epic.SetMarkerType (Epic.CurrentMarker); NewIcon (RSCindices.jputt, RSCindices.normline + i); END ChangeMarkerStatusIcon; (* ---------------------------- *) PROCEDURE ChangeFillStatusIcon; BEGIN NewVal(FillState, 0, 7); NewIcon(RSCindices.fillstat, RSCindices.nofill + FillState); END ChangeFillStatusIcon; (* ---------------------------- *) PROCEDURE ChangeTextmodeIcon; BEGIN NewVal(TextMode, 0, 3); NewIcon(RSCindices.textmode, RSCindices.text1 + TextMode); END ChangeTextmodeIcon; (* ---------------------------- *) PROCEDURE ChangeFontmodeIcon; BEGIN IF VectorFont.FontsLoaded()>0 THEN NewVal(FontMode, 0, 1); ELSE FontMode := 0; END; NewIcon(RSCindices.fontmode, RSCindices.txtfont1 + FontMode); END ChangeFontmodeIcon; (* ---------------------------- *) PROCEDURE ChangeWidthIcon; VAR j : INTEGER; BEGIN IF SHIFT THEN DEC(LineWidth, 2); ELSE INC(LineWidth, 2); END; IF (LineWidth<1) THEN LineWidth := 5; END; IF (LineWidth>5) THEN LineWidth := 1; END; j := (LineWidth + 1) DIV 2; (* => 1,2,3 *) j := j -1; NewIcon(RSCindices.width, RSCindices.n + j); END ChangeWidthIcon; (* ------------------------------------------------------------ *) PROCEDURE Change3DIcon; BEGIN NewVal(Mode3D, 0, 1); NewIcon(RSCindices.polyoptn, RSCindices.pyramid + Mode3D); END Change3DIcon; (* ------------------------------------------------------------ *) PROCEDURE ChangeLinetypeIcon; BEGIN NewVal(EpicLinestyle, 0, 3); NewIcon(RSCindices.epioptn, RSCindices.epiline + EpicLinestyle); Epic.SetLineType(VAL(LineType, EpicLinestyle)); END ChangeLinetypeIcon; (* ------------------------------------------------------------ *) PROCEDURE ChangeArrowIcon; BEGIN NewVal(Arrowstyle, 0, 3); NewIcon(RSCindices.arrowopt, RSCindices.arrow1 + Arrowstyle); Epic.SetArrows(Arrowstyle MOD 2 = 1, Arrowstyle DIV 2 = 1); END ChangeArrowIcon; (* ------------------------------------------------------------ *) PROCEDURE MouseState(VAR MoX, MoY : INTEGER; VAR MoBut : BITSET); VAR keystate : BITSET; BEGIN GetMKState(MoX, MoY, MoBut, keystate); SHIFT := (MagicAES.KLSHIFT IN keystate) OR (MagicAES.KRSHIFT IN BITSET(keystate)); CTRL := (MagicAES.KCTRL IN keystate); ALTER := (MagicAES.KALT IN keystate); END MouseState; (* ------------------------------------------------------------ *) (* --------- Darstellung der Objekte ---------- *) (* ------------------------------------------------------------ *) PROCEDURE GetMinMax(global : BOOLEAN; VAR minx, miny, maxx, maxy : INTEGER); VAR ob : ObjectPtrTyp; BEGIN IF global THEN minx := FirstObject^.Code[1] (* = 0 *); maxx := FirstObject^.Code[3]; miny := FirstObject^.Code[2] (* = 0 *); maxy := FirstObject^.Code[4]; ELSE minx := 0; miny := 0; maxx := 0; maxy := 0; END; ob := FirstObject^.Next; WHILE ob<>NIL DO IF ob^.Surround[0]maxx THEN maxx := ob^.Surround[0] + ob^.Surround[2]; END; IF ob^.Surround[1]>maxy THEN maxy := ob^.Surround[1]; END; IF ob^.Surround[1]+ob^.Surround[3]0 THEN sy := -sy; END; (* Umgekehrte Achse *) sx := sx + 500; sy := sy + 500; WinUtils.SetSliderPos(WindowHandle , sx, sy); END SetSliderPos; (* ---------------------------- *) PROCEDURE ZeroVal(x, y : INTEGER); VAR oldx, oldy : INTEGER; BEGIN (** RTD.Message('Into ZeroVal'); **) oldx := ZeroX; oldy := ZeroY; ZeroX := x; IF ZeroX > +30000 THEN ZeroX := +30000; END; IF ZeroX < -30000 THEN ZeroX := -30000; END; ZeroY := y; IF ZeroY > +30000 THEN ZeroY := +30000; END; IF ZeroY < -30000 THEN ZeroY := -30000; END; (** RTD.ShowVar('ZeroX', ZeroX); RTD.ShowVar('ZeroY', ZeroY); **) SetSliderPos(ZeroX, ZeroY); (** RTD.Message('Now Redraw'); RTD.SetDevice(RTD.printer); **) Redraw (0, 0, 30000, 30000); (** RTD.Message('Exit ZeroVal'); **) END ZeroVal; PROCEDURE UndoZoom; BEGIN ZoomMode(FALSE, 1.0); IF zoommode THEN ZeroVal(ZStorex, ZStorey); ELSE ZeroVal(ZeroX, ZeroY); END; zoommode := FALSE; ChangeCheck(RSCindices.overview, TRUE); END UndoZoom; PROCEDURE MakeZoom; VAR xm, ym, XM, YM, xs, ys : INTEGER; tmp : ARRAY [0..3] OF INTEGER; relx, rely : INTEGER; adjustx : BOOLEAN; factor : LONGREAL; zx, zy : INTEGER; BEGIN (** RTD.Message('Into MakeZoom'); **) IF FirstObject^.Next<>NIL THEN xm := ZeroX; ym := ZeroY; (** RTD.ShowVar('ZoomDenom', ZoomDenominator); RTD.ShowVar('ZoomNumer', ZoomNumerator); **) IF (ZoomDenominator>0) AND (ZoomNumerator>0) THEN factor := MathLib0.real(ZoomNumerator) / MathLib0.real(ZoomDenominator); ELSE GetMinMax(TRUE, xm, ym, XM, YM); WinUtils.GetWinSize(WindowHandle, tmp); xs := tmp[2]; ys := tmp[3]; relx := (XM - xm) DIV xs; rely := (YM - ym) DIV ys; IF relx=rely THEN adjustx := ((XM - xm) MOD xs) > ((YM - ym) MOD ys); ELSE adjustx := relx > rely; END; IF adjustx THEN factor := MathLib0.real(xs) / MathLib0.real(XM - xm); ELSE factor := MathLib0.real(ys) / MathLib0.real(YM - ym); END; END; (** RTD.ShowVar('factor', factor); **) IF factor>0.0 THEN ZStorex := ZeroX; ZStorey := ZeroY; ZoomMode(TRUE, factor); zoommode := TRUE; (* Muž noch korrigiert werden !! *) relx := xm; rely := ym; ChangeCheck(RSCindices.overview, FALSE); ZeroVal(relx, rely); END; END; (** RTD.Message('Leaving MakeZoom'); **) END MakeZoom; PROCEDURE Overview; BEGIN IF NOT zoommode THEN MakeZoom; ELSE UndoZoom; END; END Overview; PROCEDURE DeleteAll (all : BOOLEAN) ; VAR prev, nxt: ObjectPtrTyp ; but : INTEGER ; alertstr : ARRAY [0..255] OF CHAR; BEGIN IF (FirstObject^.Next<>NIL) AND (all OR (SelObs(TRUE)>0)) THEN IF all THEN mtAlerts.SetIcon(mtAlerts.Trash); (** MagicStrings.Assign(DeleteStr1, alertstr); MagicStrings.Append(DeleteStr2, alertstr); but := Diverses.Alert (1 , alertstr) ; **) but := Diverses.NumAlert(18, 1); (* Verblffenderweise wird 0, 1 und 2 zurckgeliefert, statt 1, 2 und 3. Aber was soll's ? *) IF (but = 0) OR (but = 1) THEN Undo.PrepareUndo(TRUE); DeleteWholeTree; IF but = 1 THEN (* Neue Zeichnung *) MenuItemStatus (RSCindices.msave , FALSE) ; FileName := ''; FirstObject^.Code[3] := DefaultWidth; FirstObject^.Code[4] := DefaultHeight; FirstObject^.Code[6] := DefaultUnit; FirstObject^.Code[7] := DefaultRes; END; ZStorex := 0; ZStorey := 0; UndoZoom; END; ELSE ShowSelection(TRUE); DeleteSelection; ShowSelection(FALSE); (** Redraw (0, 0, 30000, 30000); **) END; EnableSelectMenus(SelObs(TRUE)>0); EnableCompileMenus(FirstObject^.Next<>NIL); END; END DeleteAll ; (*------------------------------------------------------------------------*) (* Programmende *) (*------------------------------------------------------------------------*) PROCEDURE Quit () ; VAR but : INTEGER ; BEGIN (** but :=Diverses.Alert (1 , ExitStr) ; **) but := Diverses.NumAlert(17, 1); IF but = 1 THEN (* Should be 1 *) MagicAES.WindClose (WindowHandle) ; MagicAES.WindDelete (WindowHandle) ; End := TRUE ; END; END Quit ; (*------------------------------------------------------------------------*) (* Hilfestellungen *) (*------------------------------------------------------------------------*) PROCEDURE ShowHelp (Draw : INTEGER) ; BEGIN IF WinUtils.IsWinTop(WindowHandle) THEN HelpForIcon(Draw, FillState, TextMode, FontMode, TRUE); END; END (* of *) ShowHelp ; (*------------------------------------------------------------------------*) (* Verzweigung zu den einzelnen Prozeduren *) (*------------------------------------------------------------------------*) PROCEDURE NowText (lastobj : ObjectPtrTyp); VAR xy : ARRAY [0..3] OF INTEGER; i, j, len : INTEGER; align : INTEGER; str : ARRAY [0..127] OF CHAR; code : CodeAryTyp; BEGIN IF AddText AND ObjectCreated THEN FOR i:= 0 TO 9 DO code[i] := 0; END; FatherXOffset := 0; FatherYOffset := 0; PicToPix(xy[0], xy[1], LastObject^.Surround[0], LastObject^.Surround[1]); xy[2] := LastObject^.Surround[2]; xy[3] := LastObject^.Surround[3]; code[0] := ORD(Framebox); code[1] := LastObject^.Surround[0]; code[2] := LastObject^.Surround[1] - LastObject^.Surround[3]; code[3] := LastObject^.Surround[2]; code[4] := LastObject^.Surround[3]; code[5] := ORD(TextPosition) ; code[6] := 1 ; (* Flag fr Makebox *) code[8] := LineWidth ; str := ''; len := 0; (* Arbeitet mit linkem oberem Punkt *) TextBox.MakeDialog(str, len, align, ORD(TextPosition), xy); code [ 7 ] := align; code [ 9 ] := len ; IF len>0 THEN FOR i:=0 TO 3 DO xy[i] := LastObject^.Surround[i]; END; NewObject(code, ADR(str), NIL, xy); MergeToSubpic(lastobj, code[1], code[2], code[3], code[4]); END; END; END NowText; (*------------------------------------------------------------------------*) (* Eigentlicher Aufruf der Zeichenoperationen *) (*------------------------------------------------------------------------*) PROCEDURE RightMouse (VAR Draw : INTEGER) ; VAR but, dum : INTEGER; topwin : INTEGER; mkey : BITSET; BEGIN IF WinUtils.IsWinTop(WindowHandle) THEN CASE Draw OF (** RSCindices.bezier : | RSCindices.bezielli : | RSCindices.oval : | **) RSCindices.ellipse, RSCindices.framebox, RSCindices.circle : ChangeFillStatusIcon; | RSCindices.dashbox, (* RSCindices.line, RSCindices.arrow, *) RSCindices.epigrid : ChangeWidthIcon; | RSCindices.polyfigr, RSCindices.polygon : ChangeMarkerStatusIcon; | RSCindices.text : ChangeTextposIcon; | RSCindices.select : DeselectIcon(Draw); Draw := RSCindices.move; SelectIcon(Draw); | RSCindices.move : DeselectIcon(Draw); Draw := RSCindices.copy; SelectIcon(Draw); | RSCindices.copy : DeselectIcon(Draw); Draw := RSCindices.select; SelectIcon(Draw); | ELSE END; REPEAT MouseState(dum, dum, mkey); UNTIL NOT ((MagicAES.MouseLeft IN mkey) OR (MagicAES.MouseRight IN mkey)); but := MagicVDI.SetWritemode (mtAppl.VDIHandle , MagicVDI.REPLACE) ; END; END (* of *) RightMouse ; PROCEDURE DrawIt (Draw : INTEGER) ; VAR but, dum : INTEGER; topwin : INTEGER; mkey : BITSET; lastobj : ObjectPtrTyp; BEGIN IF WinUtils.IsWinTop(WindowHandle) THEN ObjectCreated := FALSE; lastobj := LastObject; CASE Draw OF RSCindices.select : Select() ; EnableSelectMenus(SelObs(TRUE)>0); | RSCindices.move : Move () ; | RSCindices.copy : Copy () ; | RSCindices.bezier : Bezier.BezierCurve () ; NowText(lastobj); | (* JP *) RSCindices.bezielli : Bezier.BezierEllipse () ; NowText(lastobj); | (* JP *) RSCindices.polygon, RSCindices.episolid, RSCindices.polyfigr : IF Draw = RSCindices.episolid THEN Epic.SetLineMode(polyline); ELSE Epic.SetLineMode(polygon); END; IF Draw = RSCindices.polyfigr THEN IF Mode3D = 0 THEN Epic.SetDrawMode(pyramid); ELSE Epic.SetDrawMode(extrude); END; ELSE Epic.SetDrawMode(flat); END; Epic.DoLine(); (** CASE EpicLinestyle OF 1: Epic.DottedLine (); | 2: Epic.DashedLine (); | ELSE (* 0 *) Epic.SolidLine (); END; **) NowText(lastobj); | RSCindices.epigrid : Epic.Grid () ; NowText(lastobj); | RSCindices.text : TextBox.SetVectorText(FontMode=1); CASE TextMode OF 0: TextBox.BoxText () ; | 1: TextBox.FrameText () ; | 2: TextBox.DashText () ; | 3: TextBox.Text () ; | ELSE END; | RSCindices.dashbox : TextBox.DashBox () ; | RSCindices.framebox : IF FillState=0 THEN TextBox.FrameBox () ; ELSE TextBox.FilledBox (FillState - 1) ; IF ObjectCreated AND (FillState>1) THEN FillObject(FillState-1, LastObject); END; END; NowText(lastobj); | RSCindices.oval : TextBox.OvalBox () ; NowText(lastobj); | RSCindices.arc : Circles.Arc () ; NowText(lastobj); | RSCindices.ellarc : Circles.EllArc () ; NowText(lastobj); | RSCindices.ellipse : Circles.Ellipse (FillState) ; IF ObjectCreated AND (FillState>1) THEN FillObject(FillState-1, LastObject); END; NowText(lastobj); | RSCindices.circle : IF FillState=0 THEN Circles.Circle () ; ELSE Circles.Disk (FillState) ; IF ObjectCreated AND (FillState>1) THEN FillObject(FillState-1, LastObject); END; END; NowText(lastobj); | (** RSCindices.line : Lines.Line () ; | RSCindices.arrow : Lines.Arrow () ; | **) ELSE END; REPEAT MouseState(dum, dum, mkey); UNTIL NOT ((MagicAES.MouseLeft IN mkey) OR (MagicAES.MouseRight IN mkey)); but := MagicVDI.SetWritemode (mtAppl.VDIHandle , MagicVDI.REPLACE) ; END; END (* of *) DrawIt ; (* ---------------------------- *) PROCEDURE LoadOrSave(load : BOOLEAN; type : INTEGER); VAR res : BOOLEAN; arr : ARRAY [0..3] OF INTEGER; BEGIN res := FALSE; CASE type OF 1 : IF load THEN Undo.PrepareUndo(TRUE); res := Load(); ELSE Save(); END; | 2 : IF load THEN Undo.PrepareUndo(TRUE); Merge(FALSE); ELSE res := SaveAs(FALSE); END; | 3 : IF load THEN Undo.PrepareUndo(TRUE); DeselectTree(FirstObject); Merge(TRUE); ELSE res := SaveAs(TRUE); END; | ELSE END; IF res THEN MenuItemStatus (RSCindices.msave , TRUE) ; IF load AND (type=1) THEN ZeroX := 0; ZeroY := 0; SetSliderPos(ZeroX, ZeroY); END; END; CheckConsistency; WinUtils.SetWinTitle(WindowHandle, FileName); WinUtils.SetWinTop (WindowHandle); EnableSelectMenus(SelObs(TRUE)>0); UndoZoom; (* Update des Fensters *) IgnoreRedraw := TRUE; (** ChangeDrawArea (0, 0); **) END LoadOrSave; (* ---------------------------- *) PROCEDURE SelectAll(All : BOOLEAN); BEGIN IF FirstObject^.Next<>NIL THEN Undo.PrepareUndo(TRUE); ShowSelectRects; (* delete old *) IF All THEN SelectTree(FirstObject); ELSE DeselectTree(FirstObject); END; ShowSelectRects; (* draw new *) EnableSelectMenus(All); END; END SelectAll; (* ---------------------------- *) PROCEDURE SelectInvert; BEGIN Undo.PrepareUndo(TRUE); ShowSelectRects; InvertSelection; ShowSelectRects; EnableSelectMenus(SelObs(TRUE)>0); END SelectInvert; PROCEDURE ChangeVisible(Flag, action : INTEGER); VAR newval : INTEGER; PROCEDURE ChangeVisArea(dx, dy : INTEGER); BEGIN ZeroVal(ZeroX + PicDistance(dx), ZeroY + PicDistance(dy)); END ChangeVisArea; BEGIN CASE Flag OF 1: (* Arrowed *) (* Inhalt von action: 0=pageup, 1=pagedown, 2=rowup, 3=rowdown, 4=pageleft, 5=pageright, 6=colleft, 7=colright *) CASE action OF 0 : ChangeVisArea(0, +5 * YSliders * InternalResolution); | 1 : ChangeVisArea(0, -5 * YSliders * InternalResolution); | 2 : ChangeVisArea(0, +1 * YSliders * InternalResolution); | 3 : ChangeVisArea(0, -1 * YSliders * InternalResolution); | 4 : ChangeVisArea(-5 * XSliders * InternalResolution, 0); | 5 : ChangeVisArea(+5 * XSliders * InternalResolution, 0); | 6 : ChangeVisArea(-1 * XSliders * InternalResolution, 0); | 7 : ChangeVisArea(+1 * XSliders * InternalResolution, 0); | ELSE END; | (* OK, wir erlauben nur einen Zeichenbereich von -30000 bis +30000 *) 2: (* HorSlide *) newval := action - 500; ZeroVal(60 * newval, ZeroY); (* 60 ist 30000 DIV 500 *) (* Inhalt von action : SliderPos *) | 3: (* VertSlide *) newval := action - 500; ZeroVal(ZeroX, -60 * newval); (* 60 ist 30000 DIV 500 *) (* Verkehrte Achsen !! *) (* Inhalt von action : SliderPos *) | ELSE END; END ChangeVisible; PROCEDURE ChangeUnitlen; VAR but, oldfak, oldunit, newfak, newunit : INTEGER; zoom : BOOLEAN; changefak : LONGREAL; txt : ARRAY [0..255] OF CHAR; BEGIN oldunit := FirstObject^.Code[6] MOD 0100H; oldfak := FirstObject^.Code[6] DIV 0100H; IF GetUnitLength(newfak, newunit, zoom) THEN (* Bevor wir jetzt den Wert einsetzen, sehen wir erst einmal nach, ob nicht etwa Kreise oder Kreisabschnitte vorhanden sind. *) IF zoom AND ((oldunit<>newunit) OR (oldfak<>newfak)) THEN IF oldunit = newunit THEN changefak := 1.0; ELSE CASE oldunit OF 0 : (* mm *) changefak := 186467.0; | 1 : (* cm *) changefak := 1864679.0; | 2 : (* pt *) changefak := 65536.0; | 3 : (* pc *) changefak := 786432.0; | 4 : (* in *) changefak := 4736286.0; | 5 : (* bp *) changefak := 65781.0; | 6 : (* dd *) changefak := 70124.0; | 7 : (* cc *) changefak := 841489.0; | 8 : (* sp *) changefak := 1.0; | 9 : (* pp *) changefak := 4736286.0 / 300.0; | (* 300 dpi *) 10 : (* em *) changefak := 655361.0; | (* 10pt *) (** 10 : (* em *) changefak := 717621.0; | (* 11pt *) 10 : (* em *) changefak := 770040.0; | (* 12pt *) **) 11 : (* ex *) changefak := 282168.0; | (* 10pt *) (** 11 : (* ex *) changefak := 308974.0; | (* 11pt *) 11 : (* ex *) changefak := 338603.0; | (* 12pt *) **) ELSE (* mm *) changefak := 186467.0; (* sollte nie vorkommen *) END; CASE newunit OF 0 : (* mm *) changefak := 186467.0 / changefak; | 1 : (* cm *) changefak := 1864679.0 / changefak; | 2 : (* pt *) changefak := 65536.0 / changefak; | 3 : (* pc *) changefak := 786432.0 / changefak; | 4 : (* in *) changefak := 4736286.0 / changefak; | 5 : (* bp *) changefak := 65781.0 / changefak; | 6 : (* dd *) changefak := 70124.0 / changefak; | 7 : (* cc *) changefak := 841489.0 / changefak; | 8 : (* sp *) changefak := 1.0 / changefak; | 9 : (* pp *) changefak := (4736286.0 / 300.0) / changefak; | (* 300 dpi *) 10 : (* em *) changefak := 655361.0 / changefak; | (* 10pt *) (** 10 : (* em *) changefak := 717621.0 / changefak; | (* 11pt *) 10 : (* em *) changefak := 770040.0 / changefak; | (* 12pt *) **) 11 : (* ex *) changefak := 282168.0 / changefak; | (* 10pt *) (** 11 : (* ex *) changefak := 308974.0 / changefak; | (* 11pt *) 11 : (* ex *) changefak := 338603.0 / changefak; | (* 12pt *) **) ELSE (* mm *) changefak := 186467.0 / changefak; (* sollte nie vorkommen *) END; END; IF oldfak<>newfak THEN CASE oldfak OF 0 : (* x 1 *) | 1 : (* x 1/10 *) changefak := changefak / 10.0; | 2 : (* x 10 *) changefak := changefak * 10.0; | 3 : (* x 1/100 *) changefak := changefak / 100.0; | 4 : (* x 100 *) changefak := changefak * 100.0; | ELSE (* sollte nicht vorkommen *) END; CASE newfak OF 0 : (* x 1 *) | 1 : (* x 1/10 *) changefak := changefak * 10.0; | 2 : (* x 10 *) changefak := changefak / 10.0; | 3 : (* x 1/100 *) changefak := changefak * 100.0; | 4 : (* x 100 *) changefak := changefak / 100.0; | ELSE (* sollte nicht vorkommen *) END; END; IF ABS(changefak-1.0) > 1.0E-3 THEN Undo.PrepareUndo(TRUE); ChangeAll(changefak, changefak, 0, 0); END; FirstObject^.Code[6] := newunit + 0100H * newfak; FirstObject^.Code[3] := MagicSys.CastToInt(MathLib0.entier(changefak * MathLib0.real(FirstObject^.Code[3]) + 0.5)); FirstObject^.Code[4] := MagicSys.CastToInt(MathLib0.entier(changefak * MathLib0.real(FirstObject^.Code[4]) + 0.5)); Redraw(0, 0, 30000, 30000); ELSE IF ObjectExist(ObjectSet{Circle, Disk, Oval, Ovalbox}) THEN mtAlerts.SetIcon(mtAlerts.Graphic); but := Diverses.NumAlert(20, 2); IF but=1 THEN FirstObject^.Code[6] := newunit + 0100H * newfak; Redraw(0, 0, 30000, 30000); END; ELSE FirstObject^.Code[6] := newunit + 0100H * newfak; Redraw(0,0,10,10); END; END; END; END ChangeUnitlen; PROCEDURE Poly2Spline; BEGIN END Poly2Spline; (*------------------------------------------------------------------------*) PROCEDURE KillBlanks(VAR path : ARRAY OF CHAR); VAR i : INTEGER; BEGIN (** So wird's nicht mehr so fehlertr„chtig i := 0; WHILE (path[i]=' ') DO INC(i); END; IF (i>0) THEN MagicStrings.Delete(path, 0, i); END; **) i := 0; WHILE path[i]<>0C DO IF path[i]=' ' THEN path[i] := 0C; ELSE INC(i); END; END; END KillBlanks; PROCEDURE LoadExtensions; VAR i, Handle : INTEGER; str : ARRAY [0..255] OF CHAR; BEGIN IF FileExists(ExtensFile) THEN BusyStart(ExtensFile, FALSE); Reset(Handle, ExtensFile); i := 0; WHILE NOT EOF AND (i0C THEN MagicStrings.Assign(str, Extensions[i]); END; END; Close(Handle); BusyEnd; END; END LoadExtensions; PROCEDURE LoadPrefs; VAR File, i, j : INTEGER; temp : ARRAY [0..255] OF CHAR; compare : ARRAY [0..79] OF CHAR; ok : BOOLEAN; PROCEDURE FixPath(VAR path : ARRAY OF CHAR); VAR Slash : ARRAY [0..1] OF CHAR; i : INTEGER; drv, stddrv : CARDINAL; dummy : MagicSys.lBITSET; std, test : ARRAY [0..255] OF CHAR; BEGIN StdPath(std); (** RTD.Write('p[IN]', path); RTD.Write('std ', std); **) Slash := '\'; KillBlanks(path); (** RTD.Write('p[KB]', path); **) i := 0; WHILE (path[i]<>0C) DO INC(i); END; IF i>0 THEN IF NOT ((path[i-1]=':') OR (path[i-1]='\')) THEN MagicStrings.Append(Slash, path); END; (* Jetzt berprfe, ob der angegebene Pfad berhaupt existiert *) MagicStrings.Assign(path, test); MagicStrings.Append('*.*', test); (** RTD.Write('test', test); **) IF NOT FileExists(test) THEN path[0] := 0C; END; END; IF path[0] = 0C THEN MagicStrings.Assign(std, path); END; (* Um relative Angaben aufzul”sen, wechseln wir auf angegebenen Pfad *) (* Zun„chst aber: gibt es Laufwerksangabe ? *) stddrv := MagicDOS.Dgetdrv(); IF (path[0]<>0C) AND (path[1]=':') THEN IF (path[0]>='a') AND (path[0]<='z') THEN drv := ORD(path[0]) - ORD('a'); ELSIF (path[0]>='A') AND (path[0]<='Z') THEN drv := ORD(path[0]) - ORD('A'); ELSE drv := stddrv; END; ELSE drv := stddrv; END; (** RTD.ShowVar('stddrv', stddrv); RTD.ShowVar('drv', drv); **) IF drv<>stddrv THEN (** RTD.Message('SetDrive ...'); **) MagicDOS.Dsetdrv (drv, dummy); (** RTD.Message('SetDrive ready'); **) END; (** MagicStrings.Assign(path, test); IF (test[1] = ':') AND (test[0]<>0C) THEN MagicStrings.Delete(test, 0, 2); END; RTD.Write('WO Drive', test); RTD.Message('SetTestPath ...'); i := MagicDOS.Dsetpath(test); RTD.Message('SetTestPath ready'); StdPath(path); RTD.Write('WO Drive Path', test); **) (** RTD.Message('SetPath ...'); **) i := MagicDOS.Dsetpath(path); (** RTD.Message('SetPath ready'); **) StdPath(path); IF drv<>stddrv THEN MagicDOS.Dsetdrv (stddrv, dummy); END; i := MagicDOS.Dsetpath(std); END FixPath; PROCEDURE GetNum(VAR num : INTEGER); VAR okay : BOOLEAN; i, res : INTEGER; BEGIN IF NOT EOF THEN temp := ''; ReadLn(File, temp); KillBlanks(temp); i := 0; okay := TRUE; WHILE okay AND (temp[i]<>0C) DO IF (temp[i]<>'+') AND ((temp[i]<'0') OR (temp[i]>'9')) THEN okay := FALSE; ELSE INC(i); END; END; IF okay AND (i>0) THEN res := MagicConvert.StrToInt(temp); (* Nur echt positive Angaben erlaubt *) IF res>=0 THEN num := res; END; END; END; END GetNum; PROCEDURE GetNoZero(VAR num : INTEGER); VAR i : INTEGER; BEGIN GetNum(i); IF i<>0 THEN num := i; END; END GetNoZero; PROCEDURE GetBool(VAR bool : BOOLEAN); VAR okay : BOOLEAN; i, res : INTEGER; BEGIN IF NOT EOF THEN temp := ''; ReadLn(File, temp); KillBlanks(temp); bool := (temp[0] = 'T') OR (temp[0]='t'); END; END GetBool; PROCEDURE GetPath(VAR path : ARRAY OF CHAR); BEGIN IF NOT EOF THEN ReadLn(File, path); FixPath(path); END; END GetPath; BEGIN IF FileExists(InfoFile) THEN BusyStart(InfoFile, FALSE); Reset(File, InfoFile); (* RTD.Message('Start read'); *) IF NOT EOF THEN ReadLn(File, temp); KillBlanks(temp); ok := TRUE; MagicStrings.Assign(InfoID, compare); FOR i:=0 TO 4 DO IF temp[i]<>compare[i] THEN ok := FALSE; END; END; IF ok THEN GetPath(LTDPath); GetPath(LaTeXPath); GetPath(PiCTeXPath); GetPath(MetaPath); GetPath(IMGPath); GetPath(STADPath); GetPath(TeXPath); GetPath(HPGLPath); GetPath(FontPath); GetPath(GFPKPath); GetPath(GEMPath); GetPath(PostPath); GetPath(FIGPath); GetPath(HelpPath); GetPath(CSGPath); GetPath(IncludePath); GetBool(Diverses.DialCentered); GetBool(WholeArea); GetBool(OwnHPGLFont); GetBool(LimitedDisk); GetBool(UseUndo); GetBool(ShowBezLine); GetNoZero(InternalResolution); FirstObject^.Code[7] := InternalResolution; GetNum(FirstObject^.Code[6]); (* Unitlen *) GetNoZero(FirstObject^.Code[3]); (* Xsize *) GetNoZero(FirstObject^.Code[4]); (* Ysize *) GetNoZero(MetaLThin); (* LineThickness Metafont (thin) *) GetNoZero(MetaLThick); (* LineThickness Metafont (thick) *) GetNoZero(MetaLVThick); (* LineThickness Metafont (vthick) *) GetNoZero(MetaPAscii); (* MetaAscii *) MetaPAscii := MetaPAscii MOD 256; (* Picture-Code Metafont *) GetNoZero(SnapX); (* SnapX *) GetNoZero(SnapY); (* SnapY *) GetNum(i); (* Special-Set *) IF (i>=0) AND (ORD(i)<=ORD(emtex)) THEN Usespecial := VAL(LatexSpecials, i); END; GetBool(ThinCrossMouse); ELSE mtAlerts.SetIcon(mtAlerts.Bomb); (** i := Diverses.Alert(1, InfFileCorrupt); **) i := Diverses.NumAlert(16, 1); END; END; Close(File); BusyEnd; END; END LoadPrefs; PROCEDURE SavePrefs; VAR File : INTEGER; PROCEDURE WriteText(pth, txt : ARRAY OF CHAR); VAR Line : ARRAY [0..255] OF CHAR; len, i : INTEGER; BEGIN MagicStrings.Assign(pth, Line); len := MagicStrings.Length(Line); i := len; WHILE i<60 DO Line[i] := ' '; INC(i, 1); END; Line[i] := ' '; Line[i+1] := 0C; MagicStrings.Append(txt, Line); WriteLn(File, Line); END WriteText; PROCEDURE WritePath(pth, txt : ARRAY OF CHAR); VAR Line : ARRAY [0..255] OF CHAR; null : ARRAY [0..1] OF CHAR; len, i : INTEGER; BEGIN null := ''; MagicStrings.Assign(pth, Line); ReplaceFilename(Line, null); IF Line[0]=0C THEN StdPath(Line); END; WriteText(Line, txt); END WritePath; PROCEDURE WriteBool(Bool : BOOLEAN; txt : ARRAY OF CHAR); BEGIN IF Bool THEN WriteText('TRUE', txt); ELSE WriteText('FALSE', txt); END; END WriteBool; PROCEDURE WriteNum(num : INTEGER; txt : ARRAY OF CHAR); VAR temp : ARRAY [0..127] OF CHAR; BEGIN NumberToStr(num, temp); WriteText(temp, txt); END WriteNum; BEGIN Rewrite(File, InfoFile); WriteLn(File, InfoID); WritePath(LTDPath, 'PicturePath'); WritePath(LaTeXPath, 'LaTeXPath'); WritePath(PiCTeXPath, 'PiCTeXPath'); WritePath(MetaPath, 'MetaPath'); WritePath(IMGPath, 'IMGPath'); WritePath(STADPath, 'STADPath'); WritePath(TeXPath, 'TeXPath'); WritePath(HPGLPath, 'HPGLPath'); WritePath(FontPath, 'FontPath'); WritePath(GFPKPath, 'GFPKPath'); WritePath(GEMPath, 'GEMPath'); WritePath(PostPath, 'PSPath'); WritePath(FIGPath, 'FIGPath'); WritePath(HelpPath, 'HelpPath'); WritePath(CSGPath, 'CSGPath'); WritePath(IncludePath, 'IncludePath'); WriteBool(Diverses.DialCentered, 'DialCentered'); WriteBool(WholeArea, 'WholeArea'); WriteBool(OwnHPGLFont, 'HPGLFont'); WriteBool(LimitedDisk, 'LimitedDisk'); WriteBool(UseUndo, 'UseUndo'); WriteBool(ShowBezLine, 'BeziLine'); (* Jetzt diverse Zahlenwerte *) WriteNum (InternalResolution, 'InternalRes'); WriteNum(FirstObject^.Code[6], 'Unitlength'); WriteNum(FirstObject^.Code[3], 'XSize'); WriteNum(FirstObject^.Code[4], 'YSize'); WriteNum(MetaLThin, 'MetaThin'); WriteNum(MetaLThick, 'MetaThick'); WriteNum(MetaLVThick,'MetaVThick'); WriteNum(MetaPAscii, 'MetaAscii'); WriteNum(SnapX, 'SnapX'); WriteNum(SnapY, 'SnapY'); WriteNum(ORD(Usespecial), 'SpecialSet'); WriteBool(ThinCrossMouse, 'CrossMouse'); Close(File); END SavePrefs; PROCEDURE LoadFonts; VAR ok : BOOLEAN; File : INTEGER; dummy : INTEGER; count : INTEGER; names : ARRAY [1..VectorFont.MaxFonts],[0..127] OF CHAR; PROCEDURE LoadEm(txt : ARRAY OF CHAR); VAR dummy : BOOLEAN; fontname : ARRAY [0..255] OF CHAR; i, handle : INTEGER; BEGIN dummy := FALSE; i := 0; (* Explizite Pfad-Angabe *) WHILE (txt[i]<>0C) DO IF txt[i]='\' THEN dummy := TRUE; END; INC(i); END; IF (FontPath[0]=0C) OR dummy THEN MagicStrings.Assign(txt, fontname); ELSE MagicStrings.Assign(FontPath, fontname); MagicStrings.Append(txt, fontname); END; IF FileExists(fontname) THEN dummy := VectorFont.LoadFont(fontname, handle); ELSE (* Vielleicht in diesem Verzeichnis ? *) IF FontPath[0]=0C THEN MagicStrings.Assign(txt, fontname); IF FileExists(fontname) THEN dummy := VectorFont.LoadFont(fontname, handle); END; END; END; END LoadEm; BEGIN IF FileExists(FontFile) THEN BusyStart(FontFile, FALSE); Reset(File, FontFile); ok := TRUE; dummy := 0; WHILE ok DO ok := NOT EOF; IF ok THEN INC(dummy); ReadLn(File, names[dummy]); KillBlanks(names[dummy]); ok := names[dummy,0]<>0C; IF ok THEN ok := dummy0 THEN CurrentVectorFont := 1; ELSE CurrentVectorFont := 0; MenuItemStatus(RSCindices.repltext, FALSE); OwnHPGLFont := TRUE; InvertFlag(OwnHPGLFont, RSCindices.repltext); END; END LoadFonts; (*------------------------------------------------------------------------*) (* Hauptprozedur fr Ereignisse *) (*------------------------------------------------------------------------*) PROCEDURE ProcessMenu(Item : INTEGER); VAR oldx, oldy, but, oldres, i, j, minx, maxx, miny, maxy, x0, y0, w, h : INTEGER; xmal, ymal : LONGREAL; flag : BOOLEAN; txt : ARRAY [0..255] OF CHAR; source : sourceformat; target : targetformat; BEGIN CASE Item OF RSCindices.minfo : Info (VerTxt) ; | RSCindices.mload : LoadOrSave(TRUE, 1); | RSCindices.mmerge : LoadOrSave(TRUE, 2); | RSCindices.mauswlod : LoadOrSave(TRUE, 3); | RSCindices.mimport : but := ChooseImport(); IF but>=0 THEN IF but = 0 THEN Parse.DoIt(); (* LaTeX *) ELSE CASE but OF 1 : flag := HPGL.DoIt(); | 2 : flag := FIG.ReadIt(); | 3 : flag := ImportCSspecial(); | 4 : flag := FALSE; | (* GEM-Metafile *) ELSE flag := FALSE; END; IF flag THEN (** RTD.Message('Immediate Redraw'); **) CheckConsistency; Redraw(0, 0, 30000, 30000); (** RTD.Message('Now GetMinMax'); **) GetMinMax(FALSE, minx, miny, maxx, maxy); (** RTD.ShowVar('minx', minx); RTD.ShowVar('maxx', maxx); RTD.ShowVar('miny', miny); RTD.ShowVar('maxy', maxy); **) IF maxx > 0 THEN FirstObject^.Code[3] := maxx; END; IF maxy > 0 THEN FirstObject^.Code[4] := maxy; END; MenuItemStatus (RSCindices.msave , FALSE) ; END; END; (** RTD.Message('Import ready'); **) ChangeDrawArea(0, 0); DoOwnRedraw; END;| RSCindices.msave : LoadOrSave(FALSE, 1); | RSCindices.msaveas : LoadOrSave(FALSE, 2); | RSCindices.mauswsav : LoadOrSave(FALSE, 3); | RSCindices.mcompile : but := ChooseExport(flag); IF but>=0 THEN CheckConsistency; CASE but OF 0: (* LaTeX *) Compile.Do (flag, FALSE) ; | 1: Pictex.Do (flag) ; | 2: (* Metafont *) IF TextInPic() THEN mtAlerts.SetIcon(mtAlerts.Graphic); (** but := Diverses.Alert (1 , MetaSpecialStr) ; **) but := Diverses.NumAlert(19, 1); IF but=1 THEN Compile.Do(FALSE, TRUE); END; END; Metafont.Do(); | 3: (* FIG *) FIG.WriteIt(); | 4: (* PostScript *)| ELSE END; DoOwnRedraw; END;| RSCindices.mquit : Quit () ; | RSCindices.mauswall, RSCindices.mawnone : SelectAll(Item = RSCindices.mauswall); | RSCindices.mawinv : SelectInvert; | RSCindices.mawsize : ChangeObjSize(xmal, ymal); IF (xmal<>0.0) OR (ymal<>0.0) THEN (* Jetzt bestimme den Fixpunkt (=linke untere Ecke) *) getsurround(x0, y0, w, h); ChangeIt(xmal, ymal, x0, y0); Redraw(0, 0, 30000, 30000); END; | RSCindices.mawfront : BringSelectionFront; | RSCindices.mawback : BringSelectionBack; | RSCindices.madjust : IF AdjustIt(flag, i, j) THEN ShowSelection(TRUE); AdjustSelection(i, j, flag); ShowSelection(FALSE); END; | RSCindices.ply2spl : Poly2Spline; | RSCindices.plysplit : SplitLines; | RSCindices.plymerge : MergeLines; | RSCindices.munitlen : ChangeUnitlen; | RSCindices.mmetaopt : SetMetaOptions; | RSCindices.msystem : oldres := InternalResolution; SetSystem(flag); IF oldres<>InternalResolution THEN IF ObjectExist( ObjectSet{Circle, Disk, Oval, Ovalbox}) THEN mtAlerts.SetIcon(mtAlerts.Graphic); (** MagicStrings.Assign(DiskText1, txt); MagicStrings.Append(DiskText3, txt); but := Diverses.Alert(2, txt); **) but := Diverses.NumAlert(21, 2); IF but=2 THEN InternalResolution := oldres; FirstObject^.Code[7] := oldres; END; END; END; IF flag THEN SavePrefs; END; Redraw(0, 0, 10, 10); | RSCindices.wholepic : InvertAreaStatus; | RSCindices.diskoptn : InvertFlag(LimitedDisk, RSCindices.diskoptn); | RSCindices.beziline : InvertFlag(ShowBezLine, RSCindices.beziline); | RSCindices.repltext : InvertFlag(OwnHPGLFont, RSCindices.repltext); | RSCindices.hpglfont : SetFont; IF VectorFont.FontsLoaded()>0 THEN MenuItemStatus(RSCindices.repltext, TRUE); END; (** but := Diverses.Alert(1, '[1][Testcode?][[Ja|[Nein]'); IF but=1 THEN MagicVDI.SetClipping (mtAppl.VDIHandle , ClipXY , TRUE) ; Diverses.MouseOff; FOR w:=0 TO 7 DO VectorFont.SetTextStyle(1.5, 1.5, 0.0, w*45); x0 := 100 + w * 25; y0 := 150 + w * 30; VectorFont.OutText(x0, y0, '! Test'); END; MagicVDI.SetClipping (mtAppl.VDIHandle , ClipXY , FALSE) ; Diverses.MouseOn; END; **) | RSCindices.mpicsize : SetPicsize; ChangeDrawArea(0, 0); IF NOT WholeArea THEN Redraw (0, 0, 30000, 30000); ELSE Redraw (0, 0, 10, 10); END; | RSCindices.overview : Overview; | RSCindices.overfakt : x0 := ZoomNumerator; y0 := ZoomDenominator; OverFaktor; IF zoommode AND ((x0<>ZoomNumerator) OR (y0<>ZoomDenominator)) THEN MakeZoom; END; | RSCindices.allowund : InvertFlag(UseUndo, RSCindices.allowund); Undo.SetUndoFeature(UseUndo); | RSCindices.mconvert : IF PicConvert(source, target) THEN PicToMeta.ConvertPicture(source, target); END; DoOwnRedraw; | RSCindices.mspecial : SetSpecialOptions; | RSCindices.mgridopt : oldx := SnapX; oldy := SnapY; SetGridSize; IF ((oldx<>SnapX) OR (oldy<>SnapX)) AND (RasterFlag>0) THEN i := SnapX; j := SnapY; SnapX := oldx; SnapY := oldy; ShowRaster(RasterFlag); SnapX := i; SnapY := j; ShowRaster(RasterFlag); END; | ELSE END; END ProcessMenu; (* ---------------------------- *) PROCEDURE SpecifiedIcon( x, y : INTEGER; VAR Icon : INTEGER; VAR Disabled : BOOLEAN); VAR Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; BEGIN Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.desktop) ; Icon := MagicAES.ObjcFind (Tree, 0, MAX(INTEGER), x, y); Disabled := MagicAES.DISABLED IN Tree^[Icon].obState; IF Icon>=RSCindices.posbox THEN Disabled := FALSE; Icon := RSCindices.posbox; END; END SpecifiedIcon; (* ---------------------------- *) PROCEDURE ProcessKeyboard(scan, x, y : INTEGER); VAR Tastatur : MagicXBIOS.PtrKEYTAB; (* Zeiger auf Tastaturtabelle *) long : MagicSys.lCARDINAL; i, menu, found : INTEGER; ch : CHAR; tb : ADDRESS; kc, ka, ks : BOOLEAN; Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; tmp : ARRAY [0..3] OF INTEGER; minx, miny, maxx, maxy, newx, newy, sizex, sizey : INTEGER; BEGIN (* šberprfe, ob KBKey etwas enth„lt, was wir ben”tigen *) (** RTD.ShowVar('scan', scan); **) (* $D+*) i := scan; (* $D-*) IF (scan=72) (* Cursor Up *) OR (scan=80) (* Cursor Down *) OR (scan=75) (* Cursor Left *) OR (scan=77) (* Cursor Right *) OR (scan=115) (* CTRL-Cursor Left *) OR (scan=116) (* CTRL-Cursor Right *) THEN (* 0=pageup, 1=pagedown, 2=rowup, 3=rowdown 4=pageleft, 5=pageright, 6=colleft, 7=colright *) IF (scan=72) THEN IF CTRL THEN i := 0; ELSE i := 2; END; END; IF (scan=80) THEN IF CTRL THEN i := 1; ELSE i := 3; END; END; IF (scan=75) THEN i := 6; END; IF (scan=115) THEN i := 4; END; IF (scan=77) THEN i := 7; END; IF (scan=116) THEN i := 5; END; ChangeVisible(1, i); ELSIF (scan=15) (* TAB *) OR (scan=1) (* ESC *) THEN MakeAllDirty; Redraw(0, 0, 30000, 30000); ELSIF (scan=97) THEN (* Undo *) IF UseUndo THEN Undo.UndoIt(); EnableSelectMenus(SelObs(TRUE)>0); EnableCompileMenus(FirstObject^.Next<>NIL); Redraw(0, 0, 30000, 30000); END; ELSIF (scan=98) THEN (* Help *) found := 0; IF (CTRL OR ALTER OR SHIFT) THEN SpecifiedIcon(x, y, found, kc); END; HelpForIcon(found, FillState, TextMode, FontMode, FALSE); ELSIF (scan>=103) AND (scan<=111) THEN GetMinMax(TRUE, minx, miny, maxx, maxy); WinUtils.GetWinSize(WindowHandle, tmp); sizex := tmp[2]; sizey := tmp[3]; CASE scan OF 103 : (* num 7 *) newx := minx - 5; newy := maxy + 5 - sizey; | 104 : (* num 8 *) newx := minx + (maxx - minx - sizex) DIV 2; newy := maxy + 5 - sizey; | 105 : (* num 9 *) newx := maxx - sizex + 5; newy := maxy + 5 - sizey; | 106 : (* num 4 *) newx := minx - 5; newy := miny + (maxy - miny - sizey) DIV 2; | 107 : (* num 5 *) newx := minx + (maxx - minx - sizex) DIV 2; newy := miny + (maxy - miny - sizey) DIV 2; | 108 : (* num 6 *) newx := maxx - sizex + 5; newy := miny + (maxy - miny - sizey) DIV 2; | 109 : (* num 1 *) newx := minx - 5; newy := miny - 5; | 110 : (* num 2 *) newx := minx + (maxx - minx - sizey) DIV 2; newy := miny - 5; | 111 : (* num 3 *) newx := maxx - sizex + 5; newy := miny - 5; | ELSE END; ZeroVal(newx, newy); ELSE tb:= MagicSys.Nil; (* nicht NIL !! *) Tastatur := MagicXBIOS.Keytbl (tb, tb, tb); found := -1; IF (scan>=0) AND (scan<=127) THEN ch := Tastatur^.capslock^[scan]; i := 1; WHILE (i<=shortcuts) AND (found<0) DO kc := (MagicAES.KCTRL IN ShortCutArray[i].CtrlCut); ka := (MagicAES.KALT IN ShortCutArray[i].CtrlCut); (*$? UseShiftShortcut: ks := (MagicAES.KRSHIFT IN ShortCutArray[i].CtrlCut) OR (MagicAES.KLSHIFT IN ShortCutArray[i].CtrlCut); *) IF (CTRL=kc) AND (ALTER=ka) (*$? UseShiftShortcut: AND (SHIFT=ks) *) THEN IF (scan >= 119) THEN scan:= (scan - 118); END; IF ch = ShortCutArray[i].CutChar THEN found := ShortCutArray[i].Index; menu := ShortCutArray[i].Menu; END; END; INC(i, 1); END; IF found>0 THEN (* Eintrag disabled ? *) Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.menu) ; IF NOT (MagicAES.DISABLED IN Tree^[found].obState) THEN AnimateWindowTitle(menu); ProcessMenu(found); DeAnimateWindowTitle(menu); END; END; END; END; (* So jetzt leere Queue... *) LoescheQueue; (** (* So jetzt leere Tastaturpuffer... *) WHILE MagicBIOS.Bconstat (MagicBIOS.CON) DO long := MagicBIOS.Bconin (MagicBIOS.CON) ; END ; **) END ProcessKeyboard; (* ---------------------------- *) PROCEDURE ProcessMessage(MessagePipe : ARRAY OF INTEGER); VAR dummy, MessageId, Menu, Item : INTEGER; bdummy : BITSET; BEGIN MessageId := MessagePipe [ 0 ] ; IF MessageId = MagicAES.MNSELECTED THEN Menu := MessagePipe [ 3 ] ; Item := MessagePipe [ 4 ] ; ProcessMenu(Item); MagicAES.MenuTnormal (MenuTree , Menu , MagicAES.Set) ; MagicAES.MenuTnormal (MenuTree , RSCindices.mdesk , MagicAES.Set) ; ELSE IF MessagePipe[3] = WindowHandle THEN CASE MessageId OF MagicAES.WMREDRAW : MagicAES.MenuTnormal (MenuTree , RSCindices.mdesk , MagicAES.Set) ; IF NOT IgnoreRedraw THEN Redraw (MessagePipe [ 4 ] , MessagePipe [ 5 ] , MessagePipe [ 6 ] , MessagePipe [ 7 ]) ; END; IgnoreRedraw := FALSE; | MagicAES.WMTOPPED : WinUtils.SetWinTop(WindowHandle); | MagicAES.WMCLOSED : DeleteAll (TRUE) ; | MagicAES.WMSIZED : | MagicAES.WMFULLED : IF (ZeroX<>0) OR (ZeroY<>0) THEN ZeroVal(0, 0); END; | MagicAES.WMARROWED : (* Inhalt von MessagePipe[4]: 0=pageup, 1=pagedown, 2=rowup, 3=rowdown, 4=pageleft, 5=pageright, 6=colleft, 7=colright *) MouseState(dummy, dummy, bdummy); IF CTRL THEN ChangeArea(MessagePipe[4]); ELSE ChangeVisible(1, MessagePipe[4]); END; | MagicAES.WMHSLID : MouseState(dummy, dummy, bdummy); IF NOT CTRL THEN ChangeVisible(2, MessagePipe[4]); END;| MagicAES.WMVSLID : MouseState(dummy, dummy, bdummy); IF NOT CTRL THEN ChangeVisible(3, MessagePipe[4]); END;| ELSE END; END; END; END ProcessMessage; (* ---------------------------- *) PROCEDURE ProcessRec1; VAR MoX, MoY : INTEGER; MoButton : BITSET; but : INTEGER; popupstr : ARRAY [0..255] OF CHAR; popupres : INTEGER; BEGIN IF WinUtils.IsWinTop(WindowHandle) THEN Diverses.MouseOff; IF ThinCrossMouse THEN Diverses.MouseThincross; ELSE Diverses.MouseArrow; END; MouseState(MoX, MoY, MoButton); Position (FALSE, MoX, MoY, 0, 0) ; MagicAES.WindUpdate (MagicAES.BEGMCTRL) ; IF (MagicAES.MouseLeft IN MoButton) AND NOT (MagicAES.MouseRight IN MoButton) THEN DrawIt (Draw); ShowHelp(Draw); ELSIF NOT (MagicAES.MouseLeft IN MoButton) AND (MagicAES.MouseRight IN MoButton) THEN RightMouse (Draw); ShowHelp(Draw); END; MagicAES.WindUpdate (MagicAES.ENDMCTRL) ; END; END ProcessRec1; (* ---------------------------- *) PROCEDURE ProcessRec2; VAR dummy : INTEGER; MoButton : BITSET; Tree : POINTER TO ARRAY [ 0..199 ] OF MagicAES.OBJECT ; Icon : INTEGER ; x, y : INTEGER ; x1, y1 : INTEGER ; w, h : INTEGER ; w1, h1 : INTEGER ; dx, dy : INTEGER ; Window : INTEGER ; entry : INTEGER ; icon : CARDINAL; LeftBut : BOOLEAN ; RightBut : BOOLEAN ; Disabled : BOOLEAN ; mx, my : LONGREAL; BEGIN IF WinUtils.IsWinTop(WindowHandle) THEN Diverses.MouseOff; Diverses.MouseArrow; MouseState(x, y, MoButton); Tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.desktop) ; (* Also dann verwalten wir es halt selbst, wenn's mit der einfachen Version: Icon := MagicAES.FormDo (Tree , -1) ; Probleme gibt (Doppelklicks, keine rechte Maustaste etc.) *) IF (MagicAES.MouseLeft IN MoButton) OR (MagicAES.MouseRight IN MoButton) THEN LeftBut := (MagicAES.MouseLeft IN MoButton); RightBut := (MagicAES.MouseRight IN MoButton); (* Zun„chst welches Objekt liegt drunter ? *) SpecifiedIcon(x, y, entry, Disabled); Window := 0; IF entry>=RSCindices.text THEN (* Ist entry irgendwo von einem Fenster verdeckt ? *) Window := MagicAES.WindFind(x, y); IF Disabled THEN Window := -1; END; END; IF Window=0 THEN IF LeftBut THEN AddText := CTRL; IF AddText THEN DisplayStatus('T '); ELSE DisplayStatus(' '); END; Icon := entry; (* Abfrage, um repetieren zu verhindern *) IF Icon0 THEN ShowSelectRects; (* delete old *) SplitSelection; ShowSelectRects; (* draw new *) END; | RSCindices.together : IF SelObs(FALSE)>1 THEN ShowSelectRects; (* delete old *) MergeSelection; ShowSelectRects; (* draw new *) END; | RSCindices.jputt : ChangeMarkerStatusIcon; | RSCindices.arrowopt : ChangeArrowIcon; | RSCindices.width : ChangeWidthIcon; | RSCindices.unlock, RSCindices.lock : IF Icon = RSCindices.lock THEN LockSelection; ELSE UnLockSelection; END; | RSCindices.fillstat : ChangeFillStatusIcon; ShowHelp(Draw); (* Update erforderlich *) | RSCindices.textmode : ChangeTextmodeIcon; ShowHelp(Draw); (* Update erforderlich *) | RSCindices.fontmode : ChangeFontmodeIcon; ShowHelp(Draw); (* Update erforderlich *) | RSCindices.textpos : ChangeTextposIcon; | RSCindices.posbox : IF SelObs(FALSE) > 0 THEN getsurround(x1, y1, w1, h1); x := Diverses.min(x1, w1); y := Diverses.min(y1, h1); w := ABS(w1-x1); h := ABS(h1-y1); x1 := x; y1 := y; w1 := w; h1 := h; IF MoveResize(x1, y1, w1, h1) THEN IF (x1<>x) OR (y1<>y) OR (h1<>h) OR (w1<>w) THEN Undo.PrepareUndo(TRUE); ShowSelection(TRUE); dx := x1 - x; dy := y1 - y; IF (dx<>0) OR (dy<>0) THEN MoveSelection(dx, dy); END; IF (w1<>w) OR (h1<>h) THEN IF (w=0) OR (w1=0) OR (w1=w) THEN mx := 0.0; ELSE mx := MathLib0.real(w1) / MathLib0.real(w); END; IF (h=0) OR (h1=0) OR (h1=h) THEN my := 0.0; ELSE my := MathLib0.real(h1) / MathLib0.real(h); END; ChangeIt(mx, my, x1, y1); (* Im Extremfall nochmal verschieben *) ShowSelection(TRUE); getsurround(x, y, w, h); x := Diverses.min(w, x); y := Diverses.min(h, y); MoveSelection(x1 - x, y1 -y); ShowSelection(TRUE); END; ShowSelection(FALSE); END; END; END; | ELSE DeselectIcon(Draw); SelectIcon(Icon); ShowHelp(Icon); Draw := Icon ; END; ELSIF RightBut AND NOT LeftBut THEN HelpForIcon(entry, FillState, TextMode, FontMode, FALSE); END; ELSE (* Dann setze das Fenster hoch *) REPEAT MouseState(dummy, dummy, MoButton); UNTIL NOT ((MagicAES.MouseLeft IN MoButton) OR (MagicAES.MouseRight IN MoButton)) ; IF Window<>WindowHandle THEN WinUtils.SetWinTop(WindowHandle); END; END; END; END; END ProcessRec2; (* ---------------------------- *) PROCEDURE Events () ; VAR EventSet : BITSET ; MoX,MoY : INTEGER ; MoButton : BITSET ; MoKState : BITSET ; KBtaste : INTEGER ; KBscan : INTEGER ; KBascii : CHAR ; MoClicks : INTEGER ; MessagePipe : ARRAY [ 0..15 ] OF INTEGER ; BEGIN EventSet := MagicAES.EvntMulti (EventFlag , ButtonClicks , ButtonMask, ButtonState, M1Flag, M1rect, M2Flag, M2rect, MessagePipe, LoCount, HiCount, MoX, MoY, MoButton, KBtaste, MoKState, KBscan, KBascii, MoClicks) ; SHIFT := (MagicAES.KLSHIFT IN MoKState) OR (MagicAES.KRSHIFT IN MoKState); CTRL := (MagicAES.KCTRL IN MoKState); ALTER := (MagicAES.KALT IN MoKState); (* So klappen Fenster ein *) MagicAES.WindUpdate (MagicAES.BEGUPDATE) ; IF MagicAES.MUMESAG IN EventSet THEN ProcessMessage(MessagePipe); END; IF MagicAES.MUKEYBD IN EventSet THEN ProcessKeyboard(KBscan, MoX, MoY); END; IF MagicAES.MUM1 IN EventSet THEN ProcessRec1; END; IF MagicAES.MUM2 IN EventSet THEN (** RTD.ShowVar('MoClicks', MoClicks); **) ProcessRec2; END; MagicAES.WindUpdate (MagicAES.ENDUPDATE) ; EnableSelectMenus(SelObs(TRUE)>0); EnableCompileMenus(FirstObject^.Next<>NIL); END Events ; PROCEDURE ParseMenu; (* Sucht den Inhalt der Menu-Zeilen nach Shortcuts ab *) CONST AltCut = 007C; (* = '' *) CtrlCut = 136C; (* = '^' *) ShiftCut = 043C; (* = '#' *) (* not yet implemented *) VAR index, menu, i, j, k : INTEGER; tree : POINTER TO ARRAY [ 0..200 ] OF MagicAES.OBJECT ; ready : BOOLEAN; ctrl : BOOLEAN; alt : BOOLEAN; shift : BOOLEAN; CapChar : CHAR; CutChar : CHAR; okay : BOOLEAN; warning : ARRAY [0..127] OF CHAR; BEGIN tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.menu) ; shortcuts := 0; FOR index:=RSCindices.minfo TO RSCindices.mconvert DO IF (index=RSCindices.minfo) OR (index >= RSCindices.mload) THEN IF index=RSCindices.minfo THEN menu := RSCindices.mdesk; ELSIF (index>=RSCindices.mload) AND (index<=RSCindices.mquit) THEN menu := RSCindices.mdrawing; ELSIF (index>=RSCindices.mauswall) AND (index<=RSCindices.mauswlod) THEN menu := RSCindices.mauswahl; ELSIF (index>=RSCindices.diskoptn) AND (index<=RSCindices.msystem) THEN menu := RSCindices.moptions; ELSE menu := RSCindices.mdiverse; END; IF (tree^[index].obType=MagicAES.GSTRING) THEN j := 0; ready := FALSE; WHILE NOT ready AND (tree^[index].StringPtr^[j]<>0C) DO IF (tree^[index].StringPtr^[j]=AltCut) OR (tree^[index].StringPtr^[j]=CtrlCut) (*$? UseShiftShortcut: OR (tree^[index].StringPtr^[j]=ShiftCut) *) THEN ready := TRUE; alt := (tree^[index].StringPtr^[j]=AltCut); ctrl := (tree^[index].StringPtr^[j]=CtrlCut); (*$? UseShiftShortcut: shift := (tree^[index].StringPtr^[j]=ShiftCut); *) IF (tree^[index].StringPtr^[j+1]=AltCut) OR (tree^[index].StringPtr^[j+1]=CtrlCut) (*$? UseShiftShortcut: OR (tree^[index].StringPtr^[j+1]=ShiftCut) *) THEN alt := alt OR (tree^[index].StringPtr^[j+1]=AltCut); ctrl := ctrl OR (tree^[index].StringPtr^[j+1]=CtrlCut); (*$? UseShiftShortcut: shift := shift OR (tree^[index].StringPtr^[j+1]=ShiftCut); *) IF (tree^[index].StringPtr^[j+2]=AltCut) OR (tree^[index].StringPtr^[j+2]=CtrlCut) (*$? UseShiftShortcut: OR (tree^[index].StringPtr^[j+2]=ShiftCut) *) THEN alt := alt OR (tree^[index].StringPtr^[j+2]=AltCut); ctrl := ctrl OR (tree^[index].StringPtr^[j+2]=CtrlCut); (*$? UseShiftShortcut: shift := shift OR (tree^[index].StringPtr^[j+2]=ShiftCut); *) CutChar := tree^[index].StringPtr^[j+3]; ELSE CutChar := tree^[index].StringPtr^[j+2]; END; ELSE CutChar := tree^[index].StringPtr^[j+1]; END; IF ready AND (CutChar<>0C) THEN CapChar := MagicStrings.Cap(CutChar); IF (shortcuts ShortCutArray[shortcuts].CtrlCut; END; END; IF NOT okay THEN warning := '[1][ Es stimmen mehrere | Menueintr„ge ber- | ein: "#" !!][ [MIST ]'; k := 0; WHILE warning[k]<>'#' DO INC(k); END; warning[k] := CapChar; k := Diverses.Alert (1 , warning); END; ** Ende der Testroutinen **) END; END; END; INC(j, 1); END; END; END; END; END ParseMenu; (*------------------------------------------------------------------------*) (* Initialisierung *) (*------------------------------------------------------------------------*) (* ---------------------------- *) PROCEDURE Init () ; VAR tree , tree1 : POINTER TO ARRAY [ 0..200 ] OF MagicAES.OBJECT ; dummy, i, File, ww, wh : INTEGER ; adr, small, big : ARRAY [0..3] OF INTEGER; wind : ARRAY [0..3] OF INTEGER; bdummy : BOOLEAN; arg : ARRAY [0..127] OF CHAR; BEGIN MagicStrings.Assign(Version, VerTxt); i := 0; WHILE (VerTxt[i]<>0C) AND (VerTxt[i]<>'#') DO INC(i); END; IF VerTxt[i]='#' THEN VerTxt[i+0] := CHR(ORD('0') + MajorRelease); MagicStrings.Insert('___', VerTxt, i+1); VerTxt[i+1] := '.'; VerTxt[i+2] := CHR(ORD('0') + (MinorRelease DIV 10)); VerTxt[i+3] := CHR(ORD('0') + (MinorRelease MOD 10)); IF SubRelease<>0 THEN MagicStrings.Insert('__', VerTxt, i+4); VerTxt[i+4] := '.'; VerTxt[i+5] := CHR(ORD('0') + SubRelease); END; END; MagicStrings.Assign(InfoIDRaw, InfoID); i := 0; WHILE (InfoID[i]<>0C) AND (InfoID[i]<>'#') DO INC(i); END; IF InfoID[i]='#' THEN InfoID[i+0] := CHR(ORD('0') + MajorRelease); MagicStrings.Insert('__', InfoID, i+1); InfoID[i+1] := CHR(ORD('0') + (MinorRelease DIV 10)); InfoID[i+2] := CHR(ORD('0') + (MinorRelease MOD 10)); END; (* RTD.Message('Setting Dclicks'); *) DClickSpeed := MagicAES.EvntDclicks(1, FALSE); dummy := MagicAES.EvntDclicks(1, TRUE); (* RTD.Message('Init vars'); *) zoommode := FALSE; ZoomNumerator := -1; ZoomDenominator := -2; InternalResolution := 4; ThinCrossMouse := TRUE; ColorFlag := mtAppl.Bitplanes>1; (* Menu-Zeile darstellen *) (* RTD.Message('Show Menu'); *) MenuTree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.menu) ; MagicAES.MenuBar(MenuTree, MagicAES.Set); (* RTD.Message('Parse Menu'); *) ParseMenu; (* RTD.Message('Parse Menu ready'); *) WindowTitle := ''; IgnoreRedraw := FALSE; (* RTD.Message('Window get/set'); *) tree := mtRsc.GaddrRsc(RSC, MagicAES.RTREE , RSCindices.desktop) ; WinUtils.GetWinSize(WindowHandle, wind); tree^ [ 0 ] .obX := wind[0] ; tree^ [ 0 ] .obY := wind[1] ; tree^ [ 0 ] .obWidth := wind[2] ; tree^ [ 0 ] .obHeight := wind[3] ; adr[0] := MagicSys.CastToInt(ADDRESS(tree) DIV 10000H); adr[1] := MagicSys.CastToInt(ADDRESS(tree) MOD 10000H); adr[2] := 0; adr[3] := 0; MagicAES.WindSet (0 , MagicAES.WFNEWDESK , adr); FOR i:=0 TO 3 DO small[i] := 0; big[i] := 0; END; small[2] := tree^[0].obX+tree^[0].obWidth; big[2] := small[2]; small[3] := tree^[0].obY+tree^[0].obHeight; big[3] := small[3]; MagicAES.FormDial (MagicAES.FMDFINISH , small, big); (* ... dann ”ffnen wir das Arbeitsfenster zum Zeichnen, ... *) XSliders := ((mtAppl.MaxWidth DIV 1000)+1) * 10; YSliders := ((mtAppl.MaxHeight DIV 1000)+1) * 10; small[0] := tree^ [ RSCindices.funcbox ] .obWidth + 1; small[1] := 19; small[2] := wind[2]-small[0]; small[3] := wind[3]; WinWidth := small[2]; WinHeight := small[3]; WindowHandle := MagicAES.WindCreate ( BITSET{MagicAES.NAME, MagicAES.INFO, MagicAES.CLOSER, MagicAES.FULL, MagicAES.LFARROW, MagicAES.RTARROW, MagicAES.UPARROW, MagicAES.DNARROW, MagicAES.HSLIDE, MagicAES.VSLIDE }, small); (* Genau in die Mitte bringen *) ZeroX := 0; ZeroY := 0; SetSliderPos(ZeroX, ZeroY); WinUtils.SetWinTitle(WindowHandle, WindowTitle); HelpMessage(VerTxt); MagicAES.WindGet (WindowHandle , MagicAES.WFFULLXYWH , wind); MagicAES.WindOpen (WindowHandle , wind); (* RTD.Message('Window opened'); *) (* ... jetzt legen wir noch fest, auf welche Ereignisse wir warten *) (* wollen : Rechteck 1 zum Zeichen, Rechteck 2 fr die Zeichen- *) (* funktionen (Icons) und Nachrichten fr die Menleiste mit *) (* ihren Menpunkten. *) EventFlag := BITSET{MagicAES.MUM1, MagicAES.MUM2, MagicAES.MUMESAG, (* MagicAES.MUBUTTON, *) MagicAES.MUKEYBD}; M1Flag := MagicAES.EnterRect; WinUtils.GetWinSize(WindowHandle, M1rect); M2Flag := MagicAES.EnterRect; MagicAES.ObjcOffset (tree , RSCindices.posbox , M2rect[0] , M2rect[1]) ; M2rect[2] := tree^ [ RSCindices.posbox ] .obWidth ; M2rect[3] := tree^ [ RSCindices.posbox ] .obHeight ; MagicAES.ObjcOffset (tree , RSCindices.funcbox , dummy , i) ; dummy := dummy + tree^ [ RSCindices.funcbox ] .obWidth ; i := i + tree^ [ RSCindices.funcbox ] .obHeight ; M2rect[2] := dummy - M2rect[0] ; M2rect[3] := i - M2rect[1] ; (* ... zum Schluž initialisieren wir noch die wichtigen Variablen. *) MagicAES.ObjcOffset (tree , RSCindices.xpos , XPosx , XPosy) ; MagicAES.ObjcOffset (tree , RSCindices.dxpos , DXPosx , DXPosy) ; MagicAES.ObjcOffset (tree , RSCindices.ypos , YPosx , YPosy) ; MagicAES.ObjcOffset (tree , RSCindices.dypos , DYPosx , DYPosy) ; XPosy := XPosy + 13 ; YPosy := YPosy + 13 ; DXPosy := DXPosy + 13 ; DYPosy := DYPosy + 13 ; (* Nun wird's wichtig : Default-Zeichen Werte *) (* RTD.Message('First Object'); *) NEW (FirstObject) ; WITH FirstObject^ DO FOR i := 0 TO 9 DO Code [ i ] := 0 END; Code [ 0 ] := ORD(Picture) ; Code [ 1 ] := 0; (* Dummy-Koordinaten *) Code [ 2 ] := 0; Code [ 3 ] := InternalResolution*100; (* Breite : 100 mm *) Code [ 4 ] := InternalResolution*70; (* H”he : 70 mm *) Code [ 6 ] := 0; (* Unitlength = 1 x mm *) Code [ 7 ] := InternalResolution; Code [ 8 ] := MajorRelease * 100 + MinorRelease; DefaultWidth := Code[3]; DefaultHeight := Code[4]; DefaultUnit := Code[6]; DefaultRes := Code[7]; Surround[0] := 0; Surround[1] := Code [4]; Surround[2] := Code [3]; Surround[3] := Code [4]; CPtr := NIL ; EPtr := NIL ; Next := NIL ; (* Beim Masterbild werden die Kinder unter Next abgelegt *) Children := NIL; END; LastObject := FirstObject ; (* Restliche Variablen werden via InvertAreaStatus bestimmt... *) Draw := -1 ; (* Nun lade, falls vorhanden, die Datei mit den Voreinstellungen *) LTDPath [0] := 0C; MetaPath [0] := 0C; LaTeXPath [0] := 0C; PiCTeXPath [0] := 0C; IMGPath [0] := 0C; STADPath [0] := 0C; TeXPath [0] := 0C; HPGLPath [0] := 0C; FontPath [0] := 0C; PostPath [0] := 0C; GEMPath [0] := 0C; IncludePath[0] := 0C; HelpPath [0] := 0C; CSGPath [0] := 0C; WholeArea := FALSE; LimitedDisk := TRUE; OwnHPGLFont := TRUE; SnapMode := FALSE; ShowBezLine := TRUE; Usespecial := cstrunk2; XSnap := TRUE; YSnap := TRUE; UseUndo := TRUE; MetaLThin := 0040 + 10000 * 0; (* = 00.40pt *) MetaLThick := 0060; (* = 00.60pt *) MetaLVThick := 0080; (* = 00.80pt *) MetaPAscii := ORD('A'); SnapX := 5; SnapY := 5; Extensions[1] := "LTD"; Extensions[2] := "TEX"; Extensions[3] := "TEX"; Extensions[4] := "MF" ; Extensions[5] := "PLO"; Extensions[6] := "FIG"; Extensions[7] := "GEM"; Extensions[8] := "CSG"; Extensions[9] := "TFM"; Extensions[10] := "GF"; Extensions[11] := "PK"; (* RTD.Message('Loading Prefs'); *) LoadPrefs; (* RTD.Message('Inverting Status'); *) SnapMode := NOT SnapMode; InvertSnapMode; LimitedDisk := NOT LimitedDisk; OwnHPGLFont := NOT OwnHPGLFont; UseUndo := NOT UseUndo; ShowBezLine := NOT ShowBezLine; DefaultWidth := FirstObject^.Code[3]; DefaultHeight := FirstObject^.Code[4]; DefaultUnit := FirstObject^.Code[6]; DefaultRes := FirstObject^.Code[7]; InvertFlag(OwnHPGLFont, RSCindices.repltext); InvertFlag(LimitedDisk, RSCindices.diskoptn); InvertFlag(UseUndo, RSCindices.allowund); InvertFlag(ShowBezLine, RSCindices.beziline); Undo.SetUndoFeature(UseUndo); WholeArea := NOT WholeArea; InvertAreaStatus; (* macht auch Redraw *) (* Damit wird das allererste Redraw unterdrckt: *) IgnoreRedraw := TRUE; (* RTD.Message('Loading fonts'); *) LoadFonts; LoadExtensions; (* RTD.Message('Init variables'); *) RasterFlag := 0 ; (* Nun die dazu geh”rigen Icons einbinden *) SHIFT := FALSE; LineWidth := 5; ChangeWidthIcon; (* => 1 *) (* = thin *) TextPosition := Top; ChangeTextposIcon; (* = > Center *) FillState := 7; ChangeFillStatusIcon; (* => 0 *) TextMode := 3; ChangeTextmodeIcon; (* => 0 *) FontMode := 1; ChangeFontmodeIcon; (* => 0 *) EpicLinestyle := 3; ChangeLinetypeIcon; (* => 0 *) Arrowstyle := 3; ChangeArrowIcon; (* => 0 *) Mode3D := 1; Change3DIcon; (* => 0 *) Epic.CurrentMarker := PutOtimes; ChangeMarkerStatusIcon; (* => NormLine *) (* RTD.Message('Enabling menus'); *) EnableCompileMenus (FALSE); (* RTD.Message('Disabling not ready func.'); *) DisableNotReadyFunctions; (* Jetzt berprfe die Kommandozeile, wenn etwas bergeben wurde, lade die Datei *) (* RTD.Message('Checking arguments'); *) dummy := mtAppl.ParamCount(); IF dummy>0 THEN mtAppl.ParamString(1, arg); (** RTD.Message(arg); **) IF LoadFile(arg) THEN IgnoreRedraw := FALSE; END; END; (** FOR i:=1 TO 26 DO dummy := Diverses.NumAlert(i, 1); END; **) (* $D+ i := MagicVDI.SetMarkerheight(mtAppl.VDIHandle, 1); i := MagicVDI.SetMarkerheight(mtAppl.VDIHandle, i); $D-*) END Init ; PROCEDURE HeapInit() : BOOLEAN; (** VAR wanted : MagicSys.lCARD; result : BOOLEAN; **) BEGIN (** result := TRUE; wanted := 010000H; (* Wir fangen mal mit 1024 k an *) REPEAT result := CreateHeap(wanted, TRUE); IF NOT result THEN DEC(wanted, 20000H); (* geht's mit 128 k weniger ? *) END; UNTIL result OR (wanted<=0); RETURN result; **) RETURN TRUE; END HeapInit; (*------------------------------------------------------------------------*) (* Hauptprogramm *) (*------------------------------------------------------------------------*) BEGIN (* VDI-Workstation wird automatisch von mtAppl aufgerufen *) (* RTD.SetDevice(RTD.printer); *) (* RTD.Message('Init of Modules complete...'); *) Diverses.MouseArrow; (* RTD.Message('Now loading RSC-file...'); *) IF mtRsc.LoadRsc ("TEXDRAW.RSC" , RSC) THEN (* RTD.Message('RSC loaded'); *) IF (mtAppl.MaxWidth>=639) AND (mtAppl.MaxHeight>=399) THEN IF HeapInit() THEN (* RTD.Message('Heap init ready'); *) DClickSpeed := MagicAES.EvntDclicks(1, FALSE); DClickSpeed := MagicAES.EvntDclicks(1, TRUE); (* RTD.Message('Start init'); *) Init () ; (* RTD.Message('Init ready'); *) End := FALSE ; REPEAT Events () ; UNTIL End ; DClickSpeed := MagicAES.EvntDclicks(DClickSpeed, TRUE); ELSE mtAlerts.SetIcon(mtAlerts.Bomb); ButtonClicks := Diverses.Alert(1, NoMemory); END; ELSE mtAlerts.SetIcon(mtAlerts.Bomb); ButtonClicks := Diverses.NumAlert(15, 1); END; mtRsc.FreeAll; ELSE mtAlerts.SetIcon(mtAlerts.Bomb); ButtonClicks :=Diverses.Alert(1, NoRSC); END; mtAppl.ApplTerm(0); END TexDraw.