home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 402.lha / AntiFlicker_v1.1 / AntiFlicker.mod < prev    next >
Text File  |  1990-08-04  |  7KB  |  242 lines
  1. (**********************************************************************
  2.  
  3.     :Program.    AntiFlicker.mod
  4.     :Contents.   software solution against flickering in interlace mode
  5.     :Author.     Nicolas Benezan [bne]
  6.     :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
  7.     :Support.    copied most parts of "WBShadow" from Fridtjof Siebert
  8.     :Copyright.  Public Domain
  9.     :Language.   Modula-2
  10.     :Translator. M2Amiga A+L V3.2d
  11.     :Imports.    TaskMemory [bne]
  12.     :History.    V1.0 [bne] 19.May.1989
  13.     :History.    V1.1 [bne] 31.Aug.1989 (bugs fixed)
  14.     :History.    V1.2 [bne] 01.Sep.1989 (works with 2 planes, optional)
  15.     :History.    V1.3 [bne] 03.Sep.1989 (+ "-c"-option)
  16.     :Usage.      AntiFlicker [-c]
  17.  
  18. **********************************************************************)
  19.  
  20. MODULE AntiFlicker;
  21.  
  22. FROM Arguments   IMPORT NumArgs, GetArg;
  23. FROM Arts        IMPORT Assert, Terminate, TermProcedure;
  24. FROM Dos         IMPORT Delay;
  25. FROM Exec        IMPORT AllocMem, CopyMemQuick, FindPort, Forbid,
  26.                         FreeMem, GetMsg, MemReqs, MemReqSet, Message,
  27.                         MessagePtr, MsgPortPtr, NodeType, Permit, PutMsg,
  28.                         ReplyMsg, WaitPort;
  29. FROM ExecSupport IMPORT CreatePort, DeletePort;
  30. FROM Graphics    IMPORT BitMap, BltClear;
  31. FROM Intuition   IMPORT CloseWindow, IDCMPFlagSet, MakeScreen, NewWindow,
  32.                         OpenWindow, RethinkDisplay, ScreenFlags,
  33.                         ScreenFlagSet, ScreenPtr, WindowFlags,
  34.                         WindowFlagSet, WindowPtr;
  35. FROM SYSTEM      IMPORT ADDRESS, ADR, BITSET, CAST, SHIFT;
  36.  
  37. CONST
  38.   WindowTitle = "AntiFlicker © AMOK Stuttgart [fbs]+[bne]";
  39.   PortName    = "NewWBPlanes[fbs].Port";
  40.   ReplyName   = "NewWBPlanes[fbs].ReplyPort";
  41.  
  42. TYPE
  43.   ColorTable=ARRAY [0..31] OF CARDINAL;
  44.   ColorTablePtr=POINTER TO ColorTable;
  45.  
  46. VAR
  47.   WBScreen: ScreenPtr;
  48.   OldPlane: ADDRESS;
  49.   Window: WindowPtr;
  50.   MyMsg: Message;
  51.   QuitMessage: MessagePtr;
  52.   MyPort: MsgPortPtr;
  53.   OldColorPtr: ColorTablePtr;
  54.   NewColors: ColorTable;
  55.   ColorOption: BOOLEAN;
  56.   Arg: ARRAY [0..2] OF CHAR;
  57.   Len: INTEGER;
  58.  
  59. PROCEDURE CheckPublicPort;
  60.   VAR
  61.     OldPort:MsgPortPtr;
  62.   BEGIN
  63.     OldPort:= FindPort(ADR(PortName));
  64.     IF OldPort#NIL THEN
  65.       MyPort:= CreatePort(ADR(ReplyName),0);
  66.       Assert(MyPort#NIL,ADR("CreatePort failed"));
  67.       MyMsg.node.type:= message;
  68.       MyMsg.replyPort:= MyPort;
  69.       PutMsg(OldPort,ADR(MyMsg)); (* Signal task to quit *)
  70.       WaitPort(MyPort);
  71.       DeletePort(MyPort);
  72.       MyPort:= NIL;
  73.       Terminate(0);
  74.     END;
  75.     MyPort:= CreatePort(ADR(PortName),0);
  76.     Assert(MyPort#NIL,ADR("CreatePort failed"));
  77.   END CheckPublicPort;
  78.  
  79. PROCEDURE InitWindow;
  80.   VAR
  81.     NuWindow: NewWindow;
  82.   BEGIN
  83.     WITH NuWindow DO
  84.       leftEdge   := 0;
  85.       topEdge    := 0;
  86.       width      := 1;
  87.       height     := 1;
  88.       detailPen  := 0;
  89.       blockPen   := 1;
  90.       idcmpFlags := IDCMPFlagSet{};
  91.       flags      := WindowFlagSet{backDrop};
  92.       firstGadget:= NIL;
  93.       checkMark  := NIL;
  94.       title      := ADR(WindowTitle);
  95.       screen     := NIL;
  96.       bitMap     := NIL;
  97.       type       := ScreenFlagSet{wbenchScreen};
  98.     END;
  99.     Window:= OpenWindow(NuWindow);
  100.     Assert(Window#NIL,ADR("Can't open Window!!!"));
  101.     WBScreen:= Window^.wScreen;
  102.     IF WBScreen^.bitMap.depth>2 THEN
  103.       Terminate(0)
  104.     END; (* thers sth. strange ! *)
  105.   END InitWindow;
  106.  
  107. PROCEDURE SetPlanes(AddPlane: BOOLEAN);
  108.   VAR
  109.     RasSize: LONGINT;
  110.     NewPlane: ADDRESS;
  111.     Color: CARDINAL;
  112.  
  113.   PROCEDURE Mix(Color1, Color2: CARDINAL): CARDINAL;
  114.     BEGIN
  115.       RETURN SHIFT(CAST(CARDINAL, CAST(BITSET, Color1)-{0,4,8})+
  116.                    CAST(CARDINAL, CAST(BITSET, Color2)-{0,4,8}), -1);
  117.     END Mix;
  118.  
  119.   BEGIN
  120.     WITH WBScreen^ DO
  121.       WITH bitMap DO
  122.         RasSize:=LONGINT(bytesPerRow)*LONGINT(rows);
  123.         Forbid;
  124.         IF NOT AddPlane THEN
  125.           FreeMem(planes[1], RasSize);
  126.           depth:=1;
  127.         END;
  128.         NewPlane:=AllocMem(RasSize+LONGINT(bytesPerRow),
  129.                            MemReqSet{chip});
  130.         IF NewPlane#NIL THEN
  131.           CopyMemQuick(planes[0], NewPlane, RasSize);
  132.           BltClear(NewPlane+RasSize, bytesPerRow, 0);
  133.           FreeMem(planes[0], RasSize);
  134.           planes[0]:=NewPlane;
  135.         END;
  136.         planes[depth]:=NewPlane;
  137.         INC(planes[depth], bytesPerRow);
  138.       END;
  139.       OldColorPtr:=viewPort.colorMap^.colorTable;
  140.       FOR Color:=0 TO 31 DO
  141.         NewColors[Color]:=OldColorPtr^[Color];
  142.       END;
  143.       IF AddPlane THEN
  144.         NewColors[1]:=Mix(OldColorPtr^[0], OldColorPtr^[1]);
  145.         NewColors[4]:=NewColors[1];
  146.         NewColors[5]:=OldColorPtr^[1];
  147.         NewColors[2]:=OldColorPtr^[2];
  148.         NewColors[3]:=Mix(OldColorPtr^[0], OldColorPtr^[3]);
  149.         NewColors[6]:=NewColors[3];
  150.         NewColors[7]:=OldColorPtr^[3];
  151.       ELSE
  152.         NewColors[1]:=Mix(OldColorPtr^[0], OldColorPtr^[1]);
  153.         NewColors[2]:=NewColors[1];
  154.         NewColors[3]:=OldColorPtr^[1];
  155.       END;
  156.       Permit;
  157.     END;
  158.   END SetPlanes;
  159.  
  160. PROCEDURE UnsetPlanes;
  161.   VAR
  162.     RasSize: LONGINT;
  163.   BEGIN
  164.     WITH WBScreen^ DO
  165.       WITH bitMap DO
  166.         RasSize:=LONGINT(bytesPerRow)*LONGINT(rows);
  167.         Forbid();
  168.         IF planes[0]=planes[depth]-LONGINT(bytesPerRow) THEN
  169.           FreeMem(planes[0]+RasSize, bytesPerRow);
  170.         END;
  171.         IF depth=1 THEN
  172.           planes[1]:=AllocMem(RasSize, MemReqSet{chip});
  173.           IF planes[1]#NIL THEN
  174.             BltClear(planes[1], RasSize, 0);
  175.             depth:=2;
  176.           END;
  177.         END;
  178.       END;
  179.       Permit();
  180.     END;
  181.     MakeScreen(WBScreen);
  182.     RethinkDisplay;
  183.   END UnsetPlanes;
  184.  
  185. PROCEDURE CleanUp();
  186. BEGIN
  187.   IF WBScreen#NIL THEN
  188.     UnsetPlanes;
  189.     RethinkDisplay();
  190.   END;
  191.   IF Window#NIL THEN CloseWindow(Window); END;
  192.   IF MyPort#NIL THEN
  193.     Forbid();
  194.       IF QuitMessage=NIL THEN
  195.         QuitMessage := GetMsg(MyPort)
  196.       END;
  197.       WHILE QuitMessage#NIL DO
  198.         ReplyMsg(QuitMessage);
  199.         QuitMessage := GetMsg(MyPort);
  200.       END;
  201.       DeletePort(MyPort);
  202.     Permit();
  203.   END;
  204. END CleanUp;
  205.  
  206. PROCEDURE InitTermProc;
  207.   BEGIN
  208.     WBScreen:= NIL;
  209.     Window:= NIL;
  210.     MyPort:= NIL;
  211.     TermProcedure(CleanUp);
  212.   END InitTermProc;
  213.  
  214. BEGIN
  215.   InitTermProc;
  216.   CheckPublicPort;
  217.   InitWindow;
  218.   ColorOption:=FALSE;
  219.   IF NumArgs()>0 THEN
  220.     GetArg(1, Arg, Len);
  221.     IF (Arg[0]="-") AND (CAP(Arg[1])="C") AND (Len=2) THEN
  222.       ColorOption:=TRUE;
  223.     END;
  224.   END;
  225.   SetPlanes(ColorOption);
  226.   WITH WBScreen^.bitMap DO
  227.     REPEAT
  228.       Forbid();
  229.         INC(depth);
  230.         WBScreen^.viewPort.colorMap^.colorTable:=ADR(NewColors);
  231.         MakeScreen(WBScreen);
  232.         DEC(depth);
  233.         WBScreen^.viewPort.colorMap^.colorTable:=OldColorPtr;
  234.       Permit();
  235.       RethinkDisplay();
  236.       Delay(16);
  237.       QuitMessage:=GetMsg(MyPort);
  238.     UNTIL QuitMessage#NIL;
  239.   END;
  240. END AntiFlicker.
  241.  
  242.