home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / demos / mines.mod (.txt) < prev    next >
Oberon Text  |  2002-10-03  |  38KB  |  1,221 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. FoldElems
  4. Syntax10.Scn.Fnt
  5. (* standard colors *)
  6. Syntax10.Scn.Fnt
  7. (* the colors of Mines for Windows *)
  8.         (*black=Display.white; red=1; yellow=10; lightgray=11; midgray=12; darkgray=14;
  9.         Col1=3; Col2=5; Col3=red; Col4=6; Col5=4; Col6=8; Col7=7; Col8=black;*)
  10. MODULE Mines; (* Oberon-Mines V1.31  (C) 1 Oct  94 by Ralf Degner *)
  11.     IMPORT
  12.         Oberon, Texts,  Display, MenuViewers, TextFrames, Input, Fonts, Viewers, SYSTEM, Files;
  13.     CONST
  14. (* the colors of Mines with Mines.Pal *)
  15.         black=Display.white; red=1; yellow=4; lightgray=12; midgray=13; darkgray=14;
  16.         Col1=3; Col2=2; Col3=red; Col4=9; Col5=7; Col6=5; Col7=6; Col8=black;
  17. (*MS-Windows Colors*)
  18.         Menu = "System.Close  System.Copy  System.Grow  Mines.Pause  Mines.Beginner  Mines.Advanced  Mines.Expert  Mines.Max  Mines.Score";
  19.         KastenBreite=16;ObenPlatz=25;
  20.         UntenPlatz=4;SeitenPlatz=4;
  21.         KastenPlatz*=KastenBreite+1;KB=KastenBreite;
  22.         MinKastenAnz=7;CharBreite=8;
  23.     TYPE
  24.         FeldPtr* = POINTER TO ARRAY OF ARRAY OF SHORTINT;
  25.         String = ARRAY 32 OF CHAR;
  26.         HiScoreType = RECORD
  27.             Name: String;
  28.             Time: LONGINT;
  29.         END;
  30.         HiScoreArrayType = ARRAY 3 OF HiScoreType;
  31.         Data* = POINTER TO DataDesc;
  32.         DataDesc* = RECORD
  33.             XKastenAnz*,YKastenAnz*: INTEGER;
  34.             Aktiv*, Pause*, StartPlay*: BOOLEAN;
  35.             Feld*: FeldPtr;
  36.             Time*, Count*, Mines*: LONGINT;
  37.             Quote*, Mode*: INTEGER;
  38.         END;
  39.         Frame* = POINTER TO FrameDesc;
  40.         FrameDesc* = RECORD(Display.FrameDesc)
  41.             SeitenOffset*, UntenOffset*: INTEGER;
  42.             LastModMsg: BOOLEAN;
  43.             d*: Data;
  44.         END;
  45.         MinerMsg = RECORD(Display.FrameMsg)
  46.             d*: Data;
  47.         END;
  48.         PlotNewMsg = RECORD(MinerMsg)
  49.         END;
  50.         PlotKastenMsg* = RECORD(MinerMsg)
  51.             x*, y*: INTEGER;
  52.         END;
  53.         NeuesFeldMsg = RECORD(MinerMsg)
  54.             Change: BOOLEAN;
  55.         END;
  56.         RePlotMsg = RECORD(MinerMsg)
  57.             All: BOOLEAN;
  58.         END;
  59.         TimeMsg = RECORD(MinerMsg)
  60.             id: LONGINT;
  61.             Count: INTEGER;
  62.         END;
  63.         UsedFont: Fonts.Font;
  64.         W: Texts.Writer;
  65.         TimeTask: Oberon.Task;
  66.         seed, StartTime, LastTime: LONGINT;
  67.         HiScore: HiScoreArrayType;
  68.         Name: String;
  69.         ScoreFile: Files.File;
  70.         ScoreRider: Files.Rider;
  71.         Color, UseTimeTask, TimeTaskRuns, PauseFlag: BOOLEAN;
  72.         Colors: ARRAY 8 OF INTEGER;
  73.         Dummy: INTEGER;
  74.         (* data for patterns *)
  75.         HappyData, SadData, BackData, GotItData, PauseData: ARRAY 17 OF SET;
  76.         HappyPat, SadPat, BackPat, GotItPat, PausePat: LONGINT;
  77.         Data1, Data2, Data3, Data4: ARRAY 13 OF SET;
  78.         Pat: ARRAY 5 OF LONGINT;
  79.     (* clear HiScore *)
  80.     PROCEDURE ClearHi;
  81.         VAR Dummy: INTEGER;
  82.     BEGIN
  83.         FOR Dummy:=0 TO 2 DO
  84.             HiScore[Dummy].Time:=999999;
  85.             HiScore[Dummy].Name:="Amiga";
  86.         END;
  87.     END ClearHi;
  88.     (* store HiScore *)
  89.     PROCEDURE SaveHi(Register: BOOLEAN);
  90.         VAR Dum: INTEGER;
  91.     BEGIN
  92.         Files.Set(ScoreRider, ScoreFile, 0);
  93.         Files.WriteBool(ScoreRider, Color);
  94.         Files.WriteBool(ScoreRider, UseTimeTask);
  95.         FOR Dum:=0 TO 2 DO
  96.             Files.WriteLInt(ScoreRider, HiScore[Dum].Time);
  97.             Files.WriteBytes(ScoreRider, HiScore[Dum].Name, 32);
  98.         END;
  99.         IF Register THEN
  100.             Files.Register(ScoreFile);
  101.         ELSE
  102.              Files.Close(ScoreFile);
  103.          END;
  104.     END SaveHi;
  105.     (* load HiScore *)
  106.     PROCEDURE LoadHi;
  107.         VAR Dum: INTEGER;
  108.     BEGIN
  109.         ClearHi();
  110.         ScoreFile:=Files.Old("Mines.Score");
  111.         IF ScoreFile=NIL THEN
  112.             ScoreFile:=Files.New("Mines.Score");
  113.             SaveHi(TRUE);
  114.         ELSE
  115.             Files.Set(ScoreRider, ScoreFile, 0);
  116.             Files.ReadBool(ScoreRider, Color);
  117.             Files.ReadBool(ScoreRider, UseTimeTask);
  118.             FOR Dum:=0 TO 2 DO
  119.                 Files.ReadLInt(ScoreRider, HiScore[Dum].Time);
  120.                 Files.ReadBytes(ScoreRider, HiScore[Dum].Name, 32);
  121.             END;
  122.         END;
  123.     END LoadHi;
  124.     (* produces random numbers *)
  125.     PROCEDURE Random(Ein: INTEGER):INTEGER;
  126.         VAR
  127.             Max, Wert: INTEGER;
  128.             Gerade: BOOLEAN;
  129.     BEGIN
  130.         IF (Ein MOD 2)=0 THEN
  131.             Max:=Ein+1;
  132.             Gerade:=TRUE;
  133.         ELSE
  134.             Max:=Ein;
  135.             Gerade:=FALSE;
  136.         END;
  137.         seed:=SYSTEM.ROT(ASH(Input.Time(), -1)+ASH(seed, -1), 13);
  138.         seed:=SYSTEM.ROT(seed, seed MOD 32);
  139.         seed:=SYSTEM.ROT(2147483647+ASH(seed, -1), 13);
  140.         seed:=SYSTEM.ROT(seed, seed DIV 01000000H);
  141.         Wert:=SHORT(seed  MOD Max);
  142.         IF Gerade THEN
  143.             IF Wert=Ein THEN
  144.                 RETURN Random(Ein);
  145.             END;
  146.         END;
  147.         RETURN Wert;
  148.     END Random;
  149.     (* stop the TimeTask *)
  150.     PROCEDURE StopTask*;
  151.     BEGIN
  152.         IF TimeTaskRuns THEN
  153.             Oberon.Remove(TimeTask);
  154.             TimeTaskRuns:=FALSE;
  155.         END;
  156.     END StopTask;
  157.     (* the task, that sends every second a TimeMsg *)
  158.     PROCEDURE TheTimeTask;
  159.         VAR timsg: TimeMsg;
  160.     BEGIN
  161.         IF Input.Time()>LastTime THEN
  162.             LastTime:=LastTime+Input.TimeUnit;
  163.             timsg.id:=StartTime;
  164.             timsg.Count:=0;
  165.             Viewers.Broadcast(timsg);
  166.             IF timsg.Count=0 THEN StopTask();END;
  167.         END;
  168.     END TheTimeTask;
  169.     (* start the TimeTask *)
  170.     PROCEDURE StartTask;
  171.     BEGIN
  172.         IF ~TimeTaskRuns THEN
  173.             NEW(TimeTask);
  174.             TimeTask.safe:=FALSE;
  175.             TimeTask.handle:=TheTimeTask;
  176.             Oberon.Install(TimeTask);
  177.             LastTime:=Input.Time();
  178.             TimeTaskRuns:=TRUE;
  179.         END;
  180.     END StartTask;
  181.     (* draw box at top of the field *)
  182.     PROCEDURE PlotSmily(f: Frame; Smile: BOOLEAN);
  183.         VAR XPos, YPos, Col: INTEGER;
  184.     BEGIN
  185.         IF f.H>ObenPlatz THEN
  186.             IF f.W>30 THEN
  187.                 YPos:=f.Y+f.H-ObenPlatz+3;
  188.                 XPos:=f.W DIV 2-10+f.X;
  189.                 IF Color THEN
  190.                     Display.ReplConst(lightgray, XPos, YPos, 20, 20, Display.replace);
  191.                     Display.ReplConst(darkgray, XPos+1, YPos, 19, 19, Display.replace);
  192.                     Display.ReplConst(midgray, XPos+1, YPos+1, 18, 18, Display.replace);
  193.                     Display.CopyPattern(yellow, BackPat, XPos+2, YPos+2, Display.paint);
  194.                     Col:=black;
  195.                 ELSE
  196.                     Display.ReplConst(Display.white, XPos, YPos, 20, 20, Display.replace);
  197.                     Display.ReplConst(Display.black, XPos+1, YPos+1, 18, 18, Display.replace);
  198.                     Col:=Display.white;
  199.                 END;
  200.                 IF f.d.Pause THEN
  201.                     Display.CopyPattern(Col, PausePat, XPos+2, YPos+2, Display.paint);
  202.                 ELSE
  203.                     IF Smile THEN                
  204.                         Display.CopyPattern(Col, HappyPat, XPos+2, YPos+2, Display.paint);
  205.                     ELSE
  206.                         Display.CopyPattern(Col, SadPat, XPos+2, YPos+2, Display.paint);
  207.                     END;
  208.                 END;
  209.             END;
  210.         END;    
  211.     END PlotSmily;
  212.     (* clear a frame *)
  213.     PROCEDURE ClearFrame(f: Frame; Smile: BOOLEAN);
  214.     BEGIN
  215.         Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
  216.         Display.ReplConst(Display.black, f.X, f.Y, f.W, f.H, Display.replace);
  217.         f.SeitenOffset:=(f.W-f.d.XKastenAnz*KastenPlatz) DIV 2 +f.X;
  218.         f.UntenOffset:=f.Y+f.H-ObenPlatz-f.d.YKastenAnz*KastenPlatz;
  219.         PlotSmily(f, Smile);
  220.     END ClearFrame;
  221.     (* copy frame with same data *)
  222.     PROCEDURE CopyMe(f: Frame): Frame;
  223.         VAR nf: Frame;
  224.     BEGIN
  225.         NEW(nf);IF nf=NIL THEN RETURN NIL;END;
  226.         nf.handle:=f.handle;
  227.         nf.d:=f.d;nf.LastModMsg:=TRUE;
  228.         RETURN nf;
  229.     END CopyMe;
  230.     (* clear a box *)
  231.     PROCEDURE ClearKasten(f: Frame; x, y: INTEGER; Color: BOOLEAN);
  232.         VAR dumx, dumy: INTEGER;
  233.     BEGIN
  234.         dumx:=f.SeitenOffset+x*KastenPlatz-KastenBreite;
  235.         dumy:=f.UntenOffset+y*KastenPlatz-KastenBreite;
  236.         IF Color THEN
  237.             Display.ReplConst(darkgray, dumx, dumy, KB, KB, Display.replace);
  238.             Display.ReplConst(lightgray, dumx+1, dumy, KB-1, KB-1, Display.replace);
  239.             Display.ReplConst(midgray, dumx+1, dumy+1, KB-2, KB-2, Display.replace);
  240.         ELSE
  241.             Display.ReplConst(Display.black, dumx, dumy, KB, KB, Display.replace);
  242.         END;
  243.     END ClearKasten;
  244.     (* draw not selected box *)
  245.     PROCEDURE BlockKasten(f: Frame; x, y: INTEGER; Color: BOOLEAN; col: INTEGER);
  246.         VAR dumx, dumy: INTEGER;
  247.     BEGIN
  248.         dumx:=f.SeitenOffset+x*KastenPlatz-KastenBreite;
  249.         dumy:=f.UntenOffset+y*KastenPlatz-KastenBreite;
  250.         IF Color THEN
  251.             Display.ReplConst(lightgray, dumx, dumy, KB, KB, Display.replace);
  252.             Display.ReplConst(darkgray, dumx+1, dumy, KB-1, KB-1, Display.replace);
  253.             Display.ReplConst(midgray, dumx+1, dumy+1, KB-2, KB-2, Display.replace);
  254.         ELSE
  255.             Display.ReplConst(Display.black, dumx, dumy, KB, KB, Display.replace);
  256.             Display.ReplConst(col, dumx+1, dumy+1, KB-2, KB-2, Display.replace);
  257.         END;
  258.     END BlockKasten;
  259.     (* draw char at box *)
  260.     PROCEDURE DrawChar(f: Frame; ch: CHAR; XKasten, YKasten: INTEGER; Color: BOOLEAN; col: INTEGER);
  261.         VAR
  262.             Pat: Display.Pattern;
  263.             dx, x, y, w, h: INTEGER;
  264.             dumx, dumy: INTEGER;
  265.     BEGIN
  266.         Display.GetChar(UsedFont.raster, ch, dx, x, y, w, h, Pat);
  267.         ClearKasten(f, XKasten, YKasten, Color);
  268.         dumx:=f.SeitenOffset+XKasten*KastenPlatz-KastenBreite+(KB-w) DIV 2;
  269.         dumy:=f.UntenOffset+YKasten*KastenPlatz-KastenBreite+(KB-h) DIV 2;
  270.         IF Color THEN
  271.             col:=Colors[ORD(ch)-49];
  272.         END;
  273.         Displ