home *** CD-ROM | disk | FTP | other *** search
/ Die ASC Mega 2 / ASC-Mega2-CD-ROM.iso / SPIELE / BACKGAMM / BACKGAM1 / RAND2.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-12-13  |  4.3 KB  |  141 lines
  1. {***************************************************************************}
  2. {* RAND2.PAS                                                               *}
  3. {* Externer Zufallsgenerator für PC-Backgammon Pro                         *}
  4. {* Programmiersprache: Turbo-Pascal, Autor: Michael Schellong              *}
  5. {*                                                                         *}
  6. {* Dieses Beispiel-Programm soll Ihnen demonstrieren, wie Sie in Pascal    *}
  7. {* eigene Zufallsgeneratoren für PC-Backgammon Pro V2.0 schreiben können.  *}
  8. {* Der externe Zufallsgenerator wird von PC-Backgammon Pro zur Ermittlung  *}
  9. {* der Würfelaugen aufgerufen. Als Parameter wird dem Generator ein Zeiger *}
  10. {* auf einen 32 Byte langen Speicherbereich übergeben, den er für seine ei-*}
  11. {* genen Zwecke frei verwenden kann. Beispielsweise können hier Variablen- *}
  12. {* Inhalte gespeichert werden, die beim nächsten Aufruf wieder benötigt    *}
  13. {* werden. Beim ersten Aufruf des Generators haben sämtliche Bytes des     *}
  14. {* Speicherbereichs einen Wert von 0xFF.                                   *}
  15. {* Als Programmbeendigungs-Code muss die ermittelte Zufallszahl (im Bereich*}
  16. {* von 1 bis 6) zurückgeliefert werden.                                    *}
  17. {***************************************************************************}
  18.  
  19. Program Rand2;
  20. Uses Dos;
  21.  
  22. Type
  23.     LongPtr=^LongInt;
  24.  
  25. Var
  26.     W: LongInt;
  27.     CubeVal:Integer;
  28.     PoolPtr: Pointer;
  29.  
  30.  
  31. {******************************************}
  32. {* Initialisierung des Zufallsgenerators  *}
  33. {******************************************}
  34. Procedure InitMyRand;
  35. Var
  36.     Year, Month, Day, Dummy: Word;
  37.     Hour, Minute, Second: Word;
  38. Begin
  39.     { Aktuelles Datum und Uhrzeit ermitteln }
  40.     GetDate(Year, Month, Day, Dummy);
  41.     GetTime(Hour, Minute, Second, Dummy);
  42.  
  43.     { Ungefähr die Sekunden seit dem 1.1.1980 berechnen
  44.       und Zufallsgenerator damit initialisieren }
  45.  
  46.     W:=(Year-1980)*31557600+
  47.        (Month-1)*2592000+
  48.        (Day-1)*86400;
  49.  
  50.     W:=W+Hour*3600+Minute*60+Second;
  51.     W:=W mod 716397;
  52. End;
  53.  
  54. {****************************************************}
  55. {* Ermittelt eine Zufallszahl im Bereich 0..Range-1 *}
  56. {****************************************************}
  57. Function MyRand(Range: Integer): Integer;
  58. Begin
  59.     W:=(W*431+1237) mod 716397;
  60.     MyRand:=Trunc(Range*(W/716397));
  61. End;
  62.  
  63. {****************************************************}
  64. {* Ermittelt den als Aufrufparameter übergebenen    *}
  65. {* Zeiger.                                          *}
  66. {* Für die etwas kompliziertere Vorgehensweise kann *}
  67. {* ich leider nichts. Die Ursache liegt in dem spär-*}
  68. {* lichen Angebot von Pascal an Stringkonvertie-    *}
  69. {* rungs-Funktionen.                                *}
  70. {****************************************************}
  71. Function GetParamPtr:Pointer;
  72. Var
  73.     S:String;
  74.  
  75. {****************************************************}
  76. {* Diese lokale Funktion wandelt eine ASCII-Hex-Zif-*}
  77. {* fer in ihren binären Wert um.                    *}
  78. {****************************************************}
  79. Function _HexDigitAsc2Bin(C:Char):Byte;
  80. Begin
  81.     C:=UpCase(C);
  82.     If (C>='A') And (C<='F') Then
  83.         _HexDigitAsc2Bin:=Ord(C)-Ord('A')+$0A
  84.     Else
  85.         if (C>='0') And (C<='9') Then
  86.             _HexDigitAsc2Bin:=Ord(C)-Ord('0')
  87.         else _HexDigitAsc2Bin:=0;
  88. End;
  89.  
  90. {****************************************************}
  91. {* Diese lokale Funktion wandelt ein 4 Zeichen      *}
  92. {* langes ASCII-Hex-Wort in seinen binären Wert um. *}
  93. {****************************************************}
  94. Function _HexWordAsc2Bin(S: String):Word;
  95. Var
  96.     W:Word;
  97.     I:Integer;
  98.  
  99. Begin
  100.     W:=0;
  101.     For I:=1 To 4 Do
  102.         W:=W*$10+_HexDigitAsc2Bin(S[I]);
  103.     _HexWordAsc2Bin:=W;
  104. End;
  105.  
  106. Begin
  107.     {1. Aufrufparameter holen (Format XXXX:YYYY)}
  108.     S:=ParamStr(1);
  109.  
  110.     {Segment und Offset konvertieren und in
  111.      Pointer umwandeln}
  112.     GetParamPtr:=Ptr(_HexWordAsc2Bin(S),
  113.                      _HexWordAsc2Bin(Copy(S,6,4)));
  114. End;
  115.  
  116.  
  117. Begin
  118.  
  119.     If ParamCount<1 Then
  120.         halt(0);
  121.  
  122.     {Pointer auf Pool ermitteln}
  123.     PoolPtr:=GetParamPtr;
  124.  
  125.  
  126.     if LongPtr(PoolPtr)^=-1 Then
  127.     {Beim 1. Aufruf Zufallsgenerator initialisieren}
  128.         InitMyRand
  129.     Else
  130.     {Zwischengespeicherte Variable W holen}
  131.         W:=LongPtr(PoolPtr)^;
  132.  
  133.     {Würfelwert ermitteln}
  134.     CubeVal:=MyRand(6)+1;
  135.  
  136.     {Variable W für den nächsten Aufruf im Pool speichern}
  137.     LongPtr(PoolPtr)^:=W;
  138.  
  139.     Halt(CubeVal);
  140. End.
  141.