;' Based On DMA Monitor - SNG March 1999, HiSoft BASIC, WB2+
.initalize
  WBStartup:NoCli:CloseEd
  WbToScreen 0
  WBenchToFront_

  *scr.Screen=Peek.l(Addr Screen(0)) ; get some screen info
  scrnh.w = *scr\Height
  scrnw.w = *scr\Width
  ;scrnd.w = *scr\Depth
  ;scrnd=1^scrnd

  as.s="C:Audioselect"
  name.s=Peek$(Peek.l(FindTask_(0)+$B0)+4)
  title.s=name+" V0.02"
  oldstat.s="0"

  If Exists(as)
    picasso.b=True
  Else
    picasso=False
  EndIf

  JSR loadprefs
  JSR creategfx

  If picasso
    ShapeGadget 0,2,2,$0,0,0,1
    ShapeGadget 0,19,2,$0,1,0,1
    ShapeGadget 0,36,2,$0,2,0,1
    ShapeGadget 0,53,2,$0,3,0,1

    Dim cmd.s(3)
    cmd(0)=as+" source=amiga set"
    cmd(1)=as+" source=av set"
    cmd(2)=as+" source=cd set"
    cmd(3)=as+" source=linein set"
    Window 0,xpos.w,ypos.w,72,10,$800,"",1,2,0
  Else
    Window 0,xpos,ypos,72,10,$800,"",1,2
  EndIf
  rp.l=RastPort(0)

  ;###[ CREATE OUR CUSTOM DRAGBAR! ]################################

  ;--- As David said, this looks bloody horrible, but it works :)
  ;
  DEFTYPE.Gadget      *gad
  DEFTYPE.NewGadget   ng

  ;--- some stuff we need :)
  ;
  *WinAddr = Peek.l(Addr Window(0))
  *VisInfo = GetVisualInfoA_(*scr,0)
  *gad = CreateContext_(&*GadList)

  ;--- Create drag bar gadget stuff
  ;
  ng\ng_LeftEdge  = 0
  ng\ng_TopEdge   = 0
  ng\ng_Width     = 72
  ng\ng_Height    = 10
  ng\ng_GadgetText= 0
  ng\ng_TextAttr  = 0
  ng\ng_GadgetID  = -1

  ng\ng_Flags     = 0
  ng\ng_VisualInfo= *VisInfo
  ng\ng_UserData  = 0
  *gad = CreateGadgetA_(#GENERIC_KIND, *gad, &ng, 0)

  *gad\Activation = *gad\Activation | #GACT_IMMEDIATE | #GACT_RELVERIFY
  *gad\GadgetType = #GTYP_WDRAGGING | #GTYP_BOOLGADGET
  *gad\Flags = *gad\Flags | #GFLG_GADGHNONE

  ;--- Add our custom dragbar to the window...
  ;
  AddGList_ *WinAddr,*GadList,-1,-1,0
  RefreshGList_ *GadList,*WinAddr,0,-1
  GT_RefreshWindow_ *WinAddr,0

  ;###[ END CREATE OUR CUSTOM DRAGBAR! ]############################
  SetAPen_ rp,light.w   ;draw border round window
  Move_ rp,0,9
  Draw_ rp,0,0
  Draw_ rp,71,0
  SetAPen_ rp,dark.w
  Draw_ rp,71,9
  Draw_ rp,1,9
  SetAPen_ rp,back.w
  RectFill_ rp,1,1,70,8

  Repeat
    stat.s=Right$(Bin$(Peek.w($dff002)),4) ; get DMA information
    If stat<>oldstat                       ; check for change
      chnl.b=4
      For a.b=0 To 3
        If Mid$(stat,chnl,1)="1"           ; get channel status
          If lon.w=0 Then RectFill_ rp,17*a+2,3,17*a+18,6
          WBlit 1,17*a+2,2                 ; if on activate led
        Else
          If loff.w=0 Then RectFill_ rp,17*a+2,3,17*a+18,6
          WBlit 0,17*a+2,2                 ; and draw off led
        EndIf
        chnl-1
      Next
      oldstat.s=stat
    EndIf
    For j=1 To 10                          ; pause about 1/5th second
      WaitTOF_
    Next
    If picasso
      If Event=$40
        Execute_ &cmd(GadgetHit),0,0
        oldstat="0"
      EndIf
    EndIf
    k.s=Inkey$
  Until k=Chr$(27)                         ; quit if esc pressed

  JSR saveprefs

  RemoveGList_ *WinAddr,*GadList,-1        ; clean up and bye bye...
  FreeGadgets_ *GadList
  FreeVisualInfo_ *VisInfo
  Free Window 0
End

.loadprefs
  If GetIconObject("PROGDIR:"+name)
    border.w =Val(FindToolValue("BORDER"))
    loff.w   =Val(FindToolValue("LIGHTOFF"))
    lon.w    =Val(FindToolValue("LIGHTON"))
    hoff.w   =Val(FindToolValue("HILIGHTOFF"))
    hon.w    =Val(FindToolValue("HILIGHTON"))
    back.w   =Val(FindToolValue("BACKGROUND"))
    light.w  =Val(FindToolValue("LIGHT"))
    dark.w   =Val(FindToolValue("DARK"))
    xpos.w   =Val(FindToolValue("XPOS"))
    ypos.w   =Val(FindToolValue("YPOS"))
    FreeIconObject

    If border > 255 Then border=1
    If loff   > 255 Then loff=0
    If lon    > 255 Then lon=3
    If hoff   > 255 Then hoff=2
    If hon    > 255 Then hon=2
    If back   > 255 Then back=0
    If light  > 255 Then light=2
    If dark   > 255 Then dark=1
    If xpos>scrnw-72 Then xpos=scrnw-72
    If ypos>scrnh-10 Then ypos=scrnh-10

  Else
    Request "Error...","Can't Open Tooltypes","_Ok"
    End
  EndIf
RTS

.saveprefs
  If GetIconObject("PROGDIR:"+name)
    ok=SetToolValue ("BORDER",Str$(border))
    If ok=False Then NewToolType "BORDER",Str$(border)
    ok=SetToolValue ("LIGHTOFF",Str$(loff))
    If ok=False Then NewToolType "LIGHTOFF",Str$(loff)
    ok=SetToolValue ("LIGHTON",Str$(lon))
    If ok=False Then NewToolType "LIGHTON",Str$(lon)
    ok=SetToolValue ("HILIGHTOFF",Str$(hoff))
    If ok=False Then NewToolType "HILIGHTOFF",Str$(hoff)
    ok=SetToolValue ("HILIGHTON",Str$(hon))
    If ok=False Then NewToolType "HILIGHTON",Str$(hon)
    ok=SetToolValue ("BACKGROUND",Str$(back))
    If ok=False Then NewToolType "BACKGROUND",Str$(back)
    ok=SetToolValue ("LIGHT",Str$(light))
    If ok=False Then NewToolType "LIGHT",Str$(light)
    ok=SetToolValue ("DARK",Str$(dark))
    If ok=False Then NewToolType "DARK",Str$(dark)
    ok=SetToolValue ("XPOS",Str$(xpos))
    If ok=False Then NewToolType "YPOS",Str$(ypos)
    ok=SetToolValue ("XPOS",Str$(xpos))
    If ok=False Then NewToolType "YPOS",Str$(ypos)
    FreeIconObject
  Else
    Request "Error...","Cannot Save Prefs","Oh Sh*t..."
  EndIf
RTS

.creategfx
  BitMap 0,16,6,8    ;create led shapes
    Boxf 0,0,15,5,border
    Boxf 1,1,14,4,loff
    Boxf 1,1,2,2,hoff
    GetaShape 0,0,0,16,6
    Boxf 1,1,14,4,lon
    Boxf 1,1,2,2,hon
    GetaShape 1,0,0,16,6
  Free BitMap 0
RTS