home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 560.lha / Reversi_v1.0 / source / reversi.mod < prev   
Encoding:
Text File  |  1991-09-19  |  25.9 KB  |  719 lines
  1. (*****************************************************************************
  2. **                                        **
  3. **   #####  ###### ##   ## ##### #####   ##### ####       written by:       **
  4. **   ##  ## ##     ##   ## ##    ##  ## ##      ##      Robert Brandner     **
  5. **   #####  ####    ## ##  ####  #####   ####   ##       Schillerstr. 3      **
  6. **   ##  ## ##      ## ##  ##    ##  ##     ##  ##       A-8280 Fürstenfeld  **
  7. **   ##  ## ######   ###   ##### ##  ## #####  ####      AUSTRIA/EUROPE      **
  8. **                                        **
  9. **   This program is written in Modula-II using the compiler M2Amiga V3.3d  **
  10. **                                        **
  11. *****************************************************************************)
  12.  
  13. MODULE Reversi;
  14.  
  15. FROM Intuition IMPORT
  16.   NewScreen, ScreenPtr, OpenScreen, CloseScreen, NewWindow, WindowPtr,
  17.   OpenWindow, CloseWindow, WindowFlags,WindowFlagSet,customScreen,IDCMPFlagSet;
  18. FROM SYSTEM IMPORT ADR, ADDRESS, INLINE, CAST;
  19. FROM Graphics IMPORT
  20.   RastPortPtr, SetRast, RectFill, SetAPen, LoadRGB4, Text, Move, Draw,
  21.   SetDrMd, jam1, jam2, BitMap, normalFont, InitBitMap, BltBitMapRastPort,
  22.   AllocRaster, FreeRaster, SetFont, CloseFont, TextFontPtr, TextAttr, SetRGB4,
  23.   TextLength, OpenFont, ReadPixel, FontFlags, FontFlagSet, ViewModeSet;
  24. FROM GfxMacros IMPORT RasSize;
  25. FROM Arts IMPORT Assert, TermProcedure;
  26. FROM Dos IMPORT Delay;
  27. FROM Hardware IMPORT gamePort0, ciaa;
  28. FROM Exec IMPORT CopyMem;
  29. FROM RandomNumber IMPORT RND;
  30.  
  31. CONST GROSS = 8;
  32.       SCHWARZ = 0; WEISS = 1; LEER = 2;
  33.       MENSCH = 0; AMIGA = 1; PAUSE = 2; KEIN = 3;
  34.       BREAK = -30000;
  35.  
  36. TYPE Brett = ARRAY [0..GROSS-1],[0..GROSS-1] OF INTEGER;
  37.  
  38. VAR SCHWSP, WEISSP, STIEF, WTIEF : INTEGER;
  39.     memptr : ARRAY[1..4] OF ADDRESS;
  40.     ns : NewScreen;
  41.     nw : NewWindow;
  42.     scr : ScreenPtr;
  43.     win : WindowPtr;
  44.     rp : RastPortPtr;
  45.     maxzug, amzug, zugnum, mx, my, x, y, zx, zy : INTEGER;
  46.     i : CARDINAL;
  47.     anz : ARRAY[0..2] OF INTEGER;
  48.     brett, wert : Brett;
  49.     memory : ARRAY[0..GROSS*GROSS-1] OF
  50.              RECORD
  51.                b : Brett;
  52.                sp : INTEGER;
  53.              END;
  54.     forward, back, paused, force, restart, quit, sZieh, wZieh : BOOLEAN;
  55.     bm : BitMap;
  56.     pl : ADDRESS;
  57.     ch : ARRAY[0..0] OF CHAR;
  58.     topaz : TextFontPtr;
  59.     ta : TextAttr;
  60.  
  61. PROCEDURE Graphics; (* $E- *)
  62. BEGIN
  63.   INLINE(0FFFFH,0FFFFH,0FFFEH,003F0H,00000H,00000H,00FFFH,0FFE0H,0C000H,
  64.          0FC07H,0FFC0H,07FFBH,0FCF7H,0FFFFH,0FFFFH,0EC1FH,0F7FEH,04000H,0F001H,
  65.          0FF00H,01FFFH,0FF72H,0ABAEH,0BEAAH,0E80FH,083FFH,00000H,0E000H,0FE00H,
  66.          00FFFH,0FFB3H,0AAAAH,0E6EFH,0E405H,001BFH,08000H,0E000H,07E00H,007DFH,
  67.          0FFD3H,0BBAAH,0F6EAH,0A404H,000BFH,08000H,08000H,03800H,003FFH,0FFD0H,
  68.          089AAH,03E2EH,0A404H,000BFH,08000H,0C000H,03C00H,003BFH,0FFE7H,048C4H,
  69.          02516H,0A604H,0009FH,08000H,04000H,01400H,001BFH,0FFE4H,00000H,00000H,
  70.          00304H,001CFH,0C000H,04000H,01400H,001BFH,0FFE0H,00048H,02763H,009EEH,
  71.          003E1H,0C000H,04000H,01400H,001BFH,0FFE0H,06B1EH,0CD96H,02C1FH,007FFH,
  72.          0C000H,04000H,01400H,001BFH,0FFE2H,01144H,08D06H,02FFFH,0FF00H,00000H,
  73.          04000H,01400H,001BFH,0FFE0H,03948H,09924H,00C1DH,0FF00H,00000H,06000H,
  74.          01600H,001BFH,0FFE0H,09482H,0F657H,0080DH,0FF00H,00000H,02000H,01200H,
  75.          001DFH,0FFF1H,00000H,00000H,00405H,0FF00H,00000H,0B000H,03B00H,003DFH,
  76.          0FFD0H,00440H,0A11BH,0A405H,0FF00H,00000H,09800H,03980H,003EFH,0FFF0H,
  77.          00000H,00000H,00405H,0FF00H,00000H,0CC00H,07CC0H,007F7H,0FFF0H,00000H,
  78.          00000H,00605H,0FF00H,00000H,0E701H,0FE70H,01FF9H,0FEF0H,00000H,00000H,
  79.          00305H,0FF00H,00000H,0F1FDH,0FF1FH,0DFFEH,003F0H,00000H,00000H,009EDH,
  80.          0FF00H,00000H,0FC07H,0FFC0H,07FFFH,0FFF0H,00000H,00000H,00C1CH,00100H,
  81.          00000H,0FE03H,0FFFFH,0FFFEH,003F7H,0FFFFH,0FFFFH,0FE0FH,0FFE0H,0C000H,
  82.          0FBF8H,0FFC0H,07FFBH,0FCF7H,0FFFFH,0FFFFH,0FFE7H,0FFFEH,04000H,0FFFEH,
  83.          07F00H,01FFFH,0FF72H,0ABAEH,0BEAAH,0FFF3H,0FFFFH,00000H,0FFFFH,03E00H,
  84.          00FFFH,0FFB3H,0AAAAH,0E6EFH,0F7F9H,0FFFFH,08000H,0FFFFH,09C00H,007FFH,
  85.          0FFD3H,0BBAAH,0F6EAH,0B7F9H,0FFFFH,08000H,0BFFFH,0D800H,003FFH,0FFD0H,
  86.          089AAH,03E2EH,0B7F9H,0FFFFH,08000H,0FFFFH,0C800H,003FFH,0FFE7H,048C4H,
  87.          02516H,0B7F9H,0BBFFH,08000H,07FFFH,0E000H,001FFH,0FFE4H,00000H,00000H,
  88.          013FCH,0C7FFH,0C000H,07FFFH,0E000H,001FFH,0FFE0H,00048H,02763H,019FEH,
  89.          07FFFH,0C000H,07FFFH,0E000H,001FFH,0FFE0H,06B1EH,0CD96H,03C1FH,007FFH,
  90.          0C000H,07FFFH,0E000H,001FFH,0FFE2H,01144H,08D06H,03FFEH,00000H,00000H,
  91.          07FFFH,0E000H,001FFH,0FFE0H,03948H,09924H,01C1CH,00000H,00000H,07FFFH,
  92.          0E000H,001FFH,0FFE0H,09482H,0F657H,0180CH,00000H,00000H,03FFFH,0F000H,
  93.          001FFH,0FFF1H,00000H,00000H,01004H,00000H,00000H,0BFFFH,0D800H,003FFH,
  94.          0FFD0H,00440H,0A11BH,0B004H,00000H,00000H,09FFFH,0F800H,003FFH,0FFF0H,
  95.          00000H,00000H,01004H,00000H,00000H,0CFFFH,0FC00H,007FFH,0FFF0H,00000H,
  96.          00000H,00004H,00000H,00000H,0E7FFH,0FE00H,00FFFH,0FFF0H,00000H,00000H,
  97.          00004H,00000H,00000H,0F1FDH,0FF00H,01FFFH,0FFF0H,00000H,00000H,0080CH,
  98.          00000H,00000H,0FC07H,0FFC0H,07FFFH,0FFF0H,00000H,00000H,00C1CH,00100H,
  99.          00000H,001FCH,0001FH,0C001H,0FC08H,00000H,00000H,001F0H,06C1FH,00000H,
  100.          007FFH,00040H,07004H,0030BH,0BB2CH,0E4EEH,0A3F8H,0FE01H,08000H,00FFFH,
  101.          08000H,01800H,0008FH,07EFBH,0CFDDH,047FDH,0FF00H,0C000H,01FFFH,0C000H,
  102.          00C00H,0004EH,07FFFH,0BDBEH,0AFFFH,0FF00H,04000H,03FFFH,0E000H,00600H,
  103.          0002FH,0FF7FH,0E9FDH,0EFFFH,0FF00H,04000H,07FFFH,0E400H,00200H,0002FH,
  104.          07655H,0C1D1H,04FFFH,0FF00H,04000H,07FFFH,0F000H,00300H,00019H,048C4H,
  105.          02516H,08FFFH,0FF00H,04000H,0FFFFH,0F800H,00100H,00018H,0FFFFH,0FFFFH,
  106.          08FFBH,0FE00H,00000H,0FFFFH,0F800H,00100H,0001DH,0C8DAH,03FFBH,0C7F1H,
  107.          0FC00H,00000H,0FFFFH,0F800H,00100H,0001DH,0EFBFH,0FFDFH,0E3E0H,0F800H,
  108.          00000H,0FFFFH,0F800H,00100H,0001FH,0B5EDH,0BF57H,0E1F1H,0FF00H,00000H,
  109.          0FFFFH,0F800H,00100H,0001DH,0BD69H,0BB7DH,0C01BH,0FF00H,00000H,0FFFFH,
  110.          0F800H,00100H,0001DH,0B4CAH,0FEDFH,0C00FH,0BB00H,00000H,0FFFFH,0EC00H,
  111.          00000H,0000DH,0FFFFH,0FFFFH,08807H,0EF00H,00000H,07FFFH,0E400H,00200H,
  112.          0002EH,00440H,0A11BH,08807H,0EF00H,00000H,07FFFH,0C600H,00000H,0000FH,
  113.          0FFFFH,0FFFFH,0E807H,0BB00H,00000H,03FFFH,08300H,00000H,00000H,00000H,
  114.          00000H,00807H,0C700H,00000H,01FFFH,00180H,00000H,00000H,00000H,00000H,
  115.          00C03H,0FF00H,00000H,00FFEH,000E0H,02000H,00000H,00000H,00000H,00603H,
  116.          0FF00H,00000H,003F8H,0003FH,08000H,00000H,00000H,00000H,003E3H,0FE00H,
  117.          00000H,0FFFFH,0FFE0H,03FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,093FFH,0C000H,
  118.          0FFFFH,0FFBFH,08FFFH,0FFFFH,0FFFFH,0FFFFH,0FFFFH,001FFH,0C000H,0FFFFH,
  119.          0FFFFH,0E7FFH,0FFFFH,0FFFFH,0FFFFH,0FFFEH,000FFH,0C000H,0FFFFH,0FFFFH,
  120.          0F3FFH,0FFFFH,0FFFFH,0FFFFH,0FFFEH,044FFH,0C000H,0FFFFH,0FFFFH,0F9FFH,
  121.          0FFFFH,0FFFFH,0FFFFH,0FFFEH,000FFH,0C000H,0FFFFH,0FFFFH,0FDFFH,0FFFFH,
  122.          0FFFFH,0FFFFH,0FFFEH,000FFH,0C000H,0FFFFH,0FFFFH,0FCFFH,0FFFEH,0B73BH,
  123.          0DAE9H,07FFEH,000FFH,0C000H,0FFFFH,0FFFFH,0FEFFH,0FFFFH,00000H,00000H,
  124.          07FFFH,001FFH,0C000H,0FFFFH,0FFFFH,0FEFFH,0FFFEH,03725H,0C004H,03FFFH,
  125.          083FFH,0C000H,0FFFFH,0FFFFH,0FEFFH,0FFFEH,01040H,00020H,01FFFH,0FFFFH,
  126.          0C000H,0FFFFH,0FFFFH,0FEFFH,0FFFCH,04A12H,040A8H,01E0EH,00000H,00000H,
  127.          0FFFFH,0FFFFH,0FEFFH,0FFFEH,04296H,04482H,03FE6H,0FE00H,00000H,0FFFFH,
  128.          0FFFFH,0FEFFH,0FFFEH,04B35H,00120H,03FF2H,0BA00H,00000H,0FFFFH,0FFFFH,
  129.          0FFFFH,0FFFEH,00000H,00000H,07FFAH,0EE00H,00000H,0FFFFH,0FFFFH,0FDFFH,
  130.          0FFFFH,0FBBFH,05EE4H,07FFAH,0EE00H,00000H,0FFFFH,0FFFFH,0FFFFH,0FFFFH,
  131.          0FFFFH,0FFFFH,0FFFAH,0BA00H,00000H,0FFFFH,0FFFFH,0FFFFH,0FFF0H,00000H,
  132.          00000H,00FFAH,0C600H,00000H,0FFFFH,0FFFFH,0FFFFH,0FFF0H,00000H,00000H,
  133.          00FFEH,0FE00H,00000H,0FFFFH,0FFFFH,0FFFFH,0FFF0H,00000H,00000H,00FFEH,
  134.          00000H,00000H,0FFFFH,0FFFFH,0FFFFH,0FFF0H,00000H,00000H,00FFFH,0FF00H,
  135.          00000H)
  136. END Graphics;
  137.  
  138. PROCEDURE Colors; (* $E- *)
  139. BEGIN
  140.   INLINE(0000H,0EEEH,0F00H,000FH,0C03H,0ECAH,0E84H,0FE0H,
  141.          0FC0H,0CA0H,0CCCH,0AAAH,0888H,045DH,040CH,0208H)
  142. END Colors;
  143.  
  144. PROCEDURE Werte; (* $E- *)
  145. BEGIN
  146.   INLINE(700,-10,100,100,100,100,-10,700);
  147.   INLINE(-10,-10, -7, -7, -7, -7,-10,-10);
  148.   INLINE(100, -7,  2,  2,  2,  2, -7,100);
  149.   INLINE(100, -7,  2,  1,  1,  2, -7,100);
  150.   INLINE(100, -7,  2,  1,  1,  2, -7,100);
  151.   INLINE(100, -7,  2,  2,  2,  2, -7,100);
  152.   INLINE(-10,-10, -7, -7, -7, -7,-10,-10);
  153.   INLINE(700,-10,100,100,100,100,-10,700);
  154. END Werte;
  155.  
  156. PROCEDURE Quad(x0, y0, x1, y1:INTEGER);
  157. BEGIN
  158.   SetAPen(rp, 11); RectFill(rp, x0, y0, x1, y1);
  159.   SetAPen(rp, 10); Move(rp, x0, y0); Draw(rp, x1, y0); Draw(rp, x1, y1);
  160.   SetAPen(rp, 12); Move(rp, x0, y0+1); Draw(rp, x0, y1); Draw(rp, x1, y1);
  161. END Quad;
  162.  
  163. PROCEDURE SchreibSchatt(txt : ARRAY OF CHAR; l, x, y, w, c : INTEGER);
  164. VAR xx : INTEGER;
  165. BEGIN
  166.   SetDrMd(rp, jam1);
  167.   xx := x+(w-TextLength(rp, ADR(txt), l))/2;
  168.   SetAPen(rp, 12); Move(rp, xx-1, y+1+INTEGER(rp^.txBaseline));
  169.   Text(rp, ADR(txt), l);
  170.   SetAPen(rp, c); Move(rp, xx, y+INTEGER(rp^.txBaseline));
  171.   Text(rp, ADR(txt), l);
  172. END SchreibSchatt;
  173.  
  174. PROCEDURE Schreib(txt : ARRAY OF CHAR; la, farb : INTEGER);
  175. BEGIN
  176.   Quad(32, 32+(1-farb)*32, 87, 55+(1-farb)*32);
  177.   SchreibSchatt(txt, la, 32, 40+(1-farb)*32, 56, 1);
  178. END Schreib;
  179.  
  180. PROCEDURE Blit(xoffset, yoffset, dx, dy, w, h : INTEGER);
  181. BEGIN
  182.   BltBitMapRastPort(ADR(bm), xoffset, yoffset, rp, dx, dy, w, h, 0C0H);
  183. END Blit;
  184.  
  185. PROCEDURE Titel;
  186. VAR i, j : INTEGER;
  187. BEGIN
  188.   FOR i := 0 TO 15 DO SetRGB4(ADR(scr^.viewPort), i, 0, 0, 0) END;
  189.   SetAPen(rp, 1);
  190.   Move(rp, 0, 200+rp^.txBaseline); Text(rp, ADR("REVERSI 1.0"), 11);
  191.   FOR i := 87 TO 0 BY -1 DO
  192.     FOR j := 0 TO 7 DO
  193.       IF ReadPixel(rp, i, 200+j)=1 THEN
  194.         SetAPen(rp, 12); RectFill(rp, 28+i*3, 18+j*4, 31+i*3, 21+j*4);
  195.         SetAPen(rp, 4);
  196.         RectFill(rp, 29+i*3, 17+j*4, 32+i*3, 20+j*4);
  197.       END
  198.     END
  199.   END;
  200.   SetAPen(rp, 0); RectFill(rp, 0, 200, 100, 209);
  201.   SchreibSchatt("written by Robert Brandner", 26, 0, 55, 320, 1);
  202.   SchreibSchatt("This program is public domain!", 30, 0, 70, 320, 4);
  203.   FOR i := 0 TO 4 DO
  204.     FOR j := 0 TO 4 DO
  205.       IF RND(4)<2 THEN
  206.         IF RND(2)=0 THEN
  207.           Blit(0, 0, 110+i*20, 90+j*20, 20, 20)
  208.         ELSE
  209.           Blit(20, 0, 110+i*20, 90+j*20, 20, 20)
  210.         END
  211.       END
  212.     END
  213.   END;
  214.   LoadRGB4(ADR(scr^.viewPort), ADR(Colors), 16);
  215.   SetRGB4(ADR(scr^.viewPort),11,0,0,0);
  216.   SetRGB4(ADR(scr^.viewPort),12,0,0,0);
  217.   REPEAT UNTIL NOT (gamePort0 IN ciaa.pra);
  218.   REPEAT UNTIL gamePort0 IN ciaa.pra;
  219.   FOR i := 0 TO 15 DO SetRGB4(ADR(scr^.viewPort), i, 0, 0, 0) END;
  220.   SetRast(rp, 0);
  221. END Titel;
  222.  
  223. PROCEDURE Start;
  224. BEGIN
  225.   WITH ns DO
  226.     leftEdge:=0; topEdge:=0; width:=320; height:=210; depth:=4;
  227.     detailPen:=0; blockPen:=1; viewModes:=ViewModeSet{};
  228.     type:=customScreen; font:=ADR(ta); defaultTitle:=NIL;
  229.     gadgets:=NIL; customBitMap:=NIL;
  230.   END;
  231.   scr := OpenScreen(ns);
  232.   Assert(scr#NIL, ADR("Kein Screen!"));
  233.   WITH nw DO
  234.     leftEdge:=0; topEdge:=0; width:=320; height:=210; detailPen:=0;
  235.     blockPen:=1; idcmpFlags:=IDCMPFlagSet{};
  236.     flags:=WindowFlagSet{reportMouse,borderless,activate,rmbTrap,simpleRefresh};
  237.     firstGadget:=NIL; checkMark:=NIL; title:=NIL;
  238.     screen:=scr; bitMap:=NIL;type:=customScreen;
  239.   END;
  240.   win := OpenWindow(nw);
  241.   Assert(win#NIL, ADR("Kein Window!"));
  242.   rp := win^.rPort;
  243.   SetRast(rp, 0);
  244.   quit := FALSE;
  245.   CopyMem(ADR(Werte), ADR(wert), SIZE(wert));
  246.   InitBitMap(bm, 4, 130, 20);
  247.   FOR i := 0 TO 3 DO
  248.     pl := AllocRaster(130, 20);
  249.     Assert(pl#NIL, ADR("Kein Speicher für Graphik"));
  250.     bm.planes[i] := pl;
  251.     CopyMem(ADR(Graphics)+LONGINT(i*RasSize(130, 20)), pl, RasSize(130, 20));
  252.   END;
  253.   Titel;
  254.   SetAPen(rp, 11);
  255.   RectFill(rp, 0, 0, 319, 207);
  256.   FOR i := 0 TO 25 DO
  257.     SetAPen(rp, 10); Move(rp, 0, i*8); Draw(rp, 319, i*8);
  258.     SetAPen(rp, 12); Move(rp, 0, i*8+7); Draw(rp, 319, i*8+7);
  259.   END;
  260.   FOR i := 0 TO 39 DO
  261.     SetAPen(rp, 12); Move(rp, i*8, 0); Draw(rp, i*8, 207);
  262.     SetAPen(rp, 10); Move(rp, i*8+7, 0); Draw(rp, i*8+7, 207);
  263.   END;
  264.   Quad(120, 8, 311, 199);
  265.   FOR i := 0 TO GROSS-1 DO
  266.     ch[0] := CHAR(INTEGER("8")-i);
  267.     SchreibSchatt(ch, 1, 125, 30+i*20, 8, 1);
  268.     ch[0] := CHAR(INTEGER("A")+i);
  269.     SchreibSchatt(ch, 1, 143+i*20, 188, 8, 1);
  270.   END;
  271.   Quad(8, 8, 71, 23);
  272.   SchreibSchatt("REVERSI", 7, 8, 12, 63, 4);
  273.   Blit(60, 0, 72, 8, 40, 16);
  274.   FOR i := 0 TO 1 DO
  275.     Quad(8, 32+i*32, 31, 55+i*32); Quad(32, 32+i*32, 87, 55+i*32);
  276.     Quad(88, 32+i*32, 111, 55+i*32);
  277.   END;
  278.   Blit(20, 0, 10, 34, 20, 20); Blit(0, 0, 10, 66, 20, 20);
  279.   Quad(8, 96, 111, 135);
  280.   Blit(110, 0, 10, 111, 10, 10);
  281.   FOR i := 1 TO 9 DO Blit(110, 10, 10+i*10, 111, 10, 10) END;
  282.   LoadRGB4(ADR(scr^.viewPort), ADR(Colors), 16);
  283. END Start;
  284.  
  285. PROCEDURE ZeigWahl;
  286. BEGIN
  287.   FOR i := 0 TO 9 DO Blit(120, 0, 10+i*10, 98, 10, 10) END;
  288.   FOR i := 0 TO 9 DO Blit(120, 0, 10+i*10, 124, 10, 10) END;
  289.   IF WEISSP = MENSCH THEN
  290.     Blit(100, 10, 10, 98, 10, 10)
  291.   ELSE
  292.     FOR i := 1 TO WTIEF DO Blit(100, 10, 10+i*10, 98, 10, 10) END;
  293.   END;
  294.   IF SCHWSP = MENSCH THEN
  295.     Blit(100, 0, 10, 124, 10, 10)
  296.   ELSE
  297.     FOR i := 1 TO STIEF DO Blit(100, 0, 10+i*10, 124, 10, 10) END;
  298.   END;
  299. END ZeigWahl;
  300.  
  301. PROCEDURE ZeigBrett(brett : Brett);
  302. VAR y, x : INTEGER;
  303.     num : ARRAY[0..1] OF CHAR;
  304. BEGIN
  305.   anz[0] := 0; anz[1] := 0; anz[2] := 0;
  306.   FOR y := 0 TO GROSS-1 DO
  307.     FOR x := 0 TO GROSS-1 DO
  308.       Blit(brett[y,x]*20, 0, 136+x*20, 24+y*20, 20, 20);
  309.       INC(anz[brett[y,x]]);
  310.     END
  311.   END;
  312.   num[0] := CHAR(INTEGER("0")+anz[WEISS] DIV 10);
  313.   num[1] := CHAR(INTEGER("0")+anz[WEISS] MOD 10);
  314.   Quad(88, 32, 111, 55);
  315.   SchreibSchatt(num, 2, 88, 40, 24, 1);
  316.   num[0] := CHAR(INTEGER("0")+anz[SCHWARZ] DIV 10);
  317.   num[1] := CHAR(INTEGER("0")+anz[SCHWARZ] MOD 10);
  318.   Quad(88, 64, 111, 87);
  319.   SchreibSchatt(num, 2, 88, 72, 24, 1);
  320. END ZeigBrett;
  321.  
  322. PROCEDURE MachAnfang;
  323. BEGIN
  324.   SCHWSP := AMIGA; WEISSP := MENSCH; STIEF := 1; WTIEF := 1;
  325.   restart := FALSE; back := FALSE; zugnum := 0; maxzug := 0;
  326.   amzug := WEISS; paused := FALSE;
  327.   FOR y := 0 TO GROSS-1 DO
  328.     FOR x := 0 TO GROSS-1 DO
  329.       brett[y, x] := LEER;
  330.     END
  331.   END;
  332.   brett[3,4] := SCHWARZ; brett[3,3] := WEISS;
  333.   brett[4,4] := SCHWARZ; brett[4,3] := WEISS;
  334.   ZeigBrett(brett); memory[zugnum].b := brett; memory[zugnum].sp := WEISS;
  335.   Quad(32, 32, 87, 55);
  336.   Quad(32, 64, 87, 87);
  337.   Quad(8, 152, 111, 167); SchreibSchatt("Force Move", 10, 8, 156, 103, 1);
  338.   Quad(8, 168, 47, 183);
  339.   FOR i := 0 TO 1 DO
  340.     SetAPen(rp, 10); Move(rp, 12+i*16, 175); Draw(rp, 24+i*16, 170);
  341.     Draw(rp, 24+i*16, 181); SetAPen(rp, 12); Draw(rp, 12+i*16, 175);
  342.   END;
  343.   Quad(48, 168, 71, 183); Quad(52, 170, 58, 181); Quad(62, 170, 68, 181);
  344.   Quad(72, 168, 111, 183);
  345.   FOR i := 0 TO 1 DO
  346.     SetAPen(rp, 10); Move(rp, 80+i*16, 170); Draw(rp, 92+i*16, 175);
  347.     SetAPen(rp, 12); Draw(rp, 80+i*16, 181); Draw(rp, 80+i*16, 170);
  348.   END;
  349.   Quad(8, 184, 63, 199); SchreibSchatt("New", 3, 8, 188, 55, 1);
  350.   Quad(64, 184, 111, 199); SchreibSchatt("Quit", 4, 64, 188, 47, 1);
  351.   ZeigWahl;
  352. END MachAnfang;
  353.  
  354. PROCEDURE MachZug(y, x, farb : INTEGER; VAR brett : Brett);
  355. VAR dx, dy, px, py, xx, yy : INTEGER;
  356.     moegl : BOOLEAN;
  357. BEGIN
  358.   brett[y, x] := farb;
  359.   FOR dx := -1 TO 1 DO
  360.     FOR dy := -1 TO 1 DO
  361.       moegl := FALSE;
  362.       IF (dx # 0) OR (dy # 0) THEN
  363.         px := x + dx; py := y + dy;
  364.         WHILE (px>=0) & (px<GROSS) & (py>=0) & (py<GROSS) &
  365.               (brett[py, px] = (1-farb)) DO
  366.           px := px + dx; py := py + dy;
  367.           moegl := TRUE;
  368.         END;
  369.         IF moegl & (px>=0) & (px<GROSS) & (py>=0) & (py<GROSS) &
  370.            (brett[py,px] = farb) THEN
  371.           xx := x + dx; yy := y + dy;
  372.           WHILE NOT ((xx = px) AND (yy = py)) DO
  373.             brett[yy,xx] := farb;
  374.             xx := xx + dx; yy := yy + dy;
  375.           END
  376.         END
  377.       END
  378.     END
  379.   END;
  380. END MachZug;
  381.  
  382. PROCEDURE ZeigZug(y, x, farb:INTEGER; VAR brett : Brett);
  383. VAR dx, dy, px, py, xx, yy : INTEGER;
  384.     moegl : BOOLEAN;
  385. BEGIN
  386.   FOR i := 0 TO 2 DO
  387.     BltBitMapRastPort(ADR(bm), farb*20, 0, rp,
  388.                         136+x*20, 24+y*20, 20, 20, 0C0H);
  389.     Delay(4);
  390.     BltBitMapRastPort(ADR(bm), 40, 0, rp,
  391.                       136+x*20, 24+y*20, 20, 20, 0C0H);
  392.     Delay(2);
  393.   END;
  394.   MachZug(y, x, farb, brett);
  395.   ZeigBrett(brett);
  396.   INC(zugnum); memory[zugnum].b:=brett; memory[zugnum].sp := 1-farb;
  397.   maxzug := zugnum;
  398. END ZeigZug;
  399.  
  400. PROCEDURE TestZug(y, x, farb : INTEGER; b : Brett) : BOOLEAN;
  401. VAR dx, dy, px, py, xx, yy : INTEGER;
  402.     moegl : BOOLEAN;
  403. BEGIN
  404.   IF b[y, x] # LEER THEN RETURN FALSE END;
  405.   FOR dx := -1 TO 1 DO
  406.     FOR dy := -1 TO 1 DO
  407.       IF (dx # 0) OR (dy # 0) THEN
  408.         px := x + dx; py := y + dy; moegl := FALSE;
  409.         WHILE (px>=0) & (px<GROSS) & (py>=0) & (py<GROSS) &
  410.               (b[py,px] = (1-farb)) DO
  411.           moegl := TRUE;
  412.           px := px + dx; py := py + dy;
  413.         END;
  414.         IF moegl & (px>=0) & (px<GROSS) & (py>=0) &
  415.            (py<GROSS) & (b[py, px] = farb) THEN
  416.           RETURN TRUE
  417.         END
  418.       END
  419.     END
  420.   END;
  421.   RETURN FALSE
  422. END TestZug;
  423.  
  424. PROCEDURE TestBrett(farb : INTEGER) : BOOLEAN;
  425. VAR y, x : INTEGER;
  426. BEGIN
  427.   FOR y := 0 TO GROSS-1 DO
  428.     FOR x := 0 TO GROSS-1 DO
  429.       IF TestZug(y, x, farb, brett) THEN
  430.         RETURN TRUE;
  431.       END
  432.     END
  433.   END;
  434.   RETURN FALSE;
  435. END TestBrett;
  436.  
  437. PROCEDURE Bewertung(b : Brett; farb : INTEGER) : INTEGER;
  438. VAR y, x, erg : INTEGER;
  439. BEGIN
  440.   erg := 0;
  441.   FOR y := 0 TO GROSS-1 DO
  442.     FOR x := 0 TO GROSS-1 DO
  443.       IF b[y, x] = farb THEN INC(erg, wert[y, x])
  444.       ELSIF b[y, x] = 1-farb THEN DEC(erg, wert[y, x])
  445.       END;
  446.     END
  447.   END;
  448.   RETURN erg;
  449. END Bewertung;
  450.  
  451. PROCEDURE TestMaus(typ : INTEGER);
  452. BEGIN
  453.   IF NOT (gamePort0 IN ciaa.pra) THEN
  454.     mx := scr^.mouseX; my := scr^.mouseY;
  455.     IF (typ = AMIGA) & (mx>8) & (mx<111) & (my>152) & (my<167) THEN
  456.       SetAPen(rp, 11); Move(rp, 8, 152); Draw(rp, 111, 152);
  457.       Draw(rp, 111, 167); Draw(rp, 8, 167); Draw(rp, 8, 152);
  458.       force := TRUE;
  459.     ELSIF (mx>48) & (mx<71) & (my>168) & (my<183) & NOT paused THEN
  460.       SetAPen(rp, 11); Move(rp, 48, 168); Draw(rp, 71, 168);
  461.       Draw(rp, 71, 183); Draw(rp, 48, 183); Draw(rp, 48, 168);
  462.       paused := TRUE;
  463.     ELSIF paused THEN
  464.       IF (mx>48) & (mx<71) & (my>168) & (my<183) THEN
  465.         SetAPen(rp, 10); Move(rp, 48, 168); Draw(rp, 71, 168);
  466.         Draw(rp, 71, 183); SetAPen(rp, 12); Move(rp, 48, 169);
  467.         Draw(rp, 48, 183); Draw(rp, 71, 183);
  468.         paused := FALSE;
  469.       ELSIF (mx>8) & (mx<47) & (my>168) & (my<183) & (zugnum>0)
  470.       THEN back := TRUE;
  471.         SetAPen(rp, 11); Move(rp, 8, 168); Draw(rp, 47, 168);
  472.         Draw(rp, 47, 183); Draw(rp, 8, 183); Draw(rp, 8, 168);
  473.         DEC(zugnum); brett := memory[zugnum].b;
  474.       ELSIF (mx>72) & (mx<111) & (my>168) & (my<183) & (zugnum<maxzug)
  475.       THEN forward := TRUE;
  476.         SetAPen(rp, 11); Move(rp, 72, 168); Draw(rp, 111, 168);
  477.         Draw(rp, 111, 183); Draw(rp, 72, 183); Draw(rp, 72, 168);
  478.         INC(zugnum); brett := memory[zugnum].b;
  479.       ELSIF (mx>8) & (mx<63) & (my>184) & (my<199) THEN
  480.         SetAPen(rp, 11); Move(rp, 8, 184); Draw(rp, 63, 184);
  481.         Draw(rp, 63, 199); Draw(rp, 8, 199); Draw(rp, 8, 184);
  482.         restart := TRUE;
  483.       ELSIF (mx>64) & (mx<111) & (my>184) & (my<199) THEN
  484.         SetAPen(rp, 11); Move(rp, 64, 184); Draw(rp, 111, 184);
  485.         Draw(rp, 111, 199); Draw(rp, 64, 199); Draw(rp, 64, 184);
  486.         quit := TRUE;
  487.       ELSIF (mx>9) & (mx<19) & (my>98) & (my<108) THEN
  488.         WEISSP := MENSCH; ZeigWahl;
  489.       ELSIF (mx>9) & (mx<19) & (my>124) & (my<134) THEN
  490.         SCHWSP := MENSCH; ZeigWahl;
  491.       ELSIF (mx>19) & (mx<111) & (my>98) & (my<108) THEN
  492.         WEISSP := AMIGA; WTIEF := (mx-9) DIV 10; ZeigWahl;
  493.       ELSIF (mx>19) & (mx<111) & (my>124) & (my<134) THEN
  494.         SCHWSP := AMIGA; STIEF := (mx-9) DIV 10; ZeigWahl;
  495.       END;
  496.     END;
  497.     REPEAT UNTIL gamePort0 IN ciaa.pra;
  498.   END
  499. END TestMaus;
  500.  
  501. PROCEDURE MiniMax(farb, aktfarb, tief, alpha, beta : INTEGER;
  502.                   br : Brett) : INTEGER;
  503. VAR max, min, w, px, py : INTEGER;
  504.     b :Brett;
  505. BEGIN
  506.   IF tief = 0 THEN RETURN Bewertung(br, farb) END;
  507.   max := -10000; min := 10000;
  508.   FOR py := 0 TO GROSS-1 DO
  509.     FOR px := 0 TO GROSS-1 DO
  510.       IF TestZug(py, px, aktfarb, br) THEN
  511.         IF farb = aktfarb THEN
  512.           IF max <= beta THEN
  513.             b := br;
  514.             MachZug(py, px, aktfarb, b);
  515.             w := MiniMax(farb, 1-aktfarb, tief-1, max, 0, b);
  516.             IF w>max THEN max := w END;
  517.           END;
  518.         ELSE
  519.           IF min > alpha THEN
  520.             b := br;
  521.             MachZug(py, px, aktfarb, b);
  522.             w := MiniMax(farb, 1-aktfarb, tief-1, 0, min, b);
  523.             IF w<min THEN min := w END;
  524.           END
  525.         END;
  526.         TestMaus(AMIGA);
  527.         IF quit OR restart OR paused OR
  528.            ((farb = WEISS) & (WEISSP # AMIGA)) OR
  529.            ((farb = SCHWARZ ) & (SCHWSP # AMIGA)) THEN
  530.           RETURN BREAK
  531.         END;
  532.         IF force THEN
  533.           IF farb = aktfarb THEN RETURN max ELSE RETURN min END;
  534.         END;
  535.       END
  536.     END
  537.   END;
  538.   IF farb = aktfarb THEN RETURN max ELSE RETURN min END;
  539. END MiniMax;
  540.  
  541. PROCEDURE ComputerZug(farb, tiefe : INTEGER; VAR y, x : INTEGER);
  542. VAR max, w, px, py : INTEGER;
  543.     b : Brett;
  544. BEGIN
  545.   max := -10000; x := -1;
  546.   FOR py := 0 TO GROSS-1 DO
  547.     FOR px := 0 TO GROSS-1 DO
  548.       IF TestZug(py, px, farb, brett) THEN
  549.         b := brett;
  550.         MachZug(py, px, farb, b);
  551.         w := MiniMax(farb, 1-farb, tiefe-1, max, 0, b);
  552.         IF w = BREAK THEN x := -1; RETURN END;
  553.         IF (w>max) OR (x = -1) THEN max := w; x := px; y := py; END;
  554.         TestMaus(AMIGA);
  555.         IF restart OR quit OR paused OR ((farb = WEISS) & (WEISSP # AMIGA)) OR
  556.            ((farb = SCHWARZ ) & (SCHWSP # AMIGA)) THEN RETURN END;
  557.         IF force THEN
  558.           SetAPen(rp, 10); Move(rp, 8, 152); Draw(rp, 111, 152);
  559.           Draw(rp, 111, 167);
  560.           SetAPen(rp, 12); Move(rp, 8, 153); Draw(rp, 8, 167);
  561.           Draw(rp, 111, 167);
  562.           force := FALSE; RETURN
  563.         END;
  564.       END
  565.     END
  566.   END;
  567. END ComputerZug;
  568.  
  569. PROCEDURE MenschZug(farb : INTEGER; VAR y, x : INTEGER) : BOOLEAN;
  570. BEGIN
  571.   x := (mx-136) DIV 20;
  572.   y := (my-24) DIV 20;
  573.   IF (x >= 0) & (x < GROSS) & (y >= 0) & (y < GROSS) THEN
  574.     IF TestZug(y, x, farb, brett) THEN
  575.       RETURN TRUE
  576.     ELSE
  577.       SetRGB4(ADR(scr^.viewPort), 0, 15, 15, 15);
  578.       Delay(1);
  579.       SetRGB4(ADR(scr^.viewPort), 0, 0, 0, 0);
  580.       RETURN FALSE;
  581.     END
  582.   END;
  583.   RETURN FALSE;
  584. END MenschZug;
  585.  
  586. PROCEDURE SpielEnde;
  587. BEGIN
  588.   IF anz[WEISS] > anz[SCHWARZ] THEN
  589.     Schreib("Wins!", 5, WEISS); Schreib("Looses", 6, SCHWARZ);
  590.   ELSIF anz[WEISS] < anz[SCHWARZ] THEN
  591.     Schreib("Wins!", 5, SCHWARZ); Schreib("Looses", 6, WEISS);
  592.   ELSE
  593.     Schreib("Drawn", 5, SCHWARZ); Schreib("Drawn", 5, WEISS);
  594.   END
  595. END SpielEnde;
  596.  
  597. PROCEDURE TheEnd;
  598. BEGIN
  599.   IF win#NIL THEN CloseWindow(win) END;
  600.   IF scr#NIL THEN CloseScreen(scr) END;
  601.   FOR i := 0 TO 3 DO
  602.     IF bm.planes[i] # NIL THEN
  603.       FreeRaster(bm.planes[i], 130, 20)
  604.     END
  605.   END;
  606.   IF topaz#NIL THEN CloseFont(topaz) END;
  607. END TheEnd;
  608.  
  609. PROCEDURE Spiel;
  610. BEGIN
  611.   MachAnfang;
  612.   LOOP
  613.     WHILE paused DO
  614.       TestMaus(PAUSE);
  615.       IF back OR forward THEN
  616.         amzug := memory[zugnum].sp;
  617.         back := FALSE; forward := FALSE;
  618.         IF amzug # KEIN
  619.           THEN Schreib("Move", 4, amzug); Schreib("", 0, 1-amzug);
  620.         ELSE
  621.           SpielEnde;
  622.         END;
  623.         SetAPen(rp, 10); Move(rp, 8, 168); Draw(rp, 47, 168); Draw(rp, 47, 183);
  624.         SetAPen(rp, 12); Move(rp, 8, 169); Draw(rp, 8, 183); Draw(rp, 47, 183);
  625.         SetAPen(rp, 10); Move(rp, 72, 168); Draw(rp, 111, 168);
  626.         Draw(rp, 111, 183); SetAPen(rp, 12); Move(rp, 72, 169);
  627.         Draw(rp, 72, 183); Draw(rp, 111, 183);
  628.         ZeigBrett(brett);
  629.       END;
  630.       IF restart OR quit THEN RETURN END;
  631.     END;
  632.     LOOP
  633.       IF amzug = WEISS THEN
  634.         wZieh := TestBrett(WEISS);
  635.         IF NOT (wZieh OR sZieh) THEN
  636.           SpielEnde; paused := TRUE; memory[zugnum].sp := KEIN;
  637.           SetAPen(rp, 11); Move(rp, 48, 168); Draw(rp, 71, 168);
  638.           Draw(rp, 71, 183); Draw(rp, 48, 183); Draw(rp, 48, 168);
  639.           EXIT
  640.         END;
  641.         IF NOT wZieh THEN
  642.           Schreib("Can't", 5, WEISS);
  643.         ELSE
  644.           Schreib("Move", 4, WEISS);
  645.           LOOP
  646.             IF WEISSP = MENSCH THEN
  647.               LOOP
  648.                 WHILE gamePort0 IN ciaa.pra DO END;
  649.                 mx := scr^.mouseX; my := scr^.mouseY;
  650.                 TestMaus(MENSCH);
  651.                 IF paused THEN EXIT END;
  652.                 IF WEISSP # MENSCH THEN EXIT END;
  653.                 IF MenschZug(WEISS, zy, zx) THEN EXIT END;
  654.               END;
  655.             END;
  656.             IF (WEISSP = AMIGA) THEN
  657.               ComputerZug(WEISS, WTIEF, zy, zx);
  658.             END;
  659.             IF (zx # -1) OR paused THEN EXIT END;
  660.           END;
  661.           IF paused THEN EXIT END;
  662.           ZeigZug(zy, zx, WEISS, brett);
  663.           Schreib("", 0, WEISS);
  664.         END;
  665.         amzug := SCHWARZ;
  666.       END;
  667.       IF amzug=SCHWARZ THEN
  668.         sZieh := TestBrett(SCHWARZ);
  669.         IF NOT (sZieh OR wZieh) THEN
  670.           SpielEnde; paused := TRUE; memory[zugnum].sp := KEIN;
  671.           SetAPen(rp, 11); Move(rp, 48, 168); Draw(rp, 71, 168);
  672.           Draw(rp, 71, 183); Draw(rp, 48, 183); Draw(rp, 48, 168);
  673.           EXIT
  674.         END;
  675.         IF NOT sZieh THEN
  676.           Schreib("Can't", 5, SCHWARZ);
  677.         ELSE
  678.           Schreib("Move", 4, SCHWARZ);
  679.           LOOP
  680.             IF SCHWSP = MENSCH THEN
  681.               LOOP
  682.                 WHILE gamePort0 IN ciaa.pra DO END;
  683.                 mx := scr^.mouseX; my := scr^.mouseY;
  684.                 TestMaus(MENSCH);
  685.                 IF paused THEN EXIT END;
  686.                 IF SCHWSP # MENSCH THEN EXIT END;
  687.                 IF MenschZug(SCHWARZ, zy, zx) THEN EXIT END;
  688.               END;
  689.             END;
  690.             IF SCHWSP = AMIGA THEN
  691.               ComputerZug(SCHWARZ, STIEF, zy, zx);
  692.             END;
  693.             IF (zx # -1) OR paused THEN EXIT END;
  694.           END;
  695.           IF paused THEN EXIT END;
  696.           ZeigZug(zy, zx, SCHWARZ, brett);
  697.           Schreib("", 0, SCHWARZ);
  698.         END;
  699.         amzug := WEISS;
  700.       END;
  701.     END;
  702.   END;
  703. END Spiel;
  704.  
  705. BEGIN
  706.   TermProcedure(TheEnd);
  707.   WITH ta DO
  708.     name :=ADR("topaz.font"); ySize:=8; style:=normalFont;
  709.     flags:=FontFlagSet{romFont,designed};
  710.   END;
  711.   topaz:=OpenFont(ADR(ta));
  712.   Assert(topaz#NIL, ADR("Kein topaz.font"));
  713.   Start;
  714.   LOOP
  715.     Spiel;
  716.     IF quit THEN EXIT END;
  717.   END;
  718. END Reversi.
  719.