Amiga-Request@cs.odu.edu (Amiga Sources/Binaries Moderator) (02/01/90)
Submitted-by: amichel@neabbs.uucp
Posting-number: Volume 90, Issue 034
Archive-name: workbench/megawb-1.2
This Program makes it possible to make your Workbenchscreen as large as
you like! All the problems you've had with programs like TurboBackup,
KwikBackUp, AudioMaster etc. are gone now. You can easily drag their
Window away or use the Workbench area around them!
uucp: hp4nl!neabbs!amichel@nluug.nl | bix: tmpda
#!/bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 1 (of 1)."
# Contents: MegaWB.ReadMe.info.uu MegaWB.Readme MegaWB.mod
# MegaWB.mod.info.uu
# Wrapped by tadguy@xanth on Wed Jan 31 21:27:53 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'MegaWB.ReadMe.info.uu' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MegaWB.ReadMe.info.uu'\"
else
echo shar: Extracting \"'MegaWB.ReadMe.info.uu'\" \(1041 characters\)
sed "s/^X//" >'MegaWB.ReadMe.info.uu' <<'END_OF_FILE'
Xbegin 664 MegaWB.ReadMe.info
XMXQ```0``````TP`4`#``&``&``,``0`GP:``)\@P````````````````````4
XM````!"8`)[_0`````````+,````5```````````````````````P`!@``@`!S
XM[#`#```````!5555```!5555$``!5555%``!5555%0`!5555%4`!5555```!N
XM555555`!555555`!555555`!555555`!555555`!555555`!555555`!5555"
XM55`!555555`!555555`!555555`!555555`!555555`!555555`!555555`!I
XM555555`!555555``````````````````````````````````````````````)
XM`````````````````````````````````````````````````````````````
XM`````````````````````````````````````````````````````````````
XM`````````````````````````````````````````#``&``"``'M4`,`````+
XM``%5554```%55540``%55544``%55545``%555450`%5554```%555554`%5)
XM55554`%555554`%555554`%555554`%555554`%555554`%?]555\`%_]5556
XM\`'______P/______P______\#_7______]7_____P%555554`%555554`%5I
XM55554```````````````````````````````````````````````````````/
XM```````````````````````````````````````````````````````````//
XMX```X``_X```X`#_[_[^_P/[[_[^_P__[_[NX#^#_N____X#_N___P``````R
XC``````````````````````````````PZ8R]-=6-H36]R90`#[
X``
Xend
Xsize 710
END_OF_FILE
if test 1041 -ne `wc -c <'MegaWB.ReadMe.info.uu'`; then
echo shar: \"'MegaWB.ReadMe.info.uu'\" unpacked with wrong size!
fi
# end of 'MegaWB.ReadMe.info.uu'
fi
if test -f 'MegaWB.Readme' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MegaWB.Readme'\"
else
echo shar: Extracting \"'MegaWB.Readme'\" \(4452 characters\)
sed "s/^X//" >'MegaWB.Readme' <<'END_OF_FILE'
X
X
X M e g a W B
X =================
X
X
X (c) 1988 by Fridtjof Siebert
X Nobileweg 67
X 7000 Stuttgart 40
X
X
X
XDescription:
X
X
X This Program makes it possible to make your Workbenchscreen as large as
X you like! All the problems you've had with programs like TurboBackup,
X KwikBackUp, AudioMaster etc. are gone now. You can easily drag their
X Window away or use the Workbench area around them!
X
X To be able to use the hole Workbench, it scrolls everytime you move the
X mouse.
X
X There are two different methods to scroll the Workbenchscreen. You can
X select proportional scrolling. Then your workbench will scroll anytime
X you move the mouse. If you don't select this mode, the workbench scrolls
X everytime the pointer hits the Workbench's edges.
X
X
XHow to use it:
X
X You can start MegaWB by doubleclicking its Icon or by typing its name
X into your CLI window.
X
X Usage: MegaWB [P] [WIDTH HEIGHT]
X
X
X The Option "P" selects proportional mode.
X
X WIDTH and HEIGHT specify the size your Workbench should have. If you
X start MegaWB without specifying the size, it'll create a 1024 x 512
X pixels large Workbench.
X
X Example: MegaWB P 800 400
X
X
X If you start MegaWB by clicking it's Icon, it'll read its parameters from
X the toolTypes of its Icon. The ToolTypes "WIDTH" and "HEIGHT" specify the
X Workbench's size. IF you set "PROP" in the "FLAGS"-ToolType, your
X Workbench will scroll proportionally to your mousemovements.
X
X Example:
X
X FLAGS=PROP
X WIDTH=1024
X HEIGHT=512
X
X The Workbench's width and height shouldn't be higher than 1024, 'cause
X that's the maximum size of a bitmap blitter can handle. If your workbench
X is too large, you may accidentally make a window higher or wider than
X 1024 Pixels. This causes strange things to happen.
X
X If you start MegaWB within your Startup-Sequence ("RunBack MegaWB 800
X 400"), before you execute LoadWB, the Workbenchwindow will be as big as
X your Workbench. Then the Disk-Icons will appear at the very right border
X of your MegaWB-Screen.
X
X
XHow to quit MegaWB:
X
X
X To get back your ancient Workbench, just start MegaWB once again. You
X have to have smallened all your Windows and have moved them to the upper
X left corner of the Workbench, else MegaWB won't quit. If there isn't
X enough Chip-Memory available to allocate the original Workbench's BitMap,
X MegaWB won't quit or will open a 1 plane deep Workbench.
X
X
XTricks:
X
X MegaWB starts to be really funny when you've installed Mathew Dillon's
X DMouse (Fish-Disk 145, 160 and 168). Then you can scroll through your
X great Workbench with an accelerated mousepointer. To use DMouse
X together with MegaWB, you have to set DMouse's Inputhandler-priority to a
X value higher than MegaWB's, i.e. at least 52.
X
X It's very useful to have a memory extension (more than 1MB), because a
X 1024 x 1024 pixel large Workbench eats 256 KB!
X
X My favorite Workbenchsize is 704 x 1024 (I use an overscan 704x278
X Workbench). This way I am able to use several texteditors (DME's) and I
X can put them directly above each other.
X
X
XBugs:
X
X The large Workbench doesn't have any ScreenDepth-Gadgets. I never use the
X Workbench's ScreenDepth-Gadgets, that's why I didn't even try to remove
X this bug. Just use C=-M and C=-N!
X
X Some programs are not written to run on a very large workbench so they
X get a bit confused if you make their windows bigger than the size of the
X original Workbenchscreen.
X
X It is sometime possible to drag a window one pixel over the
X Workbenchscreen's right border. This trashes the display a bit but
X doesn't cause any serious problems.
X
X
XCopyright:
X
X MegaWB is Public Domain. It is free to be copied and to be given to other
X Amiga-Users. The only limitation is that you have to leave my Name in the
X program, in its source and in the documentation files.
X
X Who makes any changes in the program is allowed to add his name in the
X programs head, but he mustn't remove my name. I think that it would be
X good if anybody who has made any improvements or has any suggestions
X sends them to me.
X
X If there's anyone who would send a Shareware-fee to me if this program
X was ShareWare, he can do this anyway. He can decide which amount he'd
X like to send. I'm not only interested in money, but also (maybe even
X more) in new and good public domain software.
X
X
X--- Fridtjof.
X
END_OF_FILE
if test 4452 -ne `wc -c <'MegaWB.Readme'`; then
echo shar: \"'MegaWB.Readme'\" unpacked with wrong size!
fi
# end of 'MegaWB.Readme'
fi
if test -f 'MegaWB.mod' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MegaWB.mod'\"
else
echo shar: Extracting \"'MegaWB.mod'\" \(21555 characters\)
sed "s/^X//" >'MegaWB.mod' <<'END_OF_FILE'
X(*---------------------------------------------------------------------------
X :Program. MegaWB.mod
X :Author. Fridtjof Siebert
X :Address. Nobileweg 67, D-7-Stgt-40
X :Shortcut. [fbs]
X :Version. 1.2
X :Date. 17-Mar-89
X :Copyright. PD
X :Language. Modula-II
X :Translator. M2Amiga v3.1d
X :Contents. Program to create a 1024 x 512 pixels large Workbench!
X---------------------------------------------------------------------------*)
X
XMODULE MegaWB;
X
XFROM SYSTEM IMPORT ADR, ADDRESS, LONGSET, CAST, BITSET, INLINE, SETREG;
XFROM Arts IMPORT Assert, TermProcedure, Terminate, wbStarted;
XFROM Arguments IMPORT NumArgs, GetArg;
XFROM Conversions IMPORT StrToVal;
XFROM Exec IMPORT Forbid, Permit, FindPort, MsgPortPtr, NodeType,
X Message, MessagePtr, GetMsg, ReplyMsg, PutMsg,
X WaitPort, IOStdReq, Interrupt, IOStdReqPtr, DoIO,
X OpenDevice, CloseDevice, AddIntServer, RemIntServer,
X AllocSignal, FreeSignal, Wait, Signal, FindTask,
X TaskPtr, Byte, FreeMem, MemReqs, MemReqSet,
X SetTaskPri, SetFunction;
XFROM ExecSupport IMPORT CreatePort, DeletePort, CreateStdIO, DeleteStdIO;
XFROM Graphics IMPORT BitMap, BltBitMap, SimpleSprite, GetSprite, SetRGB4,
X ChangeSprite, MoveSprite, FreeSprite, WaitBlit,
X GfxBasePtr, ViewModes, LayerPtr, ViewPortPtr,
X SimpleSpritePtr, ScrollVPort, UCopListPtr, CWait,
X CMove, CBump, FreeCopList;
XFROM Hardware IMPORT vertb, custom;
XFROM Heap IMPORT AllocMem;
XFROM Icon IMPORT GetDiskObject, FreeDiskObject, FindToolType,
X MatchToolValue;
XFROM Input IMPORT inputName, addHandler, remHandler;
XFROM InputEvent IMPORT InputEvent, InputEventPtr, Class, lButton, lAlt,
X lCommand, rCommand;
XFROM Intuition IMPORT ScreenPtr, MakeScreen, RethinkDisplay, NewWindow,
X WindowFlags, WindowFlagSet, ScreenFlags, CloseWindow,
X ScreenFlagSet, IDCMPFlagSet, OpenWindow, WindowPtr,
X IntuitionBase, GetPrefs, Preferences, GadgetPtr,
X sizing, wDragging, GadgetFlags;
XFROM Layers IMPORT WhichLayer;
XFROM Workbench IMPORT DiskObjectPtr;
XIMPORT Exec, Intuition, Graphics;
X
X(*------ CONSTS: ------*)
X
XCONST
X WindowTitle = "MegaWB (c) 1989 Fridtjof Siebert / AMOK Stuttgart";
X PortName = "NewWBPlanes[fbs].Port";
X ReplyName = "NewWBPlanes[fbs].ReplyPort";
X Usage = "Usage: MegaWB [p] [width height]";
X TooSmall = "Can't shrink Workbenchscreen";
X tTWidth = "WIDTH";
X tTHeight = "HEIGHT";
X tTProp = "PROP";
X tTFlags = "FLAGS";
X tTErr = "Error in Tooltypes";
X oom = "Out of memory!";
X noSprites = "No more free Sprites!";
X noSignal = "No free Signalbit";
X intName = "MegaWB.interrupt";
X wins = "U must move Windows to old WB-Area!";
X MOVEMS = 48E7H;
X MOVEML = 4CDFH;
X
X(*------ TYPES: ------*)
X
XTYPE
X SprData = POINTER TO ARRAY[0..255] OF LONGINT;
X
X CantQuit = (cqok,cqoom,cqwin);
X MyMessage = RECORD
X msg: Message;
X cq: CantQuit;
X END;
X MyMessagePtr = POINTER TO MyMessage;
X
X
X(*------ VARS: ------*)
X
XVAR
X WBS: ScreenPtr;
X Window: WindowPtr;
X NuWindow: NewWindow;
X MyMsg: MyMessage;
X QuitMessage: MyMessagePtr;
X MyPort, OldPort: MsgPortPtr;
X l: LONGINT;
X bm,oldbm: BitMap;
X iB: POINTER TO IntuitionBase;
X GetSpr,EmptySprite: SprData;
X SprImg: ARRAY[0..1] OF SprData;
X ActSprImg: INTEGER;
X sprite: SimpleSprite;
X sprID: INTEGER;
X oldmx,oldmy: INTEGER;
X lx,ly,mx,my,i,clickX,clickY,cx,cy,rox,roy: INTEGER;
X InputDevPort: MsgPortPtr;
X InputRequestBlock: IOStdReqPtr;
X HandlerStuff: Interrupt;
X HandlerActive, InputOpen: BOOLEAN;
X VertBIntr: Interrupt;
X IntActive: BOOLEAN;
X LMBSig: INTEGER;
X Me: TaskPtr;
X mxm,mym,newmxm,newmym: INTEGER;
X pref: Preferences;
X oldw,oldh: INTEGER;
X w: WindowPtr;
X SizeX,SizeY: LONGINT;
X arg: ARRAY[0..79] OF CHAR;
X err,b: BOOLEAN;
X ev: InputEventPtr;
X gfx: GfxBasePtr;
X lay: LayerPtr;
X lw: WindowPtr;
X gdg: GadgetPtr;
X Sigs: LONGSET;
X gx,gy,gw,gh: INTEGER;
X blitted: BOOLEAN;
X OldMoveSprite: PROCEDURE();
X sx,sy: INTEGER;
X Proportional: BOOLEAN;
X tT: POINTER TO ARRAY [0..79] OF CHAR;
X MyIcon: DiskObjectPtr;
X cl,altcl: UCopListPtr;
X
X(*------ InputHandler: ------*)
X
XPROCEDURE MyHandler(Ev{8}: InputEventPtr): InputEventPtr; (* $S- *)
X
XBEGIN
X ev := Ev;
X IF (iB^.activeScreen=WBS) AND (WBS^.mouseY>=0) THEN
X WITH WBS^ DO
X sx := mouseX; sy := mouseY;
X cx := 0; cy := 0;
X WHILE ev#NIL DO
X WITH ev^ DO
X IF class=rawmouse THEN
X INC(cx,x); INC(cy,y);
X INC(sx,x); INC(sy,y);
X IF sx-rox>oldw THEN
X rox := sx - oldw;
X IF rox+oldw>SizeX THEN rox := SizeX-oldw END;
X END;
X IF sy-roy>oldh THEN
X roy := sy - oldh;
X IF roy+oldh>SizeY THEN roy := SizeY-oldh END;
X END;
X IF sx-rox<0 THEN
X rox := sx;
X IF rox<0 THEN rox := 0 END;
X END;
X IF sy-roy<0 THEN
X roy := sy;
X IF roy<0 THEN roy := 0 END;
X END;
X END;
X IF (class=rawmouse) AND (code=lButton+128) OR (class=rawkey) AND (code>=128) THEN (* LMB released *)
X newmxm := width - 1; newmym := height + topEdge - 1;
X IF lace IN viewPort.modes THEN mym := newmym ELSE mym := 2*newmym END;
X IF hires IN viewPort.modes THEN mxm := newmxm ELSE mxm := 2*newmxm END;
X 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 *)
X clickX := mouseX; clickY := mouseY;
X IF lace IN viewPort.modes THEN INC(clickY,cy) ELSE INC(clickY,cy DIV 2) END;
X IF hires IN viewPort.modes THEN INC(clickX,cx) ELSE INC(clickX,cx DIV 2) END;
X IF clickY<0 THEN clickY := 0 END;
X IF clickX<0 THEN clickX := 0 END;
X IF clickY>=height THEN clickY := height-1 END;
X IF clickX>=width THEN clickX := width -1 END;
X IF lace IN viewPort.modes THEN mym := clickY+topEdge ELSE mym := 2*(clickY+topEdge) END;
X IF hires IN viewPort.modes THEN mxm := clickX ELSE mxm := 2*clickX END;
X Signal(Me,LONGSET{LMBSig});
X END;
X ev := nextEvent;
X END;
X END;
X END;
X WITH iB^ DO maxXMouse := mxm; maxYMouse := mym END;
X END;
X RETURN Ev;
XEND MyHandler; (* $S+ *)
X
X(*------ VertB-Interrupt: ------*)
X
XPROCEDURE MyIntProc(); (* $S- *)
X
XBEGIN
X INLINE(MOVEMS,3F3EH); (* this is MOVEM d2-d7/a2-a6,-(sp) *)
X
X IF (iB^.activeScreen = WBS) AND (WBS^.mouseY>=0) THEN
X WITH iB^ DO
X maxXMouse := mxm;
X maxYMouse := mym;
X IF aPointer#GetSpr THEN
X ActSprImg := 1-ActSprImg;
X GetSpr := aPointer;
X SprImg[ActSprImg]^ := GetSpr^;
X sprite.height := aPtrHeight;
X ChangeSprite(ADR(WBS^.viewPort),ADR(sprite),SprImg[ActSprImg]);
X END;
X END;
X IF (WBS^.mouseX#lx) OR (WBS^.mouseY#ly) THEN
X lx := WBS^.mouseX; ly := WBS^.mouseY;
X IF (ly>=0) AND (lx>=0) AND (ly<SizeY) AND (lx<SizeX) THEN
X WITH WBS^.viewPort.rasInfo^ DO
X IF Proportional THEN
X rxOffset := LONGINT(lx+1) * LONGINT(SizeX - oldw) DIV SizeX;
X ryOffset := LONGINT(ly+1) * LONGINT(SizeY - oldh) DIV SizeY;
X mx := lx - rxOffset;
X my := ly - ryOffset;
X ScrollVPort(ADR(WBS^.viewPort));
X ELSE
X IF (rox#rxOffset) OR (roy#ryOffset) OR (rox=-1)THEN
X IF rox=-1 THEN rox := 0 END;
X rxOffset := rox;
X ryOffset := roy;
X ScrollVPort(ADR(WBS^.viewPort));
X END;
X mx := lx - rox;
X my := ly - roy;
X END;
X IF hires IN WBS^.viewPort.modes THEN
X INC(mx,2*ORD(CAST(Byte,iB^.aXOffset)));
X ELSE
X INC(mx,ORD(CAST(Byte,iB^.aXOffset)));
X END;
X IF lace IN WBS^.viewPort.modes THEN
X INC(my,2*ORD(CAST(Byte,iB^.aYOffset)));
X ELSE
X INC(my,ORD(CAST(Byte,iB^.aYOffset)));
X END;
X MoveSprite(ADR(WBS^.viewPort),ADR(sprite),mx,my);
X END;
X END;
X END;
X ELSE
X sprite.height := 1;
X ChangeSprite(ADR(WBS^.viewPort),ADR(sprite),EmptySprite);
X GetSpr := NIL;
X END;
X
X INLINE(MOVEML,7CFCH); (* this is MOVEM (sp)+,d2-d7/a2-a6 *)
XEND MyIntProc; (* $S+ *)
X
X(*------ Neue MoveSprite() Funktion: ------*)
X
X(* $S- *)
XPROCEDURE MyMoveSprite(vp{8}:ViewPortPtr; sprite{9}:SimpleSpritePtr; x{0},y{1}:INTEGER);
XBEGIN
X INLINE(MOVEMS,3F3EH);
X IF (sprite^.num=0) AND (iB^.activeScreen=WBS) AND (WBS^.mouseY>=0) THEN
X x := -32;
X END;
X OldMoveSprite();
X INLINE(MOVEML,7CFCH);
XEND MyMoveSprite;
X(* $S+ *)
X
X(*------ CleanUp: ------*)
X
XPROCEDURE CleanUp();
X
XBEGIN
X
X(*------ Remove Inputhandler: ------*)
X
X IF HandlerActive THEN
X WITH InputRequestBlock^ DO
X command := remHandler;
X data := ADR(HandlerStuff);
X END;
X DoIO(InputRequestBlock);
X END;
X IF InputRequestBlock#NIL THEN DeleteStdIO(InputRequestBlock) END;
X IF InputDevPort#NIL THEN DeletePort(InputDevPort) END;
X
X(*------ Remove Interrupt: ------*)
X
X IF IntActive THEN RemIntServer(vertb,ADR(VertBIntr)) END;
X
X(*------ Remove Copperlist: ------*)
X
X IF cl#NIL THEN
X FreeCopList(cl^.firstCopList);
X WBS^.viewPort.uCopIns:=altcl;
X END;
X
X(*------ Reset Workbench: ------*)
X
X IF WBS#NIL THEN
X WITH oldbm DO
X l := 0;
X WHILE l<LONGINT(depth) DO
X IF planes[l]=NIL THEN
X planes[l] := Exec.AllocMem(LONGINT(rows)*LONGINT(bytesPerRow),MemReqSet{chip,memClear});
X IF planes[l]=NIL THEN depth := l END;
X END;
X INC(l);
X END;
X END;
X(* Korn, Bier, Schnaps und Wein *)
X Forbid();
X WITH WBS^ DO
X width := oldw;
X height := oldh;
X bitMap := oldbm;
X IF blitted THEN
X l := BltBitMap(ADR(bm),0,0,ADR(bitMap),0,0,oldw,oldh,0C0H,3,NIL);
X END;
X WITH viewPort.rasInfo^ DO rxOffset := 0; ryOffset := 0 END;
X END;
X(* und wir horen unsere Leber Schrein. *)
X IF oldmy#0 THEN
X WITH iB^ DO maxXMouse := oldmx; maxYMouse := oldmy END;
X END;
X MakeScreen(WBS);
X Permit();
X RethinkDisplay();
X END;
X
X(*------ Close everything: ------*)
X
X IF OldMoveSprite#NIL THEN
X OldMoveSprite := SetFunction(ADR(Graphics),-426,CAST(ADDRESS,OldMoveSprite));
X END;
X(* Doch eins das wissen wir ganz genau: *)
X IF Window#NIL THEN CloseWindow(Window) END;
X IF sprID#-1 THEN FreeSprite(sprID) END;
X IF LMBSig#-1 THEN FreeSignal(LMBSig) END;
X
X(*------ Remove Port: ------*)
X
X IF MyPort#NIL THEN
X Forbid();
X IF QuitMessage=NIL THEN QuitMessage := GetMsg(MyPort) END;
X WHILE QuitMessage#NIL DO
X IF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqok END;
X(* Ohne Alk da ware der Alltag so grau! *)
X ReplyMsg(QuitMessage);
X QuitMessage := GetMsg(MyPort);
X END;
X DeletePort(MyPort);
X(* (ich war Montag auf dem Hosen Konzert!) *)
X Permit();
X END;
X
XEND CleanUp;
X
X(*------ MAIN: ------*)
X
XBEGIN
X
X(*------ Initialization: ------*)
X
X WBS := NIL; Window := NIL; MyPort := NIL; blitted := FALSE;
X sprID := -1; InputDevPort := NIL; InputRequestBlock := NIL;
X HandlerActive := FALSE; InputOpen := FALSE; OldMoveSprite := NIL;
X SizeX := 1024; SizeY := 512; LMBSig := -1; oldmy := 0; cl := NIL;
X
X iB := ADR(Intuition);
X gfx := ADR(Graphics);
X
X TermProcedure(CleanUp);
X
X(*------ Have we already been started? ------*)
X
X OldPort := FindPort(ADR(PortName));
X IF OldPort#NIL THEN
X MyPort := CreatePort(ADR(ReplyName),0);
X Assert(MyPort#NIL,ADR(oom));
X MyMsg.msg.node.type := message;
X MyMsg.msg.replyPort := MyPort;
X MyMsg.msg.length := 1;
X PutMsg(OldPort,ADR(MyMsg)); (* Signal task to quit *)
X WaitPort(MyPort);
X DeletePort(MyPort);
X MyPort := NIL;
X CASE MyMsg.cq OF
X cqoom: Assert(FALSE,ADR(oom)) |
X cqwin: Assert(FALSE,ADR(wins)) |
X ELSE Terminate(0) END;
X END;
X MyPort := CreatePort(ADR(PortName),0);
X Assert(MyPort#NIL,ADR(oom));
X
X(*------ Get Arguments: ------*)
X
X IF wbStarted THEN
X GetArg(0,arg,i);
X MyIcon := GetDiskObject(ADR(arg));
X IF MyIcon#NIL THEN
X tT := FindToolType(MyIcon^.toolTypes,ADR(tTWidth));
X IF tT#NIL THEN StrToVal(tT^,SizeX,b,10,err); Assert(NOT err,ADR(tTErr)) END;
X tT := FindToolType(MyIcon^.toolTypes,ADR(tTHeight));
X IF tT#NIL THEN StrToVal(tT^,SizeY,b,10,err); Assert(NOT err,ADR(tTErr)) END;
X(* Ein Skinhead auf der Autobahn, Hui! Da kann man prima druberfahr! [Brieftauben] *)
X tT := FindToolType(MyIcon^.toolTypes,ADR(tTFlags));
X IF tT#NIL THEN
X Proportional := MatchToolValue(tT,ADR(tTProp))#NIL;
X END;
X FreeDiskObject(MyIcon);
X END;
X ELSE
X Assert(NumArgs()<4,ADR(Usage));
X Proportional := FALSE;
X IF ODD(NumArgs()) THEN
X GetArg(1,arg,i);
X Assert((CAP(arg[0])="P") AND (arg[1]=0C),ADR(Usage));
X Proportional := TRUE;
X l := 1;
X ELSE
X l := 0;
X END;
X IF NumArgs()>1 THEN
X GetArg(l+1,arg,i); StrToVal(arg,SizeX,b,10,err); Assert(NOT err,ADR(Usage));
X GetArg(l+2,arg,i); StrToVal(arg,SizeY,b,10,err); Assert(NOT err,ADR(Usage));
X END;
X END;
X
X(*------ Open Window: ------*)
X
X WITH NuWindow DO
X leftEdge := 0; topEdge := 0;
X width := 1; height := 1;
X idcmpFlags := IDCMPFlagSet{};
X flags := WindowFlagSet{backDrop};
X firstGadget:= NIL; checkMark := NIL;
X title := ADR(WindowTitle);
X screen := NIL; bitMap := NIL;
X type := ScreenFlagSet{wbenchScreen};
X END;
X Window := OpenWindow(NuWindow);
X Assert(Window#NIL,ADR(oom));
X
X(*------ Allocate Sprite: ------*)
X
X AllocMem(SprImg[0],SIZE(GetSpr^),TRUE);
X AllocMem(SprImg[1],SIZE(GetSpr^),TRUE);
X AllocMem(EmptySprite,SIZE(EmptySprite^),TRUE);
X Assert((SprImg[0]#NIL) AND (SprImg[1]#NIL),ADR(oom));
X ActSprImg := 0;
X sprID := GetSprite(ADR(sprite),-1);
X Assert(sprID>0,ADR(noSprites));
X OldMoveSprite := SetFunction(ADR(Graphics),-426,ADR(MyMoveSprite));
X
X(*------ Signal: ------*)
X
X LMBSig := AllocSignal(-1);
X Assert(LMBSig#-1,ADR(noSignal));
X Me := FindTask(NIL);
X IF SetTaskPri(Me,2)=0 THEN END; (* I'm responsible for quick WBDisplay! *)
X
X(*------ Resize Workbench: ------*)
X
X GetPrefs(ADR(pref),SIZE(Preferences));
X WITH Window^.wScreen^ DO
X oldbm:= bitMap;
X bm := oldbm;
X oldw := width;
X oldh := height;
X Assert((SizeX>=oldw) AND (SizeY>=oldh),ADR(TooSmall));
X END;
X WITH bm DO
X rows := SizeY;
X bytesPerRow := ((SizeX+15) DIV 16) * 2;
X FOR l:=0 TO depth-1 DO
X AllocMem(planes[l],LONGINT(rows+10)*LONGINT(bytesPerRow),TRUE);
X Assert(planes[l]#NIL,ADR(oom));
X END;
X END;
X WBS := Window^.wScreen;
X Forbid();
X WaitBlit();
X WITH WBS^ DO
X l := BltBitMap(ADR(oldbm),0,0,ADR(bm),0,0,width,height,0C0H,3,NIL);
X blitted := TRUE;
X bitMap := bm;
X oldw := width; oldh := height; width := SizeX; height := SizeY;
X MakeScreen(WBS);
X WITH oldbm DO
X l := 0;
X WHILE l<LONGINT(depth) DO
X FreeMem(planes[l],LONGINT(rows)*LONGINT(bytesPerRow));
X planes[l] := NIL;
X INC(l);
X END;
X END;
X WITH iB^ DO
X oldmx := maxXMouse;
X oldmy := maxYMouse;
X Permit();
X IF l>1 THEN
X l := (sprID DIV 2) * 4 + 16;
X WITH pref DO
X SetRGB4(ADR(viewPort),l+1,
X CAST(INTEGER,CAST(BITSET,color17)*{8..11}) DIV 256,
X CAST(INTEGER,CAST(BITSET,color17)*{4.. 7}) DIV 16,
X CAST(INTEGER,CAST(BITSET,color17)*{0.. 3}));
X SetRGB4(ADR(viewPort),l+2,
X CAST(INTEGER,CAST(BITSET,color18)*{8..11}) DIV 256,
X CAST(INTEGER,CAST(BITSET,color18)*{4.. 7}) DIV 16,
X CAST(INTEGER,CAST(BITSET,color18)*{0.. 3}));
X SetRGB4(ADR(viewPort),l+3,
X CAST(INTEGER,CAST(BITSET,color19)*{8..11}) DIV 256,
X CAST(INTEGER,CAST(BITSET,color19)*{4.. 7}) DIV 16,
X CAST(INTEGER,CAST(BITSET,color19)*{0.. 3}));
X END;
X END;
X sprite.x := 0;
X sprite.y := 0;
X sprite.height := aPtrHeight;
X GetSpr := aPointer;
X SprImg[ActSprImg]^ := GetSpr^;
X END;
X ChangeSprite(ADR(viewPort),ADR(sprite),SprImg[ActSprImg]);
X END;
X
X(*------ Create Copperlist: ------*)
X
X altcl:=WBS^.viewPort.uCopIns;
X AllocMem(cl,SIZE(cl^),TRUE);
X Assert(cl#NIL,ADR(oom));
X CMove(cl,ADR(custom.dmacon),CAST(INTEGER,8100H)); CBump(cl); (* Bitplane-DMA ein *)
X CWait(cl,oldh,0); CBump(cl);
X CMove(cl,ADR(custom.dmacon),0100H); CBump(cl); (* Bitplane-DMA aus *)
X CWait(cl, 10000, 255); CBump(cl);
X WBS^.viewPort.uCopIns:=cl;
X RethinkDisplay();
X
X(*------ Add Inputhandler: ------*)
X
X InputDevPort := CreatePort(NIL,0);
X Assert(InputDevPort#NIL,ADR(oom));
X
X InputRequestBlock := CreateStdIO(InputDevPort);
X Assert(InputRequestBlock#NIL,ADR(oom));
X
X OpenDevice(ADR(inputName),0,InputRequestBlock,LONGSET{});
X IF InputRequestBlock^.error#0 THEN Terminate(0) END;
X InputOpen := TRUE;
X
X WITH HandlerStuff DO
X data := NIL;
X code := ADR(MyHandler);
X node.pri := 51;
X END;
X WITH InputRequestBlock^ DO
X command := addHandler;
X data := ADR(HandlerStuff);
X END;
X DoIO(InputRequestBlock);
X HandlerActive := TRUE;
X
X(*------ Interrupt starten: ------*)
X
X WITH VertBIntr DO
X node.type := interrupt;
X node.pri := 0;
X node.name := ADR(intName);
X data := NIL;
X code := MyIntProc;
X END;
X AddIntServer(vertb,ADR(VertBIntr));
X IntActive := TRUE;
X
X(*------ Do it: ------*)
X
X lx := -1; ly := -1; rox := -1; roy := 0;
X WITH WBS^ DO
X mxm := width-1; mym := height-1;
X IF NOT(lace IN viewPort.modes) THEN INC(mym,mym) END;
X IF NOT(hires IN viewPort.modes) THEN INC(mxm,mxm) END;
X END;
X LOOP
X REPEAT
X Sigs := Wait(LONGSET{MyPort^.sigBit,LMBSig});
X IF LMBSig IN Sigs THEN
X lay:= WhichLayer(ADR(WBS^.layerInfo),clickX,clickY);
X IF (lay#NIL) THEN
X IF lay^.window=NIL THEN (* Screentitlebar *)
X newmxm := WBS^.width - 1;
X IF clickY<12 THEN newmym := oldh - 1 ELSE newmym := WBS^.height - 1 END;
X ELSE
X lw := lay^.window;
X WITH lw^ DO
X gdg:= firstGadget; DEC(clickX,leftEdge); DEC(clickY,topEdge);
X END;
X LOOP
X IF gdg=NIL THEN
X WITH WBS^ DO
X newmxm := width - 1;
X newmym := height - 1;
X EXIT;
X END;
X END;
X WITH gdg^ DO
X gy := topEdge; IF gRelBottom IN flags THEN INC(gy,lw^.height) END;
X gx := leftEdge; IF gRelRight IN flags THEN INC(gx,lw^.width ) END;
X gh := height; IF gRelHeight IN flags THEN INC(gh,lw^.height) END;
X gw := width; IF gRelWidth IN flags THEN INC(gw,lw^.width ) END;
X IF (gx<=clickX) AND (gy<=clickY) AND (gx+gw>clickX) AND (gy+gh>clickY) THEN
X CASE CAST(INTEGER,CAST(BITSET,gadgetType)*{4..7}) OF
X sizing:
X WITH lw^ DO
X IF maxWidth#-1 THEN
X newmxm := leftEdge + maxWidth + clickX - width;
X IF newmxm>=WBS^.width THEN newmxm := WBS^.width - width + clickX END;
X ELSE
X newmxm := WBS^.width - width + clickX;
X END;
X IF maxHeight#-1 THEN
X newmym := topEdge + maxHeight + clickY - height;
X IF newmym>=WBS^.height THEN newmym := WBS^.height - height + clickY END;
X ELSE
X newmym := WBS^.height - height + clickY;
X END;
X END;
X INC(newmym,WBS^.topEdge);
X EXIT |
X wDragging:
X WITH WBS^ DO
X newmxm := width - lw^.width + clickX;
X newmym := height - lw^.height + clickY + topEdge;
X END;
X EXIT |
X ELSE END;
X END;
X gdg := nextGadget;
X END;
X END;
X END;
X WITH WBS^.viewPort DO
X IF lace IN modes THEN mym := newmym ELSE mym := 2*newmym END;
X IF hires IN modes THEN mxm := newmxm ELSE mxm := 2*newmxm END;
X END;
X END;
X END;
X QuitMessage := GetMsg(MyPort);
X UNTIL QuitMessage#NIL;
X
X Forbid();
X w := WBS^.firstWindow;
X WHILE LONGCARD(w)>1 DO
X WITH w^ DO
X IF (width+leftEdge>oldw) OR (height+topEdge>oldh) THEN
X w := WindowPtr(1);
X ELSE
X w := nextWindow;
X END;
X END;
X END;
X Permit();
X
X IF w=NIL THEN
X WITH oldbm DO
X IF planes[0]=NIL THEN
X planes[0] := Exec.AllocMem(LONGINT(rows)*LONGINT(bytesPerRow),MemReqSet{chip,memClear});
X IF planes[0]#NIL THEN EXIT ELSIF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqoom END;
X END;
X END;
X ELSIF QuitMessage^.msg.length=1 THEN QuitMessage^.cq := cqwin END;
X
X ReplyMsg(QuitMessage);
X QuitMessage := NIL;
X END;
X
XEND MegaWB.
END_OF_FILE
if test 21555 -ne `wc -c <'MegaWB.mod'`; then
echo shar: \"'MegaWB.mod'\" unpacked with wrong size!
fi
# end of 'MegaWB.mod'
fi
if test -f 'MegaWB.mod.info.uu' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'MegaWB.mod.info.uu'\"
else
echo shar: Extracting \"'MegaWB.mod.info.uu'\" \(790 characters\)
sed "s/^X//" >'MegaWB.mod.info.uu' <<'END_OF_FILE'
Xbegin 664 MegaWB.mod.info
XMXQ```0``````W0!7`!\`&0`&``,``0`GNN``)[NH````````````````````U
XM````!"8`)[UP`````````+T```!8```````````````````````?`!D``@`!.
XMC8`#``````"JJJ@`JJJH`*JJJ("`H`B@JJJHJ((JJ`"J"JJJJ@*JJJHXJJJJL
XM>"JJJAHJJJHBBJJJ*(JJJHBBJJJ*(JJJHBBJJJ*(JJJHBBJJJ*`JJJH/BJJJG
XM&,JJJH^*JJJ@*JJJJJH`````````````````````?Q_P``````!]P````?``1
XM``'\```!Q@```8>```'FP``!KN```.ZP``!KN```.ZP``!KN```.ZP``!KN`L
XM``._P``!L&```.<P``!P8```'\``````````````````'P`9``(``8Y(`P``M
XM````````````````````?Q_P`%454`!]U5```?50``']4``!QU```8?0``'E4
XMT``!W7```-=P``!W6```-=P``!W6```-=P``!W6```-?P``!\&```.<P``!PR
XM8```'\```````````*JJJ`"JJJ@`JJJH@("@"*#_O_BH@C_X`*H/^JJJ`_JJ`
XMJCGZJJIX>JJJ&3JJJE$:JJH12JJJE$*JJH12JJJE$*JJH12JJJE$*JJH0"JJO
XGJD^*JJH8RJJJCXJJJJ`JJJJJJ@`````````,.F,O375C:$UO<F4`D
X``
Xend
Xsize 534
END_OF_FILE
if test 790 -ne `wc -c <'MegaWB.mod.info.uu'`; then
echo shar: \"'MegaWB.mod.info.uu'\" unpacked with wrong size!
fi
# end of 'MegaWB.mod.info.uu'
fi
echo shar: End of archive 1 \(of 1\).
cp /dev/null ark1isdone
MISSING=""
for I in 1 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have the archive.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Submissions to comp.sources.amiga and comp.binaries.amiga should be sent to:
amiga@cs.odu.edu
or amiga@xanth.cs.odu.edu ( obsolescent mailers may need this address )
or ...!uunet!xanth!amiga ( very obsolescent mailers need this address )
Comments, questions, and suggestions s should be addressed to ``amiga-request''
(only use ``amiga'' for submissions) at the above addresses.