(****************************************************************************** * * COPYRIGHT: Unless otherwise noted, all files are Copyright (c) 1992, 1993 * Commodore-Amiga, Inc. All rights reserved. * * DISCLAIMER: This software is provided "as is". No representations or * warranties are made with respect to the accuracy, reliability, performance, * currentness, or operation of this software, and all use is at your own risk. * Neither commodore nor the authors assume any responsibility or liability * whatsoever with respect to your use of this software. * ****************************************************************************** * dto.c * How to embed a DataType object within an Intuition window * Written by David N. Junod * ported to Oberon by Albert Weinert (Feb. 1994) * *) (* $OddChk- *) MODULE dto; IMPORT Dos, dt := Datatypes, e := Exec, g := Graphics, I := Intuition, pf:= Printf, u := Utility, y := SYSTEM; (*****************************************************************************) CONST template = "NAME/A"; (*****************************************************************************) CONST idcmp = LONGSET{I.closeWindow, I.vanillaKey, I.idcmpUpdate}; (*****************************************************************************) PROCEDURE PrintErrorMsg( errnum : LONGINT; name : e.STRPTR ); VAR errbuff : ARRAY 80 OF CHAR; BEGIN IF (errnum >= dt.errorUnknownDatatype) THEN pf.SPrintf1 (errbuff, dt.GetDTString (errnum)^, name); ELSE IF Dos.Fault (errnum, NIL, errbuff, SIZE (errbuff)) = 0 THEN END; END; Dos.PrintF ("%s\nerror #%ld\n", y.ADR(errbuff), errnum); END PrintErrorMsg; (*****************************************************************************) VAR dto : I.ObjectPtr; name : e.STRPTR; modeid, nomwidth, nomheight, gaWidth, gaHeight : LONGINT; useScreen, going : BOOLEAN; dtf : dt.FrameBox; fri : dt.FrameInfo; scr : I.ScreenPtr; win : I.WindowPtr; imsg : I.IntuiMessagePtr; sigr : LONGSET; tag, tstate : u.TagItemPtr; tags : u.TagListPtr; tidata, errnum : LONGINT; options : STRUCT( d : Dos.ArgsStruct ); name : e.STRPTR; END; rdargs : Dos.RDArgsPtr; BEGIN modeid := g.invalidID; useScreen := FALSE; going := TRUE; IF dt.base = NIL THEN HALT( 20 ) END; (* Parse the arguments. Note that this simple example assumes * that it was started from the shell. *) rdargs := Dos.ReadArgs (template, options, NIL); IF rdargs # NIL THEN (* Get a DataType object *) dto := dt.NewDTObject ( options.name^, u.done ); IF dto # NIL THEN (* Get information about the object *) IF dt.GetDTAttrs (dto, (* Get the name of the object *) dt.objName, y.ADR( name ), (* Get the desired size *) dt.nominalHoriz, y.ADR(nomwidth), dt.nominalVert, y.ADR(nomheight), (* Get the mode ID for graphical objects *) dt.modeID, y.ADR(modeid), u.done) # 0 THEN (* Display any information we obtained *) IF name # NIL THEN Dos.PrintF ("opened \"%s\"\n", name); END; (* Show the mode ID *) Dos.PrintF ("mode ID %08lx\n", modeid); (* Display the nominal size *) Dos.PrintF ("nominal width %ld, height %ld\n", nomwidth, nomheight); END; (* Ask the object what kind of environment it needs *) dtf.msg.methodID := dt.mFrameBox; dtf.frameInfo := y.ADR(fri); dtf.contentsInfo := y.ADR(fri); dtf.sizeFrameInfo := SIZE (dt.FrameInfo); IF dt.DoDTMethodA (dto, NIL, NIL, dtf ) # 0 THEN Dos.PrintF ("PropertyFlags : 0x%lx\n", fri.propertyFlags); Dos.PrintF ("RedBits : 0x%lx\n", y.VAL( SHORTINT, fri.redBits )); Dos.PrintF ("GreenBits : 0x%lx\n", y.VAL( SHORTINT, fri.greenBits)); Dos.PrintF ("BlueBits : 0x%lx\n", y.VAL( SHORTINT, fri.blueBits)); Dos.PrintF ("Width : %ld\n", fri.dimensions.width); Dos.PrintF ("Height : %ld\n", fri.dimensions.height); Dos.PrintF ("Depth : %ld\n", fri.dimensions.depth); Dos.PrintF ("Screen : 0x%lx\n", fri.screen); Dos.PrintF ("ColorMap : 0x%lx\n", fri.colorMap); IF ( g.isHAM IN y.VAL(LONGSET, fri.propertyFlags) )OR ( g.isExtraHalfBrite IN y.VAL(LONGSET, fri.propertyFlags)) THEN Dos.PrintF ("HAM or ExtraHalfBrite\n"); useScreen := TRUE; END; IF ( (fri.propertyFlags = 0)(* & (modeid = 0800H)*) & (modeid # g.invalidID) ) THEN Dos.PrintF ("ModeID=0x%08lx\n", modeid); useScreen := TRUE; END; ELSE Dos.PrintF ("couldn't obtain environment information\n"); END; IF useScreen THEN Dos.PrintF ("this object requires a private screen\n"); ELSE (* Get a lock on the default public screen *) scr := I.LockPubScreen( NIL ); IF scr # NIL THEN (* Make sure we have the dimensions *) IF nomwidth = 0 THEN nomwidth := 600 END; IF nomheight = 0 THEN nomheight := 175 END; (* Open the window *) win := I.OpenWindowTagsA(NIL, I.waInnerWidth, nomwidth, I.waInnerHeight, nomheight, I.waTitle, name, I.waIDCMP, idcmp, I.waDragBar, e.LTRUE, I.waDepthGadget, e.LTRUE, I.waCloseGadget, e.LTRUE, I.waAutoAdjust, e.LTRUE, I.waSimpleRefresh, e.LTRUE, I.waBusyPointer, e.LTRUE, I.waActivate, e.LTRUE, u.done ); IF win # NIL THEN (* Set the dimensions of the DataType object. *) gaWidth := win.width - win.borderLeft - win.borderRight; gaHeight := win.height - win.borderTop - win.borderBottom; IF dt.SetDTAttrs (dto, NIL, NIL, I.gaLeft, win.borderLeft, I.gaTop, win.borderTop, I.gaHeight, gaHeight, I.gaWidth, gaWidth, I.icaTarget, I.icTargetIDCMP, u.end) = 0 THEN END; (* Add the object to the window *) IF dt.AddDTObject (win, NIL, dto, -1) = 0 THEN END; (* Refresh the DataType object *) IF dt.RefreshDTObject(dto, win, NIL, NIL) = 0 THEN END; (* Keep going until we're told to stop *) WHILE (going) DO (* Wait for an event *) sigr := e.Wait ( LONGSET{ win.userPort.sigBit, Dos.ctrlC} ); (* Did we get a break signal *) IF Dos.ctrlC IN sigr THEN going := FALSE END; (* Pull Intuition messages *) REPEAT imsg := e.GetMsg( win.userPort ); IF imsg # NIL THEN (* Handle each message *) IF I.closeWindow IN imsg.class THEN going := FALSE; ELSIF I.vanillaKey IN imsg.class THEN CASE imsg.code OF | ORD( "Q" ), ORD( "q" ), 27 : going := FALSE; ELSE END; ELSIF I.idcmpUpdate IN imsg.class THEN tstate := y.VAL( u.TagItemPtr, imsg.iAddress ); tags := y.VAL( u.TagListPtr, tstate ); REPEAT tag := u.NextTagItem( tstate ); IF tag # NIL THEN tidata := tag.data; CASE tag.tag OF (* Change in busy state *) | dt.busy: IF tidata # NIL THEN I.SetWindowPointer (win, I.waBusyPointer, e.LTRUE, u.done); ELSE I.SetWindowPointer (win, I.waPointer, NIL, u.done); END; (* Error message *) | dt.errorLevel: IF tidata # NIL THEN errnum := u.GetTagData( dt.errorNumber, NIL, tags); PrintErrorMsg (errnum, options.name); END; (* Time to refresh *) | dt.sync: (* Refresh the DataType object *) IF dt.RefreshDTObject (dto, win, NIL, NIL) = 0 THEN END; ELSE END; END (* IF tag # NIL THEN *); UNTIL tag = NIL; END (* IF I.closeWindow ... *); (* Done with the message, so reply to it *) e.ReplyMsg (imsg); END (* IF imsg # NIL ... *); UNTIL imsg = NIL; END (* WHILE (going) DO *); (* Remove the object from the window *) IF dt.RemoveDTObject (win, dto) = 0 THEN END; (* Close the window now *) I.CloseWindow (win); ELSE Dos.PrintF ("couldn't open window\n"); END; (* Unlock the screen *) I.UnlockPubScreen (NIL, scr); ELSE Dos.PrintF ("couldn't lock default public screen\n"); END; (* Dispose of the DataType object *) END (* IF useScreen ... *); dt.DisposeDTObject(dto); ELSE PrintErrorMsg (Dos.IoErr (), options.name ); END; Dos.FreeArgs (rdargs); ELSE PrintErrorMsg (Dos.IoErr(), NIL); END; END dto.