Oberon Community Platform Forum
December 14, 2019, 05:21:42 AM *
Welcome, Guest. Please login or register.
Did you miss your activation email?

Login with username, password and session length
News:
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Demo Demo Demo!  (Read 5646 times)
soren renner
Global Moderator
Full Member
*****
Posts: 216



« on: February 04, 2008, 07:50:22 PM »

This is an experiment. If one person finds this note, my shipwrecked ordeal on Dev Island will not have been in vain. Compile and run this slight  modification to the Turing demo.

MODULE TuringCoatWnd;   (* Soren Renner / TF *)

IMPORT
   SYSTEM, Modules, Objects, Raster, AosRandom, WMRectangles, WMGraphics,
   WM := WMWindowManager, WMMessages;

CONST
   m =250;
   size = 1;

TYPE

   KillerMsg = OBJECT
   END KillerMsg;   

   TCW* =  OBJECT(WM.BufferWindow)
   VAR
      mesh1, mesh2, n1 : ARRAY m, m OF REAL;
      random : AosRandom.Generator;
      alive, dead, alpha : BOOLEAN;
      i : LONGINT;

      PROCEDURE &New(alpha : BOOLEAN);
      VAR i, j : LONGINT;
      BEGIN
         Init(m*size, m*size, alpha);
         SELF.alpha :=alpha;
         manager := WM.GetDefaultManager();
         manager.Add(100, 100, SELF, {WM.FlagFrame});
         
         NEW(random);
         
         FOR i := 0 TO m - 1 DO
            FOR j := 0 TO m - 1 DO
               mesh1[i, j] := 0;
               mesh2[i, j] := 0;
               n1[i, j] := 0
            END
         END;
         FOR i :=  1 TO m - 2 DO
            FOR j := 1 TO m - 2 DO
               IF random.Dice(100) > 90 THEN mesh1[i, j] := random.Dice(1000)/1000 END
            END
         END;
         IncCount;
      END New;
      
      PROCEDURE Handle(VAR m: WMMessages.Message);
      BEGIN
         IF (m.msgType = WMMessages.MsgExt) & (m.ext # NIL) & (m.ext IS KillerMsg) THEN
            Close;
         ELSE Handle^(m)
         END
      END Handle;

      PROCEDURE Draw*(canvas : WMGraphics.Canvas; w, h, q : LONGINT);
      BEGIN
         Draw^(canvas, w, h, 0)
      END Draw;

      PROCEDURE Close();
      BEGIN
         alive := FALSE;
         BEGIN {EXCLUSIVE} AWAIT(dead); END;
         Close^;
         DecCount;
      END Close;

      PROCEDURE Generation;
      VAR i, j : LONGINT;
      BEGIN
         FOR i := 1 TO m - 2 DO
            n1[i, 0] := mesh1[i - 1, 0] + mesh1[i + 1, 0] + mesh1[i, m - 1] + mesh1[i, 1]
                + mesh1[i - 1, m - 1] +  mesh1[i + 1, 1] + mesh1[i + 1, m - 1] + mesh1[i - 1,  1];
            n1[i, m - 1] := mesh1[i - 1, m - 1] + mesh1[i + 1, m - 1] + mesh1[i, m - 2] + mesh1[i, 0]
               + mesh1[i - 1, m - 2] +  mesh1[i + 1, 0] + mesh1[i + 1, m - 2] + mesh1[i - 1, 0];
            END;
         FOR j := 1 TO m - 2 DO
            n1[0, j] := mesh1[m - 1, j] + mesh1[1, j] + mesh1[0, j - 1] + mesh1[0, j + 1]
               + mesh1[m - 1, j - 1] +  mesh1[1, j + 1] + mesh1[1, j - 1] + mesh1[m - 1, j + 1];
            n1[m - 1, j] := mesh1[m - 2, j] + mesh1[0, j] + mesh1[m - 1, j - 1] + mesh1[m - 1, j + 1]
               + mesh1[m - 2, j - 1] +  mesh1[0, j + 1] + mesh1[0, j - 1] + mesh1[m - 2, j + 1]
         END;

         FOR i := 1 TO m - 2 DO
            FOR j := 1 TO m - 2 DO
               n1[i, j] := mesh1[i - 1, j] + mesh1[i + 1, j] + mesh1[i, j - 1] + mesh1[i, j + 1]
                  + mesh1[i - 1, j - 1] +  mesh1[i + 1, j + 1] + mesh1[i + 1, j - 1] + mesh1[i - 1, j + 1]
            END
         END;
         FOR i := 1 TO m - 2 DO
            FOR j := 1 TO m - 2 DO
               (*  HERE ARE THE DIFFERENCE RULES! *)
               mesh1[i, j] := mesh1[i, j] + n1[i, j] / 80*i/j - (mesh2[i, j] * mesh2[i, j])  ;
               mesh2[i, j] := mesh2[i, j] +  mesh1[i, j] / 20 - 0.03 ;
               IF mesh1[i, j] < 0 THEN mesh1[i, j] := 0 END;
               IF mesh2[i, j] < 0 THEN mesh2[i, j] := 0 END;
               IF mesh1[i, j] > 1 THEN mesh1[i, j] := 1 END;
               IF mesh2[i, j] > 1 THEN mesh2[i, j] := 1 END;
            END;
         END;
      END Generation;

      PROCEDURE DrawIt;
      VAR i, j, ix, jy : LONGINT;
         pix : Raster.Pixel;
         mode : Raster.Mode;
      BEGIN
         Raster.InitMode(mode, Raster.srcCopy);
         FOR i := 0 TO m - 1 DO
            ix := i * size ;
            FOR j := 0 TO m - 1 DO
               jy := j * size;
               IF alpha THEN
                  Raster.SetRGBA(pix, SHORT((255-ENTIER(mesh1[i, j] * 255)) ), SHORT((255-ENTIER(mesh2[i, j] * 255)) ), 0,
                  SHORT( (255-ENTIER(mesh2[i, j] * 255))+ENTIER(mesh1[i, j] * 255)) MOD 128+127 )
               ELSE
                  Raster.SetRGB(pix, SHORT((255-ENTIER(mesh1[i, j] * 255)) ), SHORT((255-ENTIER(mesh2[i, j] * 255)) ), 1)
               END;
               Raster.Fill(img, ix, jy, ix+size, jy+size, pix, mode)
            END
         END;
         Invalidate(WMRectangles.MakeRect(0, 0, GetWidth(), GetHeight()))
      END DrawIt;

   BEGIN {ACTIVE}
      alive := TRUE;
      Objects.SetPriority(Objects.Low);
      WHILE alive DO
         FOR i := 0 TO 0 DO Generation END;
         DrawIt;
      END;
      BEGIN {EXCLUSIVE} dead := TRUE; END;
   END TCW;

VAR
   nofWindows : LONGINT;

PROCEDURE OpenAlpha*;
VAR window : TCW;
BEGIN
   NEW(window, TRUE);
END OpenAlpha;

PROCEDURE Open*;
VAR window : TCW;
BEGIN
   NEW(window, FALSE);
END Open;

PROCEDURE IncCount;
BEGIN {EXCLUSIVE}
   INC(nofWindows);
END IncCount;      

PROCEDURE DecCount;
BEGIN {EXCLUSIVE}
   DEC(nofWindows);
END DecCount;      

PROCEDURE Cleanup;
VAR die : KillerMsg;
    msg : WMMessages.Message;
    m : WM.WindowManager;
BEGIN {EXCLUSIVE}
   NEW(die); msg.ext := die; msg.msgType := WMMessages.MsgExt;
   m := WM.GetDefaultManager();
   m.Broadcast(msg);
   AWAIT(nofWindows = 0);
END Cleanup;

BEGIN
   Modules.InstallTermHandler(Cleanup);
END TuringCoatWnd.

S.Free TuringCoatWnd ~
TuringCoatWnd.OpenAlpha ~
Turin
« Last Edit: February 05, 2008, 11:52:59 PM by soren renner » Logged
soren renner
Global Moderator
Full Member
*****
Posts: 216



« Reply #1 on: February 04, 2008, 08:06:35 PM »

If anyone tries this and posts in response, I will post another demo showing how to compile code and inject it into a running module. (!) (Probably this does not impress a true Oberon programmer at all, but I was surprised when I realized it could be done.)
Logged
staubesv
Administrator
Sr. Member
*****
Posts: 387



« Reply #2 on: February 04, 2008, 08:09:37 PM »

Cool demo! I'm waiting for the next one...
Logged
negelef
Administrator
Jr. Member
*****
Posts: 55


« Reply #3 on: February 08, 2008, 11:25:07 AM »

Looking forward to see what you mean with injecting code into a running module...
Logged
felix
Administrator
Newbie
*****
Posts: 17



WWW
« Reply #4 on: February 08, 2008, 02:58:34 PM »

Thanks for the cool demo.
Can't wait to see the next one.
Logged
soren renner
Global Moderator
Full Member
*****
Posts: 216



« Reply #5 on: February 08, 2008, 09:35:59 PM »

I have to go on a little coding binge ... it will be within a few days, I promise.

update: working.....
« Last Edit: February 08, 2008, 11:48:50 PM by soren renner » Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!