home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_disks / 200-299 / ff253.lzh / MegaWB / MegaWB.mod < prev    next >
Text File  |  1989-10-19  |  22KB  |  674 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    MegaWB.mod
  3.   :Author.     Fridtjof Siebert
  4.   :Address.    Nobileweg 67, D-7-Stgt-40
  5.   :Shortcut.   [fbs]
  6.   :Version.    1.2
  7.   :Date.       17-Mar-89
  8.   :Copyright.  PD
  9.   :Language.   Modula-II
  10.   :Translator. M2Amiga v3.1d
  11.   :Contents.   Program to create a 1024 x 512 pixels large Workbench!
  12. ---------------------------------------------------------------------------*)
  13.  
  14. MODULE MegaWB;
  15.  
  16. FROM SYSTEM      IMPORT ADR, ADDRESS, LONGSET, CAST, BITSET, INLINE, SETREG;
  17. FROM Arts        IMPORT Assert, TermProcedure, Terminate, wbStarted;
  18. FROM Arguments   IMPORT NumArgs, GetArg;
  19. FROM Conversions IMPORT StrToVal;
  20. FROM Exec        IMPORT Forbid, Permit, FindPort, MsgPortPtr, NodeType,
  21.                         Message, MessagePtr, GetMsg, ReplyMsg, PutMsg,
  22.                         WaitPort, IOStdReq, Interrupt, IOStdReqPtr, DoIO,
  23.                         OpenDevice, CloseDevice, AddIntServer, RemIntServer,
  24.                         AllocSignal, FreeSignal, Wait, Signal, FindTask,
  25.                         TaskPtr, Byte, FreeMem, MemReqs, MemReqSet,
  26.                         SetTaskPri, SetFunction;
  27. FROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO;
  28. FROM Graphics    IMPORT BitMap, BltBitMap, SimpleSprite, GetSprite, SetRGB4,
  29.                         ChangeSprite, MoveSprite, FreeSprite, WaitBlit,
  30.                         GfxBasePtr, ViewModes, LayerPtr, ViewPortPtr,
  31.                         SimpleSpritePtr, ScrollVPort, UCopListPtr, CWait,
  32.                         CMove, CBump, FreeCopList;
  33. FROM Hardware    IMPORT vertb, custom;
  34. FROM Heap        IMPORT AllocMem;
  35. FROM Icon        IMPORT GetDiskObject, FreeDiskObject, FindToolType,
  36.                         MatchToolValue;
  37. FROM Input       IMPORT inputName, addHandler, remHandler;
  38. FROM InputEvent  IMPORT InputEvent, InputEventPtr, Class, lButton, lAlt,
  39.                         lCommand, rCommand;
  40. FROM Intuition   IMPORT ScreenPtr, MakeScreen, RethinkDisplay, NewWindow,
  41.                         WindowFlags, WindowFlagSet, ScreenFlags, CloseWindow,
  42.                         ScreenFlagSet, IDCMPFlagSet, OpenWindow, WindowPtr,
  43.                         IntuitionBase, GetPrefs, Preferences, GadgetPtr,
  44.                         sizing, wDragging, GadgetFlags;
  45. FROM Layers      IMPORT WhichLayer;
  46. FROM Workbench   IMPORT DiskObjectPtr;
  47. IMPORT Exec, Intuition, Graphics;
  48.  
  49. (*------  CONSTS:  ------*)
  50.  
  51. CONST
  52.   WindowTitle = "MegaWB © 1989 Fridtjof Siebert / AMOK Stuttgart";
  53.   PortName    = "NewWBPlanes[fbs].Port";
  54.   ReplyName   = "NewWBPlanes[fbs].ReplyPort";
  55.   Usage       = "Usage: MegaWB [p] [width height]";
  56.   TooSmall    = "Can't shrink Workbenchscreen";
  57.   tTWidth     = "WIDTH";
  58.   tTHeight    = "HEIGHT";
  59.   tTProp      = "PROP";
  60.   tTFlags     = "FLAGS";
  61.   tTErr       = "Error in Tooltypes";
  62.   oom         = "Out of memory!";
  63.   noSprites   = "No more free Sprites!";
  64.   noSignal    = "No free Signalbit";
  65.   intName     = "MegaWB.interrupt";
  66.   wins        = "U must move Windows to old WB-Area!";
  67.   MOVEMS = 48E7H;
  68.   MOVEML = 4CDFH;
  69.  
  70. (*------  TYPES:  ------*)
  71.  
  72. TYPE
  73.   SprData = POINTER TO ARRAY[0..255] OF LONGINT;
  74.  
  75.   CantQuit = (cqok,cqoom,cqwin);
  76.   MyMessage = RECORD
  77.                 msg: Message;
  78.                 cq: CantQuit;
  79.               END;
  80.   MyMessagePtr = POINTER TO MyMessage;
  81.  
  82.  
  83. (*------  VARS:  ------*)
  84.  
  85. VAR
  86.   WBS: ScreenPtr;
  87.   Window: WindowPtr;
  88.   NuWindow: NewWindow;
  89.   MyMsg: MyMessage;
  90.   QuitMessage: MyMessagePtr;
  91.   MyPort, OldPort: MsgPortPtr;
  92.   l: LONGINT;
  93.   bm,oldbm: BitMap;
  94.   iB: POINTER TO IntuitionBase;
  95.   GetSpr,EmptySprite: SprData;
  96.   SprImg: ARRAY[0..1] OF SprData;
  97.   ActSprImg: INTEGER;
  98.   sprite: SimpleSprite;
  99.   sprID: INTEGER;
  100.   oldmx,oldmy: INTEGER;
  101.   lx,ly,mx,my,i,clickX,clickY,cx,cy,rox,roy: INTEGER;
  102.   InputDevPort: MsgPortPtr;
  103.   InputRequestBlock: IOStdReqPtr;
  104.   HandlerStuff: Interrupt;
  105.   HandlerActive, InputOpen: BOOLEAN;
  106.   VertBIntr: Interrupt;
  107.   IntActive: BOOLEAN;
  108.   LMBSig: INTEGER;
  109.   Me: TaskPtr;
  110.   mxm,mym,newmxm,newmym: INTEGER;
  111.   pref: Preferences;
  112.   oldw,oldh: INTEGER;
  113.   w: WindowPtr;
  114.   SizeX,SizeY: LONGINT;
  115.   arg: ARRAY[0..79] OF CHAR;
  116.   err,b: BOOLEAN;
  117.   ev: InputEventPtr;
  118.   gfx: GfxBasePtr;
  119.   lay: LayerPtr;
  120.   lw: WindowPtr;
  121.   gdg: GadgetPtr;
  122.   Sigs: LONGSET;
  123.   gx,gy,gw,gh: INTEGER;
  124.   blitted: BOOLEAN;
  125.   OldMoveSprite: PROCEDURE();
  126.   sx,sy: INTEGER;
  127.   Proportional: BOOLEAN;
  128.   tT: POINTER TO ARRAY [0..79] OF CHAR;
  129.   MyIcon: DiskObjectPtr;
  130.   cl,altcl: UCopListPtr;
  131.  
  132. (*------  InputHandler:  ------*)
  133.  
  134. PROCEDURE MyHandler(Ev{8}: InputEventPtr): InputEventPtr; (* $S- *)
  135.  
  136. BEGIN
  137.   ev := Ev;
  138.   IF (iB^.activeScreen=WBS) AND (WBS^.mouseY>=0) THEN
  139.     WITH WBS^ DO
  140.       sx := mouseX; sy := mouseY;
  141.       cx := 0; cy := 0;
  142.       WHILE ev#NIL DO
  143.         WITH ev^ DO
  144.           IF class=rawmouse THEN
  145.             INC(cx,x); INC(cy,y);
  146.             INC(sx,x); INC(sy,y);
  147.             IF sx-rox>oldw THEN
  148.               rox := sx - oldw;
  149.               IF rox+oldw>SizeX THEN rox := SizeX-oldw END;
  150.             END;
  151.             IF sy-roy>oldh THEN
  152.               roy := sy - oldh;
  153.               IF roy+oldh>SizeY THEN roy := SizeY-oldh END;
  154.             END;
  155.             IF sx-rox<0 THEN
  156.               rox := sx;
  157.               IF rox<0 THEN rox := 0 END;
  158.             END;
  159.             IF sy-roy<0 THEN
  160.               roy := sy;
  161.               IF roy<0 THEN roy := 0 END;
  162.             END;
  163.           END;
  164.           IF (class=rawmouse) AND (code=lButton+128) OR (class=rawkey) AND (code>=128) THEN (* LMB released *)
  165.             newmxm := width - 1; newmym := height + topEdge - 1;
  166.             IF lace  IN viewPort.modes THEN mym := newmym ELSE mym := 2*newmym END;
  167.             IF hires IN viewPort.modes THEN mxm := newmxm ELSE mxm := 2*newmxm END;
  168.           ELSIF (class=rawmouse) AND (code=lButton) OR (class=rawkey) AND (code<128) AND (lAlt IN qualifier) AND ((lCommand IN qualifier) OR (rCommand IN qualifier)) THEN (* LMB pressed *)
  169.             clickX := mouseX; clickY := mouseY;
  170.             IF lace  IN viewPort.modes THEN INC(clickY,cy) ELSE INC(clickY,cy DIV 2) END;
  171.             IF hires IN viewPort.modes THEN INC(clickX,cx) ELSE INC(clickX,cx DIV 2) END;
  172.             IF clickY<0 THEN clickY := 0 END;
  173.             IF clickX<0 THEN clickX := 0 END;
  174.             IF clickY>=height THEN clickY := height-1 END;
  175.             IF clickX>=width  THEN clickX := width -1 END;
  176.             IF lace  IN viewPort.modes THEN mym := clickY+topEdge ELSE mym := 2*(clickY+topEdge) END;
  177.             IF hires IN viewPort.modes THEN mxm := clickX ELSE mxm := 2*clickX END;
  178.             Signal(Me,LONGSET{LMBSig});
  179.           END;
  180.           ev := nextEvent;
  181.         END;
  182.       END;
  183.     END;
  184.     WITH iB^ DO maxXMouse := mxm; maxYMouse := mym END;
  185.   END;
  186.   RETURN Ev;
  187. END MyHandler; (* $S+ *)
  188.  
  189. (*------  VertB-Interrupt:  ------*)
  190.  
  191. PROCEDURE MyIntProc(); (* $S- *)
  192.  
  193. BEGIN
  194.   INLINE(MOVEMS,3F3EH); (* this is MOVEM d2-d7/a2-a6,-(sp) *)
  195.  
  196.   IF (iB^.activeScreen = WBS) AND (WBS^.mouseY>=0) THEN
  197.     WITH iB^ DO
  198.       maxXMouse := mxm;
  199.       maxYMouse := mym;
  200.       IF aPointer#GetSpr THEN
  201.         ActSprImg := 1-ActSprImg;
  202.         GetSpr := aPointer;
  203.         SprImg[ActSprImg]^ := GetSpr^;
  204.         sprite.height := aPtrHeight;
  205.         ChangeSprite(ADR(WBS^.viewPort),ADR(sprite),SprImg[ActSprImg]);
  206.       END;
  207.     END;
  208.     IF (WBS^.mouseX#lx) OR (WBS^.mouseY#ly) THEN
  209.       lx := WBS^.mouseX; ly := WBS^.mouseY;
  210.       IF (ly>=0) AND (lx>=0) AND (ly<SizeY) AND (lx<SizeX) THEN
  211.         WITH WBS^.viewPort.rasInfo^ DO
  212.           IF Proportional THEN
  213.             rxOffset := LONGINT(lx+1) * LONGINT(SizeX - oldw) DIV SizeX;
  214.             ryOffset := LONGINT(ly+1) * LONGINT(SizeY - oldh) DIV SizeY;
  215.             mx := lx - rxOffset;
  216.             my := ly - ryOffset;
  217.             ScrollVPort(ADR(WBS^.viewPort));
  218.           ELSE
  219.             IF (rox#rxOffset) OR (roy#ryOffset) OR (rox=-1)THEN
  220.               IF rox=-1 THEN rox := 0 END;
  221.               rxOffset := rox;
  222.               ryOffset := roy;
  223.               ScrollVPort(ADR(WBS^.viewPort));
  224.             END;
  225.             mx := lx - rox;
  226.             my := ly - roy;
  227.           END;
  228.           IF hires IN WBS^.viewPort.modes THEN
  229.             INC(mx,2*ORD(CAST(Byte,iB^.aXOffset)));
  230.           ELSE
  231.             INC(mx,ORD(CAST(Byte,iB^.aXOffset)));
  232.           END;
  233.           IF lace  IN WBS^.viewPort.modes THEN
  234.             INC(my,2*ORD(CAST(Byte,iB^.aYOffset)));
  235.           ELSE
  236.             INC(my,ORD(CAST(Byte,iB^.aYOffset)));
  237.           END;
  238.           MoveSprite(ADR(WBS^.viewPort),ADR(sprite),mx,my);
  239.         END;
  240.       END;
  241.     END;
  242.   ELSE
  243.     sprite.height := 1;
  244.     ChangeSprite(ADR(WBS^.viewPort),ADR(sprite),EmptySprite);
  245.     GetSpr := NIL;
  246.   END;
  247.  
  248.   INLINE(MOVEML,7CFCH); (* this is MOVEM (sp)+,d2-d7/a2-a6 *)
  249. END MyIntProc; (* $S+ *)
  250.  
  251. (*------  Neue MoveSprite() Funktion:  ------*)
  252.  
  253. (* $S- *)
  254. PROCEDURE MyMoveSprite(vp{8}:ViewPortPtr; sprite{9}:SimpleSpritePtr; x{0},y{1}:INTEGER);
  255. BEGIN
  256.   INLINE(MOVEMS,3F3EH);
  257.   IF (sprite^.num=0) AND (iB^.activeScreen=WBS) AND (WBS^.mouseY>=0) THEN
  258.     x := -32;
  259.   END;
  260.   OldMoveSprite();
  261.   INLINE(MOVEML,7CFCH);
  262. END MyMoveSprite;
  263. (* $S+ *)
  264.  
  265. (*------  CleanUp:  ------*)
  266.  
  267. PROCEDURE CleanUp();
  268.  
  269. BEGIN
  270.  
  271. (*------  Remove Inputhandler:  ------*)
  272.  
  273.   IF HandlerActive THEN
  274.     WITH InputRequestBlock^ DO
  275.       command := remHandler;
  276.       data := ADR(HandlerStuff);
  277.     END;
  278.     DoIO(InputRequestBlock);
  279.   END;
  280.   IF InputRequestBlock#NIL THEN DeleteStdIO(InputRequestBlock) END;
  281.   IF InputDevPort#NIL THEN DeletePort(InputDevPort) END;
  282.  
  283. (*------  Remove Interrupt:  ------*)
  284.  
  285.   IF IntActive THEN RemIntServer(vertb,ADR(VertBIntr)) END;
  286.  
  287. (*------  Remove Copperlist:  ------*)
  288.  
  289.   IF cl#NIL THEN
  290.     FreeCopList(cl^.firstCopList);
  291.     WBS^.viewPort.uCopIns:=altcl;
  292.   END;
  293.  
  294. (*------  Reset Workbench:  ------*)
  295.  
  296.   IF WBS#NIL THEN
  297.     WITH oldbm DO
  298.       l := 0;
  299.       WHILE l<LONGINT(depth) DO
  300.         IF planes[l]=NIL THEN
  301.           planes[l] := Exec.AllocMem(LONGINT(rows)*LONGINT(bytesPerRow),MemReqSet{chip,memClear});
  302.           IF planes[l]=NIL THEN depth := l END;
  303.         END;
  304.         INC(l);
  305.       END;
  306.     END;
  307. (* Korn, Bier, Schnaps und Wein *)
  308.     Forbid();
  309.       WITH WBS^ DO
  310.         width := oldw;
  311.         height := oldh;
  312.         bitMap := oldbm;
  313.         IF blitted THEN
  314.           l := BltBitMap(ADR(bm),0,0,ADR(bitMap),0,0,oldw,oldh,0C0H,3,NIL);
  315.         END;
  316.         WITH viewPort.rasInfo^ DO rxOffset := 0; ryOffset := 0 END;
  317.       END;
  318. (* und wir hören unsere Leber Schrein. *)
  319.       IF oldmy#0 THEN
  320.         WITH iB^ DO maxXMouse := oldmx; maxYMouse := oldmy END;
  321.       END;
  322.       MakeScreen(WBS);
  323.     Permit();
  324.     RethinkDisplay();
  325.   END;
  326.  
  327. (*------  Close everything:  ------*)
  328.  
  329.   IF OldMoveSprite#NIL THEN
  330.     OldMoveSprite := SetFunction(ADR(Graphics),-426,CAST(ADDRESS,OldMoveSprite));
  331.   END;
  332. (* Doch eins das wissen wir ganz genau: *)
  333.   IF Window#NIL THEN CloseWindow(Window) END;
  334.   IF sprID#-1 THEN FreeSprite(sprID) END;
  335.   IF LMBSig#-1 THEN FreeSignal(LMBSig) END;
  336.  
  337. (*------  Remove Port:  ------*)
  338.  
  339.   IF MyPort#NIL THEN
  340.     Forbid();
  341.       IF QuitMessage=NIL THEN QuitMessage := GetMsg(MyPort) END;
  342.       WHILE QuitMessage#NIL DO
  343.         IF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqok END;
  344. (* Ohne Alk da wäre der Alltag so grau! *)
  345.         ReplyMsg(QuitMessage);
  346.         QuitMessage := GetMsg(MyPort);
  347.       END;
  348.       DeletePort(MyPort);
  349. (* (ich war Montag auf dem Hosen Konzert!) *)
  350.     Permit();
  351.   END;
  352.  
  353. END CleanUp;
  354.  
  355. (*------  MAIN:  ------*)
  356.  
  357. BEGIN
  358.  
  359. (*------  Initialization:  ------*)
  360.  
  361.   WBS := NIL; Window := NIL; MyPort := NIL; blitted := FALSE;
  362.   sprID := -1; InputDevPort := NIL; InputRequestBlock := NIL;
  363.   HandlerActive := FALSE; InputOpen := FALSE; OldMoveSprite := NIL;
  364.   SizeX := 1024; SizeY := 512; LMBSig := -1; oldmy := 0; cl := NIL;
  365.  
  366.   iB  := ADR(Intuition);
  367.   gfx := ADR(Graphics);
  368.  
  369.   TermProcedure(CleanUp);
  370.  
  371. (*------  Have we already been started?  ------*)
  372.  
  373.   OldPort := FindPort(ADR(PortName));
  374.   IF OldPort#NIL THEN
  375.     MyPort := CreatePort(ADR(ReplyName),0);
  376.     Assert(MyPort#NIL,ADR(oom));
  377.     MyMsg.msg.node.type := message;
  378.     MyMsg.msg.replyPort := MyPort;
  379.     MyMsg.msg.length := 1;
  380.     PutMsg(OldPort,ADR(MyMsg)); (* Signal task to quit *)
  381.     WaitPort(MyPort);
  382.     DeletePort(MyPort);
  383.     MyPort := NIL;
  384.     CASE MyMsg.cq OF
  385.     cqoom: Assert(FALSE,ADR(oom)) |
  386.     cqwin: Assert(FALSE,ADR(wins)) |
  387.     ELSE Terminate(0) END;
  388.   END;
  389.   MyPort := CreatePort(ADR(PortName),0);
  390.   Assert(MyPort#NIL,ADR(oom));
  391.  
  392. (*------  Get Arguments:  ------*)
  393.  
  394.   IF wbStarted THEN
  395.     GetArg(0,arg,i);
  396.     MyIcon := GetDiskObject(ADR(arg));
  397.     IF MyIcon#NIL THEN
  398.       tT := FindToolType(MyIcon^.toolTypes,ADR(tTWidth));
  399.       IF tT#NIL THEN StrToVal(tT^,SizeX,b,10,err); Assert(NOT err,ADR(tTErr)) END;
  400.       tT := FindToolType(MyIcon^.toolTypes,ADR(tTHeight));
  401.       IF tT#NIL THEN StrToVal(tT^,SizeY,b,10,err); Assert(NOT err,ADR(tTErr)) END;
  402. (* Ein Skinhead auf der Autobahn, Hui! Da kann man prima drüberfahr! [Brieftauben] *)
  403.       tT := FindToolType(MyIcon^.toolTypes,ADR(tTFlags));
  404.       IF tT#NIL THEN
  405.         Proportional :=  MatchToolValue(tT,ADR(tTProp))#NIL;
  406.       END;
  407.       FreeDiskObject(MyIcon);
  408.     END;
  409.   ELSE
  410.     Assert(NumArgs()<4,ADR(Usage));
  411.     Proportional := FALSE;
  412.     IF ODD(NumArgs()) THEN
  413.       GetArg(1,arg,i);
  414.       Assert((CAP(arg[0])="P") AND (arg[1]=0C),ADR(Usage));
  415.       Proportional := TRUE;
  416.       l := 1;
  417.     ELSE
  418.       l := 0;
  419.     END;
  420.     IF NumArgs()>1 THEN
  421.       GetArg(l+1,arg,i); StrToVal(arg,SizeX,b,10,err); Assert(NOT err,ADR(Usage));
  422.       GetArg(l+2,arg,i); StrToVal(arg,SizeY,b,10,err); Assert(NOT err,ADR(Usage));
  423.     END;
  424.   END;
  425.  
  426. (*------  Open Window:  ------*)
  427.  
  428.   WITH NuWindow DO
  429.     leftEdge   := 0; topEdge := 0;
  430.     width      := 1; height  := 1;
  431.     idcmpFlags := IDCMPFlagSet{};
  432.     flags      := WindowFlagSet{backDrop};
  433.     firstGadget:= NIL; checkMark := NIL;
  434.     title      := ADR(WindowTitle);
  435.     screen     := NIL; bitMap    := NIL;
  436.     type       := ScreenFlagSet{wbenchScreen};
  437.   END;
  438.   Window := OpenWindow(NuWindow);
  439.   Assert(Window#NIL,ADR(oom));
  440.  
  441. (*------  Allocate Sprite:  ------*)
  442.  
  443.   AllocMem(SprImg[0],SIZE(GetSpr^),TRUE);
  444.   AllocMem(SprImg[1],SIZE(GetSpr^),TRUE);
  445.   AllocMem(EmptySprite,SIZE(EmptySprite^),TRUE);
  446.   Assert((SprImg[0]#NIL) AND (SprImg[1]#NIL),ADR(oom));
  447.   ActSprImg := 0;
  448.   sprID := GetSprite(ADR(sprite),-1);
  449.   Assert(sprID>0,ADR(noSprites));
  450.   OldMoveSprite := SetFunction(ADR(Graphics),-426,ADR(MyMoveSprite));
  451.  
  452. (*------  Signal:  ------*)
  453.  
  454.   LMBSig := AllocSignal(-1);
  455.   Assert(LMBSig#-1,ADR(noSignal));
  456.   Me := FindTask(NIL);
  457.   IF SetTaskPri(Me,2)=0 THEN END; (* I'm responsible for quick WBDisplay! *)
  458.  
  459. (*------  Resize Workbench:  ------*)
  460.  
  461.   GetPrefs(ADR(pref),SIZE(Preferences));
  462.   WITH Window^.wScreen^ DO
  463.     oldbm:= bitMap;
  464.     bm   := oldbm;
  465.     oldw := width;
  466.     oldh := height;
  467.     Assert((SizeX>=oldw) AND (SizeY>=oldh),ADR(TooSmall));
  468.   END;
  469.   WITH bm DO
  470.     rows := SizeY;
  471.     bytesPerRow := ((SizeX+15) DIV 16) * 2;
  472.     FOR l:=0 TO depth-1 DO
  473.       AllocMem(planes[l],LONGINT(rows+10)*LONGINT(bytesPerRow),TRUE);
  474.       Assert(planes[l]#NIL,ADR(oom));
  475.     END;
  476.   END;
  477.   WBS := Window^.wScreen;
  478.   Forbid();
  479.   WaitBlit();
  480.   WITH WBS^ DO
  481.     l := BltBitMap(ADR(oldbm),0,0,ADR(bm),0,0,width,height,0C0H,3,NIL);
  482.     blitted := TRUE;
  483.     bitMap := bm;
  484.     oldw := width; oldh := height; width := SizeX; height := SizeY;
  485.     MakeScreen(WBS);
  486.     WITH oldbm DO
  487.       l := 0;
  488.       WHILE l<LONGINT(depth) DO
  489.         FreeMem(planes[l],LONGINT(rows)*LONGINT(bytesPerRow));
  490.         planes[l] := NIL;
  491.         INC(l);
  492.       END;
  493.     END;
  494.     WITH iB^ DO
  495.       oldmx := maxXMouse;
  496.       oldmy := maxYMouse;
  497.       Permit();
  498.       IF l>1 THEN
  499.         l := (sprID DIV 2) * 4 + 16;
  500.         WITH pref DO
  501.           SetRGB4(ADR(viewPort),l+1,
  502.             CAST(INTEGER,CAST(BITSET,color17)*{8..11}) DIV 256,
  503.             CAST(INTEGER,CAST(BITSET,color17)*{4.. 7}) DIV 16,
  504.             CAST(INTEGER,CAST(BITSET,color17)*{0.. 3}));
  505.           SetRGB4(ADR(viewPort),l+2,
  506.             CAST(INTEGER,CAST(BITSET,color18)*{8..11}) DIV 256,
  507.             CAST(INTEGER,CAST(BITSET,color18)*{4.. 7}) DIV 16,
  508.             CAST(INTEGER,CAST(BITSET,color18)*{0.. 3}));
  509.           SetRGB4(ADR(viewPort),l+3,
  510.             CAST(INTEGER,CAST(BITSET,color19)*{8..11}) DIV 256,
  511.             CAST(INTEGER,CAST(BITSET,color19)*{4.. 7}) DIV 16,
  512.             CAST(INTEGER,CAST(BITSET,color19)*{0.. 3}));
  513.         END;
  514.       END;
  515.       sprite.x := 0;
  516.       sprite.y := 0;
  517.       sprite.height := aPtrHeight;
  518.       GetSpr := aPointer;
  519.       SprImg[ActSprImg]^ := GetSpr^;
  520.     END;
  521.     ChangeSprite(ADR(viewPort),ADR(sprite),SprImg[ActSprImg]);
  522.   END;
  523.  
  524. (*------  Create Copperlist:  ------*)
  525.  
  526.   altcl:=WBS^.viewPort.uCopIns;
  527.   AllocMem(cl,SIZE(cl^),TRUE);
  528.   Assert(cl#NIL,ADR(oom));
  529.   CMove(cl,ADR(custom.dmacon),CAST(INTEGER,8100H)); CBump(cl); (* Bitplane-DMA ein *)
  530.   CWait(cl,oldh,0); CBump(cl);
  531.   CMove(cl,ADR(custom.dmacon),0100H); CBump(cl); (* Bitplane-DMA aus *)
  532.   CWait(cl, 10000, 255); CBump(cl);
  533.   WBS^.viewPort.uCopIns:=cl;
  534.   RethinkDisplay();
  535.  
  536. (*------  Add Inputhandler:  ------*)
  537.  
  538.   InputDevPort := CreatePort(NIL,0);
  539.   Assert(InputDevPort#NIL,ADR(oom));
  540.  
  541.   InputRequestBlock := CreateStdIO(InputDevPort);
  542.   Assert(InputRequestBlock#NIL,ADR(oom));
  543.  
  544.   OpenDevice(ADR(inputName),0,InputRequestBlock,LONGSET{});
  545.   IF InputRequestBlock^.error#0 THEN Terminate(0) END;
  546.   InputOpen := TRUE;
  547.  
  548.   WITH HandlerStuff DO
  549.     data := NIL;
  550.     code := ADR(MyHandler);
  551.     node.pri := 51;
  552.   END;
  553.   WITH InputRequestBlock^ DO
  554.     command := addHandler;
  555.     data := ADR(HandlerStuff);
  556.   END;
  557.   DoIO(InputRequestBlock);
  558.   HandlerActive := TRUE;
  559.  
  560. (*------  Interrupt starten:  ------*)
  561.  
  562.   WITH VertBIntr DO
  563.     node.type := interrupt;
  564.     node.pri  := 0;
  565.     node.name := ADR(intName);
  566.     data := NIL;
  567.     code := MyIntProc;
  568.   END;
  569.   AddIntServer(vertb,ADR(VertBIntr));
  570.   IntActive := TRUE;
  571.  
  572. (*------  Do it:  ------*)
  573.  
  574.   lx := -1; ly := -1; rox := -1; roy := 0;
  575.   WITH WBS^ DO
  576.     mxm := width-1; mym := height-1;
  577.     IF NOT(lace  IN viewPort.modes) THEN INC(mym,mym) END;
  578.     IF NOT(hires IN viewPort.modes) THEN INC(mxm,mxm) END;
  579.   END;
  580.   LOOP
  581.     REPEAT
  582.       Sigs := Wait(LONGSET{MyPort^.sigBit,LMBSig});
  583.       IF LMBSig IN Sigs THEN
  584.         lay:= WhichLayer(ADR(WBS^.layerInfo),clickX,clickY);
  585.         IF (lay#NIL) THEN
  586.           IF lay^.window=NIL THEN  (* Screentitlebar *)
  587.             newmxm := WBS^.width - 1;
  588.             IF clickY<12 THEN newmym := oldh - 1 ELSE newmym := WBS^.height - 1 END;
  589.           ELSE
  590.             lw := lay^.window;
  591.             WITH lw^ DO
  592.               gdg:= firstGadget; DEC(clickX,leftEdge); DEC(clickY,topEdge);
  593.             END;
  594.             LOOP
  595.               IF gdg=NIL THEN
  596.                 WITH WBS^ DO
  597.                   newmxm := width  - 1;
  598.                   newmym := height - 1;
  599.                   EXIT;
  600.                 END;
  601.               END;
  602.               WITH gdg^ DO
  603.                 gy := topEdge;  IF gRelBottom IN flags THEN INC(gy,lw^.height) END;
  604.                 gx := leftEdge; IF gRelRight  IN flags THEN INC(gx,lw^.width ) END;
  605.                 gh := height;   IF gRelHeight IN flags THEN INC(gh,lw^.height) END;
  606.                 gw := width;    IF gRelWidth  IN flags THEN INC(gw,lw^.width ) END;
  607.                 IF (gx<=clickX) AND (gy<=clickY) AND (gx+gw>clickX) AND (gy+gh>clickY) THEN
  608.                   CASE CAST(INTEGER,CAST(BITSET,gadgetType)*{4..7}) OF
  609.                   sizing:
  610.                     WITH lw^ DO
  611.                       IF maxWidth#-1 THEN
  612.                         newmxm := leftEdge + maxWidth + clickX - width;
  613.                         IF newmxm>=WBS^.width THEN newmxm := WBS^.width - width + clickX END;
  614.                       ELSE
  615.                         newmxm := WBS^.width - width + clickX;
  616.                       END;
  617.                       IF maxHeight#-1 THEN
  618.                         newmym := topEdge + maxHeight + clickY - height;
  619.                         IF newmym>=WBS^.height THEN newmym := WBS^.height - height + clickY END;
  620.                       ELSE
  621.                         newmym := WBS^.height - height + clickY;
  622.                       END;
  623.                     END;
  624.                     INC(newmym,WBS^.topEdge);
  625.                     EXIT |
  626.                   wDragging:
  627.                     WITH WBS^ DO
  628.                       newmxm := width  - lw^.width  + clickX;
  629.                       newmym := height - lw^.height + clickY + topEdge;
  630.                     END;
  631.                     EXIT |
  632.                   ELSE END;
  633.                 END;
  634.                 gdg := nextGadget;
  635.               END;
  636.             END;
  637.           END;
  638.           WITH WBS^.viewPort DO
  639.             IF lace  IN modes THEN mym := newmym ELSE mym := 2*newmym END;
  640.             IF hires IN modes THEN mxm := newmxm ELSE mxm := 2*newmxm END;
  641.           END;
  642.         END;
  643.       END;
  644.       QuitMessage := GetMsg(MyPort);
  645.     UNTIL QuitMessage#NIL;
  646.  
  647.     Forbid();
  648.     w := WBS^.firstWindow;
  649.     WHILE LONGCARD(w)>1 DO
  650.       WITH w^ DO
  651.         IF (width+leftEdge>oldw) OR (height+topEdge>oldh) THEN
  652.           w := WindowPtr(1);
  653.         ELSE
  654.           w := nextWindow;
  655.         END;
  656.       END;
  657.     END;
  658.     Permit();
  659.  
  660.     IF w=NIL THEN
  661.       WITH oldbm DO
  662.         IF planes[0]=NIL THEN
  663.           planes[0] := Exec.AllocMem(LONGINT(rows)*LONGINT(bytesPerRow),MemReqSet{chip,memClear});
  664.           IF planes[0]#NIL THEN EXIT ELSIF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqoom END;
  665.         END;
  666.       END;
  667.     ELSIF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqwin END;
  668.  
  669.     ReplyMsg(QuitMessage);
  670.     QuitMessage := NIL;
  671.   END;
  672.  
  673. END MegaWB.
  674.