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

:Program.    EdLowLevel.mod
:Contents.   Lowlevel-Support-Routines for AmokEd
:Author.     Hartmut Goebel
:Language.   Oberon
:Translator. AmigaOberon V2.00
:Imports.    Printf (Volker Rudolph), SupLib (Hartmut Goebel)
:History.    V0.1, 03 Dec 1990 Hartmut Goebel
:History.    V1.0, 14 Apr 1991 Hartmut Goebel [hG]
:History.    V1.1, 22 Apr 1991 [hG] New/FreeLine über Exec.Alloc/FreeMem
:History.    V1.2, 28 Apr 1991 [hG] +TextInit -NewEdit
:History.    V1.2b 29 Apr 1991 [hG] ^WindowTitle
:History.    V1.2c 29 May 1991 [hG] changed check of Dos-Version
:History.    V1.2d 19 Jun 1991 [hG] +neue FreeLines() (Volker Rudolph)
:History.    V1.2e 12 Oct 1991 [hG] +NCStrCmp
:History.    V1.2f 18 Oct 1991 [hG] +DeletePort
:Date.       19 Oct 1991 03:02:00

*************************************************************************)
(* $Debug- *)
MODULE EdLowLevel;

IMPORT
  Printf, (*io,*)
  arg: Arguments,
  con: Console,
  d  : Dos,
  e  : Exec,
  eAD: EdApplDefs,
  es : ExecSupport,
  edE: EdErrors,
  edG: EdGlobalVars,
  g  : Graphics,
  I  : Intuition,
  ie : InputEvent,
  lst: EdLists,
  ol : OberonLib,
  sl : SupLib,
  str: Strings,
  s  : SYSTEM;

VAR
  TitleText: edG.StringPtr; (* sicherstellen, daß Titel erhalten bleibt *)

CONST
  CTRLC = LONGSET{d.ctrlC};

PROCEDURE MoveToCursor*;
BEGIN
  g.Move(edG.RPort,edG.XTBase+(edG.Text.pos-edG.Text.topPos)*edG.XSize,
         edG.YTBase+(SHORT(edG.Text.line-edG.Text.topLine))*edG.YSize);
END MoveToCursor;

(*-------------------------------------------------------------------------*)

PROCEDURE Length(str{8}: edG.StringPtr): INTEGER;
VAR
  p: edG.StringPtr;
BEGIN
  WHILE str[0] # 0X DO
    INC(str); END;
  RETURN SHORT(s.VAL(LONGINT,str)-s.VAL(LONGINT,p));
END Length;


PROCEDURE CopyString*(from: edG.StringPtr): edG.StringPtr;
VAR
  len: INTEGER;
  new: edG.StringPtr;
BEGIN
  IF from=NIL THEN RETURN NIL; END;
  len := str.Length(from^)+1;
  ol.New(new,len);
  IF new=NIL THEN
    INCL(edG.Status,edG.memoryFail); edG.Rc := edE.cmdSevere;
    RETURN NIL;
  END;
  e.CopyMem(from^,new^,len);
  RETURN new;
END CopyString;


PROCEDURE FreeString*(string: edG.StringPtr);
BEGIN
  DISPOSE(string);
END FreeString;


(* $Debug= *)
PROCEDURE NCStrCmp*(str1{8}, str2{9}: edG.StringPtr): INTEGER;
BEGIN
  WHILE CAP(str1[0]) = CAP(str2[0]) DO
    IF str1[0] = 0X THEN
      RETURN 0; END;
    INC(str1); INC(str2);
  END;
  RETURN ORD(str1[0])-ORD(str2[0]);
END NCStrCmp;
(* $Debug- *)

(*-------------------------------------------------------------------------*)

PROCEDURE IsAscii*(ch{0}: CHAR): BOOLEAN;
BEGIN
 CASE ch OF
   "0".."9","A".."Z","a".."z","_",CHR(192)..CHR(255): RETURN TRUE;
 ELSE
   RETURN FALSE;
 END;
END IsAscii;


PROCEDURE WordLen*(str{8}: edG.StringPtr): INTEGER;
VAR
  i: INTEGER;
BEGIN
  i := 0;
  WHILE (str[0] # 0X) AND (str[0] # " ") DO
    INC(i);
    INC(str);
  END;
  RETURN i;
END WordLen;


PROCEDURE LastNoSpace*(string{8}: edG.StringPtr): INTEGER;
VAR
  i: INTEGER;
BEGIN
  i := str.Length(string^);
  REPEAT
    DEC(i);
  UNTIL (i = 0) OR (string[i] # " ");
  RETURN i;
END LastNoSpace;


PROCEDURE FirstNoSpace*(string{8}: edG.StringPtr): INTEGER;
VAR
  i: INTEGER;
BEGIN
  i := 0;
  WHILE string[i] = " " DO
    INC(i);
  END;
  IF string[i] = "\o" THEN i := 0; END;
  RETURN i;
END FirstNoSpace;


PROCEDURE StripEndSpaces*;
VAR
  len: INTEGER;
BEGIN
  len := str.Length(edG.LineBuffer);
  REPEAT
    DEC(len);
  UNTIL (len < 0) OR (edG.LineBuffer[len] # 20X);
  INC(len);
  edG.LineBuffer[len] := 0X;
  edG.LineBufferLen := len;
END StripEndSpaces;


PROCEDURE FillUpSpaces*;
VAR
  j, i: INTEGER;
BEGIN
  i := edG.Text.pos;
  j := edG.LineBufferLen;
  WHILE i > j DO
    edG.LineBuffer[j] := 20X;
    INC(j);
  END;
  edG.LineBuffer[j] := 0X;
  edG.LineBufferLen := j;
END FillUpSpaces;

(*-------------------------------------------------------------------------*)

PROCEDURE FreeLines*(VAR List: lst.List; Start, End: edG.LinePtr);
VAR
  This: edG.LinePtr;
  TempList: lst.Mark;
  memStart, memEnd:e.ADDRESS;
BEGIN
  lst.SetMark(TempList,Start,End);
  lst.RemoveMark(List,TempList);
  TempList.tail.next := NIL;
  This := TempList.head(edG.Line);
  memStart := This;
  memEnd := This;
  REPEAT
    TempList.head := This.next; (* gar nicht erst Remove, gleich freigeben *)
    WITH This:edG.Line DO

      IF memEnd = This THEN
        INC(memEnd,edG.LineAllocSize);
      ELSE
        e.FreeMem(memStart,memEnd-memStart);
        memStart := This;
        memEnd := s.VAL(LONGINT,This)+edG.LineAllocSize;
      END; (* IF *)

      IF memEnd = This.string THEN
        INC(memEnd,This.len);
      ELSE
        e.FreeMem(memStart,memEnd-memStart);
        memStart := This.string;
        memEnd := s.VAL(LONGINT,This.string)+This.len;
      END; (* IF *)

    END; (* WITH *)
    This := TempList.head;
  UNTIL This = NIL;

  e.FreeMem(memStart,memEnd-memStart);

END FreeLines;


PROCEDURE NewLine*(VAR line: edG.LinePtr; len: INTEGER);
BEGIN
  line := e.AllocMem(len+edG.LineAllocSize,LONGSET{});
  IF line # NIL THEN
    (* $TypeChk- *)
    WITH line:edG.Line DO
      s.INIT(line);
      line.string := s.VAL(LONGINT,line)+edG.LineAllocSize;
      line.string^ := "";
      line.len := len;
    END; (* WITH *)
    (* $TypeChk= *)
    RETURN;
  END;
  INCL(edG.Status,edG.memoryFail);
END NewLine;


PROCEDURE CreateLineCopy*(from: edG.LinePtr): edG.LinePtr;
VAR
  NewOne: edG.LinePtr;
BEGIN
  NewOne := e.AllocMem(from(edG.Line).len+edG.LineAllocSize,LONGSET{});
  IF NewOne#NIL THEN
    (* $TypeChk- *)
    WITH NewOne:edG.Line DO
      s.INIT(NewOne);
      NewOne.len := from(edG.Line).len;
      NewOne.string := s.VAL(LONGINT,NewOne)+edG.LineAllocSize;
      e.CopyMemQuick(from(edG.Line).string^,NewOne.string^,NewOne.len);
    END; (* WITH *)
    (* $TypeChk= *)
    RETURN NewOne;
  END;
  INCL(edG.Status,edG.memoryFail);
  RETURN NIL;
END CreateLineCopy;

(*-------------------------------------------------------------------------*)

PROCEDURE StrToInt*(string: edG.StringPtr; VAR int: LONGINT): BOOLEAN;
VAR
  n: INTEGER;
  neg: BOOLEAN;
BEGIN
  int := 0; neg := FALSE;
  WHILE string[0]=20X DO INC(string) END;
  CASE string[0] OF "-","+": neg := string[0]="-"; INC(string) ELSE END;
  LOOP
    CASE string[0] OF "0".."9":
      n := ORD(string[0])-ORD("0");
      IF int>(MAX(LONGINT)-n) DIV 10 THEN RETURN FALSE
                                     ELSE int := 10*int + n END |
    ELSE
      IF neg THEN int := -int END;
      WHILE string[0]=20X DO INC(string) END;
      RETURN string[0]=0X
    END;
    INC(string);
  END;
END StrToInt;

(*-------------------------------------------------------------------------*)

PROCEDURE KillMarks;
VAR
  i, j: INTEGER;
BEGIN
  i := edG.NumPingPongs;
  REPEAT (* remove PingPong Marks *)
    DEC(i);
    IF edG.PingPong[i].txt = edG.Text THEN edG.PingPong[i].txt := NIL; END;
  UNTIL i = 0;
  j := 0; (*i:=0*)
  REPEAT (* remove Block Marks *)
    IF edG.BStack[i].Owner # edG.Text THEN
      edG.BStack[j].Owner := edG.BStack[i].Owner;
      INC(j);
    END;
    INC(i);
  UNTIL i >= edG.BStackCurrDepth; (* >= wg. BStackCurrDepth = 0 *)
  edG.BStackCurrDepth := j;
  IF edG.Block.Owner = edG.Text THEN (* unblock *)
    edG.Block.SNum := -1; edG.Block.ENum := -1; END;
END KillMarks;


PROCEDURE TextInit*(VAR nw: I.NewWindow): edG.TextHeaderPtr;
VAR
  txt: edG.TextHeaderPtr;
BEGIN
  (* es ist unnötig, Felder mit NIL oder 0 zu initialisieren,
   * da ol.New mit {e.memClear} alloziert
   *)
  ol.New(txt,s.SIZE(edG.TextHeader));
  IF txt # NIL THEN (* $TypeChk- *)
    s.INIT(txt); (* $TypeChk= *)
    txt.name := edG.unNamed;
    txt.propGadget := edG.Gadget1;
    txt.propGadget.specialInfo := s.ADR(txt.propInfo);
    txt.propInfo := edG.Gadget1SInfo;
    nw.firstGadget := s.ADR(txt.propGadget);
    txt.window := sl.OpenPortWindow(nw,edG.MainPort);
      IF txt.window = NIL THEN
        DISPOSE(txt); RETURN NIL;
      END;
    I.SetWindowTitles(txt.window,s.ADR(edG.Copyright),-1);
    txt.numberOfLines := 1;
    NewLine(txt.actLinePtr,edG.ChunkSize);
    lst.AddHead(txt.lineList,txt.actLinePtr);
    txt.topLinePtr := txt.actLinePtr;
    txt.iconTop := 12;
    txt.margin := 69;
    lst.AddTail(edG.EditList,txt);
    IF edG.Text#NIL THEN (* nicht erster Text *)
      txt.dirLock := d.DupLock(edG.Text.dirLock);
      txt.status := edG.Text.status - LONGSET{edG.quit,edG.macroWithQuit,
                                              edG.keepTitle,edG.modified};
      txt.tabStop := edG.Text.tabStop;
      IF edG.Text.font#NIL THEN
        txt.font := edG.Text.font;
        INC(txt.font.accessors);
        g.SetFont(txt.window.rPort,txt.font);
      END;
    ELSE
      edG.Text := txt;
      txt.dirLock := d.DupLock(arg.Me.currentDir);
      txt.tabStop := 4;
      txt.status := LONGSET{edG.insertMode};
    END;
  END;
  RETURN txt;
END TextInit;


PROCEDURE EndEdit*;
BEGIN
  IF edG.Text.lineList.head#NIL THEN
    FreeLines(edG.Text.lineList,edG.Text.lineList.head(edG.Line),
              edG.Text.lineList.tail(edG.Line));
  END;
  IF edG.Text.font#NIL THEN
    g.SetFont(edG.RPort,edG.Text.window.wScreen.rastPort.font);
    g.CloseFont(edG.Text.font);
  END;
  IF edG.Text.window # NIL THEN sl.CloseWindowSafely(edG.Text.window); END;
  KillMarks;
  d.UnLock(edG.Text.dirLock);
  lst.Remove(edG.EditList,edG.Text);
  DISPOSE(edG.Text);
  edG.Text := edG.EditList.head(edG.TextHeader);
END EndEdit;

(*-------------------------------------------------------------------------*)

PROCEDURE Title*(winText{8}: ARRAY OF CHAR); (* $CopyArrays- *)
BEGIN
  I.SetWindowTitles(edG.Text.window,s.ADR(winText),-1);
END Title;


PROCEDURE doTitle*;
BEGIN
  DISPOSE(TitleText);
  TitleText := CopyString(edG.Arg[0]);
  I.SetWindowTitles(edG.Text.window,TitleText,-1);
  INCL(edG.Text.status,edG.keepTitle); edG.Rc := edE.cmdValid2;
END doTitle;

(*
 * zeigt edG.Text.actLineNum, edG.Text.numberOfLines, edG.Text.pos,
 * edG.Text.Name und ggf. Statusmeldungen an.
*)
PROCEDURE WindowTitle*;
CONST
 Modified = "(modified)\o";
VAR
  Win: I.WindowPtr;
  len, maxlen: INTEGER;
  font, oldfont: g.TextFontPtr;
  mod: ARRAY 11 OF CHAR;
BEGIN
  IF edG.memoryFail IN edG.Status THEN
    I.SetWindowTitles(edG.Text.window,s.ADR(edG.NoMemory),-1);
    RETURN;
  END;
  IF (edG.Rc > edE.TitleThreshhold) THEN RETURN; END;

  IF edG.modified IN edG.Text.status THEN
    e.CopyMem(Modified,mod,11);
  ELSE
    e.CopyMem(edG.Spaces,mod,11);
  END;
  Printf.SPrintf5(edG.Text.wTitle,"%3ld/%-3ld %3ld %s %s  ",
                  edG.Text.line+1,edG.Text.numberOfLines,edG.Text.pos+1,
                  s.ADR(edG.Text.name),s.ADR(mod));
  Win := edG.Text.window;
  oldfont := Win.rPort.font;
  g.SetFont(Win.rPort,Win.wScreen.rastPort.font);

  IF edG.kick20 IN edG.Status THEN
    I.SetWindowTitles(Win,s.ADR(edG.Text.wTitle),-1);
  ELSE
    len := str.Length(edG.Text.wTitle);
    Win.title := s.ADR(edG.Text.wTitle);
    font := Win.rPort.font;
    maxlen := (Win.width-90) DIV font.xSize;
    IF maxlen < 0 THEN maxlen := 0; END;
    IF len > maxlen THEN len := maxlen; END;
    g.SetAPen(Win.rPort,0); g.SetBPen(Win.rPort,1);
    g.Move(Win.rPort,30,font.baseline+1);
    g.Text(Win.rPort,edG.Text.wTitle,len);      (*  No flash  *)
    g.SetAPen(Win.rPort,1); g.SetBPen(Win.rPort,0);
    IF maxlen - len > 0 THEN
      g.RectFill(Win.rPort,Win.rPort.x,1,Win.width-54,font.ySize+1);
    END;
  END;
  g.SetFont(Win.rPort,oldfont);
END WindowTitle;

(*-------------------------------------------------------------------------*)
(*
 *  Check break by scanning pending messages in the I stream for a ^C.
 *  msgCheck forces a check, else the check is only made if the signal is
 *  set in the I stream (the signal is reset).
 *)
(* $Debug= *)
PROCEDURE BreakCheck*(): BOOLEAN;
VAR
  im: I.IntuiMessagePtr;

  class: LONGSET;
  qual: SET;
  code: INTEGER;

BEGIN
  IF (edG.msgCheck IN edG.Status)
  OR (edG.MainPort.sigBit IN e.SetSignal(LONGSET{},LONGSET{})) THEN
    EXCL(edG.Status,edG.msgCheck);
    s.SETREG(0,e.SetSignal(LONGSET{},
                           LONGSET{edG.MainPort.sigBit})); (* Löschen *)
    e.Forbid();
    im := edG.MainPort.msgList.head;
    WHILE im.execMessage.node.succ # NIL DO

      class := im.class; qual := im.qualifier-{ie.capsLock,8..15};
      code := im.code;

      IF (im.idcmpWindow = edG.Text.window)
      AND (im.class = LONGSET{I.rawKey}) (* is IDCMPFlag, not ie.Class *)
      AND ({ie.control} = im.qualifier-{ie.capsLock,8..15})
          (* only check Qualifier-Keys (lower 8 Bits) *)
      AND (im.code = s.VAL(SHORTINT,edG.CtrlC)) THEN
        e.Permit();
        (*
        io.WriteInt(s.VAL(LONGINT,class),5);
        io.WriteInt(s.VAL(INTEGER,qual),5);
        io.WriteInt(s.VAL(INTEGER,code),5);io.WriteLn;
        io.Write("+");
        *)
        s.SETREG(0,e.SetSignal(CTRLC,CTRLC)); (* setzen *)
        RETURN TRUE;
      END;
      im := im.execMessage.node.succ;
    END;
    e.Permit();
    (*
    io.WriteInt(s.VAL(LONGINT,class),5);
    io.WriteInt(s.VAL(INTEGER,qual),5);
    io.WriteInt(s.VAL(INTEGER,code),5);io.WriteLn;
    *)
  END;
  (*io.Write("-");*)
  RETURN FALSE;
END BreakCheck;
(* $Debug- *)

PROCEDURE BreakReset*;
BEGIN;
  s.SETREG(0,e.SetSignal(LONGSET{},CTRLC));
END BreakReset;

(*-------------------------------------------------------------------------*)

(* Sucht <txt>, zu dem <win> gehört *)

PROCEDURE FindEdit*(win{8}: I.WindowPtr): edG.TextHeaderPtr;
VAR
  txt: edG.TextHeaderPtr;
BEGIN
  IF win = NIL THEN RETURN NIL; END;
  txt := edG.EditList.head(edG.TextHeader);
  WHILE txt # NIL DO
    IF txt.window = win THEN RETURN txt; END;
    txt := txt.node.next(edG.TextHeader);
  END;
  RETURN NIL;
END FindEdit;

(*-------------------------------------------------------------------------*)

PROCEDURE DeletePort*(port: e.MsgPortPtr);
VAR
  n, s: e.MessagePtr;
BEGIN
  e.Forbid();
  n := port.msgList.head;
  WHILE n.node.succ # NIL DO
    s := n.node.succ;
    IF n.replyPort # port THEN (* Message does not belong to us *)
      e.Remove(n);
      e.ReplyMsg(n);
    END;
    n := s;
  END;
  e.Permit;
  es.DeletePort(port);
END DeletePort;


(*-------------------------------------------------------------------------*)

BEGIN
  (*
  edG.Text := NIL;
  lst.Init(edG.EditList);
  edG.LineBuffer := ""; edG.LineBufferLen := 0;
  *)

  edG.MainPort := es.CreatePort("",0);
    IF edG.MainPort = NIL THEN HALT(20); END;
  edG.MainReq := es.CreateExtIO(edG.MainPort,s.SIZE(e.IOStdReq));
    IF edG.MainReq = NIL THEN HALT(20); END;
  s.SETREG(0,e.OpenDevice(con.consoleName,-1,edG.MainReq,LONGSET{}));
  con.base := edG.MainReq.device;

  IF d.dos.lib.version>=36 THEN INCL(edG.Status,edG.kick20);
  ELSE EXCL(edG.Status,edG.kick20);
  END;

CLOSE
  WHILE edG.EditList.head#NIL DO  (* falls noch was offen ist *)
    EndEdit; END;
  IF edG.DelLinePtr # NIL THEN
    e.FreeMem(edG.DelLinePtr(edG.Line).string,edG.DelLinePtr(edG.Line).len);
    e.FreeMem(edG.DelLinePtr,edG.LineAllocSize);
  END;

  IF con.base # NIL THEN e.CloseDevice(edG.MainReq); END;
  IF edG.MainReq # NIL THEN es.DeleteExtIO(edG.MainReq); END;
  IF edG.MainPort # NIL THEN es.DeletePort(edG.MainPort); END;
END EdLowLevel.