home *** CD-ROM | disk | FTP | other *** search
/ Atari FTP / ATARI_FTP_0693.zip / ATARI_FTP_0693 / Tex / td187src.lzh / VARIABLE.I < prev    next >
Text File  |  1991-12-14  |  27KB  |  841 lines
  1. IMPLEMENTATION MODULE Variablen;
  2.  
  3. FROM SYSTEM     IMPORT ADDRESS , ADR;
  4. FROM Storage    IMPORT ALLOCATE , DEALLOCATE;
  5. FROM Diverses   IMPORT round, NumAlert, BlockIntersect;
  6. FROM Types      IMPORT Block, ExtendedArraySize, ObjectPtrTyp,
  7.                        CodeAryTyp, DrawObjectTyp,
  8.                        CharPtrTyp, ExtendedPtrTyp;
  9.  
  10. IMPORT mtAlerts ;
  11. IMPORT mtAppl ;
  12. IMPORT MagicVDI ;
  13. IMPORT MagicAES ;
  14. IMPORT MagicSys ;
  15. IMPORT MagicConvert;
  16. IMPORT CommonData;
  17. IMPORT MagicStrings;
  18. IMPORT MathLib0;
  19. IMPORT RSCindices;
  20.  
  21. (**
  22. IMPORT Debug;
  23. IMPORT RTD;
  24. **)
  25.  
  26.  
  27. CONST Magic = 2905;
  28.  
  29. VAR IgnoreMode : BOOLEAN; (* Falls TRUE wird Aufruf von NewObject ignoriert *)
  30.     zoomit     : BOOLEAN;
  31.     aftstr     : ARRAY [1..5],[0..4] OF ARRAY [0..2] OF CHAR;
  32.     secondadr  : ObjectPtrTyp;
  33.  
  34. PROCEDURE ZoomMode (zoom : BOOLEAN; factor : LONGREAL);
  35. (*
  36.    Schaltet Zoom-Modus an/aus
  37. *)
  38. BEGIN
  39.   zoomit  := zoom;
  40.   zoomfak := factor;
  41. END ZoomMode;
  42.  
  43. PROCEDURE PixDistance(picdist : INTEGER) : INTEGER;
  44. (*
  45.   Rechnet Pixel-Abstände in PIc-Abstände um und umgekehrt
  46. *)
  47. BEGIN
  48.   IF zoomit THEN
  49.     RETURN round(MathLib0.real(picdist) * zoomfak);
  50.    ELSE
  51.     RETURN picdist;
  52.   END;
  53. END PixDistance;
  54.  
  55. PROCEDURE PicDistance(pixdist : INTEGER) : INTEGER;
  56. (*
  57.   Rechnet Pixel-Abstände in PIC-Abstände um
  58. *)
  59. BEGIN
  60.   IF zoomit THEN
  61.     RETURN round(MathLib0.real(pixdist) / zoomfak);
  62.    ELSE
  63.     RETURN pixdist;
  64.   END;
  65. END PicDistance;
  66.  
  67. PROCEDURE PixToPic ( xpix , ypix : INTEGER; VAR xpic , ypic : INTEGER) ;
  68. VAR y : INTEGER ;   (* leider geht y-Achse beim ST von oben nach unten *)
  69. BEGIN
  70.   y := CommonData.OffsetXY[3] ;
  71.   IF zoomit THEN
  72.     xpic   := round( MathLib0.real(xpix - CommonData.WorkArea[0]) /
  73.                      zoomfak);
  74.     xpic   := xpic + CommonData.ZeroX;
  75.     ypic   := round( MathLib0.real(y - ypix + CommonData.WorkArea[1]) /
  76.                      zoomfak );
  77.     ypic   := ypic + CommonData.ZeroY;
  78.    ELSE
  79.     xpic   := xpix -
  80.               CommonData.WorkArea[0] + CommonData.ZeroX;
  81.     ypic   := y - ypix +
  82.               CommonData.WorkArea[1] + CommonData.ZeroY;
  83.   END;
  84. END PixToPic ;
  85.  
  86. PROCEDURE PicToPix (VAR xpix , ypix : INTEGER; xpic , ypic : INTEGER) ;
  87.  
  88. VAR y : INTEGER ;   (* leider geht y-Achse beim ST von oben nach unten *)
  89.  
  90. BEGIN
  91.   y := CommonData.OffsetXY[3] ;
  92.   IF zoomit THEN
  93.     xpix := round( zoomfak *
  94.               MathLib0.real(CommonData.FatherXOffset + xpic
  95.                             - CommonData.ZeroX)) +
  96.               CommonData.WorkArea[0];
  97.     ypix := y - round( zoomfak *
  98.                   MathLib0.real(CommonData.FatherYOffset + ypic
  99.                                 - CommonData.ZeroY)) +
  100.               CommonData.WorkArea[1];
  101.    ELSE
  102.     xpix := (CommonData.FatherXOffset + xpic - CommonData.ZeroX) +
  103.               CommonData.WorkArea[0];
  104.     ypix := y - (CommonData.FatherYOffset + ypic - CommonData.ZeroY) +
  105.               CommonData.WorkArea[1];
  106.   END;
  107. END PicToPix ;
  108.  
  109. PROCEDURE Visible (SurroundRec : ARRAY OF INTEGER) : BOOLEAN ;
  110. (* SurroundRec entspricht Surround in ObjectRecTyp *)
  111. VAR X1, Y1, X2, Y2 : INTEGER;
  112.     temp           : INTEGER;
  113.     result         : BOOLEAN;
  114. BEGIN
  115.   PixToPic (CommonData.ClipXY[0], CommonData.ClipXY[1], X1, Y1);
  116.   PixToPic (CommonData.ClipXY[2], CommonData.ClipXY[3], X2, Y2);
  117.   (* X1,Y1 +--------+        s0,s1 +-------+              *)
  118.   (*       |        |              |       |              *)
  119.   (*       |        |              |       |              *)
  120.   (*       +--------+ X2,Y2        +-------+ s0+s2,s1-s3  *)
  121.   (* Keine X-Überschneidung ? *)
  122.   IF (X1>X2) THEN temp := X2; X2 := X1; X1 := temp; END;
  123.   IF (Y1<Y2) THEN temp := Y2; Y2 := Y1; Y1 := temp; END;
  124.   IF (X2<SurroundRec[0]) OR (X1>SurroundRec[0]+SurroundRec[2]) THEN
  125.     RETURN FALSE;
  126.    ELSE
  127.     (* Keine Y-Überschneidung ? *)
  128.     IF (Y2>SurroundRec[1]) OR (Y1<SurroundRec[1]-SurroundRec[3]) THEN
  129.       RETURN FALSE;
  130.      ELSE
  131.       RETURN TRUE;
  132.     END;
  133.   END;
  134.   RETURN TRUE;
  135. END Visible;
  136.  
  137. VAR strings : ARRAY [1..4] OF ARRAY [1..19] OF CHAR;
  138.     numbers : ARRAY [1..4] OF INTEGER;
  139.  
  140. PROCEDURE Position ( ShowDelta : BOOLEAN;
  141.                      XPos, YPos, XDelta, YDelta : INTEGER ) ;
  142. (*
  143.    Zeigt die momentane Maus-Position (XPos, YPos) an. Ist ShowDelta TRUE,
  144.    so wird zusätzlich noch der Abstand zum Punkt (XDelta,YDelta) angezeigt.
  145. *)
  146. CONST coordlen = 11;
  147.  
  148. VAR str : ARRAY [ 0..9 ] OF CHAR ;
  149.     str2: ARRAY [ 0..9 ] OF CHAR ;
  150.     bdum                 : BITSET;
  151.     xm , ym ,dum , x , y : INTEGER;
  152.     i, deltax, deltay    : INTEGER;
  153.     tree                 : POINTER TO ARRAY [ 0..255 ] OF MagicAES.OBJECT ;
  154.     xmdelta, ymdelta     : INTEGER;
  155.  
  156.   PROCEDURE ChangeNumber(num, index, rscindex : INTEGER);
  157.   VAR txt   : ARRAY [0..127] OF CHAR;
  158.       blank : ARRAY [0..1] OF CHAR;
  159.   BEGIN
  160.     blank := ' ';
  161.     CoordToStr(num, strings[index]);
  162.     WHILE MagicStrings.Length(strings[index])<coordlen DO
  163.       MagicStrings.Insert(blank, strings[index], 0);
  164.     END;
  165.     tree^[rscindex].StringPtr := ADR(strings[index]);
  166.     numbers[index] := num;
  167.   END ChangeNumber;
  168.  
  169.   PROCEDURE ShowNumber(num, x, y : INTEGER);
  170.   VAR txt   : ARRAY [0..127] OF CHAR;
  171.       blank : ARRAY [0..1] OF CHAR;
  172.   BEGIN
  173.     blank := ' ';
  174.     CoordToStr(num, txt);
  175.     WHILE MagicStrings.Length(txt)<coordlen DO
  176.       MagicStrings.Insert(blank, txt, 0);
  177.     END;
  178.     MagicVDI.Text (mtAppl.VDIHandle , x, y, txt);
  179.   END ShowNumber;
  180.  
  181.   PROCEDURE UpdatePosBox;
  182.   CONST DeskWin  = 0 ;
  183.   VAR brec, bvis, bsect, bclip : Block;
  184.   BEGIN
  185.     i := MagicVDI.SetWritemode (mtAppl.VDIHandle , MagicVDI.REPLACE) ; (* paint *)
  186.     i := MagicVDI.SetTextcolor (mtAppl.VDIHandle , MagicAES.BLACK) ;
  187.     MagicVDI.SetTextalignment (mtAppl.VDIHandle ,
  188.                                 MagicVDI.BaseJust, MagicVDI.BottomJust ,
  189.                                 i , i) ;
  190.     MagicAES.ObjcOffset (tree , RSCindices.posbox , brec.x , brec.y) ;
  191.     brec.y := brec.y + 1; (* oberen Rand schützen *)
  192.     brec.w := tree^ [ RSCindices.posbox ] .obWidth ;
  193.     brec.h := tree^ [ RSCindices.posbox ] .obHeight - 2; (* unteren auch *)
  194.     (* Zuerst holen wir uns mal den sichtbaren Bereich *)
  195.     MagicAES.WindGet(DeskWin, MagicAES.WFFIRSTXYWH, bvis);
  196.     WHILE (bvis.w > 0) AND (bvis.h > 0) DO
  197.       IF BlockIntersect(brec, bvis, bsect) THEN
  198.         bclip.x := bsect.x;
  199.         bclip.y := bsect.y;
  200.         bclip.w := bsect.x + bsect.w - 1;
  201.         bclip.h := bsect.y + bsect.h - 1;
  202.         MagicVDI.SetClipping (mtAppl.VDIHandle  , bclip , TRUE) ;
  203.         ShowNumber(deltax, CommonData.DXPosx , CommonData.DXPosy+2);
  204.         ShowNumber(xm    , CommonData.XPosx , CommonData.XPosy+2);
  205.         ShowNumber(deltay, CommonData.DYPosx , CommonData.DYPosy+2);
  206.         ShowNumber(ym    , CommonData.YPosx , CommonData.YPosy+2);
  207.         MagicVDI.SetClipping (mtAppl.VDIHandle  , bclip , FALSE) ;
  208. (**
  209.         MagicAES.ObjcDraw (tree , 0 , 9 , bsect);
  210. **)
  211.       END ;
  212.       MagicAES.WindGet(DeskWin, MagicAES.WFNEXTXYWH, bvis);
  213.     END ;
  214.     MagicVDI.SetTextalignment (mtAppl.VDIHandle ,
  215.                                 MagicVDI.BaseJust, MagicVDI.BaseJust,
  216.                                 i , i) ;
  217.   END UpdatePosBox;
  218.  
  219. BEGIN
  220.   tree := MagicAES.RsrcGaddr(MagicAES.RTREE , RSCindices.desktop) ;
  221.   x := XDelta; y := YDelta;
  222.   IF x < CommonData.WorkArea [ 0 ] THEN x := CommonData.WorkArea [ 0 ] END;
  223.   IF x > CommonData.WorkArea [ 2 ] THEN x := CommonData.WorkArea [ 2 ] END;
  224.   IF y < CommonData.WorkArea [ 1 ] THEN y := CommonData.WorkArea [ 1 ] END;
  225.   IF y > CommonData.WorkArea [ 3 ] THEN y := CommonData.WorkArea [ 3 ] END;
  226.   IF ShowDelta THEN
  227.     PixToPic (x , y , xmdelta , ymdelta) ;
  228.   END;
  229.   dum := MagicVDI.SetTextcolor (mtAppl.VDIHandle , MagicAES.BLACK) ;
  230.   x := XPos;
  231.   y := YPos;
  232.   IF x < CommonData.WorkArea [ 0 ] THEN x := CommonData.WorkArea [ 0 ] END;
  233.   IF x > CommonData.WorkArea [ 2 ] THEN x := CommonData.WorkArea [ 2 ] END;
  234.   IF y < CommonData.WorkArea [ 1 ] THEN y := CommonData.WorkArea [ 1 ] END;
  235.   IF y > CommonData.WorkArea [ 3 ] THEN y := CommonData.WorkArea [ 3 ] END;
  236.   PixToPic (x , y , xm , ym) ;
  237.   IF ShowDelta THEN
  238.     deltax := ABS (xm - xmdelta);
  239.     deltay := ABS (ym - ymdelta);
  240.    ELSE
  241.     deltax := 0;
  242.     deltay := 0;
  243.   END;
  244.   IF (deltax<>numbers[1]) OR (deltay<>numbers[3]) OR
  245.      (xm<>numbers[2]) OR (ym<>numbers[4]) THEN
  246.     ChangeNumber(deltax, 1, RSCindices.dxpos);
  247.     ChangeNumber(xm    , 2, RSCindices.xpos);
  248.     ChangeNumber(deltay, 3, RSCindices.dypos);
  249.     ChangeNumber(ym    , 4, RSCindices.ypos);
  250.     UpdatePosBox;
  251.   END;
  252. END Position ;
  253.  
  254. (* ---------------------------- *)
  255.  
  256. PROCEDURE NewObject (NewCode : CodeAryTyp ;
  257.                      NewCPtr : CharPtrTyp ;
  258.                      NewEPtr : ExtendedPtrTyp;
  259.                      NewSRec : ARRAY OF MagicSys.sWORD) ;
  260.  
  261. VAR i : INTEGER ;
  262.     error : BOOLEAN;
  263.     tmp   : ObjectPtrTyp;
  264.  
  265. BEGIN
  266.   error := FALSE;
  267.   LastObject := FirstObject;
  268.   WHILE LastObject^.Next<>NIL DO
  269.     LastObject := LastObject^.Next;
  270.   END;
  271.   IF LastObject<>NIL THEN
  272. (**
  273.     RTD.Message('LastObject<>NIL');
  274. **)
  275.     NEW (tmp);
  276.     LastObject^.Next := tmp ;
  277.     IF LastObject^.Next <> NIL THEN
  278.       CommonData.ObjectCreated := TRUE;
  279.       LastObject := LastObject^.Next ;
  280.       FOR i := 0 TO 9 DO
  281.         LastObject^.Code [ i ] := NewCode [ i ] ;
  282.       END;
  283.       FOR i := 0 TO 3 DO
  284.         LastObject^.Surround [ i ] := MagicSys.CastToInt(NewSRec [ i ]) ;
  285.       END;
  286.       LastObject^.Children  := NIL;
  287.       LastObject^.Bitmap    := NIL;
  288.       LastObject^.Selected  := FALSE;
  289.       LastObject^.Locked    := FALSE;
  290.       LastObject^.SurrDirty := FALSE;
  291.       IF (NewCode [ 9 ] > 0) AND (NewCPtr<>NIL) THEN
  292.         ALLOCATE (LastObject^.CPtr , MagicSys.CastToLCard (NewCode [ 9 ])) ;
  293.         FOR i := 0 TO NewCode [ 9 ] - 1 DO
  294.           LastObject^.CPtr^[ i ] := NewCPtr^ [ i ] ;
  295.         END;
  296.       ELSE
  297.         LastObject^.CPtr := NIL ;
  298.       END;
  299.       IF (NewEPtr <> NIL) AND (NewCode[3]>0) THEN
  300.         ALLOCATE (LastObject^.EPtr , 4 * MagicSys.CastToLCard (NewCode [ 3 ])) ;
  301.         FOR i := 0 TO NewCode [ 3 ] - 1 DO
  302.           LastObject^.EPtr^[ (2 * i)    ] := NewEPtr^ [ (2 * i) ] ;
  303.           LastObject^.EPtr^[ (2 * i) + 1] := NewEPtr^ [ (2 * i) + 1 ] ;
  304.         END;
  305.       ELSE
  306.         LastObject^.EPtr := NIL ;
  307.       END;
  308.       LastObject^.Next := NIL ;
  309.      ELSE
  310.     (* Wer will, mag hier noch eine Alertbox ausgeben, das könnte aber
  311.        problematisch werden, wenn zuviele Objekte auf einmal angemeldet
  312.        werden...
  313.      *)
  314.       error := TRUE;
  315.     END;
  316.    ELSE
  317.     error := TRUE;
  318.   END;
  319.   IF error THEN
  320.     mtAlerts.SetIcon(mtAlerts.Bomb);
  321. (**
  322.     i := mtAlerts.Alert(1, NoMoreObjects);
  323. **)
  324.     i := NumAlert(22, 1);
  325.     IgnoreMode := TRUE;
  326.   END;
  327. END NewObject ;
  328.  
  329. PROCEDURE DeleteObject (Object : ObjectPtrTyp) ;
  330. VAR obj1, obj2 : ObjectPtrTyp;
  331. BEGIN
  332. (**
  333.   RTD.Into('DeleteObject');
  334. **)
  335.   IF Object = RefObject THEN
  336.     RefObject := NIL;
  337.   END;
  338.   IF (ORD(Object^.Code [ 0 ]) = ORD(Picture)) AND
  339.      (Object^.Children<>NIL) THEN
  340.     obj1 := Object^.Children;
  341.     WHILE obj1<>NIL DO
  342.       obj2 := obj1^.Next;
  343.       DeleteObject(obj1);
  344.       obj1 := obj2;
  345.     END;
  346.   END;
  347.   IF (Object^.CPtr<>NIL) AND (Object^.Code [ 9 ] > 0) THEN
  348.     DEALLOCATE (Object^.CPtr , MagicSys.CastToLCard (Object^.Code [ 9 ])) ;
  349.   END;
  350.   IF (Object^.EPtr<>NIL) AND (Object^.Code [ 3 ] > 0) THEN
  351.     DEALLOCATE (Object^.EPtr , 4 * MagicSys.CastToLCard (Object^.Code [ 3 ])) ;
  352.   END;
  353.   DISPOSE (Object) ;
  354.   IgnoreMode := FALSE;
  355. (**
  356.   RTD.Leaving('DeleteObject');
  357. **)
  358. END DeleteObject ;
  359.  
  360. (* ---------------------------- *)
  361.  
  362. PROCEDURE DeleteWholeTree;
  363. VAR obj, obj2 : ObjectPtrTyp;
  364. BEGIN
  365.   obj := FirstObject^.Next;
  366.   WHILE obj<>NIL DO
  367.     obj2 := obj^.Next;
  368.     DeleteObject(obj);
  369.     obj := obj2;
  370.   END;
  371.   FirstObject^.Next := NIL;
  372.   LastObject := FirstObject;
  373. END DeleteWholeTree;
  374.  
  375. (* ---------------------------- *)
  376.  
  377. PROCEDURE MergeToSubpic(LastNormalObject : ObjectPtrTyp;
  378.                         SPX, SPY, SPW, SPH : INTEGER) ;
  379. (*
  380.    Fa₧t alle Objekte HINTER LastNormalObject zu einem Subpicture zusammen
  381. *)
  382. VAR mycode   : CodeAryTyp;
  383.     temp     : ObjectPtrTyp;
  384.     i        : INTEGER;
  385.     surround : ARRAY [0..3] OF INTEGER;
  386. BEGIN
  387.   FOR i:=0 TO 9 DO mycode[i] := 0; END;
  388.   mycode[0] := ORD(Picture);
  389.   mycode[1] := SPX;  mycode[2] := SPY;
  390.   mycode[3] := SPW;  mycode[4] := SPH;
  391.   surround[0] := SPX;
  392.   surround[1] := SPY + SPH;
  393.   surround[2] := SPW;
  394.   surround[3] := SPH;
  395.   IF LastNormalObject<>NIL THEN
  396.     temp      := LastNormalObject^.Next;
  397.     LastNormalObject^.Next := NIL;
  398.     LastObject   := LastNormalObject;
  399.     NewObject(mycode, NIL, NIL, surround);
  400.     LastObject^.Children := temp;
  401.     WHILE temp<>NIL DO
  402.       temp^.Code[1] := temp^.Code[1] - SPX;
  403.       temp^.Code[2] := temp^.Code[2] - SPY;
  404.       temp := temp^.Next;
  405.     END;
  406.   END;
  407. END MergeToSubpic;
  408.  
  409. (* ---------------------------- *)
  410.  
  411. PROCEDURE CheckConsistency;
  412. (*
  413.    Überprüfung auf evtle. Unstimmigkeiten.
  414.    Z.Zt. nur Check auf leere Subpics
  415. *)
  416. VAR check, prev : ObjectPtrTyp;
  417. BEGIN
  418.   prev := FirstObject;
  419.   check := FirstObject^.Next;
  420.   WHILE check<>NIL DO
  421.     IF ORD(check^.Code[0]) = ORD(Picture) THEN
  422.       IF check^.Children=NIL THEN
  423.         prev^.Next := check^.Next;
  424.         DeleteObject(check);
  425.         check := prev^.Next;
  426.        ELSE
  427.         prev := check;
  428.         check := check^.Next;
  429.       END;
  430.      ELSE
  431.       prev := check;
  432.       check := check^.Next;
  433.     END;
  434.   END;
  435.   LastObject := FirstObject;
  436.   WHILE LastObject^.Next <> NIL DO
  437.     LastObject := LastObject^.Next;
  438.   END;
  439. END CheckConsistency;
  440.  
  441. (* ---------------------------- *)
  442.  
  443. (* ---------------------------- *)
  444. PROCEDURE NumberToStr(number : INTEGER; VAR str : ARRAY OF CHAR);
  445. (* Wandelt INTEGER-Zahl in String, keine führenden Blanks *)
  446. VAR nst : ARRAY [ 0..10 ] OF CHAR ; ind , anf : INTEGER ;
  447. BEGIN
  448.   IF number=0 THEN
  449.     MagicStrings.Assign('0', str);
  450.    ELSE
  451.     FOR ind := 0 TO 10 DO nst [ ind ] := 0C END;
  452.     MagicConvert.IntToStr (number, 9 , nst) ;
  453.     anf := 0 ;
  454.     WHILE nst [ anf ] = " " DO anf := anf + 1 END;
  455.     FOR ind := anf TO 10 DO nst [ ind - anf ] := nst [ ind ] END;
  456.     MagicStrings.Assign(nst,str);
  457.   END;
  458. END NumberToStr;
  459.  
  460. PROCEDURE FactorToStr(VAR factorstr  : ARRAY OF CHAR);
  461. (* Liefert Vorfaktor für \unitlength *)
  462. VAR one : ARRAY [0..1] OF CHAR;
  463. BEGIN
  464.   CASE FirstObject^.Code [ 6 ] DIV 0100H OF
  465.     1 : MagicStrings.Assign('0.1',factorstr); |
  466.     2 : MagicStrings.Assign('10',factorstr); |
  467.     3 : MagicStrings.Assign('0.01',factorstr); |
  468.     4 : MagicStrings.Assign('100',factorstr); |
  469.    ELSE
  470.     (* 0 *)
  471.     one := '1';
  472.     MagicStrings.Assign(one,factorstr);  (* sollte ausser bei Null nie vorkommen *)
  473.   END;
  474. END FactorToStr;
  475.  
  476. PROCEDURE UnitToStr(VAR unitstr : ARRAY OF CHAR);
  477. (* Liefert die einfache Einheit, z.B. mm *)
  478. BEGIN
  479.   CASE FirstObject^.Code [ 6 ] MOD 0100H OF
  480.     0 : MagicStrings.Assign('mm',unitstr); |
  481.     1 : MagicStrings.Assign('cm',unitstr); |
  482.     2 : MagicStrings.Assign('pt',unitstr); |
  483.     3 : MagicStrings.Assign('pc',unitstr); |
  484.     4 : MagicStrings.Assign('in',unitstr); |
  485.     5 : MagicStrings.Assign('bp',unitstr); |
  486.     6 : MagicStrings.Assign('dd',unitstr); |
  487.     7 : MagicStrings.Assign('cc',unitstr); |
  488.     8 : MagicStrings.Assign('sp',unitstr); |
  489.     9 : MagicStrings.Assign('pp',unitstr); |
  490.    10 : MagicStrings.Assign('em',unitstr); |
  491.    11 : MagicStrings.Assign('ex',unitstr); |
  492.    ELSE
  493.     MagicStrings.Assign('mm',unitstr);  (* sollte nie vorkommen *)
  494.   END;
  495. END UnitToStr;
  496.  
  497. PROCEDURE CoordToStr(coord : INTEGER; VAR str : ARRAY OF CHAR);
  498. (* Liefert Angabe mit Einheit *)
  499. VAR unitstr, valuestr : ARRAY [0..127] OF CHAR;
  500. BEGIN
  501.   UnitToStr(unitstr);
  502.   ValueToStr(coord, valuestr);
  503.   MagicStrings.Assign(valuestr,str);
  504.   MagicStrings.Append(unitstr, str);
  505. END CoordToStr;
  506.  
  507. PROCEDURE ValueToStr(value : INTEGER; VAR str : ARRAY OF CHAR);
  508. (*
  509.    Liefert Angabe in Einheiten der Basis-Einheit (pt, cm, mm...)
  510.    ohne Angabe dieser Einheit, also z.B. bei einer unitlength
  511.    von 1/10 * 1cm liefert bei CommonData.InternalResolution=2
  512.    der Integer-Wert von 40 den String "2.000"
  513.    beim Faktor  1/1  : "20.00"
  514.    beim Faktor  1/10 : "2.000"
  515.    beim Faktor  1/100: "0.2000"
  516.    beim Faktor  10/1 : "200.0"
  517.    beim Faktor  100/1: "2000"
  518. *)
  519. VAR res      : ARRAY [0..127] OF CHAR;
  520.     pre, aft : INTEGER;
  521.     i, j     : INTEGER;
  522.     comma    : CARDINAL;
  523.     r        : LONGREAL;
  524.     minus    : BOOLEAN;
  525. BEGIN
  526.   minus  := value<0;
  527.   pre := ABS(value) DIV (CommonData.InternalResolution);
  528.   aft := ABS(value) MOD (CommonData.InternalResolution);
  529.   NumberToStr(pre, res);
  530.   (* Diese Lösung ist nicht unabhängig vom Wert von InternalResolution *)
  531.   MagicStrings.Append(aftstr[CommonData.InternalResolution, aft], res);
  532.   CASE FirstObject^.Code [ 6 ] DIV 0100H OF
  533.     0 : (* x 1     *) comma := 2; |
  534.     1 : (* x 1/10  *) comma := 3; |
  535.     2 : (* x 10    *) comma := 1; |
  536.     3 : (* x 1/100 *) comma := 4; |
  537.     4 : (* x 100   *) comma := 0; |
  538.    ELSE
  539.     comma := 2; (* sollte nicht vorkommen *)
  540.   END;
  541.   IF comma>0 THEN
  542.     WHILE (MagicStrings.Length(res) < comma) DO
  543.       MagicStrings.Insert('0', res, 0);
  544.     END;
  545.     MagicStrings.Insert('.', res, MagicStrings.Length(res) - comma);
  546.     IF res[0]='.' THEN
  547.       MagicStrings.Insert('0', res, 0);
  548.     END;
  549.     IF minus THEN
  550.       MagicStrings.Insert('-', res, 0);
  551.     END;
  552.   END;
  553.   MagicStrings.Assign(res,str);
  554. END ValueToStr;
  555.  
  556. PROCEDURE Value10ToStr(value : MagicSys.lINTEGER; VAR str : ARRAY OF CHAR);
  557. VAR res      : ARRAY [0..127] OF CHAR;
  558.     pre      : MagicSys.lINTEGER;
  559.     aft      : INTEGER;
  560.     i, j     : INTEGER;
  561.     comma    : CARDINAL;
  562.     r        : LONGREAL;
  563.     minus    : BOOLEAN;
  564. BEGIN
  565.   minus  := value<0;
  566.   pre := ABS(value) DIV LONG(CommonData.InternalResolution);
  567.   aft := SHORT(ABS(value) MOD LONG(CommonData.InternalResolution));
  568.   MagicConvert.LIntToStr(pre, 20, res);
  569.   WHILE (res[0]=' ') DO MagicStrings.Delete(res, 0, 1); END;
  570.   (* Diese Lösung ist nicht unabhängig vom Wert von InternalResolution *)
  571.   MagicStrings.Append(aftstr[CommonData.InternalResolution, aft], res);
  572.   CASE FirstObject^.Code [ 6 ] DIV 0100H OF
  573.     0 : (* x 1     *) comma := 3; |
  574.     1 : (* x 1/10  *) comma := 4; |
  575.     2 : (* x 10    *) comma := 2; |
  576.     3 : (* x 1/100 *) comma := 5; |
  577.     4 : (* x 100   *) comma := 1; |
  578.    ELSE
  579.     comma := 3; (* sollte nicht vorkommen *)
  580.   END;
  581.   IF comma>0 THEN
  582.     WHILE (LENGTH(res) < comma) DO
  583.       MagicStrings.Insert('0', res, 0);
  584.     END;
  585.     MagicStrings.Insert('.', res, LENGTH(res) - comma);
  586.     IF res[0]='.' THEN
  587.       MagicStrings.Insert('0', res, 0);
  588.     END;
  589.     IF minus THEN
  590.       MagicStrings.Insert('-', res, 0);
  591.     END;
  592.   END;
  593.   MagicStrings.Assign(res,str);
  594. END Value10ToStr;
  595.  
  596. PROCEDURE SimpleValueToStr(value : INTEGER; VAR str : ARRAY OF CHAR);
  597. (*
  598.    Liefert Angabe Als Vielfaches der Basis-Einheit (pt, cm, mm...)
  599.    unter berücksichtigung des Vorfaktors ohne Angabe dieser Einheit,
  600.    also z.B. bei einer unitlength von 1/10 * 1cm liefert bei
  601.    CommonData.InternalResolution=2 der Integer-Wert von 40 den
  602.    String "20.00"
  603. *)
  604. VAR res      : ARRAY [0..127] OF CHAR;
  605.     pre, aft : INTEGER;
  606.     i, j     : INTEGER;
  607.     comma    : CARDINAL;
  608.     r        : LONGREAL;
  609.     minus    : BOOLEAN;
  610. BEGIN
  611.   (* $D+*)
  612.   minus  := value<0;
  613.   pre := ABS(value) DIV (CommonData.InternalResolution);
  614.   aft := ABS(value) MOD (CommonData.InternalResolution);
  615.   NumberToStr(pre, res);
  616.   (* Diese Lösung ist nicht unabhängig vom Wert von InternalResolution *)
  617.   MagicStrings.Append('.', res);
  618.   MagicStrings.Append(aftstr[CommonData.InternalResolution, aft], res);
  619.   IF res[0]='.' THEN
  620.     MagicStrings.Insert('0', res, 0);
  621.   END;
  622.   IF minus THEN
  623.     MagicStrings.Insert('-', res, 0);
  624.   END;
  625.   MagicStrings.Assign(res,str);
  626.   (* $D-*)
  627. END SimpleValueToStr;
  628.  
  629. PROCEDURE SimpleValue10ToStr(  value : MagicSys.lINTEGER;
  630.                              VAR str : ARRAY OF CHAR);
  631. (*
  632.    Liefert Angabe Als Vielfaches der Basis-Einheit (pt, cm, mm...)
  633.    unter berücksichtigung des Vorfaktors ohne Angabe dieser Einheit,
  634.    also z.B. bei einer unitlength von 1/10 * 1cm liefert bei
  635.    CommonData.InternalResolution=2 der Integer-Wert von 40 den
  636.    String "20.00"
  637. *)
  638. VAR res      : ARRAY [0..127] OF CHAR;
  639.     tmp      : ARRAY [0..2] OF CHAR;
  640.     aft      : INTEGER;
  641.     pre10,
  642.     aft10    : INTEGER;
  643.     pre      : MagicSys.lINTEGER;
  644.     i, j     : INTEGER;
  645.     comma    : CARDINAL;
  646.     r        : LONGREAL;
  647.     minus    : BOOLEAN;
  648. BEGIN
  649.   (* $D+*)
  650.   minus  := value<0;
  651.   pre := ABS(value) DIV LONG(CommonData.InternalResolution);
  652.   pre10 := SHORT(pre DIV 10);
  653.   aft10 := SHORT(pre MOD 10);
  654.   aft   := SHORT(ABS(value) MOD LONG(CommonData.InternalResolution));
  655.   NumberToStr(pre10, res);
  656.   (* Diese Lösung ist nicht unabhängig vom Wert von InternalResolution *)
  657.   tmp := '.?';
  658.   tmp[1] := CHR(ORD(aft10) + ORD('0'));
  659.   MagicStrings.Append(tmp, res);
  660.   MagicStrings.Append(aftstr[CommonData.InternalResolution, aft], res);
  661.   MagicStrings.Append(aftstr[CommonData.InternalResolution, aft], res);
  662.   IF res[0]='.' THEN
  663.     MagicStrings.Insert('0', res, 0);
  664.   END;
  665.   IF minus THEN
  666.     MagicStrings.Insert('-', res, 0);
  667.   END;
  668.   MagicStrings.Assign(res,str);
  669.   (* $D-*)
  670. END SimpleValue10ToStr;
  671.  
  672. PROCEDURE GetOneVal(VAR str : ARRAY OF CHAR;
  673.                     VAR val : INTEGER;
  674.                       reals : BOOLEAN);
  675. VAR r  : LONGREAL;
  676.     ok : BOOLEAN;
  677. BEGIN
  678. (*
  679.    Im übergebenen String steht eine Zahl. Diese wird extrahiert und in
  680.    Integer-Wert gewandelt (eventuell mit vorheriger Konversion der
  681.    Koordinaten in die internen Rasterkoordinaten (1/4 mm Auflösung)
  682.  *)
  683.   val := 0;
  684.   r := MagicConvert.StrToReal(str);
  685.   IF reals THEN
  686.     r := r * MathLib0.real(CommonData.InternalResolution); (* Auflösung 1/4 mm *)
  687.   END;
  688.   val := round ( r );
  689. END GetOneVal;
  690.  
  691. PROCEDURE StrToCoord(VAR coord : INTEGER; VAR str : ARRAY OF CHAR);
  692. (* Wandelt Text in Koordinatenangabe *)
  693. BEGIN
  694. (*
  695.    Im übergebenen String steht eine Zahl. Diese wird extrahiert und in
  696.    Integer-Wert gewandelt (mit vorheriger Konversion der
  697.    Koordinaten in die internen Rasterkoordinaten (1/4 mm Auflösung)
  698. *)
  699.   GetOneVal(str, coord, TRUE);
  700. END StrToCoord;
  701.  
  702. PROCEDURE StrToValue(VAR value : INTEGER; VAR str : ARRAY OF CHAR);
  703. (* Wandelt Text in Wertangabe *)
  704. BEGIN
  705. (*
  706.    Im übergebenen String steht eine Zahl. Diese wird extrahiert und in
  707.    Integer-Wert gewandelt.
  708. *)
  709.   GetOneVal(str, value, FALSE);
  710. END StrToValue;
  711.  
  712. PROCEDURE InitAftComma;
  713. VAR i, j : INTEGER;
  714. BEGIN
  715.   FOR i:=1 TO 5 DO FOR j:=1 TO 4 DO aftstr[i, j] := ''; END; END;
  716.   FOR i:=1 TO 5 DO aftstr[i, 0] := '00'; END;
  717.   aftstr[2, 1] := '50';
  718.   aftstr[3, 1] := '33'; aftstr[3, 2] := '67';
  719.   aftstr[4, 1] := '25'; aftstr[4, 2] := '50'; aftstr[4, 3] := '75';
  720.   aftstr[5, 1] := '20'; aftstr[5, 2] := '40'; aftstr[5, 3] := '60';
  721.   aftstr[5, 4] := '80';
  722. END InitAftComma;
  723.  
  724. (* Die Durchmesser der Kreise und Scheiben sind beschränkt. *)
  725. (* Im LaTeX-Manual werden 40 pts bzw. 15 pts angegeben.     *)
  726. (* Somit ergeben sich folgende Radien.                      *)
  727.  
  728. (*
  729.    Merke: Die Auflösung beträgt immer ein 1/4 der momentanen
  730.           \unitlength
  731.           MaxCircle  MaxDisk
  732.  In mm:      21         8
  733.  In cm:       2         1      (   10mm = 1cm    )
  734.  In pt:      60        24      (    1pt = 0.351mm)
  735.  In pc:       5         2      (    1pc = 12pt   )
  736.  In in:       1         1      (    1in = 72.27pt)
  737.  In bp:      60        24      (    72p = 1in    )
  738.  In dd:      56        23      ( 1157dd = 1238pt )
  739.  In cc:       5         2      (    1cc = 12dd   )
  740.  In sp:   32767     32767      (65536sp = 1pt    )
  741.  In pp:     249       100      (  300pp = 1in    ) (Laserdruckerauflösung)
  742. *)
  743.  
  744. PROCEDURE MaxValue(ForCircle : BOOLEAN) : INTEGER;
  745. (* wie oben angegeben *)
  746. VAR factor        : LONGREAL;
  747.     MaxValInPts   : LONGREAL;
  748.     result        : INTEGER;
  749. BEGIN
  750. (**
  751.   IF ForCircle THEN
  752.     MaxValInPts := 2621440.0;  (* 40 * 65536  *)
  753.    ELSE
  754.     MaxValInPts :=  983040.0;  (* 15 * 65536 *)
  755.   END;
  756. **)
  757.   IF ForCircle THEN
  758.     MaxValInPts := 1310720.0;  (* 20 * 65536  *)
  759.    ELSE
  760.     MaxValInPts :=  491520.0;  (* 7.5* 65536 *)
  761.   END;
  762.   IF CommonData.LimitedDisk THEN
  763.     CASE (FirstObject^.Code[6] MOD 0100H) OF
  764.       0 : (* mm *) factor :=  186467.0; |
  765.       1 : (* cm *) factor := 1864679.0; |
  766.       2 : (* pt *) factor :=   65536.0; |
  767.       3 : (* pc *) factor :=  786432.0; |
  768.       4 : (* in *) factor := 4736286.0; |
  769.       5 : (* bp *) factor :=   65781.0; |
  770.       6 : (* dd *) factor :=   70124.0; |
  771.       7 : (* cc *) factor :=  841489.0; |
  772.       8 : (* sp *) factor :=       1.0; |
  773.       9 : (* pp *) factor := 4736286.0 / 300.0; | (* 300 dpi *)
  774.      10 : (* em *) factor :=  655361.0; | (* 10pt *)
  775. (**
  776.      10 : (* em *) factor :=  717621.0; | (* 11pt *)
  777.      10 : (* em *) factor :=  770040.0; | (* 12pt *)
  778. **)
  779.      11 : (* ex *) factor :=  282168.0; | (* 10pt *)
  780. (**
  781.      11 : (* ex *) factor :=  308974.0; | (* 11pt *)
  782.      11 : (* ex *) factor :=  338603.0; | (* 12pt *)
  783. **)
  784.   ELSE
  785.      (* mm *) factor := 186467.0;  (* sollte nie vorkommen *)
  786.     END;
  787.     CASE (FirstObject^.Code[6] DIV 0100H) OF
  788.       0 : (* x 1     *) |
  789.       1 : (* x 1/10  *) factor := factor / 10.0; |
  790.       2 : (* x 10    *) factor := factor * 10.0; |
  791.       3 : (* x 1/100 *) factor := factor / 100.0; |
  792.       4 : (* x 100   *) factor := factor * 100.0; |
  793.      ELSE
  794.       (* sollte nicht vorkommen *)
  795.     END;
  796.     MaxValInPts := MaxValInPts / factor *
  797.                    MathLib0.real(CommonData.InternalResolution);
  798.     IF MaxValInPts>32767.0 THEN
  799.       result := 32767;
  800.      ELSE
  801.       result := round( MaxValInPts );
  802.     END;
  803.    ELSE
  804.     result := 32767;
  805.   END;
  806.   RETURN result;
  807. END MaxValue;
  808.  
  809. PROCEDURE MaxCircle() : INTEGER;
  810. (* wie oben angegeben *)
  811. BEGIN
  812.   RETURN MaxValue(TRUE);
  813. END MaxCircle;
  814.  
  815. PROCEDURE MaxDisk() : INTEGER;
  816. (* wie oben angegeben *)
  817. BEGIN
  818.   RETURN MaxValue(FALSE);
  819. END MaxDisk;
  820.  
  821.  
  822. BEGIN
  823. (**
  824.   RTD.SetDevice(RTD.printer);
  825. **)
  826.   IgnoreMode  := FALSE;
  827.   zoomit      := FALSE;
  828.   zoomfak     := 1.0;
  829.   FirstObject := NIL;
  830.   LastObject  := NIL;
  831.   secondadr   := NIL;
  832.   numbers[1] := 0;
  833.   numbers[2] := 0;
  834.   numbers[3] := 0;
  835.   numbers[4] := 0;
  836. (**
  837.   InitSentinel;
  838. **)
  839.   InitAftComma;
  840. END Variablen.
  841.