(*********************************************************************
 *
 *  :Program.		HilfsModul für Mastermind
 *  :Author.		Hans Schafft
 *  :Address.		Landfriedstraße 1A - Hinterhaus
 *  :Address.		6900 Heidelberg
 *  :Phone.		06221 - 22416
 *  :Version.		1.3
 *  :Date.		6/1990
 *  :Copyright.		PD
 *  :Language.		Modula-II
 *  :Translator.	M2Amiga
 *
 *********************************************************************)

IMPLEMENTATION MODULE BESTENLISTE;

FROM BenutzerEingabe	IMPORT	Eingabe;
FROM Arts		IMPORT	TermProcedure,Assert;
FROM SYSTEM		IMPORT	ADDRESS, LONGSET, ADR, BITSET;
FROM FileSystem 	IMPORT	Lookup,Close,Response,File,SetPos,
				ReadByteBlock, WriteByteBlock,Delete;
FROM Graphics		IMPORT	TextLength, jam1,Move,Text,SetAPen,SetRast,
				SetBPen,RastPortPtr,ScrollRaster,RectFill,jam2;
FROM FileMessage	IMPORT	ResponseText,StrPtr;
FROM Conversions	IMPORT	ValToStr;
FROM Str 		IMPORT	Copy,Length,Compare;
FROM Intuition		IMPORT	WindowPtr;

TYPE  Eintrag = RECORD
	stel : LONGINT;
	farb : LONGINT;
	vers : LONGINT;
	hilf : LONGINT;
	punk : LONGINT;
	name : ARRAY [1..20] OF CHAR;
      END;

VAR bl		: File;
    eintrag	: ARRAY [0..19] OF Eintrag;
    bewerber	: Eintrag;
    dummy	: Eintrag;
    err		: BOOLEAN;
    rpPtr	: RastPortPtr;

(***************************************************************)
PROCEDURE TextAusgabe(text : ARRAY OF CHAR; farbe,x,y : INTEGER);
BEGIN
  SetAPen(rpPtr,farbe);
  SetBPen(rpPtr,0);
  Move(rpPtr,x,y);
  Text(rpPtr,ADR(text),Length(text));
END TextAusgabe;

(***************************************************************)
PROCEDURE RichteBestenListeEin;
VAR x : CARDINAL;
   strPtr : StrPtr;
BEGIN
  Lookup(bl,"MMBestenListe",18*SIZE(Eintrag),TRUE);
  ResponseText(bl.res,strPtr);
  Assert(bl.res = done,strPtr);
  FOR x := 1 TO 18 DO
    WriteByteBlock(bl,eintrag[0]);
  END;
  Close(bl);
END RichteBestenListeEin;

(***************************************************************)
PROCEDURE BestenListeSuchen;
VAR strPtr : StrPtr;
    mm : CARDINAL;
BEGIN
  Lookup(bl,"MMBestenListe",18*SIZE(Eintrag),FALSE);
  IF bl.res = notFound THEN
    Close(bl);
    RichteBestenListeEin;
    Lookup(bl,"MMBestenListe",18*SIZE(Eintrag),FALSE);
    ResponseText(bl.res,strPtr);
    Assert(bl.res = done,strPtr);
  END;
  FOR mm := 1 TO 18 DO
    ReadByteBlock(bl,eintrag[mm]);
  END;
  Close(bl);
END BestenListeSuchen;

(***************************************************************)
PROCEDURE Einordnen;
VAR x,k : CARDINAL;
BEGIN
 eintrag[19] := bewerber;
 k := 18;
 WHILE (k > 0) AND (eintrag[k+1].punk > eintrag[k].punk) DO
   dummy := eintrag[k];
   eintrag[k] := eintrag[k+1];
   eintrag[k+1] := dummy;
   DEC(k);
 END;
END Einordnen;

(***************************************************************)
PROCEDURE NeueListeSpeichern;
VAR strPtr : StrPtr;
    x : CARDINAL;
BEGIN
  Lookup(bl,"MMBestenListe",18*SIZE(Eintrag),TRUE);
  ResponseText(bl.res,strPtr);
  Assert(bl.res = done,strPtr);
  FOR x := 1 TO 18 DO
    WriteByteBlock(bl,eintrag[x]);
  END;
  Close(bl);
END NeueListeSpeichern;

(***************************************************************)
PROCEDURE AufDemBildschirmDarstellen;
VAR x,s,f,v,h : INTEGER;
    ar : ARRAY [0..7] OF CHAR;
BEGIN
  SetAPen(rpPtr,0);
  RectFill(rpPtr,0,0,640,512);
  TextAusgabe("DER AKTUELLE STAND DER BESTENLISTE",14,15,19);

  TextAusgabe("NAME",13,0,45);
  TextAusgabe("ST",13,290,45);
  TextAusgabe("FB",13,340,45);
  TextAusgabe("VRS",13,390,45);
  TextAusgabe("HLF",13,450,45);
  TextAusgabe("PUNKTE",13,520,45);

  FOR x := 1 TO 18 DO
    TextAusgabe(eintrag[x].name,15,0,22 * x + 55);
  END;

  SetAPen(rpPtr,0);
  RectFill(rpPtr,275,55,640,512);

  FOR x := 1 TO 18 DO
    ValToStr(eintrag[x].stel,FALSE,ar,10,4," ",err);
    TextAusgabe(ar,15, 280,22 * x + 55);

    ValToStr(eintrag[x].farb,FALSE,ar,10,4," ",err);
    TextAusgabe(ar,15, 330,22 * x + 55);

    ValToStr(eintrag[x].vers,FALSE,ar,10,4," ",err);
    TextAusgabe(ar,15, 390,22 * x + 55);

    ValToStr(eintrag[x].hilf,FALSE,ar,10,4," ",err);
    TextAusgabe(ar,15, 450,22 * x + 55);

    ValToStr(eintrag[x].punk,TRUE,ar,10,8," ",err);
    TextAusgabe(ar,15, 510,22 * x + 55);
  END;
END AufDemBildschirmDarstellen;

(***************************************************************)
PROCEDURE UnwuerdigkeitBescheinigen;
VAR len : INTEGER;
    text : ARRAY [0..44] OF CHAR;
BEGIN
  IF (bewerber.vers = 0) THEN
    Copy(text,"NUR ZUM ANZUSCHAUEN !");
  ELSIF (bewerber.hilf >= bewerber.stel) THEN
    Copy(text,"DAS WAR ZUVIEL DER HILFESTELLUNG !");
  ELSIF (bewerber.vers >= (bewerber.stel * bewerber.farb * bewerber.farb)) THEN
    Copy(text,"ZUVIELE VERSUCHE !");
  ELSE
    Copy(text,"DAS IST EINE B E S T E N - LISTE !");
  END;

  len := TextLength(rpPtr,ADR(text),Length(text));
  TextAusgabe(text,9,(640-len) DIV 2,500);

END UnwuerdigkeitBescheinigen;

(***************************************************************)
PROCEDURE UeberPruefenObWuerdig() : BOOLEAN;
VAR wuerdig : BOOLEAN;
BEGIN
  IF (bewerber.hilf >= bewerber.stel)
  OR (bewerber.vers >= (bewerber.stel * bewerber.farb * bewerber.farb)) THEN
    RETURN FALSE;
  ELSIF (bewerber.vers = 0) THEN
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END UeberPruefenObWuerdig;

(******************************************************************)
PROCEDURE LinkeMausTaste() : BOOLEAN;
VAR	set[0BFE001H]	: SET OF [0..7];
BEGIN
  IF 6 IN set THEN
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END LinkeMausTaste;

(******************************************************************)
PROCEDURE RechteMausTaste() : BOOLEAN;
VAR	set[0DFF016H] : BITSET;
BEGIN
  IF 10 IN set THEN
    RETURN FALSE;
  ELSE
    RETURN TRUE;
  END;
END RechteMausTaste;

(***************************************************************)
PROCEDURE BestenListe(wiPtr : WindowPtr;
			stellen,farben,versuche,hilfen : INTEGER);
VAR len : INTEGER;
BEGIN
  bewerber.stel := LONGINT(stellen);
  bewerber.farb := LONGINT(farben);
  bewerber.vers := LONGINT(versuche);
  bewerber.hilf := LONGINT(hilfen);
  (**********************************************)
  (* Die Punkte werden wie folgt vergeben :     *)
  (**********************************************)
  IF versuche # 0 THEN

    bewerber.punk := ((bewerber.stel-bewerber.hilf) * 101 *
    (bewerber.stel-bewerber.hilf) * (bewerber.stel-bewerber.hilf) *
    (bewerber.stel-bewerber.hilf) * (bewerber.farb * bewerber.farb)) DIV
    (bewerber.vers * bewerber.vers);

  END;

  rpPtr := wiPtr^.rPort;

  BestenListeSuchen;
  AufDemBildschirmDarstellen;
  IF UeberPruefenObWuerdig() THEN

    Eingabe(wiPtr,bewerber.name);
    Einordnen;
    AufDemBildschirmDarstellen;
    NeueListeSpeichern;
  ELSE
    UnwuerdigkeitBescheinigen;
  END;

  REPEAT
  UNTIL LinkeMausTaste() OR RechteMausTaste();

END BestenListe;

(***************************************************************)
(***************************************************************)
BEGIN
  eintrag[0].stel := 0;
  eintrag[0].farb := 0;
  eintrag[0].vers := 0;
  eintrag[0].hilf := 0;
  eintrag[0].punk := 0;
  Copy(eintrag[0].name,"----");
END BESTENLISTE.