(*************************************************************************

:Program.    EdGadgets.mod
:Contents.   Gadget-Routines for AmokEd (Datas in EdGlobalVars)
:Author.     Hartmut Goebel
:Copyright.  Copyright © 1989 by Thomas Siemens and Volker Rudolph
:Copyright.  Oberon-Implementation Copyright © 1991 by Hartmut Goebel
:Language.   Oberon
:Translator. Amiga Oberon Compiler V2.13
:History.    V1.0 19 Feb 1991 Hartmut Goebel [hG]
:History.    V1.1 16 Nov 1991 [hG] PropGadget funktioniert fast
:History.    V1.2 12 Dec 1991 [hG] PropSupport included (von Kay Bolai)
:History.    V1.3 19 Jan 1992 [hG] -Bug: Overflow in Proportion
:History.    V1.4 08 Feb 1992 [hG],Tobias Ruland -Bug: Overflow in Fraction
:Date.       08 Feb 1992 11:48:14

*************************************************************************)

MODULE EdGadgets;

IMPORT
  edD: EdDisplay,
  edG: EdGlobalVars,
  I  : Intuition,
  g  : Graphics,
  lst: EdLists,
  s:   SYSTEM;

VAR
  KnobModified: BOOLEAN;
  noSetProp: BOOLEAN;
  long: LONGINT;

(*------------- Begin PropSupport ------------*)

(**********************************************************************

:Program.    PropSupport.mod
:Contents.   Support procedures for PropGadgets
:Author.     Nicolas Benezan [bne], HArtmut Goebeb [hG], Tobias Ruland
:Address.    Postwiesenstr. 2, D7000 Stuttgart 60
:Phone.      711/333679
:Copyright.  (c) 1990 by Nicolas Benezan. All rights reserved.
:Language.   Oberon
:Translator. AmigaOberon Compiler V2.13
:History.    V1.0 [bne] 03.Aug.1990
:History.    V1.1 [bne] 08.Sep.1990 (bug fixes)
:History.    V1.1b [hG] 12 Dec 1991 Proportion returns -1, if Max <0
:History.    V1.3 19 Jan 1992 [hG] -Bug: Overflow in Proportion
:History.    V1.4 08 Feb 1992 [hG],Tobias Ruland -Bug: Overflow in Fraction

**********************************************************************)

TYPE
  CARDINAL = INTEGER;

CONST
  MAXCARD = 0FFFFH;
  ASL15   = 08000H;  (* = MAX(LONGINT) DIV MAXCARD; *)

(* $ReturnChk- *)
PROCEDURE LONGtoCARD (Long{0}: LONGINT): CARDINAL;
(* $EntryExitCode- *)
BEGIN
  s.INLINE (00C80H, 00001H, 00000H);  (* CMPI.L #00010000,D0 *)
  s.INLINE (06502H);                  (* BCS.S  2            *)
  s.INLINE (04E40H);                  (* TRAP   #0           *)
  s.INLINE (04E75H);                  (* RTS                 *)
END LONGtoCARD;

PROCEDURE CARDtoLONG (Card{0}: CARDINAL): LONGINT;
(* $EntryExitCode- *)
BEGIN
  s.INLINE (00280H, 00000H, 0FFFFH);  (* ANDI.L #0000FFFF,D0 *)
  s.INLINE (04E75H);                  (* RTS                 *)
END CARDtoLONG;
(* $ReturnChk= *)

(*
 * Berechnet die Position des Scrollers
 *)

(*
PROCEDURE LowFraction {"LowFraction"}(Num{0},Max{1}: LONGINT): LONGINT;
PROCEDURE Fraction020 {"Fraction020"}(Num{0},Max{1}: LONGINT): LONGINT;
*)
PROCEDURE HighFraction{"HighFraction"}(Num{0},Max{1}: LONGINT): LONGINT;

PROCEDURE Fraction (Num, Max: LONGINT): CARDINAL;
BEGIN
IF Num >= Max THEN
    RETURN -1; (* MAXCARD *)
  ELSIF Num <= ASL15 THEN
    RETURN LONGtoCARD (Num * MAXCARD DIV Max)
  ELSE
    RETURN LONGtoCARD (HighFraction(Num,Max));
  END;
END Fraction;

PROCEDURE GuckyFraction (Num, Max: LONGINT): CARDINAL;
(* Lösungsvorschlag von Gerog (Gucky) Hessman *)
BEGIN
  IF Num >= Max THEN
    RETURN -1; (* MAXCARD *)
  ELSIF Num <= ASL15 THEN    (* to avoid Overflow *)
    RETURN LONGtoCARD (Num * MAXCARD DIV Max)
  ELSIF Num <= ASH(1,19) THEN
    RETURN LONGtoCARD(ASH(ASH(Num,12) DIV Max,4));
  ELSIF Num <= ASH(1,23) THEN
    RETURN LONGtoCARD(ASH(ASH(Num,8) DIV Max,8));
  ELSIF Num <= ASH(1,27) THEN
    RETURN LONGtoCARD(ASH(ASH(Num,4) DIV Max,12));
  ELSE
    RETURN -1; (* MAXCARD *)
  END;
END GuckyFraction;

(*
 * Berechnet aus Scroller-Position die Element-Nummer
 *)
PROCEDURE Proportion (Pot: CARDINAL;
                      Max: LONGINT): LONGINT;
BEGIN
  IF Max < 0 THEN
    RETURN -1                (* easier to check!! *)
  ELSIF Max <= ASL15 THEN    (* to avoid Overflow *)
    RETURN Max * CARDtoLONG(Pot) DIV MAXCARD
  ELSE
    RETURN Max DIV ASL15 * CARDtoLONG (Pot) DIV 2 +
           Proportion (Pot, Max MOD ASL15)
  END;
END Proportion;

(*------------- End PropSupport --------------*)

(*
 * Verschiebt den Scroller entsprechend der aktuellen Zeilennummer
 *)
PROCEDURE SetProp*; (* bei Änderungen Def. in edG. korrigieren!! *)
VAR
  newPot,newBody: CARDINAL;
  (*
  newPot,newBody: LONGINT;
  i: LONGINT;
  *)
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF noSetProp THEN RETURN; END;
  newBody := Fraction(edG.Rows,edG.Text.numberOfLines);
  newPot  := Fraction(edG.Text.topLine,edG.Text.numberOfLines-edG.Rows-1);

  IF KnobModified OR (edG.Text.propInfo.vertPot # newPot)
  OR (edG.Text.propInfo.vertBody # newBody) THEN
    I.NewModifyProp(edG.Text.propGadget,edG.Text.win,NIL,
                    edG.Text.propInfo.flags,0,newPot,0,newBody,1);
    KnobModified := FALSE;
  END;
END SetProp;


(*
 * Verschiebt den ScrollBar entsprechend
 * edG.Text.topLine und berechnet die Größe des Body.
 *
 * Muß von jeder Prozedur aufgerufen werden, die
 * die Zeilenanzahl ändert oder Zeilen verschiebt
 *)

PROCEDURE RecalcPropKnob*; (* bei Änderungen Def. in edG. korrigieren!! *)
CONST
  py = 12;
VAR
  px,
  kyStart,kyEnd,
  kHeight,cHeight: INTEGER; (* CARDINAL *)
  (*
  i: LONGINT;
  newPot: LONGINT; (* LONGCARD *)
  *)
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  IF edG.kick20 IN edG.Status THEN SetProp; RETURN; END;

  cHeight := edG.Text.propInfo.cHeight-5;
  px := edG.Text.win.width-12;

  edG.Text.propInfo.vertBody := Fraction(edG.Rows,edG.Text.numberOfLines);
  edG.Text.propInfo.vertPot := Fraction(edG.Text.topLine,
                                        edG.Text.numberOfLines-edG.Rows-1);
  IF edG.Rows <= edG.Text.numberOfLines THEN
    kHeight :=  SHORT(cHeight * edG.Rows DIV edG.Text.numberOfLines);
  ELSE
    kHeight := cHeight;
  END;

  IF kHeight < 3 THEN kHeight := 3; END;
  IF kHeight >= cHeight THEN kHeight := cHeight - 1; END;

  (* $RangeChk- *)
  kyStart := py + SHORT(edG.Text.propInfo.vertPot * (cHeight-kHeight) DIV 0FFFFH);
  (* $RangeChk= *)
  kyEnd := kyStart + kHeight;
  IF kyStart > kyEnd THEN kyEnd := kyStart; END;

  g.SetAPen(edG.RPort,0);
  g.RectFill(edG.RPort,px-2,py,px+9,py+cHeight);
  g.SetAPen(edG.RPort,1);
  g.RectFill(edG.RPort,px,kyStart,px+7,kyEnd);

  KnobModified := TRUE;
END RecalcPropKnob;


(*
 * Scrollt den Text entsprechend dem Verschieben des PropGadgets
 *)
PROCEDURE PropKnobAction*;
VAR
  n: LONGINT;
  diff: LONGINT;
  (* $ClearVars- *)
BEGIN
  (* $ClearVars= *)
  noSetProp := TRUE;
  n := Proportion(edG.Text.propInfo.vertPot,edG.Text.numberOfLines-edG.Rows);
  IF n >= 0 THEN   (* Text hat mehr Zeilen als Fenster *)
    IF n > edG.Text.numberOfLines-edG.Rows THEN (* nicht gezeigter Bereich *)
      IF edG.Text.numberOfLines <= edG.Rows THEN
        n := 0;
      ELSE
        n := edG.Text.numberOfLines-edG.Rows; (* nicht gezeigter Bereich *)
      END;
    END;
    diff := SHORT(n - edG.Text.topLine);
    IF diff # 0 THEN
      edD.TextCursor(FALSE);
      edD.PutBackLine;
      edG.Text.line := n + (edG.Text.line - edG.Text.topLine);
      edG.Text.topLine := n;
      LOOP (* Dummy *)
        IF diff > 0 THEN
          lst.GoForwardNil(edG.Text.actLinePtr,diff);
          lst.GoForwardNil(edG.Text.topLinePtr,diff);
          edD.TextLoad;
          IF (diff < ((edG.Rows * 2) DIV 3)) THEN
            g.ScrollRaster(edG.RPort,0,SHORT(edG.YSize*diff),edD.Col(0),edD.Row(0),
                           edD.Col(edG.Columns)-1,edD.Row(edG.Rows)-1);
            edD.TextDisplaySeg(SHORT(edG.Rows-diff),SHORT(diff));
            EXIT;
          END;
        ELSE
          diff := -diff;
          lst.GoBackwardNil(edG.Text.actLinePtr,diff);
          lst.GoBackwardNil(edG.Text.topLinePtr,diff);
          edD.TextLoad;
          IF (diff < ((edG.Rows * 2) DIV 3)) THEN
            g.ScrollRaster(edG.RPort,0,SHORT(-edG.YSize*diff),edD.Col(0),edD.Row(0),
                           edD.Col(edG.Columns)-1,edD.Row(edG.Rows)-1);
            edD.TextDisplaySeg(0,SHORT(diff));
            EXIT;
          END;
        END;
        edD.TextSync(TRUE);
        EXIT;
      END; (* DummyLoop *)
      edD.TextCursor(TRUE);
    END; (* IF diff#0 *)
    IF KnobModified THEN
      SetProp;
    END;
  END;
  noSetProp := FALSE;
END PropKnobAction;

(*
 * setzt PropGadget entsprechend up/down arrow
 *)
PROCEDURE DrawKnob*(num: INTEGER);
BEGIN
  CASE num OF
    2,3:
      KnobModified := TRUE;
      SetProp;
  ELSE END;
END DrawKnob;

BEGIN
  noSetProp := FALSE;

END EdGadgets.