שתשת incdir "include:" include "libraries/gadtools.i" include "exec/execbase.i" include "libraries/gadutil.i" include "libraries/gadutil_lib.i" include "LVOs.i" ;----------------------------------------------------------------------------- NEXTDRIVE_GAD: equ 1 PREVDRIVE_GAD: equ 2 REQUESTER_GAD: equ 3 CYCLE_GAD: equ 4 MX_GAD: equ 5 CANCEL_GAD: equ 6 STRING_GAD: equ 7 INT_GAD: equ 8 CHECK_GAD: equ 9 LIST_GAD: equ 10 SLIDER_GAD: equ 11 SCROLLER_GAD: equ 12 PALETTE_GAD: equ 13 ;----------------------------------------------------------------------------- Main: lea.l BSS_Datas,a5 move.l _AbsExecBase.w,a6 move.l DeviceList(a6),LvGadTags+4 ; Set list pointer for ListView gadget lea.l LibPtrs(pc),a2 move.w (a2)+,d2 .OpenLib: ; Open all required libraries move.l (a2),a1 moveq.l #37,d0 CallLib OpenLibrary move.l d0,(a2)+ dbeq d2,.OpenLib beq.s .CloseLibs lea.l gadutilname(pc),a1 moveq.l #36,d0 CallLib OpenLibrary move.l d0,GUtilBase beq.s .CloseLibs bsr.s MyProgram move.l GUtilBase(pc),a1 CallLib CloseLibrary .CloseLibs: lea.l LibPtrs(pc),a2 ; Close all libraries that were opened move.w (a2)+,d2 .CloseLib: move.l (a2)+,d0 beq.s .NotOpened move.l d0,a1 CallLib CloseLibrary dbra d2,.CloseLib .NotOpened: moveq.l #0,d0 rts ;--------------------------------- Main program ------------------------------ MyProgram: movem.l d0-a6,-(sp) bsr.b SetupScreen ; Prepare screen for gadtools beq.s .freescreen ; Error! lea.l GadgetDatas1(pc),a3 ; Get pointer to gadget datas suba.l a4,a4 ; Don't save pointers move.l gt_gad(a5),a0 ; Previous gadget bsr.w MakeGTGadList beq.s .freescreen ; Error! lea.l GadgetDatas2(pc),a3 ; Get pointer to gadget datas lea.l mx_gad(a5),a4 ; Save pointers to created gadgets move.l gt_gad(a5),a0 ; Previous gadget bsr.w MakeGTGadList beq.s .freescreen ; Error! suba.l a0,a0 ; No NewWindow structure lea.l wintags(pc),a1 ; Tag pointer move.l IntuiBase(pc),a6 CallLib OpenWindowTagList ; Open the window move.l d0,main_win(a5) beq.s .freescreen ; Window failed to open move.l d0,a0 ; Window pointer to A0 move.l wd_UserPort(a0),a1 ; Get userport for window moveq.l #1,d0 moveq.l #0,d1 move.b MP_SIGBIT(a1),d1 ; Make signal mask lsl.l d1,d0 move.l d0,MainWinSigMask(a5) ; Save for later use suba.l a1,a1 move.l GToolsBase(pc),a6 CallLib GT_RefreshWindow ; Refresh the gadgets move.l main_win(a5),a0 bsr.w process_window_events ; Wait for close gadget .closewindow: move.l main_win(a5),a0 ; Close our window move.l IntuiBase(pc),a6 CallLib CloseWindow .freescreen: bsr.b FreeScreen movem.l (sp)+,d0-a6 rts ;---------------- Set up a screen for using gadtools.library ----------------- ; Result: ; Z flag set in SR if anything went wrong ; SetupScreen: move.l a6,-(sp) suba.l a0,a0 ; Lock default public screen CallLib LockPubScreen,IntuiBase(pc) move.l d0,mysc ; Save screen pointer in window tags beq.s .error move.l d0,a0 lea.l EmptyTag(pc),a1 ; Pointer to an empty tag list move.l GToolsBase(pc),a6 ; Get VisualInfo for screen CallLib GetVisualInfoA move.l d0,vi_inf(a5) beq.s .error lea.l glist(pc),a0 ; Create first "gadget" CallLib CreateContext move.l d0,gt_gad(a5) lea.l gt_ng(a5),a1 ; Get pointer to the NewGadget struct move.l vi_inf(a5),gng_VisualInfo(a1) move.l #Topaz80,gng_TextAttr(a1) moveq.l #1,d0 ; Adjust topmost gadget to font size move.l mysc(pc),a1 add.b sc_WBorTop(a1),d0 ; Get mysc->WBorTop + move.l sc_Font(a1),a0 add.w ta_YSize(a0),d0 ; mysc->Font->ta_YSize move.w d0,TopBorOffs(a5) ; Save offset value for later use .error: move.l (sp)+,a6 rts ;---------------- Clean up after using screen for gadtools ------------------- ; FreeScreen: move.l a6,-(sp) move.l glist(pc),a0 ; Deallocate mem used for gadgets CallLib GU_FreeGadgets,GUtilBase(pc) .FreeVisual: move.l vi_inf(a5),a0 ; Free the VisualInfo structure CallLib FreeVisualInfoA,GToolsBase(pc) .UnlockSc: suba.l a0,a0 ; Unlock the default public screen move.l mysc(pc),d0 ; Check if pubscreen pointer is valid beq.s .NoScreen ; Exit if no locked public screen move.l d0,a1 ; Unlock the public screen move.l IntuiBase(pc),a6 CallLib UnlockPubScreen .NoScreen: lea.l RememberKey(a5),a0 ; Always safe to call FreeRemember moveq.l #TRUE,d0 CallLib FreeRemember move.l (sp)+,a6 rts ;---------------------------- Create some gadgets ----------------------------- ; Inputs: ; A0 - Pointer to previous gadget (from CreateContext if first gadget) ; A3 - Pointer to gadget datas ; A4 - Pointer to storage for gadget pointers or NULL for no storage ;------------------------------------------------------------------------------ MakeGTGadList: movem.l d0-d3/a0-a4/a6,-(sp) move.w (a3)+,d2 subq.w #1,d2 move.l GUtilBase(pc),a6 .MakeGadget: lea.l gt_ng(a5),a1 ; NewGadget structure move.w (a3)+,gng_LeftEdge(a1) move.w TopBorOffs(a5),d0 move.w (a3)+,gng_TopEdge(a1) add.w d0,gng_TopEdge(a1) move.w (a3)+,gng_Width(a1) move.w (a3)+,gng_Height(a1) move.w (a3)+,gng_GadgetID(a1) move.l (a3)+,d0 ; Gadget type move.l (a3)+,gng_GadgetText(a1) move.l (a3)+,a2 ; Tags move.l (a3)+,gng_Flags(a1) ; Flags CallLib GU_CreateGadgetA move.l a4,d1 ; Check for NULL address beq.s .dontsave move.l d0,(a4)+ ; Save address of gadget .dontsave: move.l d0,a0 move.l d0,gt_gad(a5) dbeq d2,.MakeGadget movem.l (sp)+,d0-d3/a0-a4/a6 rts ;---------------------- Get a message from the window ------------------------ ; Input: ; A0 = pointer to window ; Output: ; A2 = Message IAddress ; D2 = Message Code ; D3 = Message Class ; Flags: ; Z = 1 for no message (use BEQ) ; Z = 0 for a valid message other than IDCMP_REFRESHWINDOW ; N = 1 for a IDCMP_REFRESHWINDOW message (use BMI) ; ;------------------------------------------------------------------------------ GetIMessage: move.l a0,-(sp) ; Save window pointer move.l wd_UserPort(a0),a0 ; Get UserPort CallLib GU_GetIMsg,GUtilBase(pc) beq.s .NoMessage ; No message - return move.l d0,a1 move.l im_IAddress(a1),a2 ; IAddress to A2 moveq.l #0,d2 ; Clear code longword move.w im_Code(a1),d2 ; Code to D2 move.l im_Class(a1),d3 ; Class to D3 CallLib GT_ReplyIMsg,GToolsBase(pc) ; Reply the message cmp.l #IDCMP_REFRESHWINDOW,d3 ; Do window need to be refreshed ? bne.b .NoMessage ; Nope! Check next message! move.l (sp),a0 CallLib GT_BeginRefresh ; Start refreshing window move.l (sp),a0 moveq.l #TRUE,d0 CallLib GT_EndRefresh ; Refreshing done moveq.l #-1,d0 ; Set N flag .NoMessage: move.l (sp)+,a0 rts ;------------------ Wait for and process window events ----------------------- process_window_events: movem.l d0-a6,-(sp) .WaitEvent: move.l _AbsExecBase.w,a6 move.l MainWinSigMask(a5),d0 ; Get signal mask for main window CallLib Wait ; Wait for a message cmp.l MainWinSigMask(a5),d0 ; Check for signal from main window bne.s .WaitEvent ; Wait for event from main window .GetEvent: move.l 32(sp),a0 ; Get window pointer bsr.w GetIMessage ; Get the message and process REFRESH bmi.s .GetEvent ; Get next event if IDCMP_REFRESHWIN beq.s .WaitEvent ; Continue waiting if no message .checkgadup: cmp.l #IDCMP_GADGETUP,d3 ; Any gadget released ? bne.w .CheckGadDown ; Nope! Check for gadget down messages move.w gg_GadgetID(a2),d1 ; Get GadgetID bchg #1,$bfe001 cmp.w #NEXTDRIVE_GAD,d1 ; Button 1 pressed ? bne.s .CheckButton2 ; Nope! Check more gadgets move.l mx_gad(a5),a0 ; MX gadget was created last move.l 32(sp),a1 ; Window pointer suba.l a2,a2 lea.l act(pc),a3 ; Tags move.l 4(a3),d0 ; Get current active entry addq.l #1,d0 ; Add one cmp.l #4,d0 ; Check for max value bls.s .HighOk moveq.l #0,d0 ; Activate first if too high value .HighOk: move.l d0,4(a3) move.l GUtilBase(pc),a6 CallLib GU_SetGadgetAttrsA bra.b .GetEvent ; Get next event .CheckButton2: cmp.w #PREVDRIVE_GAD,d1 ; Button 2 pressed ? bne.s .CheckButton3 move.l mx_gad(a5),a0 ; MX gadget was created last move.l 32(sp),a1 ; Window pointer suba.l a2,a2 lea.l act(pc),a3 ; Tags move.l 4(a3),d0 ; Get current active entry subq.l #1,d0 ; Subtract one bpl.s .LowOk ; Ok if 0 or greater moveq.l #4,d0 ; Too low - use largest possible value .LowOk: move.l d0,4(a3) move.l GUtilBase(pc),a6 CallLib GU_SetGadgetAttrsA bra.b .GetEvent .CheckButton3: cmp.w #REQUESTER_GAD,d1 ; Button 3 pressed ? bne.s .CheckButton4 move.l 32(sp),a0 ; Block input of main window ; bsr.w GU_BlockInput bsr.w OpenReqWin ; Open the progress requester move.l 32(sp),a0 ; Unblock input of main window ; bsr.w GU_FreeInput bra.w .GetEvent .CheckButton4: cmp.w #CYCLE_GAD,d1 ; Button 4 pressed ? bne.w .GetEvent bchg #1,$bfe001 bra.w .GetEvent .CheckGadDown: cmp.l #IDCMP_GADGETDOWN,d3 ; Check for GADGETDOWN message bne.s .CheckMouse cmp.w #MX_GAD,gg_GadgetID(a2) ; MX gadget pressed ? bne.w .GetEvent move.l d2,act+4 ; Save new active entry number bra.w .GetEvent ; Get next event .CheckMouse: cmp.l #IDCMP_MOUSEMOVE,d3 bne.s .CheckClose bchg #1,$bfe001 bra.w .GetEvent .CheckClose: cmp.l #IDCMP_CLOSEWINDOW,d3 ; Close gadget pressed ? bne.w .GetEvent ; Nope! Get next message .Exit movem.l (sp)+,d0-a6 rts ;-------------------------------- Datas -------------------------------------- GTIDCMP1: equ BUTTONIDCMP!CYCLEIDCMP!STRINGIDCMP!INTEGERIDCMP!CHECKBOXIDCMP GTIDCMP2: equ SLIDERIDCMP!MXIDCMP!LISTVIEWIDCMP INTIDCMP1: equ IDCMP_VANILLAKEY!IDCMP_RAWKEY INTIDCMP2: equ IDCMP_CLOSEWINDOW!IDCMP_REFRESHWINDOW!IDCMP_INTUITICKS IDCMP1: equ GTIDCMP1!GTIDCMP2!INTIDCMP1!INTIDCMP2 wintags: dc.l WA_Title, wintitle, WA_IDCMP, IDCMP1 gl: dc.l WA_Gadgets, 0, WA_CloseGadget, TRUE dc.l WA_Width, 520, WA_InnerHeight, 115 dc.l WA_Flags, WFLG_REPORTMOUSE stdwintags: dc.l WA_DragBar, TRUE, WA_DepthGadget, TRUE dc.l WA_Activate, TRUE, WA_AutoAdjust, TRUE dc.l WA_RMBTrap, TRUE sc: dc.l WA_PubScreen, 0, TAG_DONE glist: equ gl+4 mysc: equ sc+4 ;--------------------------- Data for main program --------------------------- StdGadTags: dc.l GT_Underscore, '_', GU_LabelHotkey, TRUE EmptyTag: dc.l TAG_DONE Topaz80: dc.l topazname,$00080000 LibPtrs: dc.w 5-1 IntuiBase: dc.l IntuiName GToolsBase: dc.l GToolsName DosBase: dc.l DosName GfxBase: dc.l GfxName UtilBase: dc.l UtilName GUtilBase: dc.l 0 gadutilname: dc.b "gadutil.library",0 IntuiName: dc.b "intuition.library",0 GToolsName: dc.b "gadtools.library",0 DosName: dc.b "dos.library",0 GfxName: dc.b "graphics.library",0 UtilName: dc.b "utility.library",0 topazname: dc.b 'topaz.font',0 wintitle: dc.b "GadTools Gadget Demo",0 even ;-------------------------- Gadget datas ------------------------------------- GadgetDatas1: dc.w 6 dc.w 15, 1, 100, 14, NEXTDRIVE_GAD dc.l BUTTON_KIND, NextDriveTxt, StdGadTags, PLACETEXT_IN dc.w 120, 1, 100, 14, PREVDRIVE_GAD dc.l BUTTON_KIND, PrevDriveTxt, StdGadTags, PLACETEXT_IN dc.w 120, 33, 100, 14, REQUESTER_GAD dc.l BUTTON_KIND, RequesterTxt, StdGadTags, PLACETEXT_IN dc.w 100, 51, 200, 14, STRING_GAD dc.l STRING_KIND, StringTxt, StdGadTags, PLACETEXT_LEFT dc.w 100, 66, 200, 14, INT_GAD dc.l INTEGER_KIND, IntegerTxt, StdGadTags, PLACETEXT_LEFT dc.w 90, 34, 26, 11, CHECK_GAD dc.l CHECKBOX_KIND, CheckMeTxt, StdGadTags, PLACETEXT_LEFT GadgetDatas2: dc.w 6 dc.w 280, 1, 0, 0, MX_GAD dc.l MX_KIND, 0, MxTags, PLACETEXT_LEFT dc.w 305, 16, 200, 60, LIST_GAD dc.l LISTVIEW_KIND, ListTxt, LvGadTags, PLACETEXT_ABOVE!NG_HIGHLABEL dc.w 120, 17, 100, 14, CYCLE_GAD dc.l CYCLE_KIND, DriveCyTxt, CycleTags, PLACETEXT_LEFT dc.w 100, 82, 190, 14, SLIDER_GAD dc.l SLIDER_KIND, DragMeTxt, SliderTags, PLACETEXT_LEFT dc.w 100, 98, 220, 14, SCROLLER_GAD dc.l SCROLLER_KIND, ScrollMeTxt, ScrollerTags, PLACETEXT_LEFT dc.w 340, 94, 166, 18, PALETTE_GAD dc.l PALETTE_KIND, PaletteTxt, PaletteTags, PLACETEXT_ABOVE!NG_HIGHLABEL PaletteTags: dc.l GTPA_Depth, 2, GTPA_IndicatorWidth, 36 dc.l TAG_MORE, StdGadTags ScrollerTags: dc.l GTSC_Top, 110, GTSC_Total, 9 dc.l GTSC_Visible, 5, GTSC_Arrows, 16 dc.l TAG_MORE, StdGadTags SliderTags: dc.l GTSL_Min, -50, GTSL_Max, 50 dc.l GTSL_Level, 10, GTSL_MaxLevelLen,3 dc.l GTSL_LevelFormat, sliderform dc.l GTSL_LevelPlace, PLACETEXT_RIGHT dc.l TAG_MORE, StdGadTags LvGadTags: dc.l GTLV_Labels, NULL dc.l GTLV_ShowSelected, NULL dc.l TAG_MORE, StdGadTags CycleTags: dc.l GTCY_Labels, CycleText dc.l TAG_MORE, StdGadTags MxTags: dc.l GTMX_Labels, CycleText dc.l GTMX_Spacing, 2 act: dc.l GTMX_Active, 2, TAG_DONE CycleText: dc.l CyText1,CyText2,CyText3,CyText4,CyText5,0 CyText1: dc.b "DF0:",0 CyText2: dc.b "DF1:",0 CyText3: dc.b "DF2:",0 CyText4: dc.b "RAD:",0 CyText5: dc.b "SD0:",0 activemx: equ act+4 NextDriveTxt: dc.b "_Next drive",0 PrevDriveTxt: dc.b "_Prev drive",0 RequesterTxt: dc.b "_Requester",0 DriveCyTxt: dc.b "_Drive",0 StringTxt: dc.b "_Filename:",0 IntegerTxt: dc.b "_Integer:",0 CheckMeTxt: dc.b "C_heck me:",0 ListTxt: dc.b "_Select an item:",0 DragMeTxt: dc.b "Dra_g me:",0 sliderform: dc.b "%3ld",0 ScrollMeTxt: dc.b "Scr_oll me:",0 PaletteTxt: dc.b "Select _Color:",0 even ;----------------- Open a window to use as a requester --------------------- OpenReqWin: movem.l d0-d1/a0-a1/a6,-(sp) move.l GToolsBase(pc),a6 lea.l reqglist(pc),a0 CallLib CreateContext ; Create storage for context data move.l d0,a0 ; Previous gadget (CreateContext) lea.l ReqGadDatas(pc),a3 ; Get pointer to gadget datas suba.l a4,a4 ; Don't save gadget pointers bsr.w MakeGTGadList beq.s .FreeGads ; Error! suba.l a0,a0 ; No NewWindow structure lea.l ReqWinTags(pc),a1 ; Tag pointer move.l IntuiBase(pc),a6 CallLib OpenWindowTagList ; Open the window move.l d0,req_win(a5) beq.s .FreeGads ; Window failed to open move.l d0,a0 ; Window pointer to A0 suba.l a1,a1 move.l GToolsBase(pc),a6 CallLib GT_RefreshWindow ; Refresh the gadgets move.l req_win(a5),a0 ; Draw a bevel box for progress move.l wd_RPort(a0),a0 ; indicator lea.l BevelBoxTags(pc),a1 move.l vi_inf(a5),4(a1) moveq.l #20,d0 moveq.l #5,d1 add.w TopBorOffs(a5),d1 move.w #410,d2 moveq.l #14,d3 CallLib DrawBevelBoxA move.l GfxBase(pc),a6 ; Change pen for RastPort move.l req_win(a5),a1 move.l wd_RPort(a1),a1 moveq.l #3,d0 CallLib SetAPen move.l req_win(a5),a0 bsr.s ProcessReqEvents .CloseReq: move.l req_win(a5),a0 ; Close our window move.l IntuiBase(pc),a6 CallLib CloseWindow .FreeGads: move.l GToolsBase(pc),a6 ; Deallocate mem for gadgets move.l reqglist(pc),a0 CallLib FreeGadgets .NoButt: movem.l (sp)+,d0-d1/a0-a1/a6 rts ;--------------- Process events for requester window ---------------------- ProcessReqEvents: movem.l d0-d3/a0-a3/a6,-(sp) move.l a0,-(sp) .WaitEvent: move.l (sp),a0 move.l wd_UserPort(a0),a0 ; Window -> UserPort move.l _AbsExecBase,a6 CallLib WaitPort ; Wait for a message .GetEvent: move.l (sp),a0 ; Get UserPort pointer bsr.w GetIMessage bmi.s .GetEvent ; Event processed - get next event beq.s .WaitEvent ; No message - wait more cmp.l #IDCMP_GADGETUP,d3 ; Any gadget released ? bne.s .GetEvent ; Nope! Get next event cmp.w #CANCEL_GAD,gg_GadgetID(a2) beq.b .Exit bra.s .GetEvent .Exit move.l (sp)+,a0 movem.l (sp)+,d0-d3/a0-a3/a6 rts ;------------------------ Data for requester ---------------------------- IDCMP3: equ BUTTONIDCMP!IDCMP_REFRESHWINDOW!IDCMP_VANILLAKEY!IDCMP_RAWKEY BevelBoxTags: dc.l GT_VisualInfo, 0, GTBB_Recessed, TRUE dc.l TAG_DONE ReqGadDatas: dc.w 1 dc.w 175, 25, 100, 14, CANCEL_GAD dc.l BUTTON_KIND, CancelTxt, StdGadTags, PLACETEXT_IN ReqWinTags: dc.l WA_Width, 450, WA_InnerHeight, 45 dc.l WA_Title, reqtitle, WA_IDCMP, IDCMP3 reqgl: dc.l WA_Gadgets, 0, TAG_MORE, stdwintags reqglist: equ reqgl+4 reqtitle: dc.b " My progress requester NOT included!!!",0 CancelTxt: dc.b "_Cancel",0 even ;--------------------------------------------------------------------------- ; include "data:Sources/Routines/TestProgs/HotkeyRoutines.s" ;------------------------------------- BSS ----------------------------------- STRUCTURE BSS,0 WORD TopBorOffs ; Top border offset for gadgets LONG vi_inf LONG RememberKey ; for AllocRemember of userdata LONG main_win LONG gt_gad STRUCT gt_ng,gng_SIZEOF ; NewGadget structure LONG MainWinSigMask ; Signal mask for main window LONG req_win STRUCT myreq,rq_SIZEOF LONG mx_gad ; Storage for some gadget ptrs LONG lv_gad LONG cy_gad LONG sl_gad LONG sc_gad LONG pa_gad LABEL BSS_Sizeof SECTION BSSDatas,BSS BSS_Datas: ds.b BSS_Sizeof