home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D4.DMS / in.adf / Beispiele / ConcurrencyDemo.mod < prev    next >
Encoding:
Text File  |  1992-10-10  |  2.0 KB  |  109 lines
  1. MODULE ConcurrencyDemo;
  2.  
  3. IMPORT C := Concurrency,
  4.        B := BasicTypes,
  5.        E := Exec,
  6.        I := Intuition,
  7.        D := Display;
  8.  
  9. VAR p: C.Process;
  10.  
  11. TYPE
  12.   Window = POINTER TO WindowDesc;
  13.   WindowDesc = RECORD (B.ANYDesc)
  14.     x,y,w,h: INTEGER;
  15.   END;
  16.  
  17. VAR w: Window;
  18.  
  19.  
  20. PROCEDURE New(w: B.ANY): B.ANY;
  21.  
  22. VAR
  23.   win: D.WindowPtr;
  24.   i,top: INTEGER;
  25.   msg: E.MessagePtr;
  26.   fertig: BOOLEAN;
  27.  
  28.   PROCEDURE NewProcess;
  29.   VAR
  30.     new: Window;
  31.   BEGIN
  32.     NEW(new);
  33.     new^ := w(Window)^;
  34.     INC(new.y,20);
  35.     INC(new.x,20);
  36.     IF C.NewProcess(New,new)=NIL THEN END;
  37.   END NewProcess;
  38.  
  39. BEGIN
  40.  
  41.   WITH w: Window DO
  42.  
  43.     NEW(win);
  44.     IF D.OpenWindow(win,"Neuer Prozeß",w.x,w.y,w.w,w.h,NIL) THEN
  45.  
  46.       I.OldModifyIDCMP(win.window,LONGSET{I.closeWindow,I.newSize,I.vanillaKey});
  47.  
  48.       top := win.rp.font.ySize;
  49.       fertig := FALSE;
  50.  
  51.       REPEAT
  52.         D.FrontPen(win,1);
  53.         D.Jam1(win);
  54.         D.Home(win);
  55.         D.Write(win,"Taste <S> startet noch einen Prozeß!");
  56.         D.Complement(win);
  57.         msg := NIL;
  58.         WHILE msg=NIL DO
  59.           i := 0;
  60.           WHILE (i<=win.width-2) & (msg=NIL) DO
  61.             D.Line(win,0,top,win.width-1-i,win.height-1);
  62.             D.Line(win,win.width-1-i,top,win.width-1,win.height-1);
  63.             msg := E.GetMsg(win.window.userPort);
  64.             INC(i,2);
  65.           END;
  66.         END;
  67.  
  68.         IF msg#NIL THEN
  69.           WITH msg: I.IntuiMessage DO
  70.             IF    I.newSize     IN msg.class THEN
  71.               D.Init(win); D.Clear(win);
  72.             ELSIF I.vanillaKey  IN msg.class THEN
  73.               IF CAP(CHR(msg.code))="S" THEN NewProcess END;
  74.             ELSIF I.closeWindow IN msg.class THEN
  75.               fertig := TRUE;
  76.             END;
  77.             E.ReplyMsg(msg);
  78.           END;
  79.         END;
  80.  
  81.       UNTIL fertig;
  82.  
  83.       D.Close(win);
  84.  
  85.     END;   (* IF D.OpenWindow(..) END; *)
  86.  
  87.   END;   (* WITH w: Window DO *)
  88.  
  89.   RETURN NIL;
  90.  
  91. END New;
  92.  
  93.  
  94. BEGIN
  95.  
  96.   NEW(w);
  97.   w.x := 0;
  98.   w.y := 0;
  99.   w.w := 320;
  100.   w.h := 70;
  101.   p := C.NewProcess(New,w);
  102.  
  103. CLOSE
  104.  
  105.   C.WaitForAllProcesses;
  106.  
  107. END ConcurrencyDemo.
  108.  
  109.