(*---------------------------------------------------------------------------
    :Program.	  BackText.mod
    :Contents.	  Anzeige von Hilfstexten auf Tastendruck
    :Author.	  Bernd Preusing
    :Address.	  Gerhardstr. 16  D-2200 Elmshorn
    :Phone.	  04121/22486
    :Copyright.	  Public Domain
    :Language.	  Modula-2
    :Translator.  M2Amiga V3.2e
    :History.	  V1.0 05-May-89 Preusing
    :Imports.	  BackDrop V1.0 (Preusing)
    :Imports.	  HotKey V1.0 (Preusing)
    :Imports.	  PopMenu V1.0 (Preusing)
    :Bugs.	  Verwaltet höchstens 27 Menü-Einträge,
    :Bugs.	  Läuft nur auf PAL-Amigas
    :Remark.	  FastFonts von Workbench1.3 sollte installiert sein,
    :Remark.	  dann geht's wirklich schnell!
    :Usage.	  (run(back)) BackText FileName/A
---------------------------------------------------------------------------*)
MODULE BackText;

(* System: *)
FROM SYSTEM	 IMPORT	ADR, ADDRESS, CAST;
FROM Arts	 IMPORT	CurrentLevel, Terminate, Assert, TermProcedure,
			DetectCtrlC;
(* M2Amiga: *)
FROM Arguments	 IMPORT	GetArg, NumArgs;
FROM ASCII	 IMPORT	eol, nul;
FROM Dos	 IMPORT FileHandlePtr, Open, Close, Read, Seek,
			beginning, end, oldFile;
FROM Exec	 IMPORT	AllocMem, FreeMem, MemReqSet, WaitPort, ReplyMsg,
			GetMsg;
FROM Graphics	 IMPORT	RastPortPtr, ClearEOL, Move, RectFill,
			SetAPen, SetBPen, Text;
FROM InputEvent	 IMPORT	Qualifiers, QualifierSet;
FROM Intuition	 IMPORT	IDCMPFlags, IDCMPFlagSet, ModifyIDCMP, IntuiMessagePtr,
			WindowFlags, menuUp, menuDown, selectDown;
(* Preusing: *)
FROM BackDrop	 IMPORT	BdRp, BdWindow, OpenBackDrop, CloseBackDrop;
FROM HotKey	 IMPORT	InstallKey, HELP, RAMIGA;
FROM PopMenu	 IMPORT	PopUpItem, PopUpMenu, StructPopUp, AddItem,
			InitPopUp, PopUp, NOITEMSELECTED, OUTSIDEWINDOW;


CONST
	ActivationKey=HELP;
	ActivationQual = RAMIGA;
	PORTNAME ='BackTextPort_1.0';

	TEXTLINES = 31; (* für NTSC: 24 *)
	SCREENHEIGHT = TEXTLINES*8+12;
	MAXLENGTH = 500000; (* max. TextLänge *)
	MAXITEMS = ((SCREENHEIGHT-4) DIV 9)-1; (* 27, mehr geht nicht! *)
	ENDID = MAXITEMS+2;
	MAXSTRLEN = 25;
	SCREENDEPTH = 1;


TYPE
	ActionKey = (esc, up, aup, sup, down, adown, sdown);
	CharPtr = POINTER TO CHAR;
	TextPtr = POINTER TO ARRAY[0..MAXLENGTH] OF CHAR;
	CasePtr = RECORD (* spart ein paar CAST *)
		    CASE :INTEGER OF
		    | 0: cp: CharPtr;
		    | 1: in: LONGINT
		    END
		  END;
	LinePtr = POINTER TO ARRAY[0..MAXLENGTH] OF CasePtr;
	Str25 = ARRAY[0..MAXSTRLEN-1] OF CHAR;

VAR TextArr: TextPtr;
    LineArr:LinePtr;
    fh: FileHandlePtr;
    StartLevel:INTEGER;
    Lines:INTEGER;
    StartLine, EndLine: INTEGER;
    TextLength:LONGINT;
    WinRP: RastPortPtr;
    ActLine: INTEGER;
    Menu: PopUpMenu;
    Items: INTEGER;
    ItemArr: ARRAY[1..MAXITEMS+1] OF PopUpItem;
    ItemLines: ARRAY[1..MAXITEMS+1] OF INTEGER;
    ItemTexts: ARRAY[1..MAXITEMS] OF Str25;
    TextLoaded: BOOLEAN;
    FileName: ARRAY [0..63] OF CHAR;
    NameLen: INTEGER;

PROCEDURE FileLength(VAR file: FileHandlePtr):LONGINT;
VAR OldPos: LONGINT;
BEGIN
  OldPos:=Seek(file,0,end);
  RETURN Seek(file,OldPos,beginning);
END FileLength;

PROCEDURE ReadText();
VAR Len, Actual:LONGINT;
BEGIN
  fh:=Open(ADR(FileName),oldFile);
  Assert(fh#NIL,ADR('File nicht zu öffnen!'));
  Len:=FileLength(fh);
  TextLength:=Len+1;
  TextArr:=AllocMem(TextLength,MemReqSet{});
  Assert(TextArr#NIL,ADR('kein Speicher für TextArr'));
  Actual:=Read(fh,TextArr,Len);
  Assert(Actual=Len,ADR('Dos Lesefehler'));
  Close(fh);
  fh:=NIL;
  TextArr^[Len]:=nul;
END ReadText;

PROCEDURE CountLines(cp{0}:CharPtr);
VAR
  ActLine,i:LONGINT;

  PROCEDURE CopyItem(cp:CharPtr; VAR s:Str25);
  VAR i:INTEGER;
  BEGIN
    i:=0;
    WHILE cp^='_' DO INC(cp) END;
    WHILE (cp^#eol) AND (cp^#nul) AND (cp^#'_') AND (i<MAXSTRLEN) DO
      s[i]:=cp^;
      INC(i);
      INC(cp)
    END;
    s[i]:=nul;
  END CopyItem;

BEGIN
  cp:=CAST(CharPtr,TextArr);
  Lines:=0;
  (* $R- $V- *)
  WHILE cp^#nul DO
    IF cp^=eol THEN INC(Lines) END;
    INC(cp)
  END;
  LineArr:=AllocMem((Lines+2)*4,MemReqSet{});
  Assert(LineArr#NIL,ADR('kein Mem für LineArr'));
  cp:=CAST(CharPtr,TextArr);
  ActLine:=1;
  LineArr^[0].cp:=cp;
  WHILE cp^#nul DO
    IF cp^=eol THEN
      INC(cp);
      LineArr^[ActLine].cp:=cp;
      INC(ActLine)
    ELSE
      INC(cp)
    END
  END;
  StartLine:=0; EndLine:=Lines;
  StructPopUp(Menu,SCREENDEPTH,1,0);
  Items:=0;
  FOR i:=0 TO Lines-1 DO
    IF (LineArr^[i].cp^='_') AND (Items<MAXITEMS) THEN
      INC(Items);
      ItemLines[Items]:=i;
      CopyItem(LineArr^[i].cp,ItemTexts[Items]);
      AddItem(Menu,ItemArr[Items],ADR(ItemTexts[Items]),Items,1);
    END;
  END;
  ItemLines[Items+1]:=Lines;
  AddItem(Menu,ItemArr[Items+1],ADR('--- END PROGRAM ---'),ENDID,1);
  InitPopUp(Menu);
  Menu.deactivate:=menuUp;
  (* $R= $V= *)
END CountLines;


PROCEDURE ShowLines(VAR FirstLine:INTEGER);
TYPE
  TrickPtr = POINTER TO RECORD
			  my, next: LONGINT
			END;
VAR
  i:INTEGER;
  tp:TrickPtr;
  Length:INTEGER;
BEGIN
  IF FirstLine>EndLine-TEXTLINES THEN
    FirstLine:=EndLine-TEXTLINES
  END;
  IF FirstLine<StartLine THEN
    FirstLine:=StartLine
  END;
  tp:=CAST(TrickPtr,ADR(LineArr^[FirstLine]));
  FOR i:=0 TO TEXTLINES-1 DO
    Move(WinRP,0,i*8+(6+12));
    IF (i+FirstLine)<EndLine THEN
      WITH tp^ DO
	Length:=next-my-1;
      END;
      Text(WinRP,tp^.my,Length);
    ELSE
      Length:=0
    END;
    IF Length<80 THEN
      ClearEOL(WinRP);
    END;
    INC(tp,4);
  END;
END ShowLines;

PROCEDURE Init;
VAR Dummy: CharPtr;
BEGIN
  ReadText();
  CountLines(Dummy);
END Init;

PROCEDURE Cleanup;
BEGIN
  IF CurrentLevel()<=StartLevel THEN
    IF fh#NIL THEN Close(fh); fh:=NIL END;
    IF TextArr#NIL THEN FreeMem(TextArr,TextLength); TextArr:=NIL END;
    IF LineArr#NIL THEN FreeMem(LineArr,(Lines+2)*4); LineArr:=NIL END;
  END
END Cleanup;


PROCEDURE ShowIt; (* HotKeyProc *)
VAR
  IMsg: IntuiMessagePtr;

  PROCEDURE ReadAction():ActionKey; (* nur bei gültigem zurück *)
  VAR i:IntuiMessagePtr;
      Class:IDCMPFlagSet;
      Key:CARDINAL;
      Qual:QualifierSet;
      X,Y: INTEGER;
      Action:INTEGER;
  BEGIN
    LOOP
      WaitPort(BdWindow^.userPort);
      i:=GetMsg(BdWindow^.userPort);
      WITH i^ DO
	Key:=code;
	Qual:=qualifier;
	Class:=class;
	X:=mouseX;
	Y:=mouseY;
      END;
      ReplyMsg(i);
      IF Class = IDCMPFlagSet{rawKey} THEN
	CASE Key OF
	| 45H: (* esc *)
	  IF (lShift IN Qual) OR (rShift IN Qual) THEN
	    Terminate(CurrentLevel())
	  ELSE
	    RETURN esc;
	  END;
	| 4CH: (* up *)
	  IF (lShift IN Qual) OR (rShift IN Qual) THEN
	    RETURN sup
	  ELSIF (lAlt IN Qual) OR (rAlt IN Qual) THEN
	    RETURN aup
	  ELSE
	    RETURN up
	  END;
	| 4DH: (* down *)
	  IF (lShift IN Qual) OR (rShift IN Qual) THEN
	    RETURN sdown
	  ELSIF (lAlt IN Qual) OR (rAlt IN Qual) THEN
	    RETURN adown
	  ELSE
	    RETURN down
	  END;
	| ELSE
	END; (* CASE Key OF *)
      ELSIF (Class=IDCMPFlagSet{mouseButtons}) AND (Key=menuDown) THEN
	Action:=PopUp(Menu,BdWindow);
	CASE Action OF
	| ENDID:
	    Terminate(CurrentLevel());
	| OUTSIDEWINDOW,NOITEMSELECTED:
	    StartLine:=0;
	    EndLine:=Lines;
	| 1..MAXITEMS:
	    ActLine:=ItemLines[Action];
	    StartLine:=ActLine;
	    DEC(ActLine); (* wg down nachher *)
	    EndLine:=ItemLines[Action+1];
	    RETURN down;
	END;
      ELSIF (Class=IDCMPFlagSet{mouseButtons}) AND (Key=selectDown) THEN
	IF    (Y<10) AND (X<16) THEN RETURN esc (* Close-Gadget *)
	ELSIF Y<(62+12)   THEN RETURN aup
	ELSIF Y<(2*62+12) THEN RETURN up
	ELSIF Y>(3*62+12) THEN RETURN adown
	ELSIF Y>(2*62+12) THEN RETURN down
	END;
      END; (* IF ELSIF.. *)
    END; (* LOOP *)
  END ReadAction;

  PROCEDURE FetchMsg(VAR m:ADDRESS):ADDRESS;
  BEGIN (* für simple While-Schleife *)
    m:=GetMsg(BdWindow^.userPort);
    RETURN m
  END FetchMsg;

BEGIN (* ShowIt *)
  IF NOT TextLoaded THEN
    Init;
    TextLoaded:=TRUE;
    ActLine:=0;
  END;
  OpenBackDrop(SCREENDEPTH,640,SCREENHEIGHT,NIL);
  WinRP:=BdRp; (* für Speed *)
  (* $Z- (Parameter direkt in Register) *)
  RectFill(WinRP,0,0,639,9); (* Title invers *)
  SetAPen(WinRP,0);
  SetBPen(WinRP,1);
  RectFill(WinRP,4,2,12,7); (* Close-Gadget *)
  Move(WinRP,24,6+1);
  Text(WinRP,
    ADR('Info-Screen V1.0  © BP 1989  Menu-Button for Quick Reference'),60);
  INCL(BdWindow^.flags,rmbTrap);
  SetAPen(WinRP,1);
  SetBPen(WinRP,0);
  (* $Z= *)
  ModifyIDCMP(BdWindow,IDCMPFlagSet{rawKey,mouseButtons});
  LOOP
    ShowLines(ActLine); (* passt auch ActLine an *)
    CASE ReadAction() OF
    | up:    DEC(ActLine);
    | down:  INC(ActLine);
    | sup:   ActLine:=0;
    | sdown: ActLine:=Lines;
    | aup:   DEC(ActLine,TEXTLINES-1);
    | adown: INC(ActLine,TEXTLINES-1);
    | esc:   EXIT;
    | ELSE   (* nix *)
    END;
  END; (* loop *)
  WHILE FetchMsg(IMsg)#NIL DO (* userPort leeren *)
    ReplyMsg(IMsg)
  END;
  CloseBackDrop;
END ShowIt; (* und wieder schlafen gehen *)


BEGIN
  TextArr:=NIL;
  LineArr:=NIL;
  fh:=NIL;
  StartLevel:=CurrentLevel();
  TermProcedure(Cleanup);
  TextLoaded:=FALSE;
  DetectCtrlC(FALSE);
  Assert(NumArgs()=1,ADR('BackText FileName!!'));
  GetArg(1,FileName,NameLen);
  InstallKey(ActivationKey, ActivationQual, ShowIt, ADR(PORTNAME));
END BackText.