home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / oberon / demos / mines.mod (.txt) < prev    next >
Oberon Text  |  1977-12-31  |  38KB  |  1,199 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. FoldElems
  4. Syntax10.Scn.Fnt
  5. (* standard colors *)
  6. Syntax10.Scn.Fnt
  7. (*MS-Windows Colors*)
  8. MODULE Mines; (** Oberon-Mines V1.32  (C) 1 Oct  95 by Ralf Degner *)
  9. (* If you use MacOberon or the Ceres replace Input.TimeUnit by 300 *)
  10. IMPORT
  11.     Oberon, Texts,  Display, MenuViewers, TextFrames, Input, Fonts, Viewers, Files;
  12. CONST
  13. (* the colors of Mines with Mines.Pal *)
  14.     black=Display.white; red=1; yellow=4; lightgray=12; midgray=13; darkgray=14;
  15.     Col1=3; Col2=2; Col3=red; Col4=9; Col5=7; Col6=5; Col7=6; Col8=black;
  16. (* the colors of Mines for Windows *)
  17.     (*black=Display.white; red=1; yellow=10; lightgray=11; midgray=12; darkgray=14;
  18.     Col1=3; Col2=5; Col3=red; Col4=6; Col5=4; Col6=8; Col7=7; Col8=black;*)
  19.     Menu = "System.Close  System.Copy  System.Grow  Mines.Pause  Mines.Beginner  Mines.Advanced  Mines.Expert  Mines.Max  Mines.Score";
  20.     KastenBreite=16;ObenPlatz=25;
  21.     UntenPlatz=4;SeitenPlatz=4;
  22.     KastenPlatz*=KastenBreite+1;KB=KastenBreite;
  23.     MinKastenAnz=7;CharBreite=8;
  24.     FeldPtr* = POINTER TO ARRAY OF ARRAY OF SHORTINT;
  25.     String = ARRAY 32 OF CHAR;
  26.     Data* = POINTER TO DataDesc;
  27.     DataDesc* = RECORD
  28.         XKastenAnz*,YKastenAnz*: INTEGER;
  29.         Aktiv*, Pause*, StartPlay*: BOOLEAN;
  30.         Feld*: FeldPtr;
  31.         Time*, Count*, Mines*: LONGINT;
  32.         Quote*, Mode*: INTEGER;
  33.     END;
  34.     Frame* = POINTER TO FrameDesc;
  35.     FrameDesc* = RECORD(Display.FrameDesc)
  36.         SeitenOffset*, UntenOffset*: INTEGER;
  37.         LastModMsg: BOOLEAN;
  38.         d*: Data;
  39.     END;
  40.     MinerMsg = RECORD(Display.FrameMsg)
  41.         d*: Data;
  42.     END;
  43.     PlotNewMsg = RECORD(MinerMsg)
  44.     END;
  45.     PlotKastenMsg* = RECORD(MinerMsg)
  46.         x*, y*: INTEGER;
  47.     END;
  48.     NeuesFeldMsg = RECORD(MinerMsg)
  49.         Change: BOOLEAN;
  50.     END;
  51.     RePlotMsg = RECORD(MinerMsg)
  52.         All: BOOLEAN;
  53.     END;
  54.     TimeMsg = RECORD(MinerMsg)
  55.         id: LONGINT;
  56.         Count: INTEGER;
  57.     END;
  58.     UsedFont: Fonts.Font;
  59.     W: Texts.Writer;
  60.     TimeTask: Oberon.Task;
  61.     seed, StartTime, LastTime: LONGINT;
  62.     HiTime: ARRAY 3 OF LONGINT;
  63.     HiName: ARRAY 3 OF String;
  64.     Name: String;
  65.     ScoreFile: Files.File;
  66.     ScoreRider: Files.Rider;
  67.     Color, UseTimeTask, TimeTaskRuns, PauseFlag: BOOLEAN;
  68.     Colors: ARRAY 8 OF INTEGER;
  69.     Dummy: INTEGER;
  70.     TimeUnit: LONGINT;
  71.     (* data for patterns *)
  72.     HappyData, SadData, BackData, GotItData, PauseData: ARRAY 17 OF SET;
  73.     HappyPat, SadPat, BackPat, GotItPat, PausePat: LONGINT;
  74.     Data1, Data2, Data3, Data4: ARRAY 13 OF SET;
  75.     Pat: ARRAY 5 OF LONGINT;
  76. (* clear HiScore *)
  77. PROCEDURE ClearHi;
  78.     VAR d: INTEGER;
  79. BEGIN
  80.     FOR d:=0 TO 2 DO
  81.         HiTime[d]:=999999;
  82.         HiName[d]:="Amiga"
  83. END ClearHi;
  84. (* store HiScore *)
  85. PROCEDURE SaveHi(Register: BOOLEAN);
  86.     VAR d: INTEGER;
  87. BEGIN
  88.     Files.Set(ScoreRider, ScoreFile, 0);
  89.     Files.WriteBool(ScoreRider, Color);
  90.     Files.WriteBool(ScoreRider, UseTimeTask);
  91.     FOR d:=0 TO 2 DO
  92.         Files.WriteLInt(ScoreRider, HiTime[d]);
  93.         Files.WriteBytes(ScoreRider, HiName[d], 32);
  94.     END;
  95.     IF Register THEN
  96.         Files.Register(ScoreFile)
  97.     ELSE
  98.          Files.Close(ScoreFile)
  99.      END
  100. END SaveHi;
  101. (* load HiScore *)
  102. PROCEDURE LoadHi;
  103.     VAR d: INTEGER;
  104. BEGIN
  105.     ClearHi();
  106.     ScoreFile:=Files.Old("Mines.Score");
  107.     IF ScoreFile=NIL THEN
  108.         ScoreFile:=Files.New("Mines.Score");
  109.         SaveHi(TRUE)
  110.     ELSE
  111.         Files.Set(ScoreRider, ScoreFile, 0);
  112.         Files.ReadBool(ScoreRider, Color);
  113.         Files.ReadBool(ScoreRider, UseTimeTask);
  114.         FOR d:=0 TO 2 DO
  115.             Files.ReadLInt(ScoreRider, HiTime[d]);
  116.             Files.ReadBytes(ScoreRider, HiName[d], 32)
  117.         END
  118. END LoadHi;
  119. (* produces random numbers *)
  120. PROCEDURE Random(Ein: INTEGER):INTEGER;
  121.     CONST a=16807; m=2147483647; q=m DIV a; r=m MOD a;
  122.     VAR g: LONGINT;
  123. BEGIN
  124.     g:=a*(seed MOD q)-r*(seed DIV q);
  125.     IF g>0 THEN seed:=g
  126.     ELSE seed:=g+m END;
  127.     RETURN SHORT(seed) MOD Ein
  128. END Random;
  129. (* stop the TimeTask *)
  130. PROCEDURE StopTask*;
  131. BEGIN
  132.     IF TimeTaskRuns THEN
  133.         Oberon.Remove(TimeTask);
  134.         TimeTaskRuns:=FALSE
  135. END StopTask;
  136. (* the task that sends a TimeMsg every second *)
  137. PROCEDURE TheTimeTask;
  138.     VAR timsg: TimeMsg;
  139. BEGIN
  140.     IF Input.Time()>LastTime THEN
  141.         LastTime:=LastTime+TimeUnit;
  142.         timsg.id:=StartTime;
  143.         timsg.Count:=0;
  144.         Viewers.Broadcast(timsg);
  145.         IF timsg.Count=0 THEN StopTask() END
  146. END TheTimeTask;
  147. (* start the TimeTask *)
  148. PROCEDURE StartTask;
  149. BEGIN
  150.     IF ~TimeTaskRuns THEN
  151.         NEW(TimeTask);
  152.         TimeTask.safe:=FALSE;
  153.         TimeTask.handle:=TheTimeTask;
  154.         Oberon.Install(TimeTask);
  155.         LastTime:=Input.Time();
  156.         TimeTaskRuns:=TRUE
  157. END StartTask;
  158. (* draw box at top of the field *)
  159. PROCEDURE PlotSmily(f: Frame; Smile: BOOLEAN);
  160.     VAR XPos, YPos, Col: INTEGER;
  161. BEGIN
  162.     IF f.H>ObenPlatz THEN
  163.         IF f.W>30 THEN
  164.             YPos:=f.Y+f.H-ObenPlatz+3;
  165.             XPos:=f.W DIV 2-10+f.X;
  166.             IF Color THEN
  167.                 Display.ReplConst(lightgray, XPos, YPos, 20, 20, Display.replace);
  168.                 Display.ReplConst(darkgray, XPos+1, YPos, 19, 19, Display.replace);
  169.                 Display.ReplConst(midgray, XPos+1, YPos+1, 18, 18, Display.replace);
  170.                 Display.CopyPattern(yellow, BackPat, XPos+2, YPos+2, Display.paint);
  171.                 Col:=black
  172.             ELSE
  173.                 Display.ReplConst(Display.white, XPos, YPos, 20, 20, Display.replace);
  174.                 Display.ReplConst(Display.black, XPos+1, YPos+1, 18, 18, Display.replace);
  175.                 Col:=Display.white;
  176.             END;
  177.             IF f.d.Pause THEN
  178.                 Display.CopyPattern(Col, PausePat, XPos+2, YPos+2, Display.paint)
  179.             ELSE
  180.                 IF Smile THEN
  181.                     Display.CopyPattern(Col, HappyPat, XPos+2, YPos+2, Display.paint)
  182.                 ELSE
  183.                     Display.CopyPattern(Col, SadPat, XPos+2, YPos+2, Display.paint)
  184.                 END
  185.             END
  186.         END
  187. END PlotSmily;
  188. (* clear a frame *)
  189. PROCEDURE ClearFrame(f: Frame; Smile: BOOLEAN);
  190. BEGIN
  191.     Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  192.     Display.ReplConst(Display.black, f.X, f.Y, f.W, f.H, Display.replace);
  193.     f.SeitenOffset:=(f.W-f.d.XKastenAnz*KastenPlatz) DIV 2 +f.X;
  194.     f.UntenOffset:=f.Y+f.H-ObenPlatz-f.d.YKastenAnz*KastenPlatz;
  195.     PlotSmily(f, Smile);
  196. END ClearFrame;
  197. (* copy frame with same data *)
  198. PROCEDURE CopyMe(f: Frame): Frame;
  199.     VAR nf: Frame;
  200. BEGIN
  201.     NEW(nf);IF nf=NIL THEN RETURN NIL;END;
  202.     nf.handle:=f.handle;
  203.     nf.d:=f.d;nf.LastModMsg:=TRUE;
  204.     RETURN nf;
  205. END CopyMe;
  206. (* clear a box *)
  207. PROCEDURE ClearKasten(f: Frame; x, y: INTEGER; Color: BOOLEAN);
  208.     VAR dumx, dumy: INTEGER;
  209. BEGIN
  210.     dumx:=f.SeitenOffset+x*KastenPlatz-KastenBreite;
  211.     dumy:=f.UntenOffset+y*KastenPlatz-KastenBreite;
  212.     IF Color THEN
  213.         Display.ReplConst(darkgray, dumx, dumy, KB, KB, Display.replace);
  214.         Display.ReplConst(lightgray, dumx+1, dumy, KB-1, KB-1, Display.replace);
  215.         Display.ReplConst(midgray, dumx+1, dumy+1, KB-2, KB-2, Display.replace)
  216.     ELSE
  217.         Display.ReplConst(Display.black, dumx, dumy, KB, KB, Display.replace)
  218. END ClearKasten;
  219. (* draw not selected box *)
  220. PROCEDURE BlockKasten(f: Frame; x, y: INTEGER; Color: BOOLEAN; col: INTEGER);
  221.     VAR dumx, dumy: INTEGER;
  222. BEGIN
  223.     dumx:=f.SeitenOffset+x*KastenPlatz-KastenBreite;
  224.     dumy:=f.UntenOffset+y*KastenPlatz-KastenBreite;
  225.     IF Color THEN
  226.         Display.ReplConst(lightgray, dumx, dumy, KB, KB, Display.replace);
  227.         Display.ReplConst(darkgray, dumx+1, dumy, KB-1, KB-1, Display.replace);
  228.         Display.ReplConst(midgray, dumx+1, dumy+1, KB-2, KB-2, Display.replace)
  229.     ELSE
  230.         Display.ReplConst(Display.black, dumx, dumy, KB, KB, Display.replace);
  231.         Display.ReplConst(col, dumx+1, dumy+1, KB-2, KB-2, Display.replace)
  232. END BlockKasten;
  233. (* draw char at box *)
  234. PROCEDURE DrawChar(f: Frame; ch: CHAR; XKasten, YKasten: INTEGER; Color: BOOLEAN; col: INTEGER);
  235.         Pat: Display.Pattern;
  236.         dx, x, y, w, h: INTEGER;
  237.         dumx, dumy: INTEGER;
  238. BEGIN
  239.     Display.GetChar(UsedFont.raster, ch, dx, x, y, w, h, Pat);
  240.     ClearKasten(f, XKasten, YKasten, Color);
  241.     dumx:=f.SeitenOffset+XKasten*KastenPlatz-KastenBreite+(KB-w) DIV 2;
  242.     dumy:=f.UntenOffset+YKasten*KastenPlatz-KastenBreite+(KB-h) DIV 2;
  243.     IF Color THEN
  244.         col:=Colors[ORD(ch)-49];
  245.     END;
  246.     Display.CopyPattern(col, Pat, dumx, dumy, Display.paint);
  247. END  DrawChar;
  248. (* draw char at x y to display *)
  249. PROCEDURE DrawZahl(ch:  CHAR; XPos, YPos: INTEGER);
  250.         Pat: Display.Pattern;
  251.         dx, x, y, w, h: INTEGER;
  252. BEGIN
  253.     Display.GetChar(UsedFont.raster, ch, dx, x, y, w, h, Pat);
  254.     IF Color THEN
  255.         h:=black
  256.     ELSE
  257.         h:=Display.white;
  258.     END;
  259.     Display.CopyPattern(h, Pat, XPos+x, YPos+y, Display.paint);
  260. END  DrawZahl;
  261. (* draw LONGINT *)
  262. PROCEDURE DrawInt(x, y: INTEGER; Zahl: LONGINT; DrawInt: BOOLEAN);
  263.     VAR Col, Anz: INTEGER;
  264. BEGIN
  265.     Anz:=4;
  266.     IF Color THEN
  267.         Col:=midgray
  268.     ELSE
  269.         Col:=Display.black;
  270.     END;
  271.     Display.ReplConst(Col, x, y, Anz*CharBreite+10, KastenBreite-2, Display.replace);
  272.     IF DrawInt THEN
  273.         IF Zahl<0 THEN
  274.             DrawZahl("-", x+2, y+1);
  275.             Zahl:=ABS(Zahl);
  276.         END;
  277.         REPEAT
  278.             DrawZahl(CHR(Zahl MOD 10+48), x+Anz*CharBreite+1, y+2);
  279.             Zahl:=Zahl DIV 10;
  280.             DEC(Anz)
  281.         UNTIL (Zahl=0) OR (Anz=-1)
  282. END DrawInt;
  283. (* draw number of Mines to find *)
  284. PROCEDURE DrawMinesToFind(f: Frame);
  285. BEGIN
  286.     DrawInt((f.W-119) DIV 2+f.X+2, f.Y+f.H-ObenPlatz+6, f.d.Mines, TRUE);
  287. END DrawMinesToFind;
  288. (* draw the time *)
  289. PROCEDURE DrawTime(f: Frame);
  290. BEGIN
  291.     DrawInt(f.W DIV 2+f.X+16, f.Y+f.H-ObenPlatz+6, (Input.Time()-f.d.Time) DIV TimeUnit, f.d.StartPlay);
  292. END DrawTime;
  293. (* draw pattern, like mine *)
  294. PROCEDURE DrawPat(f: Frame; XKasten, YKasten, No: INTEGER; Mode: BOOLEAN; Color: BOOLEAN; col: INTEGER);
  295.     VAR dumx, dumy: INTEGER;
  296. BEGIN
  297.     IF Mode THEN
  298.         ClearKasten(f, XKasten, YKasten, Color)
  299.     ELSE
  300.         BlockKasten(f, XKasten, YKasten, Color, col);
  301.     END;
  302.     dumx:=f.SeitenOffset+XKasten*KastenPlatz-KastenBreite;
  303.     dumy:=f.UntenOffset+YKasten*KastenPlatz-KastenBreite;
  304.     IF Color THEN
  305.         IF No<3 THEN
  306.             Display.CopyPattern(black, Pat[1], dumx+2, dumy+2, Display.paint);
  307.             IF No=2 THEN
  308.                 Display.CopyPattern(red, Pat[2], dumx+2, dumy+2, Display.paint)
  309.             END
  310.         ELSE
  311.             Display.CopyPattern(red, Pat[3], dumx+2, dumy+2, Display.paint);
  312.             Display.ReplConst(black, dumx+5, dumy+3, 1, 10, Display.replace)
  313.         END
  314.     ELSE
  315.         IF No=1 THEN
  316.             IF Mode THEN
  317.                 Display.CopyPattern(col, Pat[1], dumx+2, dumy+2, Display.paint)
  318.             ELSE
  319.                 Display.CopyPattern(Display.black, Pat[1], dumx+2, dumy+2, Display.paint)
  320.             END
  321.         ELSE
  322.             IF No=2 THEN No:=4;END;
  323.             Display.CopyPattern(Display.black, Pat[No], dumx+2, dumy+2, Display.paint)
  324.         END
  325. END  DrawPat;
  326. (* invert char *)
  327. PROCEDURE DrawCharInv(f: Frame; ch:  CHAR; XKasten, YKasten: INTEGER);
  328.         Pat: Display.Pattern;
  329.         dx, x, y, w, h: INTEGER;
  330.         dumx, dumy: INTEGER;
  331. BEGIN
  332.     Display.GetChar(UsedFont.raster, ch, dx, x, y, w, h, Pat);
  333.     dumx:=f.SeitenOffset+XKasten*KastenPlatz-KB+(KB-w) DIV 2;
  334.     dumy:=f.UntenOffset+YKasten*KastenPlatz-KB+(KB-h) DIV 2;
  335.     Display.CopyPattern(Display.white, Pat, dumx, dumy, Display.invert);
  336. END  DrawCharInv;
  337. (* make new data *)
  338. PROCEDURE NeuesFeld*(d: Data; x, y: INTEGER);
  339.         ZaehlerX, ZaehlerY: INTEGER;
  340.         dummy: LONGINT;
  341.         Bomben: SHORTINT;
  342. BEGIN
  343.     NEW(d.Feld, x+2, y+2);
  344.     IF d.Feld=NIL THEN
  345.         d.Aktiv:=FALSE;
  346.         RETURN;
  347.     END;
  348.     FOR ZaehlerX:=0 TO x+1 DO
  349.         FOR ZaehlerY:=0 TO y+1 DO
  350.             d.Feld[ZaehlerX, ZaehlerY]:=1
  351.         END
  352.     END;
  353.     dummy:=(LONG(x)*y*d.Quote) DIV 100;
  354.     d.Count:=LONG(x)*y-dummy;d.Mines:=dummy;
  355.     REPEAT
  356.         REPEAT
  357.             ZaehlerX:=Random(x)+1;
  358.             ZaehlerY:=Random(y)+1
  359.         UNTIL d.Feld[ZaehlerX, ZaehlerY]=1;
  360.         d.Feld[ZaehlerX, ZaehlerY]:=10;
  361.         DEC(dummy)
  362.     UNTIL dummy=0;
  363.         FOR ZaehlerX:=1 TO x DO
  364.         FOR ZaehlerY:=1 TO y DO
  365.             IF d.Feld[ZaehlerX, ZaehlerY]=1 THEN
  366.                 Bomben:=1;
  367.                 IF d.Feld[ZaehlerX+1, ZaehlerY]=10 THEN INC(Bomben);END;
  368.                 IF d.Feld[ZaehlerX+1, ZaehlerY+1]=10 THEN INC(Bomben);END;
  369.                 IF d.Feld[ZaehlerX, ZaehlerY+1]=10 THEN INC(Bomben);END;
  370.                 IF d.Feld[ZaehlerX-1, ZaehlerY+1]=10 THEN INC(Bomben);END;
  371.                 IF d.Feld[ZaehlerX-1, ZaehlerY]=10 THEN INC(Bomben);END;
  372.                 IF d.Feld[ZaehlerX-1, ZaehlerY-1]=10 THEN INC(Bomben);END;
  373.                 IF d.Feld[ZaehlerX, ZaehlerY-1]=10 THEN INC(Bomben);END;
  374.                 IF d.Feld[ZaehlerX+1, ZaehlerY-1]=10 THEN INC(Bomben);END;
  375.                 d.Feld[ZaehlerX, ZaehlerY]:=Bomben
  376.             END
  377.         END
  378. END NeuesFeld;
  379. (* draw a box *)
  380. PROCEDURE DrawKasten*(f: Frame; XZaehler, YZaehler: INTEGER; Color: BOOLEAN; col: INTEGER);
  381.     VAR dummy: SHORTINT;
  382. BEGIN
  383.     dummy:=f.d.Feld[XZaehler, YZaehler];
  384.     IF dummy>0 THEN
  385.         IF dummy>16 THEN
  386.             DrawPat(f, XZaehler, YZaehler, 3, FALSE, Color, col)
  387.         ELSE
  388.             BlockKasten(f, XZaehler, YZaehler, Color, col)
  389.         END
  390.     ELSE
  391.         IF dummy=-10 THEN
  392.             DrawPat(f, XZaehler, YZaehler, 1, TRUE, Color, col)
  393.         ELSIF dummy=-1 THEN
  394.             ClearKasten(f, XZaehler, YZaehler, Color)
  395.         ELSE
  396.             DrawChar(f, CHR(47-dummy), XZaehler, YZaehler, Color, col)
  397.         END
  398. END DrawKasten;
  399. (* draw all *)
  400. PROCEDURE PlotAll(f: Frame);
  401.     VAR xdum, ydum: INTEGER;
  402. BEGIN
  403.     xdum:=(f.W-7*KastenPlatz) DIV 2+f.X+2;
  404.     ydum:=f.Y+f.H-ObenPlatz+6;
  405.     IF Color THEN
  406.         Display.ReplConst(lightgray, xdum-1, ydum-1, 4*CharBreite+12, KastenBreite, Display.replace);
  407.         Display.ReplConst(darkgray, xdum, ydum-1, 4*CharBreite+11, KastenBreite-1, Display.replace);
  408.         xdum:=f.W DIV 2+f.X+16;
  409.         Display.ReplConst(lightgray, xdum-1, ydum-1, 4*CharBreite+12, KastenBreite, Display.replace);
  410.         Display.ReplConst(darkgray, xdum, ydum-1, 4*CharBreite+11, KastenBreite-1, Display.replace)
  411.     ELSE
  412.         Display.ReplConst(Display.white, xdum-1, ydum-1, 4*CharBreite+12, KastenBreite, Display.replace);
  413.         xdum:=f.W DIV 2+f.X+16;
  414.         Display.ReplConst(Display.white, xdum-1, ydum-1, 4*CharBreite+12, KastenBreite, Display.replace);
  415.     END;
  416.     DrawMinesToFind(f);
  417.     DrawTime(f);
  418.     ydum:=f.d.YKastenAnz*KastenPlatz+1;
  419.     xdum:=f.d.XKastenAnz*KastenPlatz+1;
  420.     IF Color THEN
  421.         Display.ReplConst(midgray, f.SeitenOffset, f.UntenOffset, xdum, ydum, Display.replace);
  422.         Display.ReplConst(lightgray, f.SeitenOffset-1, f.UntenOffset-1, 1, ydum+2, Display.replace);
  423.         Display.ReplConst(lightgray, f.SeitenOffset-1, f.UntenOffset+ydum, xdum+1, 1, Display.replace);
  424.         Display.ReplConst(darkgray, f.SeitenOffset-1, f.UntenOffset-1, xdum+2, 1, Display.replace);
  425.         Display.ReplConst(darkgray, f.SeitenOffset+xdum, f.UntenOffset-1, 1, ydum+2, Display.replace)
  426.     ELSE
  427.         Display.ReplConst(Display.white, f.SeitenOffset, f.UntenOffset, xdum, ydum, Display.replace);
  428.     END;
  429.     FOR xdum:=1 TO f.d.XKastenAnz DO
  430.         FOR ydum:=1 TO f.d.YKastenAnz DO
  431.             DrawKasten(f, xdum, ydum, Color, Display.white)
  432.         END
  433. END PlotAll;
  434. (* draw all, if finding a mine *)
  435. PROCEDURE SwitchAll(f: Frame; Color: BOOLEAN; col: INTEGER);
  436.         xdum, ydum: INTEGER;
  437.         Typ: SHORTINT;
  438. BEGIN
  439.     Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  440.     FOR xdum:=1 TO f.d.XKastenAnz DO
  441.         FOR ydum:=1 TO f.d.YKastenAnz DO
  442.             Typ:=f.d.Feld[xdum, ydum];
  443.             IF Typ>0 THEN
  444.                 IF Typ=10 THEN
  445.                     DrawPat(f, xdum, ydum, 1, FALSE, Color, col)
  446.                 ELSIF Typ<10 THEN
  447.                     f.d.Feld[xdum, ydum]:=-Typ;
  448.                     DrawKasten(f, xdum, ydum, Color, col)
  449.                 ELSIF (Typ>16) & (Typ#26) THEN
  450.                     DrawPat(f, xdum, ydum, 2, FALSE, Color, col)
  451.                 END
  452.             END
  453.         END
  454. END SwitchAll;
  455. (* test if Raster fits to frame *)
  456. PROCEDURE TestRaster(f: Frame): BOOLEAN;
  457.     VAR XMax,YMax: INTEGER;
  458. BEGIN
  459.     XMax:=(f.W-SeitenPlatz*2) DIV KastenPlatz;
  460.     YMax:=(f.H-ObenPlatz-UntenPlatz) DIV KastenPlatz;
  461.     IF XMax<f.d.XKastenAnz THEN RETURN FALSE;END;
  462.     IF YMax<f.d.YKastenAnz THEN RETURN FALSE;END;
  463.     RETURN TRUE;
  464. END TestRaster;
  465. (* check if Raster fits to frame *)
  466. PROCEDURE CheckRaster(f: Frame): BOOLEAN;
  467.         XMax,YMax: INTEGER;
  468.         Change, Aktiv: BOOLEAN;
  469.         XAnzNeu, YAnzNeu: INTEGER;
  470. BEGIN
  471.     Change:=FALSE;Aktiv:=TRUE;
  472.     XMax:=(f.W-SeitenPlatz*2) DIV KastenPlatz;
  473.     YMax:=(f.H-ObenPlatz-UntenPlatz) DIV KastenPlatz;
  474.     IF XMax<MinKastenAnz THEN Aktiv:=FALSE;Change:=TRUE;END;
  475.     IF YMax<MinKastenAnz THEN Aktiv:=FALSE;Change:=TRUE;END;
  476.     IF XMax<f.d.XKastenAnz THEN
  477.         XAnzNeu:=XMax;Change:=TRUE
  478.     ELSE
  479.         XAnzNeu:=f.d.XKastenAnz;
  480.     END;
  481.     IF YMax<f.d.YKastenAnz THEN
  482.         YAnzNeu:=YMax;Change:=TRUE
  483.     ELSE
  484.         YAnzNeu:=f.d.YKastenAnz;
  485.     END;
  486.     IF Change THEN
  487.         IF Aktiv THEN
  488.             f.d.XKastenAnz:=XAnzNeu;f.d.YKastenAnz:=YAnzNeu;
  489.             f.d.Aktiv:=TRUE
  490.         ELSE
  491.             f.d.Aktiv:=FALSE;
  492.         END;
  493.         f.d.Mode:=-1;
  494.     END;
  495.     RETURN Change;
  496. END CheckRaster;
  497. (* check if field fits to frame; if not, creat new field *)
  498. PROCEDURE CalcRaster (f: Frame): BOOLEAN;
  499.     VAR pnmsg: PlotNewMsg;
  500. BEGIN
  501.     IF CheckRaster(f) THEN
  502.         pnmsg.d:=f.d;
  503.         IF f.d.Aktiv THEN
  504.             NeuesFeld(f.d, f.d.XKastenAnz, f.d.YKastenAnz);
  505.         END;
  506.         f.d.StartPlay:=FALSE;
  507.         Viewers.Broadcast(pnmsg);
  508.         RETURN TRUE
  509.     ELSE
  510.         RETURN FALSE
  511. END CalcRaster;
  512. (* search boxes with no mine on it *)
  513. PROCEDURE SearchMore(d: Data; x, y: INTEGER);
  514.         Dummy: SHORTINT;
  515.         pkmsg: PlotKastenMsg;
  516. BEGIN
  517.     IF (x=0) OR (y=0) OR (x>d.XKastenAnz) OR (y>d.YKastenAnz) THEN RETURN;END;
  518.     Dummy:=d.Feld[x, y];
  519.     IF (Dummy<0) OR (Dummy>9) THEN RETURN;END;
  520.     DEC (d.Count);
  521.     d.Feld[x, y]:=-Dummy;
  522.     pkmsg.d:=d;
  523.     pkmsg.x:=x;pkmsg.y:=y;
  524.     Viewers.Broadcast(pkmsg);
  525.     IF Dummy=1 THEN
  526.         SearchMore(d, x+1, y);SearchMore(d, x+1, y+1);
  527.         SearchMore(d, x,y+1);SearchMore(d, x-1, y+1);
  528.         SearchMore(d, x-1, y);SearchMore(d, x-1, y-1);
  529.         SearchMore(d, x, y-1);SearchMore(d, x+1, y-1)
  530. END SearchMore;
  531. (* new HIScore ? *)
  532. PROCEDURE CheckHiScore(d: Data);
  533. BEGIN
  534.     IF d.Mode>-1 THEN
  535.         IF d.Time<HiTime[d.Mode] THEN
  536.             Texts.WriteString(W, "New Hi-Score !!!");Texts.WriteLn(W);
  537.             Texts.Append(Oberon.Log, W.buf);
  538.             HiTime[d.Mode]:=d.Time;
  539.             HiName[d.Mode]:=Name;
  540.             SaveHi(FALSE)
  541.         END
  542. END CheckHiScore;
  543. (* all Mines found *)
  544. PROCEDURE GotIt(f: Frame);
  545.     VAR XPos, YPos: INTEGER;
  546. BEGIN
  547.     YPos:=f.Y+f.H-ObenPlatz+4;
  548.     XPos:=(f.W DIV 2)-9+f.X;
  549.     Display.CopyPattern(black, GotItPat, XPos+1, YPos+1, Display.paint);
  550.     f.d.Mines:=0;DrawMinesToFind(f);
  551. END GotIt;
  552. (* switch field *)
  553. PROCEDURE SwitchKasten(f: Frame; XKasten, YKasten: INTEGER; Color: BOOLEAN; col: INTEGER);
  554.         timsg: TimeMsg;
  555.         pkmsg: PlotKastenMsg;
  556.         Dummy: SHORTINT;
  557. BEGIN
  558.     IF ~f.d.Aktiv THEN RETURN; END;
  559.     Dummy:=f.d.Feld[XKasten, YKasten];
  560.     IF (Dummy>0) & (Dummy<16) THEN
  561.         pkmsg.d:=f.d;
  562.         pkmsg.x:=XKasten;pkmsg.y:=YKasten;
  563.         IF Dummy=10 THEN
  564.             f.d.Feld[XKasten, YKasten]:=-10;
  565.             f.d.Aktiv:=FALSE;
  566.             SwitchAll(f, Color, col);
  567.             Viewers.Broadcast(pkmsg)
  568.         ELSE
  569.             IF Dummy=1 THEN
  570.                 SearchMore(f.d, XKasten, YKasten)
  571.             ELSE
  572.                 f.d.Feld[XKasten, YKasten]:=-Dummy;
  573.                 DEC(f.d.Count);
  574.                 Viewers.Broadcast(pkmsg);
  575.             END;
  576.             IF f.d.Count=0 THEN
  577.                 timsg.id:=StartTime;
  578.                 timsg.Count:=0;
  579.                 Viewers.Broadcast(timsg);
  580.                 f.d.Aktiv:=FALSE;
  581.                 f.d.Time:=(Input.Time()-f.d.Time) DIV TimeUnit;
  582.                 CheckHiScore(f.d)
  583.             END
  584.         END
  585. END SwitchKasten;
  586. (* react on mouse keys *)
  587. PROCEDURE MouseKeys*(f: Frame; XKasten, YKasten: INTEGER; Key: SET; Color: BOOLEAN; col: INTEGER);
  588.         Dummy: SHORTINT;
  589.         pkmsg: PlotKastenMsg;
  590. BEGIN
  591.     Dummy:=f.d.Feld[XKasten, YKasten];
  592.     pkmsg.d:=f.d;
  593.     pkmsg.x:=XKasten;pkmsg.y:=YKasten;
  594.     IF Key={2} THEN
  595.         IF ~f.d.StartPlay THEN
  596.             f.d.StartPlay:=TRUE;
  597.             f.d.Time:=Input.Time();
  598.         END;
  599.         SwitchKasten(f, XKasten, YKasten, Color, col)
  600.     ELSIF Key={0} THEN
  601.         IF Dummy>0 THEN
  602.             IF Dummy<16 THEN
  603.                 f.d.Feld[XKasten, YKasten]:=Dummy+16;
  604.                 f.d.Mines:=f.d.Mines-1
  605.             ELSE
  606.                 f.d.Feld[XKasten, YKasten]:=Dummy-16;
  607.                 f.d.Mines:=f.d.Mines+1;
  608.             END;
  609.             Viewers.Broadcast(pkmsg)
  610.         END
  611.     ELSIF Key={0,2} THEN
  612.         IF Dummy<0 THEN
  613.             IF ~f.d.StartPlay THEN
  614.                 f.d.StartPlay:=TRUE;
  615.                 f.d.Time:=Input.Time();
  616.             END;
  617.             SwitchKasten(f, XKasten+1, YKasten, Color, col);
  618.             SwitchKasten(f, XKasten+1, YKasten-1, Color, col);
  619.             SwitchKasten(f, XKasten, YKasten-1, Color, col);
  620.             SwitchKasten(f, XKasten-1, YKasten-1, Color, col);
  621.             SwitchKasten(f, XKasten-1, YKasten, Color, col);
  622.             SwitchKasten(f, XKasten-1, YKasten+1, Color, col);
  623.             SwitchKasten(f, XKasten, YKasten+1, Color, col);
  624.             SwitchKasten(f, XKasten+1, YKasten+1, Color, col)
  625.         END
  626. END MouseKeys;
  627. (* get selected frame *)
  628. PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
  629.     VAR v: Viewers.Viewer;
  630. BEGIN
  631.     IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
  632.         IF (Oberon.Par.frame # NIL) THEN
  633.             f:=Oberon.Par.frame.next;
  634.             RETURN TRUE
  635.         END
  636.     ELSE
  637.         v:=Oberon.MarkedViewer();
  638.         IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
  639.             f:=v.dsc.next;
  640.             RETURN TRUE
  641.         END
  642.     END;
  643.     RETURN FALSE
  644. END GetFrame;
  645. (* Open new Text-Frame *)
  646. PROCEDURE OpenViewer(text: Texts.Text);
  647.     VAR x, y: INTEGER; v: Viewers.Viewer; cf: TextFrames.Frame;
  648. BEGIN
  649.     Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, x, y);
  650.     cf := TextFrames.NewText(text, 0);
  651.     v := MenuViewers.New(TextFrames.NewMenu("Mines Hall Of Fame", "System.Close  System.Copy  System.Grow"),
  652.                                         cf, TextFrames.menuH, x, y)
  653. END OpenViewer;
  654. (* do the pause *)
  655. PROCEDURE DoPause(f: Frame);
  656.         nfmsg: NeuesFeldMsg;
  657.         rpmsg: RePlotMsg;
  658.         pnmsg: PlotNewMsg;
  659. BEGIN
  660.     IF f.d.Pause THEN
  661.         IF TestRaster(f) OR PauseFlag THEN
  662.             f.d.Pause:=FALSE;
  663.             nfmsg.d:=f.d;nfmsg.Change:=FALSE;
  664.             Viewers.Broadcast(nfmsg);
  665.             IF nfmsg.Change THEN
  666.                 IF f.d.Aktiv THEN
  667.                     NeuesFeld(f.d, f.d.XKastenAnz, f.d.YKastenAnz);
  668.                 END;
  669.                 pnmsg.d:=f.d;
  670.                 Viewers.Broadcast(pnmsg);
  671.                 f.d.StartPlay:=FALSE
  672.             ELSE
  673.                 rpmsg.All:=FALSE;
  674.                 rpmsg.d:=f.d;
  675.                 f.d.Time:=Input.Time()-f.d.Time;
  676.                 Viewers.Broadcast(rpmsg)
  677.             END
  678.         ELSE
  679.             Texts.WriteString(W, "Frame too small for old game !");
  680.             Texts.WriteLn(W);
  681.             Texts.Append(Oberon.Log, W.buf);
  682.             PauseFlag:=TRUE
  683.         END
  684.     ELSE
  685.         f.d.Pause:=TRUE;
  686.         f.d.Time:=Input.Time()-f.d.Time;
  687.         rpmsg.d:=f.d;rpmsg.All:=FALSE;
  688.         Viewers.Broadcast(rpmsg)
  689. END DoPause;
  690. (* set Pause mode *)
  691. PROCEDURE Pause*;
  692.         f, g: Display.Frame;
  693. BEGIN
  694.     IF GetFrame(g) THEN
  695.         f:=g;
  696.         WITH f: Frame DO
  697.             IF f.d.Aktiv THEN DoPause(f)END
  698.         ELSE
  699.         END
  700. END Pause;
  701. (* do mouseaction *)
  702. PROCEDURE DoMou(f: Frame; X, Y: INTEGER; Key, FirstKey: SET);
  703.         XKasten, YKasten: INTEGER;
  704.         XStore, YStore: INTEGER;
  705.         Dummy: SHORTINT;
  706.         pnmsg: PlotNewMsg;
  707.         nfmsg: NeuesFeldMsg;
  708.         timsg: TimeMsg;
  709. BEGIN
  710.     IF ~f.d.Pause THEN
  711.         XStore:=X;YStore:=Y;
  712.         X:=X-f.SeitenOffset;Y:=Y-f.UntenOffset;
  713.         IF X<0 THEN RETURN;END;
  714.         IF Y<0 THEN RETURN;END;
  715.         XKasten:=X DIV KastenPlatz +1;
  716.         YKasten:=Y DIV KastenPlatz +1;
  717.         IF (XKasten<=f.d.XKastenAnz) & (YKasten<=f.d.YKastenAnz) THEN
  718.             IF ~f.d.Aktiv THEN RETURN;END;
  719.             IF ((X MOD KastenPlatz)=0) OR ((Y MOD KastenPlatz)=0) THEN RETURN; END;
  720.             Dummy:=f.d.Feld[XKasten, YKasten];
  721.             IF Key={1} THEN
  722.                 IF Dummy>0 THEN
  723.                     IF Dummy<16 THEN
  724.                         Oberon.RemoveMarks(f.SeitenOffset, f.UntenOffset, f.W, f.H);
  725.                         DrawCharInv(f, "?", XKasten, YKasten)
  726.                     END
  727.                 END
  728.             ELSE
  729.                 MouseKeys(f, XKasten, YKasten, Key, Color, Display.white);
  730.             END;
  731.             IF f.d.Count=0 THEN
  732.                 GotIt(f)
  733.             ELSE
  734.                 IF ~UseTimeTask THEN
  735.                     timsg.id:=StartTime;
  736.                     timsg.Count:=0;
  737.                     Viewers.Broadcast(timsg)
  738.                 END
  739.             END
  740.         ELSE
  741.             IF (YStore>f.Y+f.H-ObenPlatz+3) & (YStore<f.Y+f.H-3) THEN
  742.                 IF (ABS(XStore-f.X-(f.W DIV 2))<10) THEN
  743.                     IF Key={2} THEN
  744.                         nfmsg.d:=f.d;
  745.                         f.d.Aktiv:=TRUE;
  746.                         Viewers.Broadcast(nfmsg);
  747.                         IF f.d.Aktiv THEN
  748.                             NeuesFeld(f.d, f.d.XKastenAnz, f.d.YKastenAnz);
  749.                         END;
  750.                         pnmsg.d:=f.d;
  751.                         f.d.StartPlay:=FALSE;
  752.                         Viewers.Broadcast(pnmsg)
  753.                     END
  754.                 END
  755.             END
  756.         END
  757. END DoMou;
  758. (* set mousecursor and call DoMouse if button is pressed *)
  759. PROCEDURE TrackMouse*(f: Frame; X, Y: INTEGER; k: SET; Mou: PROCEDURE(f: Frame; X, Y: INTEGER; K, F: SET));
  760.         XPos, YPos: INTEGER;
  761.         NewKeys, FirstKey: SET;
  762. BEGIN
  763.     XPos:=X;YPos:=Y;
  764.     FirstKey:=k;
  765.     REPEAT
  766.         Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
  767.         Input.Mouse(NewKeys, X, Y);
  768.         k:=k+NewKeys
  769.     UNTIL NewKeys={};
  770.     IF k#{} THEN Mou(f, XPos, YPos, k, FirstKey) END
  771. END TrackMouse;
  772. (* the Handler of the Miner-Frames*)
  773. PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
  774.         self: Frame;
  775.         dumY, dumH: INTEGER;
  776. BEGIN
  777.     self:=f(Frame);
  778.     WITH m: Oberon.InputMsg DO
  779.         IF m.id=Oberon.track THEN TrackMouse(self, m.X, m.Y, m.keys, DoMou)END
  780.     | m: Oberon.CopyMsg DO
  781.         m.F:=CopyMe(self)
  782.     | m: MenuViewers.ModifyMsg DO
  783.         PauseFlag:=FALSE;
  784.         IF m.H=0 THEN
  785.             self.LastModMsg:=TRUE;
  786.             RETURN;
  787.         END;
  788.         IF self.d.Pause OR ~self.d.Aktiv THEN      (* game is paused or not Aktiv *)
  789.             f.Y:=m.Y;f.H:=m.H;
  790.             ClearFrame(self, self.d.Aktiv)
  791.         ELSIF self.d.Aktiv THEN                         (* if Aktiv *)
  792.             IF m.id=MenuViewers.extend THEN    (* extended *)
  793.                 IF self.LastModMsg THEN               (* extended from 0, CalcRaster new *)
  794.                     f.Y:=m.Y;f.H:=m.H;
  795.                     ClearFrame(self, TRUE);
  796.                     IF ~CalcRaster(self) THEN          (* if old Raster, then redraw *)
  797.                         PlotAll(self);
  798.                     END;
  799.                     IF UseTimeTask THEN StartTask()END
  800.                 ELSE
  801.                     IF m.dY=0 THEN                        (* extended at the bootom, clear new area *)
  802.                         Oberon.RemoveMarks(self.X, m.Y, self.W, m.H-self.H);
  803.                         Display.ReplConst(Display.black, self.X, m.Y, self.W, m.H-self.H, Display.replace)
  804.                     ELSE                                       (* extended at the top, copy and clear new area *)
  805.                         Oberon.RemoveMarks(self.X, self.Y, self.W, self.H+m.dY);
  806.                         Display.CopyBlock(self.X, self.Y, self.W, self.H, self.X, self.Y+m.dY, Display.replace);
  807.                         Display.ReplConst(Display.black, self.X, m.Y, self.W, m.H-self.H, Display.replace);
  808.                         self.UntenOffset:=self.UntenOffset+m.dY
  809.                     END
  810.                 END
  811.             ELSIF m.id=MenuViewers.reduce THEN    (* reduced *)
  812.                 dumY:=f.Y;dumH:=f.H;
  813.                 f.Y:=m.Y;f.H:=m.H;
  814.                 IF TestRaster(self) THEN
  815.                     IF m.dY#0 THEN             (* if top moved, copy *)
  816.                         Oberon.RemoveMarks(self.X, m.Y, self.W, m.H-m.dY);
  817.                         Display.CopyBlock(self.X, dumY+dumH-m.H, self.W, m.H, self.X, m.Y, Display.replace);
  818.                         self.UntenOffset:=self.UntenOffset-m.dY
  819.                     END
  820.                 ELSE
  821.                     DoPause(self)
  822.                 END
  823.             END
  824.         END;
  825.         self.LastModMsg:=FALSE
  826.     | m: MinerMsg DO
  827.         WITH m: RePlotMsg DO
  828.                 IF m.All OR (m.d=self.d) THEN
  829.                     ClearFrame(self, self.d.Aktiv);
  830.                     IF self.d.Aktiv & ~self.d.Pause THEN
  831.                         PlotAll(self)
  832.                     END
  833.                 END
  834.         | m: TimeMsg DO
  835.             IF m.id=StartTime THEN
  836.                 IF self.d.Aktiv & ~self.d.Pause & self.d.StartPlay  THEN
  837.                     Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  838.                     DrawTime(self);
  839.                 END;
  840.                 INC(m.Count)
  841.             END
  842.         ELSE
  843.             IF m.d=self.d THEN
  844.                 WITH m: PlotNewMsg DO            (* Message for new Raster *)
  845.                     IF self.d.Aktiv THEN
  846.                         IF ~CalcRaster(self) THEN     (* Raster OK for this Frame ? *)
  847.                             ClearFrame(self, TRUE);
  848.                             PlotAll(self)
  849.                         END
  850.                     ELSE
  851.                         ClearFrame(self, FALSE)
  852.                     END
  853.                 | m: PlotKastenMsg DO                (* PLot one box *)
  854.                     Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  855.                     DrawKasten(self, m.x, m.y, Color, Display.white);
  856.                     IF self.d.Feld[m.x, m.y]>0 THEN
  857.                         DrawMinesToFind(self);
  858.                     END;
  859.                     IF ~self.d.Aktiv THEN PlotSmily(self, FALSE)END
  860.                 | m: NeuesFeldMsg DO                (* Check if new W & H are fitting to frame *)
  861.                     IF CheckRaster(self) THEN
  862.                         m.Change:=TRUE
  863.                     END
  864.                 ELSE
  865.                 END
  866.             END
  867.         END
  868.     ELSE
  869. END Handler;
  870. (* get parameters *)
  871. PROCEDURE GetPar*(VAR Quote, X, Y, Mode: INTEGER);
  872.         S: Texts.Scanner;
  873.         text: Texts.Text;
  874.         Dummy, StoreQuote: INTEGER;
  875.         beg, end, time: LONGINT;
  876. BEGIN
  877.     StoreQuote:=Quote;
  878.     Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  879.     Texts.Scan(S);
  880.     IF S.class=Texts.Char THEN
  881.         IF S.c="^" THEN
  882.             Oberon.GetSelection(text, beg, end, time);
  883.             IF time=-1 THEN RETURN; END;
  884.             Texts.OpenScanner(S, text, beg);
  885.             Texts.Scan(S)
  886.         ELSE
  887.             RETURN
  888.         END
  889.     END;
  890.     IF S.class=Texts.Int THEN
  891.         IF (S.i>0) & (S.i<90) THEN;
  892.             Quote:=SHORT(S.i);
  893.             IF (Mode=-1) OR (X#256) THEN
  894.                 Texts.Scan(S);
  895.                 IF S.class=Texts.Int THEN;
  896.                     Dummy:=SHORT(S.i);
  897.                     Texts.Scan(S);
  898.                     IF S.class=Texts.Int THEN
  899.                         IF (Dummy<6) OR (Dummy>127) THEN
  900.                             X:=8
  901.                         ELSE
  902.                             X:=Dummy;
  903.                         END;
  904.                         IF (S.i<6) OR (S.i>127) THEN
  905.                             Y:=8
  906.                         ELSE
  907.                             Y:=SHORT(S.i)
  908.                         END
  909.                     END
  910.                 END
  911.             ELSE
  912.                 IF Quote#StoreQuote THEN Mode:=-1 END
  913.             END
  914.         END
  915. END GetPar;
  916. (* set frame and parameters *)
  917. PROCEDURE ShortNewPar(X, Y, Quote, Mode: INTEGER);
  918.         f, g: Display.Frame;
  919.         nfmsg: NeuesFeldMsg;
  920.         pnmsg: PlotNewMsg;
  921. BEGIN
  922.     IF GetFrame(g) THEN
  923.         f:=g;
  924.         WITH f: Frame DO
  925.             GetPar(Quote, X, Y, Mode);
  926.             f.d.Quote:=Quote;f.d.Mode:=Mode;
  927.             f.d.XKastenAnz:=X;f.d.YKastenAnz:=Y;
  928.             f.d.Aktiv:=TRUE;f.d.Pause:=FALSE;
  929.             nfmsg.d:=f.d;
  930.             Viewers.Broadcast(nfmsg);
  931.             IF f.d.Aktiv THEN
  932.                 NeuesFeld(f.d, f.d.XKastenAnz, f.d.YKastenAnz);
  933.             END;
  934.             pnmsg.d:=f.d;
  935.             f.d.StartPlay:=FALSE;
  936.             Viewers.Broadcast(pnmsg)
  937.         ELSE
  938.         END
  939. END ShortNewPar;
  940. (* Open MenuFrame with Mines.Menu.Text *)
  941. PROCEDURE MenuFrame(): TextFrames.Frame;
  942.         mf: TextFrames.Frame;
  943.         buf: Texts.Buffer;
  944.         t: Texts.Text;
  945.         r: Texts.Reader;
  946.         end: LONGINT;
  947.         ch: CHAR;
  948. BEGIN
  949.     IF Files.Old("Mines.Menu.Text")=NIL THEN
  950.         mf:=TextFrames.NewMenu("Mines", Menu)
  951.     ELSE
  952.         mf:=TextFrames.NewMenu("Mines", "");
  953.         NEW(t);Texts.Open(t, "Mines.Menu.Text");
  954.         Texts.OpenReader(r, t, 0);
  955.         REPEAT
  956.             Texts.Read(r, ch)
  957.         UNTIL r.eot OR (ch=0DX);
  958.         IF r.eot THEN
  959.             end:=t.len
  960.         ELSE
  961.             end:=Texts.Pos(r)-1;
  962.         END;
  963.         NEW(buf); Texts.OpenBuf(buf);
  964.         Texts.Save(t, 0, end, buf);Texts.Append(mf.text, buf)
  965.     END;
  966.     RETURN mf;
  967. END MenuFrame;
  968. (* set new username *)
  969. PROCEDURE SetUser*;
  970.         S: Texts.Scanner;
  971.         text: Texts.Text;
  972.         beg, end, time: LONGINT;
  973. BEGIN
  974.     Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  975.     Texts.Scan(S);
  976.     IF S.class=Texts.Char THEN
  977.         IF S.c="^" THEN
  978.             Oberon.GetSelection(text, beg, end, time);
  979.             IF time=-1 THEN RETURN; END;
  980.             Texts.OpenScanner(S, text, beg);
  981.             Texts.Scan(S)
  982.         ELSE
  983.             RETURN
  984.         END
  985.     END;
  986.     IF S.class=Texts.Name THEN
  987.         COPY(S.s, Name);
  988.     END;
  989.     Texts.WriteString(W, "Current Username : ");
  990.     Texts.WriteString(W, Name);
  991.     Texts.WriteLn(W);
  992.     Texts.Append(Oberon.Log, W.buf);
  993. END SetUser;
  994. (* show Hi-Score *)
  995. PROCEDURE Score*;
  996.         i: INTEGER;
  997.         te: Texts.Text;
  998. BEGIN
  999.     te:=TextFrames.Text("");
  1000.     IF Files.Old("Mines.Score.Text")=NIL THEN
  1001.         Texts.WriteString(W, "    Oberon-Mines Hall Of Fame !    ");Texts.WriteLn(W);
  1002.         Texts.WriteString(W, "________________________________________________________");Texts.WriteLn(W)
  1003.     ELSE
  1004.         Texts.Open(te, "Mines.Score.Text");
  1005.     END;
  1006.     FOR i:=0 TO 2 DO
  1007.         IF i=0 THEN Texts.WriteString(W, "Beginner")
  1008.         ELSIF i=1 THEN Texts.WriteString(W, "Advanced")
  1009.         ELSE Texts.WriteString(W, "Expert");END;
  1010.         Texts.Write(W, CHR(9));
  1011.         Texts.WriteInt(W, HiTime[i], 1);
  1012.         Texts.WriteString(W, " sec"); Texts.Write(W, CHR(9));
  1013.         Texts.WriteString(W, HiName[i]);
  1014.         Texts.WriteLn(W);
  1015.     END;
  1016.     Texts.WriteLn(W);
  1017.     Texts.WriteString(W, "Current Username : ");
  1018.     Texts.WriteString(W, Name);
  1019.     Texts.WriteLn(W);
  1020.     Texts.Append(te, W.buf);
  1021.     OpenViewer(te);
  1022. END Score;
  1023. (* create new frame with new data *)
  1024. PROCEDURE Open*;
  1025.         x, y: INTEGER;
  1026.         f: Frame;
  1027.         v: MenuViewers.Viewer;
  1028. BEGIN
  1029.     NEW(f);IF f=NIL THEN RETURN;END;
  1030.     NEW(f.d);IF f.d=NIL THEN RETURN;END;
  1031.     f.handle:=Handler;f.d.Aktiv:=TRUE;f.d.Quote:=16;
  1032.     f.LastModMsg:=TRUE;f.d.Pause:=FALSE;
  1033.     f.d.XKastenAnz:=256;f.d.YKastenAnz:=256;
  1034.     f.d.Mode:=-1;f.d.StartPlay:=FALSE;
  1035.     Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  1036.     v:=MenuViewers.New(MenuFrame(), f, TextFrames.menuH, x, y);
  1037. END Open;
  1038. (* switch between color ans b/w mode *)
  1039. PROCEDURE ColorMode*;
  1040.     VAR rpmsg: RePlotMsg;
  1041. BEGIN
  1042.     Color:=~Color;
  1043.     rpmsg.All:=TRUE;
  1044.     Viewers.Broadcast(rpmsg);
  1045.     SaveHi(FALSE);
  1046. END ColorMode;
  1047. (* switches between task und mouse action time mode *)
  1048. PROCEDURE TimeMode*;
  1049. BEGIN
  1050.     UseTimeTask:=~UseTimeTask;
  1051.     IF UseTimeTask THEN
  1052.         IF ~TimeTaskRuns THEN StartTask() END
  1053.     ELSE
  1054.         IF TimeTaskRuns THEN StopTask() END
  1055.     END;
  1056.     SaveHi(FALSE);
  1057. END TimeMode;
  1058. (* start different types of the game *)
  1059. PROCEDURE Beginner*;
  1060. BEGIN
  1061.     ShortNewPar(8, 8, 15, 0);
  1062. END Beginner;
  1063. PROCEDURE Advanced*;
  1064. BEGIN
  1065.     ShortNewPar(16, 16, 16, 1);
  1066. END Advanced;
  1067. PROCEDURE Expert*;
  1068. BEGIN
  1069.     ShortNewPar(30, 16, 21, 2);
  1070. END Expert;
  1071. PROCEDURE Max*;
  1072. BEGIN
  1073.     ShortNewPar(256, 256, 16, -1);
  1074. END Max;
  1075. PROCEDURE Start*;
  1076. BEGIN
  1077.     ShortNewPar(8, 8, 16, -1);
  1078. END Start;
  1079. BEGIN
  1080.     TimeUnit:=Input.TimeUnit; (* replace Input.TimeUnit by 300 at MacOberon and Ceres *)
  1081.     UsedFont:=Fonts.This("Syntax14.Scn.Fnt");
  1082.     Texts.OpenWriter(W);
  1083.     Texts.WriteString(W, "Oberon-Mines V1.32");
  1084.     Texts.WriteLn(W);
  1085.     Texts.WriteString(W, "(C) 1 Oct 95 by Ralf Degner");
  1086.     Texts.WriteLn(W);
  1087.     Texts.Append(Oberon.Log, W.buf);
  1088.     StartTime:=Input.Time();
  1089.     seed:=StartTime;
  1090.     TimeTaskRuns:=FALSE;
  1091.     Color:=FALSE;UseTimeTask:=TRUE;
  1092.     IF Oberon.User="" THEN
  1093.         Name:="AMIGA"
  1094.     ELSE
  1095.         COPY(Oberon.User, Name);
  1096.     END;
  1097.     Colors[0]:=Col1;Colors[1]:=Col2;Colors[2]:=Col3;Colors[3]:=Col4;
  1098.     Colors[4]:=Col5;Colors[5]:=Col6;Colors[6]:=Col7;Colors[7]:=Col8;
  1099.     LoadHi();
  1100.     (* install patterns *)
  1101.     HappyData[1]:={5,6,7,8,9,10};
  1102.     HappyData[2]:={3,4,11,12};
  1103.     HappyData[3]:={2,13};
  1104.     HappyData[4]:={1,5,6,7,8,9,10,14};
  1105.     HappyData[5]:={1,4,11,14};
  1106.     HappyData[6]:={0,3,12,15};
  1107.     HappyData[7]:={0,7,8,15};
  1108.     HappyData[8]:={0,7,8,15};
  1109.     HappyData[9]:={0,15};
  1110.     HappyData[10]:={0,15};
  1111.     HappyData[11]:={0,15,5,6,9,10};
  1112.     HappyData[12]:={1,14,5,6,9,10};
  1113.     HappyData[13]:={1,14};
  1114.     HappyData[14]:={2,13};
  1115.     HappyData[15]:={3,4,11,12};
  1116.     HappyData[16]:={5,6,7,8,9,10};
  1117.     HappyPat:=Display.NewPattern(HappyData, 16, 16);
  1118.     SadData:=HappyData;
  1119.     SadData[5]:={1,5,6,7,8,9,10,14};
  1120.     SadData[4]:={1,4,11,14};
  1121.     SadData[6]:={0,15};
  1122.     SadPat:=Display.NewPattern(SadData, 16, 16);
  1123.     BackData[1]:={};
  1124.     BackData[2]:={5,6,7,8,9,10};
  1125.     BackData[3]:={3,4,5,6,7,8,9,10,11,12};
  1126.     BackData[4]:={2,3,4,5,6,7,8,9,10,11,12,13};
  1127.     BackData[5]:={2,3,4,5,6,7,8,9,10,11,12,13};
  1128.     BackData[6]:={1,2,3,4,5,6,7,8,9,10,11,12,13,14};
  1129.     BackData[7]:={1,2,3,4,5,6,9,10,11,12,13,14};
  1130.     BackData[8]:={1,2,3,4,5,6,9,10,11,12,13,14};
  1131.     BackData[9]:={1,2,3,4,5,6,7,8,9,10,11,12,13,14};
  1132.     BackData[10]:={1,2,3,4,5,6,7,8,9,10,11,12,13,14};
  1133.     BackData[11]:={1,2,3,4,7,8,11,12,13,14};
  1134.     BackData[12]:={1,2,3,4,7,8,11,12,13,14};
  1135.     BackData[13]:={2,3,4,5,6,7,8,9,10,11,12,13};
  1136.     BackData[14]:={3,4,5,6,7,8,9,10,11,12};
  1137.     BackData[15]:={5,6,7,8,9,10};
  1138.     BackData[16]:={};
  1139.     BackPat:=Display.NewPattern(BackData, 16, 16);
  1140.     GotItData:=HappyData;
  1141.     GotItData[12]:={1,4,5,6,7,8,9,10,11,14};
  1142.     GotItData[11]:={0,3,4,5,6,9,10,11,12,15};
  1143.     GotItData[10]:={0,2,4,5,6,9,10,11,13,15};
  1144.     GotItData[9]:={0,1,5,6,7,8,9,10,14,15};
  1145.     GotItPat:=Display.NewPattern(GotItData, 16, 16);
  1146.     PauseData:=SadData;
  1147.     PauseData[5]:={1,14};
  1148.     PauseData[4]:={1,4,5,6,7,8,9,10,11,14};
  1149.     PausePat:=Display.NewPattern(PauseData, 16, 16);
  1150.     (* Mine *)
  1151.     Data1[1]:={3,4,5,6,7,8};
  1152.     Data1[2]:={2,3,4,5,6,7,8,9};
  1153.     Data1[3]:={1,2,3,5,6,7,8,9,10};
  1154.     Data1[4]:={1,2,5,6,7,8,9,10};
  1155.     Data1[5]:={1,2,4,5,6,7,8,9,10};
  1156.     Data1[6]:={1,2,3,4,5,6,7,8,9,10};
  1157.     Data1[7]:={2,3,4,5,6,7,8,9};
  1158.     Data1[8]:={3,4,5,6,7,8};
  1159.     Data1[9]:={5,6};
  1160.     Data1[10]:={5};
  1161.     Data1[11]:={6,10};
  1162.     Data1[12]:={7,8,9};
  1163.     Pat[1]:=Display.NewPattern(Data1, 12, 12);
  1164.     (* No Mine *)
  1165.     Data2[1]:={0,11};
  1166.     Data2[2]:={1,10};
  1167.     Data2[3]:={2,9};
  1168.     Data2[4]:={3,8};
  1169.     Data2[5]:={4,7};
  1170.     Data2[6]:={5,6};
  1171.     Data2[7]:={5,6};
  1172.     Data2[8]:={4,7};
  1173.     Data2[9]:={3,8};
  1174.     Data2[10]:={2,9};
  1175.     Data2[11]:={1,10};
  1176.     Data2[12]:={0,11};
  1177.     Pat[2]:=Display.NewPattern(Data2, 12, 12);
  1178.     (* Flag *)
  1179.     Data3[1]:={};
  1180.     Data3[2]:={3};
  1181.     Data3[3]:={3};
  1182.     Data3[4]:={3};
  1183.     Data3[5]:={3};
  1184.     Data3[6]:={3};
  1185.     Data3[7]:={3,4,5};
  1186.     Data3[8]:={3,4,5,6,7};
  1187.     Data3[9]:={3,4,5,6,7,8,9};
  1188.     Data3[10]:={3,4,5,6,7};
  1189.     Data3[11]:={3,4,5};
  1190.     Data3[12]:={};
  1191.     Pat[3]:=Display.NewPattern(Data3, 12, 12);
  1192.     (* No Mine - No Color *)
  1193.     FOR Dummy:=1 TO 12 DO
  1194.         Data4[Dummy]:=Data1[Dummy]/Data2[Dummy];
  1195.     END;
  1196.     Pat[4]:=Display.NewPattern(Data4, 12, 12)
  1197. END Mines.Open
  1198. System.Free MinesElems Mines ~
  1199.