2
0
Эх сурвалжийг харах

Graph: HLine and VLine swapped; Added example Fire.Mod

Arthur Yefimov 3 жил өмнө
parent
commit
cd5c17e08d
3 өөрчлөгдсөн 196 нэмэгдсэн , 8 устгасан
  1. 190 0
      Programs/Fire.Mod
  2. 2 4
      Programs/r.Mod
  3. 4 4
      src/Graph.Mod

+ 190 - 0
Programs/Fire.Mod

@@ -0,0 +1,190 @@
+MODULE Fire;
+IMPORT Out, Random, G := Graph, M := Math, Int;
+CONST signHeat = 63;
+  introLen = 3000;
+  signWaitDelay = 90;
+  signChance = 2;
+  fireRand = 3;
+  K = 2; (* Pixel buffer resolution multiplier *)
+VAR clr: ARRAY 64 OF G.Color;
+  w, h: INTEGER;
+  heat: INTEGER;
+  m: ARRAY 300*K, 640*K OF BYTE;
+  intro, wait: INTEGER;
+  f: G.Font;
+
+PROCEDURE PutPixel(x, y, c: INTEGER);
+BEGIN
+  IF m[y, x] # c THEN
+    m[y, x] := c;
+    G.PutPixel(x, y, clr[c])
+  END
+END PutPixel;
+
+PROCEDURE PutPixelMaybe(x, y, c: INTEGER);
+BEGIN
+  IF (0 <= x) & (x < w) & (0 <= y) & (y < h) THEN
+    PutPixel(x, y, c)
+  END
+END PutPixelMaybe;
+
+PROCEDURE SwapPoints(VAR x1, y1, x2, y2: INTEGER);
+VAR t: INTEGER;
+BEGIN
+  t := x1; x1 := x2; x2 := t;
+  t := y1; y1 := y2; y2 := t
+END SwapPoints;
+
+PROCEDURE Line(x1, y1, x2, y2, c: INTEGER);
+VAR dx, dy, x, y, half, t: INTEGER;
+BEGIN
+  dx := ABS(x1 - x2); dy := ABS(y1 - y2);
+  IF dx = 0 THEN
+    IF y1 > y2 THEN t := y1; y1 := y2; y2 := t END;
+    FOR y := y1 TO y2 DO PutPixelMaybe(x1, y, c) END
+  ELSIF dy = 0 THEN
+    IF x1 > x2 THEN t := x1; x1 := x2; x2 := t END;
+    FOR x := x1 TO x2 DO PutPixelMaybe(x, y1, c) END
+  ELSIF dx > dy THEN
+    IF x1 > x2 THEN SwapPoints(x1, y1, x2, y2) END;
+    half := dx DIV 2;
+    FOR x := x1 TO x2 DO
+      PutPixelMaybe(x, y1 + ((y2 - y1) * x + half) DIV dx, c)
+    END
+  ELSE
+    IF y1 > y2 THEN SwapPoints(x1, y1, x2, y2) END;
+    half := dy DIV 2;
+    FOR y := y1 TO y2 DO
+      PutPixelMaybe(x1 + ((x2 - x1) * y + half) DIV dy, y, c)
+    END
+  END
+END Line;
+
+PROCEDURE ThickLine(x1, y1, x2, y2, c: INTEGER);
+CONST T = 3;
+VAR x, y: INTEGER;
+BEGIN
+  FOR y := 0 TO T DO
+    FOR x := 0 TO T DO
+      Line(x1 + x, y1 + y, x2 + x, y2 + y, c)
+    END
+  END
+END ThickLine;
+
+PROCEDURE C(x, y, W: INTEGER);
+BEGIN
+  ThickLine(x, y, x + W, y, signHeat);
+  ThickLine(x, y + W, x + W, y + W, signHeat);
+  ThickLine(x, y, x, y + W, signHeat)
+END C;
+
+PROCEDURE P(x, y, W: INTEGER);
+VAR W2: INTEGER;
+BEGIN
+  W2 := W DIV 2;
+  ThickLine(x, y, x + W, y, signHeat);
+  ThickLine(x, y, x, y + W, signHeat);
+  ThickLine(x, y + W2, x + W, y + W2, signHeat);
+  ThickLine(x + W, y, x + W, y + W2, signHeat)
+END P;
+
+PROCEDURE Sign;
+VAR x, y, i, W, pad: INTEGER;
+BEGIN
+  pad := w DIV 20;
+  W := (w - 5 * pad) DIV 6;
+  y := (h - W) DIV 2 - Random.Int(pad * 2);
+  x := (w - W * 4 - 3 * pad) DIV 2 + Random.Int(pad * 4 + 1) - pad * 2;
+  FOR i := 0 TO 2 DO C(x, y, W); INC(x, W + pad) END;
+  P(x, y, W);
+  wait := signWaitDelay
+END Sign;
+
+PROCEDURE GoFire;
+VAR x, y, c: INTEGER;
+BEGIN
+  FOR y := 0 TO h - 2 DO
+    FOR x := 1 TO w - 2 DO
+      c := (m[y + 1, x] * 2 + m[y, x - 1] + m[y, x + 1]) DIV 4;
+      IF c # 0 THEN INC(c, Random.Int(2 * fireRand + 1) - fireRand) END;
+      IF c < 0 THEN c := 0 ELSIF c > 63 THEN c := 63 END;
+      PutPixel(x, y, c)
+    END
+  END
+END GoFire;
+
+PROCEDURE Run;
+VAR done: BOOLEAN;
+  ch: CHAR;
+  x, y: INTEGER;
+  Z: ARRAY 20 OF CHAR;
+BEGIN
+  done := FALSE;
+  FOR x := 0 TO w - 1 DO
+    FOR y := 0 TO h - 1 DO
+      m[y, x] := 0
+    END
+  END;
+  REPEAT
+    IF intro # 0 THEN
+      DEC(intro);
+      Line(2, h - 1, w - 3, h - 1,
+        FLOOR((1 - M.sin(intro * (M.pi / 2) / introLen)) * 63))
+    ELSE
+      Line(2, h - 1, w - 3, h - 1, heat)
+    END;
+
+    IF wait = 0 THEN
+      IF Random.Int(100) < signChance THEN Sign END
+    ELSE DEC(wait)
+    END;
+    GoFire;
+    G.Flip;
+
+    IF G.KeyPressed() THEN
+      ch := G.ReadKey();
+      IF ch = CHR(27) THEN done := TRUE
+      ELSIF ch = '=' (*'+'*) THEN
+        IF heat < 63 THEN INC(heat) END
+      ELSIF ch = '-' THEN
+        IF heat > 0 THEN DEC(heat) END
+      ELSIF ('0' <= ch) & (ch <= '9') THEN
+        heat := (ORD(ch) - ORD('0')) * 7
+      ELSIF (ch = ' ') THEN
+        intro := 0;
+        wait := 0
+      END
+    END
+  UNTIL done
+END Run;
+
+PROCEDURE Do;
+VAR i: INTEGER;
+BEGIN
+  G.Settings(320, 200, {});
+  G.Settings(640, 400, {G.smooth});
+  G.Init();
+  f := G.LoadFont('../Data/Fonts/Main');
+  G.ShowMouse(FALSE);
+  G.GetTargetSize(w, h);
+  IF h > LEN(m) THEN h := LEN(m) END;
+  IF w > LEN(m[0]) THEN w := LEN(m[0]) END;
+
+  (* Initialize palette *)
+  FOR i := 0 TO 15 DO
+    G.MakeCol(clr[i], i * 8, 0, 0);
+    G.MakeCol(clr[i + 16], (i + 16) * 8, 0, 0);
+    G.MakeCol(clr[i + 32], 240, i * 16, 0);
+    G.MakeCol(clr[i + 48], 240, 240, i * 16)
+  END;
+
+  heat := 63;
+  intro := introLen;
+  wait := intro;
+  Run;
+  G.Close
+END Do;
+
+BEGIN
+  Do
+END Fire.

+ 2 - 4
Programs/r.Mod

@@ -23,15 +23,13 @@ BEGIN
   Out.String('Please enter a real number: '); In.Real(x);
   FOR i := 0 TO 15 DO
     R(x, i)
-  END
-  (*
-  FOR i := 0 TO 15 BY 5 DO
+  END;
+  FOR i := 0 TO 18 BY 6 DO
     FOR j := 0 TO 3 DO
       RF(x, i, j)
     END;
     RF(x, i, 6)
   END
-  *)
 
   (*
   Out.String('Enter string:'); In.Line(s);

+ 4 - 4
src/Graph.Mod

@@ -653,12 +653,12 @@ PROCEDURE Line*(x1, y1, x2, y2: INTEGER; color: Color);
 BEGIN LineF(FLT(x1), FLT(y1), FLT(x2), FLT(y2), color)
 END Line;
 
-PROCEDURE HLine*(x, y1, y2: INTEGER; color: Color);
-BEGIN LineF(FLT(x), FLT(y1), FLT(x), FLT(y2), color)
+PROCEDURE HLine*(x1, y, x2: INTEGER; color: Color);
+BEGIN LineF(FLT(x1), FLT(y), FLT(x2), FLT(y), color)
 END HLine;
 
-PROCEDURE VLine*(x1, y, x2: INTEGER; color: Color);
-BEGIN LineF(FLT(x1), FLT(y), FLT(x2), FLT(y), color)
+PROCEDURE VLine*(x, y1, y2: INTEGER; color: Color);
+BEGIN LineF(FLT(x), FLT(y1), FLT(x), FLT(y2), color)
 END VLine;
 
 PROCEDURE FillRectF*(x1, y1, x2, y2: REAL; color: Color);