Turbo Toolbox/Turbo_Toolbox.iso/dtx9302/neuron/neuron.pas

Pascal/Delphi Source File | 1993-03-10 | 13.9 KB | 615 lines

(* ****************************************************** *)
(*                      NEURON.PAS                        *)
(*            NIMM-SPIEL mit Neuronalem Netz              *)
(*             (c) 1993 Bernd Matzke & DMV                *)                                  *)
(* ****************************************************** *)
PROGRAM Neuron;

USES Objects, Drivers, Views, Menus,
     Dialogs, App, MsgBox, Crt;


CONST

cmSpiel  =  101;
cmLernen =  102;
cmAktual =  103;
cmInfo   =  104;
cmClear  =  105;
cm_eins  = 1001;
cm_zwei  = 1002;
cm_drei  = 1003;

FileName = 'NEURON.DAT';


TYPE

NetzTyp = ARRAY[1..21,1..3,0..3] OF INTEGER;

{speichert Züge eines Spiels}
PZugListe = ^TZugListe;
TZugListe = Object(TCollection)
  PROCEDURE FreeItem(p:POINTER); Virtual;
END;

{Spezieller Dialog für Spiel}
PSpielDialog = ^TSpielDialog;
TSpielDialog = Object(TDialog)
  CONSTRUCTOR Init(VAR r:TRect; ATitle: TTitleStr);
  PROCEDURE HandleEvent(VAR Event:TEvent); Virtual;
END;

TNetz = Object    {Nachbildung Neuronales Netzwerk}
  nw: NetzTyp;                       { "Neuronen" }
  CONSTRUCTOR Init;
  DESTRUCTOR Done; Virtual;
  FUNCTION vorschlag(anz, alt:INTEGER):INTEGER;
  PROCEDURE lernen(VAR l:PZugListe; w:INTEGER);
  PROCEDURE clear;
END;

TSpiel = Object(TApplication)
  Neuron: TNetz;
  alt,                         {vorhergehender Zug}
  anzahl: INTEGER;         {noch vorhandene Steine}
  CONSTRUCTOR Init;
  DESTRUCTOR Done; Virtual;
  PROCEDURE InitStatusLine; Virtual;
  PROCEDURE InitMenuBar; Virtual;
  PROCEDURE HandleEvent(VAR Event:TEvent); Virtual;
  FUNCTION SpielerZug:INTEGER;
  FUNCTION ComputerZug:INTEGER;
  PROCEDURE Spielen;
  PROCEDURE Lernen;
  PROCEDURE ZugMerken(VAR weg:INTEGER;
                      VAR l:PZugListe);
  PROCEDURE InfoBox(s:STRING);
END;

{Window für Spielstandanzeige}
PAnzWin = ^TAnzWin;
TAnzWin = Object(TWindow)
  CONSTRUCTOR Init(r: TRect);
END;

{zeigt Spielfeld an}
PSpielstand = ^TSpielstand;
TSpielstand = Object(TView)
  steine:INTEGER;
  CONSTRUCTOR Init(VAR r: TRect);
  PROCEDURE Draw; Virtual;
  PROCEDURE HandleEvent(VAR Event:TEvent); Virtual;
END;

{Window für allgemeine Info}
PInfoWin = ^TInfoWin;
TInfoWin = Object(TWindow)
  CONSTRUCTOR Init(s:STRING);
END;

{Erzeugt allgemeine Info}
PInfo = ^TInfo;
TInfo = Object(TView)
  info,outp:STRING;
  CONSTRUCTOR Init(VAR r: TRect;s:STRING);
  PROCEDURE Draw;  Virtual;
  PROCEDURE HandleEvent(VAR Event:TEvent); Virtual;
END;

{speichert einen Zug}
PZug = ^TZug;
TZug = RECORD
  altzug,       {vorhergehender Zug}
  anz,          {momentan vorhandene Steine}
  zug: INTEGER; {ausgeführter Zug}
END;

{ ---------- Allgemeine Proceduren ---------- }

{berechnet zulässigen Bereich für folgenden Zug}
PROCEDURE Schranken(VAR alt, unten, oben:INTEGER);
BEGIN
  unten:=1;
  oben:=3;
  IF alt <> 0 THEN BEGIN
    unten:=alt-1;
    IF unten<1 THEN
      unten:=1;
    oben:=alt+1;
    IF oben>3 THEN
      oben:=3;
  END;
END;

{ ---------- TZugListe ---------- }
PROCEDURE TZugListe.FreeItem;
VAR pp:PZug;
BEGIN
  pp:=p;
  Dispose(pp);
END;

{ ---------- TSpielDialog ---------- }
CONSTRUCTOR TSpielDialog.Init;
BEGIN
  TDialog.Init(R, ATitle);
  {Dialog hat weder Zoom- noch Schließfeld}
  flags:=flags AND
         NOT(wfGrow OR wfClose OR wfZoom);
  options:=options OR ofCenterY;
END;

PROCEDURE TSpielDialog.HandleEvent;
BEGIN
  IF Event.What = evCommand THEN
    CASE Event.command OF
      cm_eins,
      cm_zwei,
      cm_drei   :EndModal(Event.command);
      cmCancel,  {diese Kommandos unterdrücken}
      cmDefault :ClearEvent(Event);
    END;
  TDialog.HandleEvent(Event);
END;

{ ---------- TNetz ---------- }
CONSTRUCTOR TNetz.Init;
VAR f:FILE OF NetzTyp;
BEGIN
  Assign(f, FileName);
  {$I-} Reset(f); {$I+}
  IF IOResult = 0 THEN BEGIN
    Read(f, nw);
    Close(f); END
  ELSE
    TNetz.Clear;  {Anfangsbelegung}
END;

DESTRUCTOR TNetz.Done;
VAR  f:FILE OF NetzTyp;
BEGIN
  Assign(f, FileName);
  Rewrite(f);
  Write(f, nw);
  Close(f);
END;

{Zug mit höchstem Wert auswählen}
FUNCTION TNetz.vorschlag;
VAR i,           {Laufvariable}
    s,           {selektierter Zug}
    a,           {minimaler Zug}
    e:INTEGER;   {maximaler Zug}
BEGIN
  schranken(alt,a,e);
  s:=a;
  FOR i:=a TO e DO
    IF (nw[anz,i,alt] >= nw[anz,s,alt]) OR
       (nw[anz,i,alt] =  nw[anz,s,alt]) AND
       (Random > 0.6)
    THEN
      s:=i;
  vorschlag:=s;
END;

{Spiel auswerten}
PROCEDURE TNetz.lernen;
VAR n:INTEGER;
    p:PZug;
BEGIN
  FOR n:=0 TO l^.count-1 DO BEGIN
    p:=l^.at(n);
    CASE w OF
      1: IF nw[p^.anz,p^.zug,p^.altzug] < 30
         THEN Inc(nw[p^.anz,p^.zug,p^.altzug]);
      0: IF nw[p^.anz,p^.zug,p^.altzug] > -30
         THEN Dec(nw[p^.anz,p^.zug,p^.altzug]);
    END;
  END;
END;

PROCEDURE TNetz.Clear;
BEGIN
  FillChar(nw, SizeOf(nw), Chr(0));
END;

{ ---------- TSpiel ---------- }
CONSTRUCTOR TSpiel.Init;
BEGIN
  TApplication.Init;
  Neuron.Init;
END;

DESTRUCTOR TSpiel.Done;
BEGIN
  Neuron.Done;
  TApplication.Done;
END;

PROCEDURE TSpiel.InitStatusLine;
VAR r: TRect;
BEGIN
  GetExtent(r);
  r.A.Y := r.B.Y - 1;
  StatusLine := New(PStatusLine, Init(r,
    NewStatusDef(0, $FFFF,
      NewStatusKey('', kbF10, cmMenu,
      NewStatusKey('~Alt-X~ Exit    ',
                    kbAltX,  cmQuit,
      NewStatusKey('~F4~ Spiel      ',
                    kbF4,    cmSpiel,
      NewStatusKey('~F5~ Lernen     ',
                    kbF5,    cmLernen,
      NewStatusKey('Netzwerk löschen',
                    kbNoKey, cmClear, NIL)
    )))), NIL)
  ));
END;

PROCEDURE TSpiel.InitMenuBar;
VAR r:TRect;
BEGIN
  GetExtent(r);
  r.b.y := r.a.y +1;
  Insert(New(PStaticText,
    Init(r, '      Nimm-Spiel mit '+
            'Neuronalem Netz')));
END;

PROCEDURE TSpiel.HandleEvent(VAR Event: TEvent);
BEGIN
  TApplication.HandleEvent(Event);
  IF Event.What = evCommand THEN BEGIN
    CASE Event.Command OF
      cmSpiel : Spielen;
      cmLernen: Lernen;
      cmClear : Neuron.Clear;
    ELSE
      EXIT;
    END;
    ClearEvent(Event);
  END;
END;


PROCEDURE TSpiel.Spielen;
VAR
  r: TRect;
  s:STRING;
  m: POINTER;
  dran:BOOLEAN;
  mn,cn:INTEGER;
  AnzWin: PAnzWin;
  mlist,clist: PZugListe;
  li:LONGINT;
BEGIN
  r.Assign(2,2,30,17);
  AnzWin := New(PAnzWin, Init(r));
  Desktop^.Insert(AnzWin);
  Randomize;
  anzahl:=10+Random(12);
  m:=message(Desktop, evBroadcast, cmAktual,
             Addr(anzahl));
  alt:=0;
  dran:=Odd(Random(2));
  mlist:=New(PZugListe, Init(5,1));
  clist:=New(PZugListe, Init(5,1));
  WHILE anzahl > 0 DO BEGIN
    IF dran THEN BEGIN
      IF alt-1 <= anzahl THEN BEGIN
        mn:= SpielerZug;
        ZugMerken(mn, mlist);
        anzahl:= anzahl- mn;
        m:=message(Desktop, evBroadcast,
                   cmAktual, Addr(anzahl));
        IF anzahl=0 THEN BEGIN
          InfoBox('Sie haben verloren !!!');
          Neuron.lernen(mlist,0);
          Neuron.lernen(clist,1);
        END; END
      ELSE BEGIN
        InfoBox('Sie können nicht setzen !');
        InfoBox('Ich habe verloren !!!');
        Neuron.lernen(mlist,1);
        Neuron.lernen(clist,0);
        anzahl:=0;
      END;
      dran:=NOT dran;
      alt:=mn; END
    ELSE BEGIN
      IF alt-1 <= anzahl THEN BEGIN
        cn:=ComputerZug;
        li:=cn;
        FormatStr(s,'Ich nehme: %d',li);
        InfoBox(s);
        ZugMerken(cn, clist);
        anzahl:=anzahl-cn;
        m:=message(Desktop, evBroadcast,
                   cmAktual, Addr(anzahl));
        IF anzahl=0 THEN BEGIN
          InfoBox('Ich habe verloren !!!');
          Neuron.lernen(mlist,1);
          Neuron.lernen(clist,0);
        END; END
      ELSE BEGIN
        InfoBox('Ich kann nicht setzen !');
        InfoBox('Sie haben verloren !!!');
        Neuron.lernen(mlist,0);
        Neuron.lernen(clist,1);
        anzahl:=0;
      END;
      dran:=NOT dran;
      alt:=cn;
    END;
  END;
  Dispose(AnzWin,Done);
  Dispose(clist,Done);
  Dispose(mlist,Done);
END;

{wie TSpiel.spielen, ohne Bildschirmausgaben }
PROCEDURE TSpiel.Lernen;
VAR
  m:POINTER;
  dran:BOOLEAN;
  mn,cn:INTEGER;
  mlist,clist: PZugListe;
  n:LONGINT;
  InfoWin: PInfoWin;
BEGIN
  InfoWin:=New(PinfoWin,
    Init('Netz anlernen, %d. Versuch'));
  Desktop^.Insert(InfoWin);
  FOR n:=1 TO 500 DO BEGIN
    Randomize;
    anzahl:=10+Random(12);
    alt:=0;
    dran:=Odd( Random(2));
    mlist:=New( PZugListe, Init(5,1));
    clist:=New( PZugListe, Init(5,1));
    WHILE anzahl > 0 DO BEGIN
      IF dran THEN BEGIN
        IF alt-1 <= anzahl THEN BEGIN
          mn:=ComputerZug;
          ZugMerken(mn,mlist);
          anzahl:=anzahl-mn;
          IF anzahl=0 THEN BEGIN
            Neuron.lernen(mlist,0);
            Neuron.lernen(clist,1);
          END; END
        ELSE BEGIN
          Neuron.lernen(mlist,1);
          Neuron.lernen(clist,0);
          anzahl:=0;
        END;
        dran:=NOT dran;
        alt:=mn; END
      ELSE BEGIN
        IF alt-1 <= anzahl THEN BEGIN
          cn:=ComputerZug;
          ZugMerken(cn,clist);
          anzahl:=anzahl-cn;
          IF anzahl=0 THEN BEGIN
            Neuron.lernen(mlist,1);
            Neuron.lernen(clist,0);
          END; END
        ELSE BEGIN
          Neuron.lernen(mlist,0);
          Neuron.lernen(clist,1);
          anzahl:=0;
        END;
        dran:=NOT dran;
        alt:=cn;
      END;
    END;
    Dispose(clist,Done);
    Dispose(mlist,Done);
    m:=Message(Desktop, evBroadcast, cmInfo, @n);
    Delay(10);
  END;
  Dispose(InfoWin,Done);
END;

FUNCTION TSpiel.SpielerZug;
VAR r:TRect;
    d:PSpielDialog;
    erg,
    unten,
    oben,
    y:INTEGER;
BEGIN
  Schranken(alt,unten,oben);
  IF oben > anzahl THEN
    oben:=anzahl;
  r.Assign(40, 0, 65, 3*(oben-unten+1) +2);
  d:=New(PSpielDialog, Init(r,'Sie nehmen:'));
  y:=2;
  WITH d^ DO BEGIN
    IF 1 IN [unten..oben] THEN BEGIN
      r.Assign(3,y,18,y+2);
      Insert( New( PButton,Init(
        r,'~E~in Stein',cm_eins,bfNormal)));
      y:=y+3;
    END;
    IF 2 IN [unten..oben] THEN BEGIN
      r.Assign(3,y,18,y+2);
      Insert( New( PButton,Init(
        r,'~Z~wei Steine',cm_zwei,bfNormal)));
      y:=y+3;
    END;
    IF 3 IN [unten..oben] THEN BEGIN
      r.Assign(3,y,18,y+2);
      Insert( New( PButton,Init(
        r,'~D~rei Steine',cm_drei,bfNormal)));
    END;
  END;
  CASE Desktop^.execview(d) OF
    cm_eins: SpielerZug:=1;
    cm_zwei: SpielerZug:=2;
    cm_drei: SpielerZug:=3;
  END;
  Dispose(d,Done);
END;

FUNCTION TSpiel.ComputerZug;
VAR msg,unten,oben,v:INTEGER;
BEGIN
  v:=Neuron.vorschlag(anzahl,alt);
  IF v > anzahl THEN
    v:=anzahl;
  ComputerZug:=v;
END;

PROCEDURE TSpiel.ZugMerken;
VAR p:PZug;
BEGIN
  New(p);
  p^.anz:=anzahl;
  p^.zug:=weg;
  p^.altzug:=alt;
  l^.Insert(p);
END;

{Anzeige einer Info für kurze Zeit}
PROCEDURE TSpiel.InfoBox;
VAR m:POINTER;
    info:PInfoWin;
BEGIN
  Desktop^.Lock;
  info:=New(PInfoWin,Init(s));
  Desktop^.Insert(info);
  info^.MoveTo(35,5);
  m:=message(Desktop, evBroadcast,
             cmInfo, NIL);
  Desktop^.UnLock;
  Sound(1000);
  Delay(100);
  NoSound;
  Delay(1500);
  Dispose(info, Done);
END;

{ ---------- TSpielstand ---------- }
CONSTRUCTOR TSpielstand.Init;
BEGIN
  TView.Init(r);
  Options := Options OR ofFramed;
  EventMask:=EventMask OR evBroadcast;
  steine:=0;
END;

PROCEDURE TSpielstand.Draw;
VAR i, j, zeile, st:INTEGER;
BEGIN
  FOR i:=0 TO size.y -1 DO
    WriteChar(0, i, ' ', 1, size.x);
  zeile:=size.y-2;
  st:=steine;
  WHILE st > 0 DO BEGIN
    FOR j:=6 DOWNTO 1 DO BEGIN
      FOR i:=1 TO j DO BEGIN
        IF st > 0 THEN
          WriteChar(14 - 2*j + 4*(i-1), zeile,
                    '█', 6, 2);  {#219}
        Dec(st);
      END;
      Dec(zeile, 2);
    END;
  END;
END;

PROCEDURE TSpielstand.HandleEvent;
{Anzeige Spielstand nur auf Kommando}
BEGIN
  TView.HandleEvent(Event);
  IF Event.What = evBroadcast THEN BEGIN
    CASE Event.Command OF
      cmAktual:BEGIN
        steine:=INTEGER(Event.Infoptr^);
        draw;
      END;
    ELSE
      EXIT;
    END;
    ClearEvent(Event);
  END;
END;

{ ---------- TAnzWin ---------- }
CONSTRUCTOR TAnzWin.Init;
VAR Spielstand: PSpielstand;
BEGIN
  TWindow.Init(r, 'Spielstand', WnNoNumber);
  flags:= flags AND
          NOT(wfGrow OR wfClose OR wfZoom);
  palette:= wpBlueWindow;
  options:=options OR ofCenterY;
  EventMask:= EventMask OR evBroadcast;
  GetClipRect(r);
  r.Grow(-1,-1);
  Spielstand:= New(PSpielstand, Init(r));
  Insert(Spielstand);
END;

{ ---------- TInfo ---------- }
{Anzeige allgemeiner Infos auf Kommando}
CONSTRUCTOR TInfo.Init;
BEGIN
  TView.Init(r);
  GrowMode := gfGrowHiX + gfGrowHiY;
  Options := Options OR ofFramed;
  EventMask:=EventMask OR evBroadcast;
  info:=s;       {String mit Formatangaben}
END;

PROCEDURE TInfo.Draw;
VAR i:INTEGER;
BEGIN
  FOR i:=0 TO size.y -1 DO
    WriteChar(0, i, ' ', 2, size.x);
  WriteStr(1, size.y DIV 2-1, outp, 2);
END;

PROCEDURE TInfo.HandleEvent;
BEGIN
  TView.HandleEvent(Event);
  IF Event.What = evBroadcast THEN BEGIN
    CASE Event.Command OF
      cmInfo:BEGIN
        FormatStr(outp,info,Event.Infoptr^);
        Draw;
      END;
    ELSE
      EXIT;
    END;
    ClearEvent(Event);
  END;
END;

{ ---------- TInfoWin ---------- }
CONSTRUCTOR TInfoWin.Init;
VAR Info: PInfo;
    R:TRect;
BEGIN
  R.Assign(1,1,40,5);
  TWindow.Init(r, '', WnNoNumber);
  flags:= flags AND
          NOT(wfGrow OR wfClose OR wfZoom);
  options:= options OR ofCentered;
  palette:= wpGrayWindow;
  EventMask:= EventMask OR evBroadcast;
  GetClipRect(r);
  r.Grow(-1,-1);
  Info:= New(PInfo, Init(r,s));
  Insert(Info);
END;

VAR Spiel: TSpiel;

BEGIN
  Spiel.Init;
  Spiel.Run;
  Spiel.Done;
END.