;SpeedBar-Gadget, written by Uwe Keller, 5.10.2012

EnableExplicit

Enumeration ;flags
  #SpeedBarBorder = 1
EndEnumeration
Enumeration ;attributes
  #SpeedBarMaximum
  #SpeedBarSmooth
  #SpeedBarBackColor
  #SpeedBarGridColor
  #SpeedBarValueColor
  #SpeedBarSplitsX
  #SpeedBarSplitsY
  #SpeedBarDigits
  #SpeedBarFont
EndEnumeration

Structure _SpeedBarValue
  Time.l
  Value.f
EndStructure
Structure _SpeedBar
  ;variables
  Canvas.i ;canvas gadget id
  Flags.i ;canvas gadget flags
  MaxItems.i ;maximum number of items (screenwidth)
  Font.i ;font id used for labels
  List Values._SpeedBarValue()
  ;attributes
  Maximum.i ;maximum possible value
  Smooth.i ;number of values to calculate an average (will smooth line)
  BackColor.i ;back color of the diagramm
  GridColor.i ;grid color of the diagramm
  ValueColor.i ;value color of the diagramm
  SplitsX.i ;number of horizontal sections (0=auto)
  SplitsY.i ;number of vertical sections (0=auto)
  Digits.i ; number of digits for values
EndStructure

Procedure _SpeedBarPaintLabel(x, y, w, h, Text.s, BackColor, ForeColor)
  ;draw a speed or time label
  ;background
  Box(x, y, w, h, BackColor)
  ;text centered
  x + (w - TextWidth(Text)) / 2
  y + (h - TextHeight(Text)) / 2
  DrawText(x, y, Text, ForeColor, BackColor)
EndProcedure
Procedure.f SpeedBarValue(Gadget)
  ;returns the most recent speed value
  Protected *d._SpeedBar = GetGadgetData(Gadget)
  If LastElement(*d\Values())
    ProcedureReturn *d\Values()\Value
  EndIf
EndProcedure
Procedure SpeedBarFree(Gadget)
  ;frees all memory related to the speed bar gadget (it cannot be further used!)
  Protected *d._SpeedBar = GetGadgetData(Gadget)
  FreeFont(*d\Font)
  FreeList(*d\Values())
  FreeMemory(*d)
  FreeGadget(Gadget)
EndProcedure
Procedure SpeedBarSetAttribute(Gadget, Attribute, Value)
  ;sets a speed bar attribute
  Protected *d._SpeedBar = GetGadgetData(Gadget)
  Select Attribute
  Case #SpeedBarMaximum
    *d\Maximum = Value
  Case #SpeedBarSmooth
    *d\Smooth = Value
  Case #SpeedBarBackColor
    *d\BackColor = Value
  Case #SpeedBarGridColor
    *d\GridColor = Value
  Case #SpeedBarValueColor
    *d\ValueColor = Value
  Case #SpeedBarSplitsX
    *d\SplitsX = Value
  Case #SpeedBarSplitsY
    *d\SplitsY = Value
  Case #SpeedBarDigits
    *d\Digits = Value
  Case #SpeedBarFont
    *d\Font = Value
  EndSelect
EndProcedure
Procedure SpeedBarGetAttribute(Gadget, Attribute)
  ;returns a speed bar attribute
  Protected *d._SpeedBar = GetGadgetData(Gadget)
  Select Attribute
  Case #SpeedBarMaximum
    ProcedureReturn *d\Maximum
  Case #SpeedBarSmooth
    ProcedureReturn *d\Smooth
  Case #SpeedBarBackColor
    ProcedureReturn *d\BackColor
  Case #SpeedBarGridColor
    ProcedureReturn *d\GridColor
  Case #SpeedBarValueColor
    ProcedureReturn *d\ValueColor
  Case #SpeedBarSplitsX
    ProcedureReturn *d\SplitsX
  Case #SpeedBarSplitsY
    ProcedureReturn *d\SplitsY
  Case #SpeedBarDigits
    ProcedureReturn *d\Digits
  Case #SpeedBarFont
    ProcedureReturn *d\Font
  EndSelect
EndProcedure
Procedure SpeedBarPaint(Gadget)
  Protected *d._SpeedBar, x, y, w, h, tw, th, sx, sy, i, n, lh, lasty, color, speed.f, time.s
  ;repaint the SpeedBar
  If StartDrawing(CanvasOutput(Gadget))
    *d = GetGadgetData(Gadget)
    ;paint area size
    w = OutputWidth()
    h = OutputHeight()
    ;set drawing font
    DrawingFont(FontID(*d\Font))
    ;background
    Box(0, 0, w, h, *d\BackColor)
    ;x-grid
    #_SpeedBarTextPadding = 2
    tw = TextWidth("00:00") + #_SpeedBarTextPadding
    th = TextHeight("00:00") + #_SpeedBarTextPadding
    ;horizontal split count
    If *d\SplitsX
      sx = *d\SplitsX ;fixed
    Else
      sx = w / (tw * 1.25) ;variable (use 25% padding)
    EndIf
    ;paint horizontal grid with label
    If sx
      For i = 0 To sx
        x = (w - 1) * i / sx
        Line(x, 0, 1, h, *d\GridColor)
        If i > 0 And i < sx
          n = ListSize(*d\Values()) - (w - x)
          If n >= 0
            If SelectElement(*d\Values(), n)
              time = FormatDate("%hh:%ii", *d\Values()\Time)
              _SpeedBarPaintLabel(x - tw / 2, h - th, tw, th, time, *d\GridColor, *d\BackColor)
            EndIf
          EndIf
        EndIf
      Next
    EndIf
    ;y-grid
    tw = TextWidth(StrD(*d\Maximum, *d\Digits)) + #_SpeedBarTextPadding
    ;vertical split
    If *d\SplitsY
      sy = *d\SplitsY
    Else
      sy = h / (th * 2) ;variable (use 100% padding)
    EndIf
    ;paint vertical grid with label
    If sy
      For i = 0 To sy
        y = (h - 1) * i / sy
        Line(0, y, w, 1, *d\GridColor)
        If i < sy
          speed = *d\Maximum * (sy - i) / sy
          _SpeedBarPaintLabel(0, y, tw, th, StrD(speed, *d\Digits), *d\GridColor, *d\BackColor)
        EndIf
      Next
    EndIf
    ;value
    If LastElement(*d\Values())
      color = RGBA(Red(*d\ValueColor), Green(*d\ValueColor), Blue(*d\ValueColor), 48)
      x = w - 1
      Repeat
        ;calculate line height (take care of position inside drawing area)
        lh = (h - 1) * *d\Values()\Value / *d\Maximum
        If lh > 0
          ;upper bound limit
          If lh >= h
            lh = h - 1
          EndIf
          y = h - lh
          ;transparent fill
          DrawingMode(#PB_2DDrawing_AlphaBlend)
          Line(x, y, 1, lh, color)
          DrawingMode(#PB_2DDrawing_Default)
          ;value line
          If Not lasty Or lasty = y
            Line(x, y, 1, 1, *d\ValueColor)
          Else
            LineXY(x, y, x + 1, lasty, *d\ValueColor)
          EndIf
          lasty = y
        Else
          lasty = 0
        EndIf
        x - 1
      Until x = 0 Or Not PreviousElement(*d\Values())
    EndIf
    StopDrawing()
  EndIf
EndProcedure
Procedure SpeedBarAdd(Gadget, Value.f)
  ;stores cached value with timestamp and update display
  Protected *d._SpeedBar = GetGadgetData(Gadget)
  ;smooth value (calculate average of latest available values)
  If Value > 0 And *d\Smooth > 0 And LastElement(*d\Values())
    Protected n = 1
    Repeat
      If *d\Values()\Value = 0
        Break
      EndIf
      Value + *d\Values()\Value
      n + 1
    Until n > *d\Smooth Or Not PreviousElement(*d\Values())
    Value / n
  EndIf
  ;add value to collection
  LastElement(*d\Values())
  AddElement(*d\Values())
  *d\Values()\Time = Date()
  *d\Values()\Value = Value
  ;limit number of values to screen width
  If ListSize(*d\Values()) > *d\MaxItems
    FirstElement(*d\Values())
    DeleteElement(*d\Values())
  EndIf
  ;show value
  SpeedBarPaint(Gadget)
EndProcedure
Procedure SpeedBarGadget(Gadget, x, y, w, h, Flags=0)
  ;create new speedbar
  Protected f, *d._SpeedBar, desktops, i
  ;build canvas flags
  If Flags & #SpeedBarBorder
    f | #PB_Canvas_Border
  EndIf
  ;create additional speedbar object data
  *d = AllocateMemory(SizeOf(_SpeedBar))
  *d\Canvas = CanvasGadget(Gadget, x, y, w, h, f)
  *d\Flags = Flags
  *d\Font = LoadFont(#PB_Any, "", 8)
  *d\Maximum = 100
  *d\BackColor = $000000
  *d\GridColor = $1C1C1C
  *d\ValueColor = $0000FF
  NewList *d\Values()
  ;store object in gadget data
  If Gadget = #PB_Any
    SetGadgetData(*d\Canvas, *d)
  Else
    SetGadgetData(Gadget, *d)
  EndIf
  ;maximum number of values to store is limited to desktop width
  desktops = ExamineDesktops()
  For i = 0 To desktops - 1
    If *d\MaxItems < DesktopWidth(i)
      *d\MaxItems = DesktopWidth(i)
    EndIf
  Next
  ;return gadget id
  ProcedureReturn *d\Canvas
EndProcedure

DisableExplicit

CompilerIf 1
  If OpenWindow(0, 0, 0, 460, 180, "Speedbar-Demo", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
    sb = SpeedBarGadget(#PB_Any, 10, 10, 440, 160, #SpeedBarBorder)
    SpeedBarSetAttribute(sb, #SpeedBarMaximum, 1)
    SpeedBarSetAttribute(sb, #SpeedBarDigits, 2)
    AddWindowTimer(0, 0, 100)
    value.f = 0.5
    Repeat
      Select WaitWindowEvent()
      Case #PB_Event_SizeWindow
        ResizeGadget(sb, #PB_Ignore, #PB_Ignore, WindowWidth(0) - 20, WindowHeight(0) - 20)
        SpeedBarPaint(sb)
      Case #PB_Event_Timer
        ;change color once a second
        n + 1
        If Not n % 10
          SpeedBarSetAttribute(sb, #SpeedBarValueColor, RGB(Random(256), Random(256), Random(256)))
        EndIf
        ;update speedbar once a second
        value + (Random(30) - 15) / 1000
        SpeedBarAdd(sb, value)
      Case #PB_Event_CloseWindow
        Break
      EndSelect
    ForEver
    SpeedBarFree(sb)
  EndIf
CompilerEndIf
; IDE Options = PureBasic 5.00 Beta 3 (Windows - x86)
; Folding = AA+
; HideErrorLog