CloseEd ;We need these OS-includes XINCLUDE commodities.bb2 XINCLUDE gadtools.bb2 XINCLUDE dosasl.bb2 XINCLUDE asllib.bb2 ;This is the screenmode-requester XINCLUDE screenreq ;The invisible mousepointer NEWTYPE.spritedata a.w b c d e f End NEWTYPE ;Tagitem for asl and gadtools NEWTYPE.tags a.l b c d e f g h i j k l m n o p q r s t End NEWTYPE ;StringInfo in amigalibs.res is wrong NEWTYPE.StringInfo2 *Buff.b *UndoBuffer.b BufferPos.w MaxChars.w DispPos.w UndoPos.w NumChars.w DispCount.w CLeft.w:CTop *Extension.b LongInt.l *AltKeyMap.KeyMap End NEWTYPE ;Process-struct NEWTYPE.Process pr_Task.Task pr_MsgPort.MsgPort pr_Pad.w *pr_SegList.b pr_StackSize.l *pr_GlobVec.b pr_TaskNum.l *pr_StackBase.b pr_Result2.l *pr_CurrentDir.b *pr_CIS.b *pr_COS.b *pr_ConsoleTask.b *pr_FileSystemTask.b *pr_CLI.b *pr_ReturnAddr.b *pr_PktWait.b *pr_WindowPtr.b *pr_HomeDir.b pr_Flags.l *pr_ExitCode.w pr_ExitData.l *pr_Arguments.b pr_LocalVars.MinList pr_ShellPrivate.l pr_CES.l End NEWTYPE ;WBStartup, needed for tooltype-check NEWTYPE.WBStartup sm_Message.Message *sm_Process.MsgPort *sm_Segment.b sm_NumArgs.l *sm_ToolWindow.b *sm_ArgList.WBArg End NEWTYPE ;DiskObject, needed for tooltype-check NEWTYPE.DiskObject do_Magic.w do_Version.w do_Gadget.Gadget do_Type.b pad1.b *do_DefaultTool.b *do_ToolTypes.l do_CurrentX.l do_CurrentY.l *do_DrawerData.b ; should normally be .DrawerData *do_ToolWindow.b do_StackSize.l End NEWTYPE ;Dummy-structure for pointer on array of pointers NEWTYPE.pointer_array one.l End NEWTYPE ;All special types DEFTYPE.spritedata *sprdata DEFTYPE.SimpleSprite spr DEFTYPE.NewBroker nbroker DEFTYPE.MsgPort *broker_mp,*port DEFTYPE.NewScreen newscreen DEFTYPE.Screen *myscreen,*blankscreen DEFTYPE.NewWindow newwindow DEFTYPE.Window *mywindow DEFTYPE.InputEvent *ievent DEFTYPE.Gadget *gad,*glist,*gad1,*gad2,*gad3,*gad4,*gad5,*gad6 DEFTYPE.NewGadget ng DEFTYPE.l *vi DEFTYPE.TextAttr topaz80 DEFTYPE.IntuiMessage *imsg DEFTYPE.Message *msg,halt DEFTYPE.AnchorPath *ap DEFTYPE.tags tags DEFTYPE.StringInfo2 *sinfo DEFTYPE.FileRequester *freq DEFTYPE.EasyStruct easy DEFTYPE.NameInfo screenname DEFTYPE.List *modlist DEFTYPE.Node *modnode,*tempnode DEFTYPE.Image image,image2 DEFTYPE.l ;This is a function for the readconfig-subroutine Function.l getval{s} Function Return Val(UnLeft$(Peek$(s),1)) End Function ;This is a statement for the writeconfig-subroutine Statement putint{i,fh} f$=Str$(i)+Chr$(10)+Chr$(0) FPuts_ fh,&f$ End Statement ;Max. 99 modules + 20 tooltypes Dim modname$(100) Dim tta$(20) Dim ttpoint.l(20) Dim ttn$(20) port$="BB.BlankModule"+Chr$(0) ;fontattrib for gadgets fname$="topaz.font"+Chr$(0) topaz80\ta_Name=&fname$,8,0,0 ;These are missing in amigalibs.res #GFLG_SELECTED=$80 #STRINGA_ExitHelp=#STRINGA_Dummy+$13 ;The CTRL-C signal from dos.h #SIGBREAKF_CTRL_C=1LSL12 ;The popkey-event #EVT_HOTKEY=1 ;The blankkey-event #EVT_BLANKKEY=2 ;Other events #IEVENT=3 ;The gadget-IDs #GAD_QUIT=0 #GAD_SAVE=1 #GAD_TEST=2 #GAD_CONFIG=3 #GAD_INFO=4 #GAD_ABOUT=5 #GAD_MODS=6 #GAD_PATH=7 #GAD_TIMEOUT=8 #GAD_MTIMEOUT=9 #GAD_BLANKKEY=10 #GAD_POPKEY=11 #GAD_POPUP=12 #GAD_MOUSE=13 #GAD_SCREEN=14 #GAD_SCREENNAME=15 #GAD_FILEREQ=16 #GAD_MODPRI=17 #GAD_HIDE=18 ;The gadget-labels gtext0$="_Quit"+Chr$(0) gtext1$="_Save"+Chr$(0) gtext2$="_Test"+Chr$(0) gtext3$="_Config..."+Chr$(0) gtext4$="_Info"+Chr$(0) gtext5$="_About"+Chr$(0) gtext6$="_Modules"+Chr$(0) gtext7$="_Path: "+Chr$(0) gtext8$="Time_out:"+Chr$(0) gtext9$="Tim_e:"+Chr$(0) gtext10$="_Blankkey:"+Chr$(0) gtext11$="Pop_key:"+Chr$(0) gtext12$="Pop_up at startuptime"+Chr$(0) gtext13$="B_lank Mouse"+Chr$(0) gtext14$="Sc_reen..."+Chr$(0) gtext15$=Chr$(0) gtext16$=Chr$(0) gtext17$="Mo_dPri: "+Chr$(0) gtext18$="_Hide"+Chr$(0) ;This is the search pattern for the modules (used to find the modules) modpattern$="BB."+Chr$(126)+"(#(#?.#?))"+Chr$(0) ;Prepare the stop-message halt\mn_Length=SizeOf.Message ;The appearence in Commodities-Exchange brokername$="BlitzBlank"+Chr$(0) brokertitel$="BlitzBlank 1.00 "+Chr$(169)+" 1993 Thomas Brkel"+Chr$(0) brokerdesc$="Screenblanker written in BlitzBasic 2"+Chr$(0) ;Fetch tooltype-names For i=0 To 11 Read ttn$(i) Next i ;Find my task-struct *myproc.Process=FindTask_(0) ;Started from Workbench? If *myproc\pr_CLI=0 ;Wait for WB`s message WaitPort_(*myproc\pr_MsgPort) ;Get WB`s message *wbmsg.WBStartup=GetMsg_(*myproc\pr_MsgPort) Else ;Not started from WB End EndIf ;Get my DiskObject *altlock=CurrentDir_(*wbmsg\sm_ArgList\wa_Lock) *obj.DiskObject=GetDiskObject_(*wbmsg\sm_ArgList\wa_Name) CurrentDir_ *altlock ;Get tooltype-array *tt.pointer_array=*obj\do_ToolTypes ;search for tooltypes name$=ttn$(0)+Chr$(0) t=FindToolType_(*tt,&name$) If t donotwait=1 EndIf name$=ttn$(1)+Chr$(0) t=FindToolType_(*tt,&name$) If t startpri=Val(Peek$(t)) EndIf name$=ttn$(2)+Chr$(0) t=FindToolType_(*tt,&name$) If t cxpri=Val(Peek$(t)) EndIf name$=ttn$(3)+Chr$(0) t=FindToolType_(*tt,&name$) If t popkey$=Peek$(t)+Chr$(0) EndIf name$=ttn$(4)+Chr$(0) t=FindToolType_(*tt,&name$) If t popup$=Peek$(t) Else popup$="NO" EndIf name$=ttn$(5)+Chr$(0) t=FindToolType_(*tt,&name$) If t blankmodule$=Peek$(t) EndIf name$=ttn$(6)+Chr$(0) t=FindToolType_(*tt,&name$) If t path$=Peek$(t) Else ;path$=String$(Chr$(0),200) MaxLen path$=200 NameFromLock_ GetProgramDir_(),&path$,200 path$=Peek$(&path$) EndIf If Right$(path$,1)<>"/" AND Right$(path$,1)<>":" path$=path$+"/" EndIf name$=ttn$(7)+Chr$(0) t=FindToolType_(*tt,&name$) If t timeout=Val(Peek$(t))*10 EndIf If timeout=0 timeout=50 EndIf name$=ttn$(8)+Chr$(0) t=FindToolType_(*tt,&name$) If t mtimeout=Val(Peek$(t))*10 EndIf If mtimeout=0 mtimeout=10 EndIf name$=ttn$(9)+Chr$(0) t=FindToolType_(*tt,&name$) If t If Peek$(t)="YES" blankmouse=1 EndIf EndIf name$=ttn$(10)+Chr$(0) t=FindToolType_(*tt,&name$) If t blankkey$=Peek$(t)+Chr$(0) EndIf name$=ttn$(11)+Chr$(0) t=FindToolType_(*tt,&name$) If t modpri=Val(Peek$(t)) EndIf ;Free memory from my diskobject FreeDiskObject_ *obj ;Create messageport and give it to the commodity-broker *broker_mp=CreateMsgPort_() nbroker\nb_Port=*broker_mp ;Port created? If *broker_mp ;fill out the broker-structure nbroker\nb_Version=#NB_VERSION nbroker\nb_Name=&brokername$ nbroker\nb_Title=&brokertitel$ nbroker\nb_Descr=&brokerdesc$ nbroker\nb_Unique=#NBU_NOTIFY|#NBU_UNIQUE nbroker\nb_Pri=cxpri nbroker\nb_Flags=#COF_SHOW_HIDE *broker=CxBroker_(nbroker,0) ;Are we unique (we are not running yet)? If *broker ;Allocate RAM for exec-list (for ListView-gadget) *modlist=AllocMem_(SizeOf.List,#MEMF_CLEAR) ;Allocate CHIP-RAM for blanked mouse *sprdata=AllocMem_(SizeOf.spritedata,#MEMF_CHIP|#MEMF_CLEAR) ;Read from "BB.Modules.Config" the screendata Gosub readconfig ;Check screendata Gosub checkmode ;Initialize exec-list for modules-list-gadget Gosub initlist ;Check/search for modules Gosub findmodules ;This is the commodity-signal to wait for cxsigflag=1LSL*broker_mp\mp_SigBit ;Initialize commodity Gosub docomm ;Everything works result=1 ;Automatically popup at start? -> open window If popup$="YES" Gosub winon EndIf ;Main loop Repeat ;Wait for all signals (break, Commodity, Window) sigrcvd=Wait_(#SIGBREAKF_CTRL_C|cxsigflag|winsigflag) ;Was it a signal from our window? If sigrcvd AND winsigflag ;Get all window-messages Repeat ;Use GadTools-GetMsg here because we have GadTools-gadgets *imsg=GT_GetIMsg_(*mywindow\UserPort) ;Found message? If *imsg ;Get class und pointer to gadget class=*imsg\Class *gad=*imsg\IAddress code=*imsg\Code ;Use GadTools-Reply GT_ReplyIMsg_(*imsg) Select class ;Closegadget pressed Case #IDCMP_CLOSEWINDOW Gosub winoff ;Key pressed Case #IDCMP_VANILLAKEY ;Which key? (key-actions equal to gadget-actions) Select code Case 27 ;ESC Gosub winoff Case 104 ;h Gosub winoff Case 72 ;H Gosub winoff Case 113 ;q result=0 Case 81 ;Q result=0 Case 115 ;s Gosub saveall Case 83 ;S Gosub saveall Case 116 ;t Gosub blank Case 84 ;T Gosub blank Case 99 ;c Gosub config Case 67 ;C Gosub config Case 105 ;i Gosub info Case 73 ;I Gosub info Case 97 ;a Gosub about Case 65 ;A Gosub about Case 109 ;m If amod0 amod-1 Gosub setmodlist EndIf Case 112 ;p ActivateGadget_ *gad6,*mywindow,0 Case 80 ;P ActivateGadget_ *gad6,*mywindow,0 Case 111 ;o ActivateGadget_ *gad3,*mywindow,0 Case 79 ;O ActivateGadget_ *gad3,*mywindow,0 Case 101 ;e If blankmouse ActivateGadget_ *gad4,*mywindow,0 EndIf Case 69 ;E If blankmouse ActivateGadget_ *gad4,*mywindow,0 EndIf Case 98 ;b ActivateGadget_ *gad5,*mywindow,0 Case 66 ;B ActivateGadget_ *gad5,*mywindow,0 Case 107 ;k ActivateGadget_ *gad2,*mywindow,0 Case 75 ;K ActivateGadget_ *gad2,*mywindow,0 Case 117 ;u Gosub setpopupgad Case 85 ;U Gosub setpopupgad Case 108 ;l Gosub setblankmousegad Case 76 ;L Gosub setblankmousegad Case 114 ;r Gosub getscreenmode Case 82 ;R Gosub getscreenmode Case 100; d If modpri<0 modpri+1 Gosub setmodprislider EndIf Case 68 ;D If modpri>-120 modpri-1 Gosub setmodprislider EndIf End Select ;One of our gadgets pressed and released Case #IDCMP_GADGETUP ;Which gadget? Select *gad\GadgetID ;Hide-gadget, close window Case #GAD_HIDE Gosub winoff ;Quit-gadget, quit after this loop Case #GAD_QUIT result=0 ;Save-gadget, read all stringgadgets, reconfig ;commodity and write tooltypes Case #GAD_SAVE Gosub saveall ;Test-gadget, blank immediatly Case #GAD_TEST Gosub blank ;Config-gadget, configure the actual module Case #GAD_CONFIG Gosub config ;Info-Gadget, display info about the actual module Case #GAD_INFO Gosub info ;About-Gadget, display info about BlitzBlank Case #GAD_ABOUT Gosub about ;ListView-gadget for the modules Case #GAD_MODS ;Get actual module amod=code blankmodule$=UnLeft$(modname$(amod),1) ;Path-textgadget Case #GAD_PATH ;User pressed HELP? If code=$5f ;Display ASL-filerequester and reactivate gadget Gosub aslfilereq ActivateGadget_ *gad6,*mywindow,0 ;User pressed RETURN or TAB Else ;Get new path from gadget Gosub getpath Gosub findmodules EndIf ;Timeout-gadget Case #GAD_TIMEOUT ;Get new Timeout Gosub gettimeout ;Mousetimeout-gadget Case #GAD_MTIMEOUT ;Get new Mousetimeout Gosub getmtimeout ;Blankkey-gadget Case #GAD_BLANKKEY ;Get new Blankkey, change Commodity Gosub getblankkey Gosub killcomm Gosub docommall ;Popkey-gadet Case #GAD_POPKEY ;Get new Popkey, change Commodity Gosub getpopkey Gosub killcomm Gosub docommall ;Popup-checkmark Case #GAD_POPUP ;Get status of checkmark and set popupflag If *gad\Flags AND #GFLG_SELECTED popup$="YES" Else popup$="NO" EndIf ;Mouse-checkmark Case #GAD_MOUSE ;Get status of checkmark and enable/disable ;Mousetimeout-gadget If *gad\Flags AND #GFLG_SELECTED blankmouse=1 Else blankmouse=0 EndIf Gosub setblankmousetimegad ;Screenmode-gadget Case #GAD_SCREEN Gosub getscreenmode ;Drawer-gadget Case #GAD_FILEREQ ;Fetch new modulepath with ASL-filerequester Gosub aslfilereq ;Priority-slider Case #GAD_MODPRI modpri=code End Select End Select EndIf ;Loop until all window-messages processed Until *imsg=0 EndIf ;Get all Commodity-messages Repeat ; Get message from Commodity`s messageport *msg=GetMsg_(*broker_mp) ;There was really a message? If *msg ;Get message-id, -type, IEvent, IClass msgid=CxMsgID_(*msg) msgtyp=CxMsgType_(*msg) *ievent=CxMsgData_(*msg) class=*ievent\ie_Class ReplyMsg_(*msg) ;Which type of message was it? Select msgtyp ;It was an InputEvent Case #CXM_IEVENT ;Which type of InputEvent? Select msgid ;It was our Popkey Case #EVT_HOTKEY ;Open window Gosub winon ;It was the Blankkey Case #EVT_BLANKKEY ;Blank immediatly Gosub blank ;It was a general InputEvent Case #IEVENT ;Which class of InputEvent? Select class ;It was the 10 times/sec Timerevent Case #IECLASS_TIMER ;Increase Timer and Mousetimer and blank ;if the time is up timer+1 If timeout AND timer>=timeout AND blank=0 Gosub blank EndIf If blankmouse mtimer+1 If mtimer>=mtimeout Gosub blankmouse EndIf EndIf ;It was a keystroke Case #IECLASS_RAWKEY ;Blank mouse and reset Timer, unblank screen If blankmouse Gosub blankmouse EndIf timer=0 If blank=1 Gosub unblank EndIf ;It was something like mousemove etc. Default ;Reset Mousetimer and Timer, unblank screen mtimer=0 timer=0 If blank=1 Gosub unblank EndIf End Select End Select ;It was a command from Exchange Case #CXM_COMMAND ;Which command Select msgid ;Disable ourself Case #CXCMD_DISABLE Gosub winoff ActivateCxObj_ *broker,0 ;Enable again Case #CXCMD_ENABLE ActivateCxObj_ *broker,1 ;Terminate ourself Case #CXCMD_KILL ;Quit after this result=0 ;Open our window Case #CXCMD_APPEAR Gosub winon ;Close our window Case #CXCMD_DISAPPEAR Gosub winoff ;User started tried to start another BlitzBlank Case #CXCMD_UNIQUE ;Open window Gosub winon End Select End Select EndIf ;User sent us a CTRL-C -> terminate If sigrcvd AND #SIGBREAKF_CTRL_C result=0 EndIf ;Loop until all message processed Until *msg=0 ;Loop until no one wants to terminate us Until result=0 ;Close window, terminate blanker, kill Commodity, free Nodes-RAM, ;free spritedata, free List-RAM Gosub winoff Gosub unblank Gosub killcomm Gosub freeallnodes FreeMem_ *sprdata,SizeOf.spritedata FreeMem_ *modlist,SizeOf.List EndIf ;Kill Commodity-messageport DeleteMsgPort_ *broker_mp EndIf ;Reply the WB-message before quit Forbid_ ReplyMsg_(*wbmsg) ;The end of all End ;************************************************************** ; ; SUB-ROUTINES ; ;************************************************************** ;This routine opens our window if it can .winon ;Is the window not open? If winsigflag=0 ;Get WorkBench-screen and it`s width and height *myscreen=LockPubScreen_(0) w=*myscreen\Width h=*myscreen\Height ;Create GadTools-gadgets Gosub gadgets ;Open new window titel$="BlitzBlank 1.00 Copyright 1993 by Thomas Brkel"+Chr$(0) newwindow\LeftEdge=w/2-255,h/2-100,510,200,0,1,#IDCMP_CLOSEWINDOW|#BUTTONIDCMP|#LISTVIEWIDCMP|#IDCMP_VANILLAKEY newwindow\Flags=#WFLG_CLOSEGADGET|#WFLG_DRAGBAR|#WFLG_DEPTHGADGET|#WFLG_ACTIVATE|#RMBTRAP newwindow\FirstGadget=*glist,0,&titel$,*myscreen,0,-1,-1,-1,-1,#CUSTOMSCREEN *mywindow=OpenWindow_(newwindow) ;Could window open? If *mywindow ;Activate GadTools-gadgets GT_RefreshWindow_ *mywindow,0 ;Draw borders tags\a=#GT_VisualInfo tags\b=*vi tags\c=0 DrawBevelBoxA_ *mywindow\RPort,10,20,490,105,tags DrawBevelBoxA_ *mywindow\RPort,10,130,490,45,tags ;This is the signal for events from the window winsigflag=1LSL*mywindow\UserPort\mp_SigBit EndIf ;The window IS open -> bring it to front and activate Else WindowToFront_ *mywindow ActivateWindow_ *mywindow EndIf Return ;Close window if it is open, get all data from string-gadgets, ;redo Commodity and free gadgets .winoff If winsigflag If result Gosub getpath Gosub gettimeout Gosub getmtimeout Gosub getblankkey Gosub getpopkey Gosub killcomm Gosub docommall EndIf Gosub clearwinport CloseWindow_ *mywindow winsigflag=0 FreeGadgets_ *glist FreeVisualInfo_ *vi UnlockPubScreen_ 0,*myscreen Gosub freeimagedata EndIf Return ;This routine starts blanking .blank ;Screen is not blanked yet? If blank=0 Forbid_ *port=FindPort_(&port$) Permit_ ;There is a Blanker running???? -> error -> halt Blanker If *port PutMsg_ *port,halt ;No Blanker running yet Else blank=1 ;Is there an actual module or is it Blackout? If amod ;Start module with "BLANK" dos$="run "+Chr$(34)+path$+"BB."+blankmodule$+Chr$(34) dos$=dos$+" BLANK "+Str$(width)+" "+Str$(height)+" "+Str$(mode)+" "+Str$(monitor)+" "+Str$(depth) dos$=dos$+" x "+Str$(modpri)+" "+path$+Chr$(0) Execute_ &dos$,0,0 cp=0 ;Wait max. 5 sec for module`s port Repeat Delay_ 10 Forbid_ *port=FindPort_(&port$) Permit_ cp+1 Until cp=25 OR *port ;Module`s port not found? If *port=0 title$="BlitzBlank"+Chr$(0) reqtext$=blankmodule$+" is not working!"+Chr$(0) Gosub requester blank=0 Gosub clearwinport EndIf ;Blackout module Else newscreen\LeftEdge=0,0,width,height,1,1,2 newscreen\Type=#CUSTOMSCREEN tags\a=#SA_DisplayID tags\b=modeid tags\c=0 *blankscreen=OpenScreenTagList_(newscreen,tags) If *blankscreen SetRGB4_ *blankscreen\ViewPort,0,0,0,0 Gosub blankmouse Delay_ 10 Else blank=0 EndIf EndIf Gosub clearcxport EndIf EndIf Return ;This routine unblanks if it es blanked .unblank If blank=1 blank=0 If amod ;Send message to module if one exists Forbid_ *port=FindPort_(&port$) Permit_ If *port PutMsg_ *port,halt EndIf Else ;Close Blackout`s screen CloseScreen_ *blankscreen EndIf EndIf Return ;This routine blanks the mousepointer .blankmouse VWait ChangeSprite_ 0,spr,*sprdata Return ;Prepare all GadTools-gadgets .gadgets ;Prepare drawer-gadget-image Gosub doimagedata ;Prepare gadgets *glist=0 *vi=GetVisualInfoA_(*myscreen,0) *gad=CreateContext_(&*glist) tags\a=#GT_Underscore tags\b=#US tags\c=0 ng\ng_LeftEdge=147,180,80,12,>ext1$,topaz80,#GAD_SAVE,0,*vi,0 *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=283,180,80,12,>ext5$,topaz80,#GAD_ABOUT *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=420,180,80,12,>ext0$,topaz80,#GAD_QUIT *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=10,180,80,12,>ext18$,topaz80,#GAD_HIDE *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=20,108,80,12,>ext2$,topaz80,#GAD_TEST *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=215,108,80,12,>ext3$,topaz80,#GAD_CONFIG *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=410,108,80,12,>ext4$,topaz80,#GAD_INFO *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=20,25,80,12,>ext14$,topaz80,#GAD_SCREEN *gad=CreateGadgetA_(#BUTTON_KIND,*gad,ng,tags) ng\ng_LeftEdge=328,89,20,14,>ext16$,topaz80,#GAD_FILEREQ *gad=CreateGadgetA_(#GENERIC_KIND,*gad,ng,0) image\LeftEdge=0,0,20,14,2,*imagedata,3 image2\LeftEdge=0,0,20,14,2,*imagedata+112,3 *gad\Flags=#GFLG_GADGHIMAGE|#GFLG_GADGIMAGE,#GACT_RELVERIFY *gad\GadgetType=*gad\GadgetType|#GTYP_BOOLGADGET,image,image2 tags\c=#GTCB_Checked If popup$="YES" tags\d=True Else tags\d=False EndIf tags\e=0 ng\ng_LeftEdge=203,136,0,0,>ext12$,topaz80,#GAD_POPUP *gad9=CreateGadgetA_(#CHECKBOX_KIND,*gad,ng,tags) tags\c=#GTCB_Checked If blankmouse tags\d=True Else tags\d=False EndIf tags\e=0 ng\ng_LeftEdge=115,156,0,0,>ext13$,topaz80,#GAD_MOUSE *gad10=CreateGadgetA_(#CHECKBOX_KIND,*gad9,ng,tags) tags\c=#GTLV_Labels tags\d=*modlist tags\e=#GTLV_Top tags\f=amod tags\g=#GTLV_ShowSelected tags\h=0 tags\i=#GTLV_Selected tags\j=amod tags\k=0 ng\ng_LeftEdge=20,53,220,50,>ext6$,topaz80,#GAD_MODS *gad1=CreateGadgetA_(#LISTVIEW_KIND,*gad10,ng,tags) tags\c=#GTIN_Number tags\d=mtimeout/10 tags\e=#GTIN_MaxChars tags\f=10 tags\g=#GA_Disabled If blankmouse tags\h=False Else tags\h=True EndIf tags\i=0 ng\ng_LeftEdge=192,155,48,14,>ext9$,topaz80,#GAD_MTIMEOUT *gad4=CreateGadgetA_(#INTEGER_KIND,*gad1,ng,tags) tags\c=#GTST_String tags\d=&popkey$ tags\e=#GTST_MaxChars tags\f=200 tags\g=0 ng\ng_LeftEdge=350,135,140,14,>ext11$,topaz80,#GAD_POPKEY *gad2=CreateGadgetA_(#STRING_KIND,*gad4,ng,tags) tags\c=#GTIN_Number tags\d=timeout/10 tags\e=#GTIN_MaxChars tags\f=10 tags\g=0 ng\ng_LeftEdge=350,155,140,14,>ext8$,topaz80,#GAD_TIMEOUT *gad3=CreateGadgetA_(#INTEGER_KIND,*gad2,ng,tags) tags\c=#GTST_String tags\d=&blankkey$ tags\e=#GTST_MaxChars tags\f=200 tags\g=0 ng\ng_LeftEdge=350,69,140,14,>ext10$,topaz80,#GAD_BLANKKEY *gad5=CreateGadgetA_(#STRING_KIND,*gad3,ng,tags) gadpath$=path$+Chr$(0) tags\c=#GTST_String tags\d=&gadpath$ tags\e=#GTST_MaxChars tags\f=200 tags\g=#STRINGA_ExitHelp tags\h=True tags\i=0 ng\ng_LeftEdge=350,89,140,14,>ext7$,topaz80,#GAD_PATH *gad6=CreateGadgetA_(#STRING_KIND,*gad5,ng,tags) tags\c=#GTTX_Text tags\d=&screentext$ tags\e=#GTTX_Border tags\f=True tags\g=0 ng\ng_LeftEdge=110,25,380,12,>ext15$,topaz80,#GAD_SCREENNAME *gad7=CreateGadgetA_(#TEXT_KIND,*gad6,ng,tags) slidef$="%-4ld"+Chr$(0) tags\c=#GTSL_Min tags\d=-120 tags\e=#GTSL_Max tags\f=0 tags\g=#GTSL_Level tags\h=modpri tags\i=#GTSL_LevelFormat tags\j=&slidef$ tags\k=#GTSL_MaxLevelLen tags\l=4 tags\m=#GA_RelVerify tags\n=True tags\o=#GTSL_LevelPlace tags\p=#PLACETEXT_LEFT tags\q=0 ng\ng_LeftEdge=350,53,140,11,>ext17$,topaz80,#GAD_MODPRI,#PLACETEXT_LEFT *gad8=CreateGadgetA_(#SLIDER_KIND,*gad7,ng,tags) Return ;This routine clears the Commodity`s messageport .clearcxport Repeat *msg=GetMsg_(*broker_mp) If *msg ReplyMsg_ *msg EndIf Until *msg=0 Return ;This routine clears the window`s messageport .clearwinport If winsigflag Repeat *imsg=GT_GetIMsg_(*mywindow\UserPort) If *imsg GT_ReplyIMsg_ *imsg EndIf Until *imsg=0 EndIf Return ;This routine writes the tooltypes .writett If donotwait tta$(0)=ttn$(0)+Chr$(0) EndIf tta$(1)=ttn$(1)+"="+Str$(startpri)+Chr$(0) tta$(2)=ttn$(2)+"="+Str$(cxpri)+Chr$(0) tta$(3)=ttn$(3)+"="+popkey$ tta$(4)=ttn$(4)+"="+popup$+Chr$(0) tta$(5)=ttn$(5)+"="+modname$(amod) tta$(6)=ttn$(6)+"="+path$+Chr$(0) tta$(7)=ttn$(7)+"="+Str$(timeout/10)+Chr$(0) tta$(8)=ttn$(8)+"="+Str$(mtimeout/10)+Chr$(0) If blankmouse tta$(9)=ttn$(9)+"="+"YES"+Chr$(0) Else tta$(9)=ttn$(9)+"="+"NO"+Chr$(0) EndIf tta$(10)=ttn$(10)+"="+blankkey$ tta$(11)=ttn$(11)+"="+Str$(modpri)+Chr$(0) For i=0 To 11 ttpoint(i)=&tta$(i) Next i ;Get my DiskObject *altlock=CurrentDir_(*wbmsg\sm_ArgList\wa_Lock) *obj.DiskObject=GetDiskObject_(*wbmsg\sm_ArgList\wa_Name) *tt.pointer_array=*obj\do_ToolTypes *obj\do_ToolTypes=&ttpoint(0) PutDiskObject_ *wbmsg\sm_ArgList\wa_Name,*obj CurrentDir_ *altlock *obj\do_ToolTypes=*tt FreeDiskObject_ *obj Return ;This routine scans for available modules with DOSASL`s match-routines .findmodules modules=0 *ap=AllocMem_(SizeOf.AnchorPath,#MEMF_CLEAR) d$=path$+Chr$(0) l=Lock_(&d$,-2) old=CurrentDir_(l) If MatchFirst_(&modpattern$,*ap)=0 If *ap\ap_Info\fib_DirEntryType<0 modules+1 modname$(modules)=UnRight$(Peek$(*ap\ap_Info+8),3)+Chr$(0) EndIf While MatchNext_(*ap)=0 If *ap\ap_Info\fib_DirEntryType<0 modules+1 modname$(modules)=UnRight$(Peek$(*ap\ap_Info+8),3)+Chr$(0) EndIf Wend EndIf MatchEnd_(*ap) FreeMem_ *ap,SizeOf.AnchorPath CurrentDir_ old UnLock_ l modname$(0)=Chr$(0) For i=modules+1 To 100 modname$(i)=Chr$(255) Next i Sort modname$() modname$(0)="Blackout"+Chr$(0) flag=0 For i=1 To modules If blankmodule$=UnLeft$(modname$(i),1) flag=1 amod=i EndIf Next i If flag=0 amod=0 blankmodule$="" EndIf ;Steal List-gadget the List If winsigflag tags\a=#GTLV_Labels tags\b=-1 tags\c=0 GT_SetGadgetAttrsA_ *gad1,*mywindow,0,tags EndIf ;Create exec-List Gosub addallnodes ;Readd List to List-gadget If winsigflag tags\a=#GTLV_Labels tags\b=*modlist tags\c=#GTLV_Top tags\d=amod tags\e=#GTLV_ShowSelected tags\f=0 tags\g=#GTLV_Selected tags\h=amod tags\i=0 GT_SetGadgetAttrsA_ *gad1,*mywindow,0,tags EndIf Return ;Check the current modeid and get WB`s ID if modeid is illegal .checkmode If modeid=-1 OR ModeNotAvailable_(modeid) *myscreen=LockPubScreen_(0) width=*myscreen\Width height=*myscreen\Height depth=*myscreen\BitMap\Depth modeid=GetVPModeID_(*myscreen\ViewPort) UnlockPubScreen_ 0,*myscreen EndIf mode=modeid AND $ffff monitor=modeid LSR 16 GetDisplayInfoData_ 0,screenname,SizeOf.NameInfo,#DTAG_NAME,modeid screentext$=Peek$(&screenname\Name)+"/"+Str$(width)+"x"+Str$(height)+"/"+Str$(2^depth)+Chr$(0) Return ;Display Easy-Requester .requester gadget$="OK"+Chr$(0) easy\es_StructSize=SizeOf.EasyStruct easy\es_Title=&title$ easy\es_TextFormat=&reqtext$ easy\es_GadgetFormat=&gadget$ EasyRequestArgs_ 0,easy,0,0 Return ;Kill Commodity-objects .killcomm ActivateCxObj_ *broker,0 DeleteCxObjAll_ *broker Gosub clearcxport Return ;Create complete Commodity .docommall *broker=CxBroker_(nbroker,0) Gosub docomm Return ;Create Commodity`s objects .docomm *cxfilter1=CreateCxObj_(#CX_FILTER,&popkey$,0) AttachCxObj_ *broker,*cxfilter1 *cxsender1=CreateCxObj_(#CX_SEND,*broker_mp,#EVT_HOTKEY) AttachCxObj_ *cxfilter1,*cxsender1 *cxtranslate1=CreateCxObj_(#CX_TRANSLATE,0,0) AttachCxObj_ *cxfilter1,*cxtranslate1 *cxfilter2=CreateCxObj_(#CX_FILTER,&blankkey$,0) AttachCxObj_ *broker,*cxfilter2 *cxsender2=CreateCxObj_(#CX_SEND,*broker_mp,#EVT_BLANKKEY) AttachCxObj_ *cxfilter2,*cxsender2 *cxtranslate2=CreateCxObj_(#CX_TRANSLATE,0,0) AttachCxObj_ *cxfilter2,*cxtranslate2 *cxsender3=CreateCxObj_(#CX_SEND,*broker_mp,#IEVENT) AttachCxObj_ *broker,*cxsender3 ActivateCxObj_ *broker,1 Return ;Get modulepath from pathgadget if path has changed .getpath *sinfo=*gad6\SpecialInfo If Peek$(*sinfo\Buff)<>path$ path$=Peek$(*sinfo\Buff) If Right$(path$,1)<>"/" AND Right$(path$,1)<>":" path$=path$+"/" EndIf Gosub findmodules EndIf Return ;Get timeout from timeout-gadget .gettimeout *sinfo=*gad3\SpecialInfo timeout=*sinfo\LongInt*10 Return ;Get mousetimeout from mousetimeout-gadget .getmtimeout *sinfo=*gad4\SpecialInfo mtimeout=*sinfo\LongInt*10 Return ;Get blankkey from blankkey-gadget .getblankkey *sinfo=*gad5\SpecialInfo blankkey$=Peek$(*sinfo\Buff)+Chr$(0) Return ;Get popupkey from popkey-gadget .getpopkey *sinfo=*gad2\SpecialInfo popkey$=Peek$(*sinfo\Buff)+Chr$(0) Return ;This reads the screendata from the general configfile and is ;the same as in the modules, but with OS-fileroutines .readconfig name$=path$+"BB.Modules.config"+Chr$(0) ;buf$=String$(Chr$(0),70) MaxLen buf$=70 fh=Open_(&name$,1005) If fh While FGets_(fh,&buf$,70) If UnLeft$(Peek$(&buf$),1)="*** BlitzBlank ***" FGets_ fh,&buf$,70 width=getval{&buf$} FGets_ fh,&buf$,70 height=getval{&buf$} FGets_ fh,&buf$,70 mode=getval{&buf$} FGets_ fh,&buf$,70 monitor=getval{&buf$} FGets_ fh,&buf$,70 depth=getval{&buf$} modeid=$10000*monitor+mode EndIf Wend Close_ fh EndIf ;Illegal mode? If width=0 OR height=0 OR depth=0 modeid=-1 EndIf Return ;This writes the screendata to the general configfile and is ;the same as in the modules, but with OS-fileroutines .writeconfig buf$=String$(Chr$(0),70) name$=path$+"BB.Modules.config"+Chr$(0) fh=Open_(&name$,1005) If fh name$=path$+"BB.Modules.temp"+Chr$(0) fh1=Open_(&name$,1006) If fh1 While FGets_(fh,&buf$,70) If UnLeft$(Peek$(&buf$),1)="*** BlitzBlank ***" Repeat e=FGets_(fh,&buf$,70) Until e=0 OR Left$(buf$,3)="***" If e Then FPuts_ fh1,&buf$ Else FPuts_ fh1,&buf$ EndIf Wend Close_ fh1 EndIf Close_ fh EndIf f$=path$+"BB.Modules.temp"+Chr$(0) f2$=path$+"BB.Modules.config"+Chr$(0) DeleteFile_ &f2$ Rename_ &f$,&f2$ fh=Open_(&f2$,1005) If fh Seek_ fh,0,1 f$="*** BlitzBlank ***"+Chr$(10)+Chr$(0) FPuts_ fh,&f$ putint{width,fh} putint{height,fh} putint{mode,fh} putint{monitor,fh} putint{depth,fh} Close_ fh EndIf Return ;Prepare Exec-List .initlist *modlist\lh_Head=&*modlist\lh_Tail *modlist\lh_Tail=0 *modlist\lh_TailPred=&*modlist\lh_Head Return ;Add all modules to the Exec-List of modules .addallnodes Gosub freeallnodes Gosub initlist For ii=modules To 0 Step -1 Gosub addnode Next ii Return ;Add one module to the Exec-List of modules .addnode *modnode=AllocMem_(SizeOf.Node,#MEMF_CLEAR) *modnode\ln_Name=&modname$(ii) AddHead_ *modlist,*modnode Return ;Free all Exec-Nodes .freeallnodes *tempnode=*modlist\lh_Head While *tempnode\ln_Succ *modnode=*tempnode\ln_Succ FreeMem_ *tempnode,SizeOf.Node *tempnode=*modnode Wend Return ;This routine displays the ASL-filerequester .aslfilereq ;Display ASL-Filerequester and get new path *freq=AllocAslRequest_ (#ASL_FileRequest,0) If *freq ActivateCxObj_ *broker,0 gadpath$=path$+Chr$(0) title$="Please choose modulepath..."+Chr$(0) tags\a=#ASL_Dir tags\b=&gadpath$ tags\c=#ASL_Hail tags\d=&title$ tags\e=#ASL_Pattern tags\f=&modpattern$ tags\g=0 If AslRequest_(*freq,tags) path$=Peek$(*freq\rf_Dir) If Right$(path$,1)<>"/" AND Right$(path$,1)<>":" path$=path$+"/" EndIf gadpath$=path$+Chr$(0) tags\a=#GTST_String tags\b=&gadpath$ tags\c=0 GT_SetGadgetAttrsA_ *gad6,*mywindow,0,tags Gosub findmodules EndIf Gosub clearwinport Gosub clearcxport ActivateCxObj_ *broker,1 FreeAslRequest_ *freq EndIf Return ;Copy imagedata for drawer-gadget to CHIP-RAM .doimagedata *imagedata=AllocMem_(224,#MEMF_CHIP) CopyMem_ ?imagedata,*imagedata,224 Return ;Free imagedata CHIP-RAM .freeimagedata FreeMem_ *imagedata,224 Return ;Save all data .saveall Gosub writeconfig Gosub getpath Gosub gettimeout Gosub getmtimeout Gosub getblankkey Gosub getpopkey Gosub killcomm Gosub docommall Gosub writett Return ;Config-gadget/key .config ;Is there an actual module or is it "BlackOut"? If amod ;Start the module with "CONFIG" dos$="run "+Chr$(34)+path$+"BB."+blankmodule$+Chr$(34) dos$=dos$+" CONFIG "+Str$(width)+" "+Str$(height)+" " dos$=dos$+Str$(mode)+" "+Str$(monitor)+" "+Str$(depth)+" x "+Str$(modpri)+" "+path$+Chr$(0) Execute_ &dos$,0,0 Else title$="BlitzBlank"+Chr$(0) reqtext$="Nothing to config here."+Chr$(0) Gosub requester EndIf Return ;Info-gadget/key .info ;Is there an actual module or is it "BlackOut"? If amod ;Start the module with "INFO" dos$="run "+Chr$(34)+path$+"BB."+blankmodule$+Chr$(34)+" INFO"+Chr$(0) Execute_ &dos$,0,0 Else title$="BlitzBlank"+Chr$(0) reqtext$="This is BlitzBlank`s internal Blankmodule."+Chr$(0) Gosub requester EndIf Return ;About-gadget/key .about ;deactivate commodity, display EasyRequest, ;clear window- and commodity-messageport ;reactivate commodity ActivateCxObj_ *broker,0 title$="BlitzBlank"+Chr$(0) reqtext$="BlitzBlank 1.00 (07.09.1993)"+Chr$(10) reqtext$=reqtext$+"Modular screenblanker"+Chr$(10) reqtext$=reqtext$+"written in BlitzBasic 2"+Chr$(10) reqtext$=reqtext$+Chr$(169)+" 1993 by Thomas Brkel"+Chr$(0) Gosub requester Gosub clearwinport Gosub clearcxport ActivateCxObj_ *broker,1 Return ;This sets the Module-ListView .setmodlist tags\a=#GTLV_Top tags\b=amod tags\c=#GTLV_Selected tags\d=amod tags\e=0 GT_SetGadgetAttrsA_ *gad1,*mywindow,0,tags blankmodule$=UnLeft$(modname$(amod),1) Return ;This sets the popup-checkmark .setpopupgad tags\a=#GTCB_Checked tags\c=0 If popup$="YES" popup$="NO" tags\b=False Else popup$="YES" tags\b=True EndIf GT_SetGadgetAttrsA_ *gad9,*mywindow,0,tags Return ;This sets the blankmouse-checkmark .setblankmousegad tags\a=#GTCB_Checked tags\c=0 If blankmouse blankmouse=0 tags\b=False Else blankmouse=1 tags\b=True EndIf GT_SetGadgetAttrsA_ *gad10,*mywindow,0,tags Gosub setblankmousetimegad Return ;This sets the mousetimeout in the stringgadget .setblankmousetimegad tags\a=#GA_Disabled tags\c=0 If blankmouse tags\b=False Else tags\b=True EndIf GT_SetGadgetAttrsA_ *gad4,*mywindow,0,tags Return ;This displays the screenmoderequester .getscreenmode ;Deactivate Commodity, get new screenmode, set ;Screentextfield, and reactivate Commodity ActivateCxObj_ *broker,0 ;We get width, height, depth, modeid from this screenreq{} ;Check that modeid and set new screentext Gosub checkmode tags\a=#GTTX_Text tags\b=&screentext$ tags\c=0 GT_SetGadgetAttrsA_ *gad7,*mywindow,0,tags Gosub clearwinport Gosub clearcxport ActivateCxObj_ *broker,1 Return ;This sets the level of the priority-slider .setmodprislider tags\a=#GTSL_Level tags\b=modpri tags\c=0 GT_SetGadgetAttrsA_ *gad8,*mywindow,0,tags Return ;The tooltypes Data.s DONOTWAIT,STARTPRI,CX_PRIORITY,CX_POPKEY,CX_POPUP,"MODULE" Data.s MODULEPATH,BLANKTIME,MOUSETIME,BLANKMOUSE,BLANKKEY,MODPRI ;The imagedata for the drawer-gadget imagedata: IncBin imagedata ;The version-string Dc.b "$VER: BlitzBlank 1.00 (07.09.93)",0 Even