home *** CD-ROM | disk | FTP | other *** search
/ Global Amiga Experience / globalamigaexperience.iso / compressed / development / clusterdemo.dms / clusterdemo.adf / Modules.lha / work / txt / ApfelDemo.mod next >
Text File  |  1980-01-07  |  7KB  |  275 lines
  1. |##########|
  2. |#MAGIC   #|HAHEAMHI
  3. |#PROJECT #|"ApfelDemo"
  4. |#PATHS   #|"StdProject"
  5. |#FLAGS   #|xx---x--x---x-x-----------------
  6. |#USERSW  #|--------------------------------
  7. |#USERMASK#|--------------------------------
  8. |#SWITCHES#|xx---x----------
  9. |##########|
  10. MODULE  ApfelDemo;
  11. $$StackChk:=FALSE;
  12.  
  13. FROM System          IMPORT LONGSET,BITSET,Regs;
  14. FROM Intuition       IMPORT ScreenPtr,NewScreen,OpenScreen,CloseScreen,
  15.                             customScreen,ScreenToBack,ModifyIDCMP,
  16.                             ScreenToFront,ActivateWindow,WBenchToFront,
  17.                             WindowPtr,NewWindow,OpenWindow,CloseWindow,
  18.                             WindowFlags,WindowFlagSet,IDCMPFlags,IDCMPFlagSet,
  19.                             IntuiMessagePtr;
  20. FROM Input           IMPORT Qualifiers,lButton,rButton;
  21. FROM Graphics        IMPORT SetRGB4,SetRast,RastPortPtr,OwnBlitter,DisownBlitter,
  22.                             WaitBlit,WaitTOF,ViewPortPtr,WaitBOVP,
  23.                             ViewModes,ViewModeSet,Text,Move,
  24.                             SetAPen,SetDrMd,DrawModeSet;
  25. FROM T_Exec            IMPORT GetMsg,ReplyMsg,MessagePtr,TaskPtr,CreateTask,
  26.                             SetSignal,Signal,Wait,FindTask,DeleteTask,TaskSigSet,
  27.                             TaskSignals;
  28.  
  29. VAR
  30.   MyScreen    : ScreenPtr;
  31.   MyWindow    : ARRAY [0..3] OF WindowPtr;
  32.  
  33. VAR
  34.   MyNewScreen := NewScreen:(leftEdge=0,topEdge=0,width=320,height=256,
  35.                            depth=4,detailPen=1,blockPen=3,
  36.                            viewModes=ViewModeSet:{},
  37.                            type=customScreen,
  38.                            font=NIL,defaultTitle=NIL,gadgets=NIL,
  39.                            customBitMap=NIL);
  40.  
  41.   MyNewWindow := NewWindow:(width=160,height=128,
  42.                            detailPen=1,blockPen=2,
  43.                            idcmpFlags=IDCMPFlagSet:{},
  44.                            flags=WindowFlagSet:{borderless},
  45.                            firstGadget=NIL,checkMark=NIL,title=NIL,
  46.                            screen=NIL,bitMap=NIL,type=customScreen);
  47.  
  48. TYPE
  49.   NameType    = ARRAY [0..3] OF CLASSPTR TO STRING;
  50. CONST
  51.   Names       = NameType:("LONGREAL"'PTR,"REAL=FFP"'PTR,
  52.                           "INTEGER"'PTR,"NONE"'PTR);
  53.  
  54. PROCEDURE OpenAll;
  55. VAR i,j,k : INTEGER;
  56. BEGIN
  57.   MyScreen:=OpenScreen(MyNewScreen);
  58.   IF MyScreen=NIL THEN
  59.     HALT(1002);
  60.   END;
  61.   MyNewWindow.screen:=MyScreen;
  62.   FOR i:=0 TO 3 DO
  63.     MyNewWindow.leftEdge:=(i MOD 2)*160;
  64.     MyNewWindow.topEdge:=(i DIV 2)*128;
  65.     MyWindow[i]:=OpenWindow(MyNewWindow);
  66.     IF MyWindow[i]=NIL THEN
  67.       HALT(1010+i);
  68.     END;
  69.     SetRast(MyWindow[i]^.rPort,8+i*2);
  70.     SetDrMd(MyWindow[i]^.rPort,DrawModeSet:{});
  71.     FOR k:=0 TO 127 BY 24 DO
  72.       FOR j:=0 TO 15 DO
  73.         Move(MyWindow[i]^.rPort,k+15-j,k+j);
  74.         SetAPen(MyWindow[i]^.rPort,j);
  75.         Text(MyWindow[i]^.rPort,Names[i].data'PTR,Names[i].len);
  76.       END;
  77.     END;
  78.   END;
  79.   FOR i:=0 TO 15 DO
  80.     SetRGB4(MyScreen^.viewPort'PTR,i,0,i,i);
  81.   END;
  82. END OpenAll;
  83.  
  84. (* $W- $E- $L- *)
  85. PROCEDURE WritePixel(x IN 2,y IN 3,c IN 4 : INTEGER);
  86. VAR i    IN 1 : INTEGER;
  87.     disp IN 5 : LONGINT;
  88. TYPE BitPtr = POINTER TO BITSET;
  89. BEGIN
  90.   disp:=LMUL(y,40)+(x DIV 16)*2;x:=15-(x MOD 16);
  91.   FOR i:=3 TO 0 BY -1 DO
  92.     IF i IN CAST(BITSET,c) THEN
  93.       INCL(BitPtr(MyScreen^.bitMap.planes[i]+disp)^,x);
  94.     ELSE
  95.       EXCL(BitPtr(MyScreen^.bitMap.planes[i]+disp)^,x);
  96.     END
  97.   END
  98. END WritePixel;
  99.  
  100. CONST
  101.   xStart   = -2.;
  102.   yStart   = -1.4;
  103.   delta    = 3.5/160.;
  104.   limes    = 4.;
  105.   maxDepth = 64;
  106.  
  107. VAR
  108.   Ready     : ARRAY [0..3] OF BOOLEAN;
  109.   Tasks     : ARRAY [0..3] OF TaskPtr;
  110.   HomeTask  : TaskPtr;
  111.   SDummy    : TaskSigSet;
  112.   letsBreak : BOOLEAN;
  113.  
  114. PROCEDURE CalcApfel0;
  115. VAR xm,ym,
  116.     xc,yc,
  117.     xx,yy  : LONGREAL;
  118.     xi,yi,
  119.     depth  : INTEGER;
  120.     dummy  : LONGSET;
  121. BEGIN
  122.   xc:=xStart;
  123.   FOR xi:=0 TO 159 DO
  124.     yc:=yStart;
  125.     FOR yi:=0 TO 127 DO
  126.       xm:=xc;ym:=yc;
  127.       depth:=0;
  128.       REPEAT
  129.         xx:=xm*xm;yy:=ym*ym;
  130.         ym:=2.*xm*ym+yc;
  131.         xm:=xx-yy+xc;
  132.         INC(depth);
  133.       UNTIL (depth=maxDepth) OR (xx+yy>limes);
  134.       WritePixel(xi,yi,depth);
  135.       yc:=yc+delta;
  136.     END;
  137.     xc:=xc+delta;
  138.     IF letsBreak THEN xi:=159 END;
  139.   END;
  140.   Ready[0]:=TRUE;
  141.   Signal(HomeTask,CAST(TaskSigSet,LONGSET:{20}));
  142. END CalcApfel0;
  143.  
  144. PROCEDURE CalcApfel1;
  145. VAR xc,yc  : FFP;
  146.     xi,yi,
  147.     depth  : INTEGER;
  148. BEGIN
  149.   xc:=xStart;
  150.   FOR xi:=160 TO 319 DO
  151.     yc:=yStart;
  152.     FOR yi:=0 TO 127 DO
  153.       (* $W- *)
  154.       WITH FFP AS xm,
  155.            FFP AS ym,
  156.            FFP AS xx,
  157.            FFP AS yy,
  158.            depth       DO
  159.         xm:=xc;ym:=yc;
  160.         depth:=0;
  161.         REPEAT
  162.           xx:=xm*xm;yy:=ym*ym;
  163.           ym:=2.*xm*ym+yc;
  164.           xm:=xx-yy+xc;
  165.           INC(depth);
  166.         UNTIL (depth=maxDepth) OR (xx+yy>limes);
  167.       END;
  168.       WritePixel(xi,yi,depth);
  169.       yc:=yc+delta;
  170.     END;
  171.     IF letsBreak THEN xi:=319 END;
  172.     xc:=xc+delta
  173.   END;
  174.   Ready[1]:=TRUE;
  175.   Signal(HomeTask,CAST(TaskSigSet,LONGSET:{20}));
  176. END CalcApfel1;
  177.  
  178. CONST
  179.   xStartI = -16384;
  180.   yStartI = -11468;
  181.   deltaI  = 179;
  182.   limesI  = 268435456;
  183.  
  184. PROCEDURE CalcApfel2;
  185. VAR xc,yc  : INTEGER;
  186.     xi,yi,
  187.     depth  : INTEGER;
  188. BEGIN
  189.   xc:=xStartI;
  190.   FOR xi:=0 TO 159 DO
  191.     yc:=yStartI;
  192.     FOR yi:=128 TO 255 DO
  193.       (* $W- *)
  194.       WITH INTEGER AS xm,
  195.            INTEGER AS ym,
  196.            LONGINT AS xx,
  197.            LONGINT AS yy,xc,yc,
  198.            depth       DO
  199.         xm:=xc;ym:=yc;
  200.         depth:=0;
  201.         REPEAT
  202.           xx:=LMUL(xm,xm);yy:=LMUL(ym,ym);
  203.           ym:=INTEGER(LMUL(xm,ym) SHR 12) +yc;
  204.           xm:=INTEGER((xx-yy) SHR 13) + xc;
  205.           INC(depth);
  206.         UNTIL (depth=maxDepth) OR (xx+yy>limesI);
  207.       END;
  208.       WritePixel(xi,yi,depth);
  209.       yc:=yc+deltaI
  210.     END;
  211.     IF letsBreak THEN xi:=159 END;
  212.     xc:=xc+deltaI;
  213.   END;
  214.   Ready[2]:=TRUE;
  215.   Signal(HomeTask,CAST(TaskSigSet,LONGSET:{20}));
  216. END CalcApfel2;
  217.  
  218. PROCEDURE CalcApfel3;
  219. VAR xc,yc  : INTEGER;
  220.     xo,yo  : INTEGER;
  221.     xi,yi,
  222.     depth  : INTEGER;
  223. BEGIN
  224.   FOR xi:=160 TO 319 DO
  225.     FOR yi:=128 TO 255 DO
  226.       WritePixel(xi,yi,xi+yi);
  227.     END;
  228.     IF letsBreak THEN xi:=319 END;
  229.   END;
  230.   Ready[3]:=TRUE;
  231.   Signal(HomeTask,CAST(TaskSigSet,LONGSET:{20}));
  232. END CalcApfel3;
  233.  
  234. BEGIN
  235.   MyScreen:=NIL;
  236.   OpenAll;
  237.   Ready[0]:=FALSE;
  238.   Ready[1]:=FALSE;
  239.   Ready[2]:=FALSE;
  240.   Ready[3]:=FALSE;
  241.   HomeTask:=FindTask(NIL);
  242.  
  243.   HomeTask^.sigExcept:=CAST(TaskSigSet,LONGSET:{});
  244.  
  245.   Tasks[0]:=NIL;
  246.   Tasks[1]:=NIL;
  247.   Tasks[2]:=NIL;
  248.   Tasks[3]:=NIL;
  249.  
  250.   letsBreak:=FALSE;
  251.  
  252.   Tasks[0]:=CreateTask("Apfel0",-1,CalcApfel0,4000);Ready[0]:=FALSE;
  253.   Tasks[1]:=CreateTask("Apfel1",-1,CalcApfel1,4000);Ready[1]:=FALSE;
  254.   Tasks[2]:=CreateTask("Apfel2",-1,CalcApfel2,4000);Ready[2]:=FALSE;
  255.   Tasks[3]:=CreateTask("Apfel3",-1,CalcApfel3,4000);Ready[3]:=FALSE;
  256.  
  257.   REPEAT
  258.     FORGET SetSignal(CAST(TaskSigSet,LONGSET:{}),CAST(TaskSigSet,LONGSET:{12,20}));
  259.     SDummy:=Wait(CAST(TaskSigSet,LONGSET:{12,20}));
  260.     IF TaskSignals(12) IN SDummy THEN letsBreak:=TRUE END;
  261.   UNTIL Ready[0] AND Ready[1] AND Ready[2] AND Ready[3];
  262.  
  263. CLOSE
  264.   IF MyScreen#NIL THEN
  265.  
  266.     IF MyWindow[0]#NIL THEN CloseWindow(MyWindow[0]) END;
  267.     IF MyWindow[1]#NIL THEN CloseWindow(MyWindow[1]) END;
  268.     IF MyWindow[2]#NIL THEN CloseWindow(MyWindow[2]) END;
  269.     IF MyWindow[3]#NIL THEN CloseWindow(MyWindow[3]) END;
  270.  
  271.     FORGET CloseScreen(MyScreen)
  272.   END;
  273. END ApfelDemo.
  274.  
  275.