So you don’t miss the next ones, here’s a little info tool below…just for fun a little website grabber.
Maybe someone can make use of it.
Code: Select all
; To set your own location, change this line: cookie.s = "locationOption=4; country=Deutschland;[..]"
EnableExplicit
Structure PolarlichtRow
datum.s
sturm.s
ab.s
kp.f
mlat.f
dateValue.q
isToday.b
probable.b
visible.b
EndStructure
Global NewList Rows.PolarlichtRow()
Enumeration
#WinMain
EndEnumeration
Enumeration Gadgets
#GadList
#GadCanvas
EndEnumeration
Enumeration Fonts
#FontUI
EndEnumeration
Global HoverMX.i, HoverMY.i
Global HoverActive.b
Global HoverIndex.i = -1
Declare DrawHoverOverlay(canvasW.i, canvasH.i, plotX.i, plotY.i, plotW.i, plotH.i, stepX.f, n.i, barW.i)
Procedure.s HtmlDecodeBasic(s.s)
s = ReplaceString(s, " ", " ")
s = ReplaceString(s, "&", "&")
s = ReplaceString(s, """, #DQUOTE$)
s = ReplaceString(s, "<", "<")
s = ReplaceString(s, ">", ">")
s = ReplaceString(s, "°", "°")
Protected reDec = CreateRegularExpression(#PB_Any, "&#(\d+);")
If reDec
While ExamineRegularExpression(reDec, s) And NextRegularExpressionMatch(reDec)
Protected ent.s = RegularExpressionMatchString(reDec)
Protected code.i = Val(RegularExpressionGroup(reDec, 1))
s = ReplaceString(s, ent, Chr(code))
Wend
FreeRegularExpression(reDec)
EndIf
Protected reHex = CreateRegularExpression(#PB_Any, "&#x([0-9A-Fa-f]+);")
If reHex
While ExamineRegularExpression(reHex, s) And NextRegularExpressionMatch(reHex)
Protected ent2.s = RegularExpressionMatchString(reHex)
Protected code2.i = Val("$" + RegularExpressionGroup(reHex, 1))
s = ReplaceString(s, ent2, Chr(code2))
Wend
FreeRegularExpression(reHex)
EndIf
ProcedureReturn s
EndProcedure
Procedure.s CellHtmlToText(cellHtml.s)
Protected s.s = cellHtml
; Soft-Hyphen entfernen (kommt gern in "Polarlichter" vor)
s = ReplaceString(s, Chr($AD), "")
s = ReplaceString(s, Chr($A0), " ")
s = HtmlDecodeBasic(s)
; Tags raus
Protected reTags = CreateRegularExpression(#PB_Any, "(?is)<[^>]+>")
If reTags
s = ReplaceRegularExpression(reTags, s, " ")
FreeRegularExpression(reTags)
EndIf
; Whitespace normalisieren (wichtig wegen Zeilenumbrüchen im <td>)
Protected reWS = CreateRegularExpression(#PB_Any, "(?is)\s+")
If reWS
s = ReplaceRegularExpression(reWS, s, " ")
FreeRegularExpression(reWS)
EndIf
ProcedureReturn Trim(s)
EndProcedure
Procedure.s ExtractTargetTableHtml(html.s)
Protected reTable = CreateRegularExpression(#PB_Any, "(?is)<table\b[^>]*>.*?Stärke\s+des\s+magnetischen\s+Sturms.*?</table>")
If reTable = 0
ProcedureReturn ""
EndIf
Protected tableHtml.s = ""
If ExamineRegularExpression(reTable, html) And NextRegularExpressionMatch(reTable)
tableHtml = RegularExpressionMatchString(reTable)
EndIf
FreeRegularExpression(reTable)
ProcedureReturn tableHtml
EndProcedure
Procedure ParseRowsFromTable(tableHtml.s)
ClearList(Rows())
Protected reTR = CreateRegularExpression(#PB_Any, "(?is)<tr\b[^>]*>.*?</tr>")
Protected reTD = CreateRegularExpression(#PB_Any, "(?is)<td\b[^>]*>(.*?)</td>")
If reTR = 0 Or reTD = 0
If reTR : FreeRegularExpression(reTR) : EndIf
If reTD : FreeRegularExpression(reTD) : EndIf
ProcedureReturn
EndIf
If ExamineRegularExpression(reTR, tableHtml)
While NextRegularExpressionMatch(reTR)
Protected trHtml.s = RegularExpressionMatchString(reTR)
; aus diesem <tr> die ersten 3 <td> ziehen
Protected tdCount.i = 0
Protected c1.s, c2.s, c3.s
If ExamineRegularExpression(reTD, trHtml)
While NextRegularExpressionMatch(reTD)
tdCount + 1
Select tdCount
Case 1 : c1 = CellHtmlToText(RegularExpressionGroup(reTD, 1))
Case 2 : c2 = CellHtmlToText(RegularExpressionGroup(reTD, 1))
Case 3 : c3 = CellHtmlToText(RegularExpressionGroup(reTD, 1))
EndSelect
If tdCount >= 3
Break
EndIf
Wend
EndIf
If tdCount = 3
If FindString(c1, "Datum", 1) = 0 And c1 <> ""
AddElement(Rows())
Rows()\datum = c1
Rows()\sturm = c2
Rows()\ab = c3
EndIf
EndIf
Wend
EndIf
FreeRegularExpression(reTR)
FreeRegularExpression(reTD)
EndProcedure
Procedure.s CSVQuote(s.s)
s = ReplaceString(s, #DQUOTE$, #DQUOTE$ + #DQUOTE$)
ProcedureReturn #DQUOTE$ + s + #DQUOTE$
EndProcedure
Procedure.f ExtractFirstNumber(s.s)
Protected re = CreateRegularExpression(#PB_Any, "(?i)(-?\d+(?:[\,\.]\d+)?)")
If re = 0
ProcedureReturn 0.0
EndIf
Protected v.f = 0.0
If ExamineRegularExpression(re, s) And NextRegularExpressionMatch(re)
Protected t.s = ReplaceString(RegularExpressionGroup(re, 1), ",", ".")
v = ValF(t)
EndIf
FreeRegularExpression(re)
ProcedureReturn v
EndProcedure
Procedure.f ExtractKPFromSturm(s.s)
Protected kp.f = -1.0
; bevorzugt: "Kp 5" / "KP:7" / "Kp=6"
Protected re = CreateRegularExpression(#PB_Any, "(?i)\bkp\b\s*[:=]?\s*([0-9](?:[\,\.][0-9])?)")
If re
If ExamineRegularExpression(re, s) And NextRegularExpressionMatch(re)
kp = ValF(ReplaceString(RegularExpressionGroup(re, 1), ",", "."))
EndIf
FreeRegularExpression(re)
EndIf
If kp < 0
kp = ExtractFirstNumber(s)
EndIf
If kp < 0 : kp = 0 : EndIf
If kp > 9 : kp = 9 : EndIf
ProcedureReturn kp
EndProcedure
Procedure.f ExtractMLATFromAb(s.s)
Protected mlat.f = -1.0
Protected re = CreateRegularExpression(#PB_Any, "(?i)\bmlat\b\s*[:=]?\s*(\d+(?:[\,\.]\d+)?)")
If re
If ExamineRegularExpression(re, s) And NextRegularExpressionMatch(re)
mlat = ValF(ReplaceString(RegularExpressionGroup(re, 1), ",", "."))
EndIf
FreeRegularExpression(re)
EndIf
If mlat < 0
mlat = ExtractFirstNumber(s)
EndIf
; Plausibilisierung
If mlat < 0 : mlat = 0 : EndIf
If mlat > 90 : mlat = 90 : EndIf
ProcedureReturn mlat
EndProcedure
Procedure.q ExtractDateValue(datum.s)
Protected re = CreateRegularExpression(#PB_Any, "(\d{1,2})\.(\d{1,2})(?:\.(\d{2,4}))?")
If re = 0
ProcedureReturn 0
EndIf
Protected d.i, m.i, y.i
If ExamineRegularExpression(re, datum) And NextRegularExpressionMatch(re)
d = Val(RegularExpressionGroup(re, 1))
m = Val(RegularExpressionGroup(re, 2))
Protected yStr.s = RegularExpressionGroup(re, 3)
If yStr <> ""
y = Val(yStr)
If Len(yStr) = 2
; 2-stellig -> 20xx/19xx
If y < 70
y + 2000
Else
y + 1900
EndIf
EndIf
Else
Protected now.q = Date()
Protected curY.i = Year(now)
Protected curM.i = Month(now)
y = curY
If m < curM - 6
y = curY + 1
ElseIf m > curM + 6
y = curY - 1
EndIf
EndIf
EndIf
FreeRegularExpression(re)
If d >= 1 And d <= 31 And m >= 1 And m <= 12 And y >= 1900
ProcedureReturn Date(y, m, d, 0, 0, 0)
EndIf
ProcedureReturn 0
EndProcedure
Procedure PrepareComputedFields()
Protected today0.q = Date(Year(Date()), Month(Date()), Day(Date()), 0, 0, 0)
Protected todayShort.s = FormatDate("%dd.%mm.", Date())
ForEach Rows()
Rows()\kp = ExtractKPFromSturm(Rows()\sturm)
Rows()\mlat = ExtractMLATFromAb(Rows()\ab)
Rows()\dateValue = ExtractDateValue(Rows()\datum)
Rows()\isToday = #False
If Rows()\dateValue <> 0 And Rows()\dateValue = today0
Rows()\isToday = #True
ElseIf FindString(Rows()\datum, todayShort, 1)
Rows()\isToday = #True
EndIf
Rows()\probable = Bool(Rows()\kp > 7.0)
Rows()\visible = Bool(Rows()\kp > 7.0 And Rows()\mlat > 0.0 And Rows()\mlat < 48.0)
Next
EndProcedure
Procedure FillListGadget()
ClearGadgetItems(#GadList)
Protected i.i = 0
ForEach Rows()
Protected dateDisp.s = Rows()\datum
If Rows()\isToday
dateDisp = "★ " + dateDisp
EndIf
AddGadgetItem(#GadList, -1, dateDisp + #LF$ + StrF(Rows()\kp, 1) + #LF$ + StrF(Rows()\mlat, 1))
; Einfärbung
Protected back.i = RGB(255, 255, 255)
If Rows()\visible
back = RGB(175, 255, 220) ; sichtbar
ElseIf Rows()\probable
back = RGB(255, 235, 175) ; wahrscheinlich
EndIf
; aktuelles Datum zusätzlich markieren
If Rows()\isToday
If Rows()\visible
back = RGB(140, 255, 215)
ElseIf Rows()\probable
back = RGB(255, 225, 160)
Else
back = RGB(210, 230, 255)
EndIf
EndIf
SetGadgetItemColor(#GadList, i, #PB_Gadget_BackColor, back)
i + 1
Next
EndProcedure
Procedure DrawChart()
If IsGadget(#GadCanvas) = 0
ProcedureReturn
EndIf
Protected w.i = GadgetWidth(#GadCanvas)
Protected h.i = GadgetHeight(#GadCanvas)
If w < 50 Or h < 50
ProcedureReturn
EndIf
Protected n.i = ListSize(Rows())
StartDrawing(CanvasOutput(#GadCanvas))
Box(0, 0, w, h, RGB(255, 255, 255))
If n <= 0
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(10, 10, "Keine Daten.")
StopDrawing()
ProcedureReturn
EndIf
; Plot-Rahmen
Protected mL.i = 55
Protected mR.i = 55
Protected mT.i = 28
Protected mB.i = 55
Protected plotX.i = mL
Protected plotY.i = mT
Protected plotW.i = w - mL - mR
Protected plotH.i = h - mT - mB
; MLAT Min/Max aus Daten
Protected mlatMin.f = 9999.0
Protected mlatMax.f = -9999.0
ForEach Rows()
If Rows()\mlat > 0
If Rows()\mlat < mlatMin : mlatMin = Rows()\mlat : EndIf
If Rows()\mlat > mlatMax : mlatMax = Rows()\mlat : EndIf
EndIf
Next
If mlatMin = 9999.0
mlatMin = 40.0 : mlatMax = 60.0
EndIf
; Padding
If mlatMax - mlatMin < 5.0
mlatMin - 2.5
mlatMax + 2.5
Else
mlatMin - 1.5
mlatMax + 1.5
EndIf
If mlatMin < 0 : mlatMin = 0 : EndIf
If mlatMax > 90 : mlatMax = 90 : EndIf
; Grid + Achsen
Protected axisColor.i = RGB(30, 30, 30)
Protected gridColor.i = RGB(225, 225, 225)
; Hintergrund Plot
Box(plotX, plotY, plotW, plotH, RGB(250, 250, 250))
; KP-Gitter (0..9)
Protected k.i
For k = 0 To 9
Protected yy.i = plotY + plotH - Int(k / 9.0 * plotH)
Line(plotX, yy, plotW, 1, gridColor)
Next
; Achsen
Line(plotX, plotY, 1, plotH, axisColor)
Line(plotX, plotY + plotH, plotW, 1, axisColor)
Line(plotX + plotW, plotY, 1, plotH, axisColor)
; Labels links (KP)
DrawingMode(#PB_2DDrawing_Transparent)
For k = 0 To 9
yy = plotY + plotH - Int(k / 9.0 * plotH)
DrawText(5, yy - 7, Str(k))
Next
; Labels rechts (MLAT)
Protected t.i
For t = 0 To 4
Protected v.f = mlatMin + (mlatMax - mlatMin) * (t / 4.0)
yy = plotY + plotH - Int((v - mlatMin) / (mlatMax - mlatMin) * plotH)
DrawText(plotX + plotW + 5, yy - 7, StrF(v, 0))
Next
; Titel/Legende
DrawingFont(FontID(#FontUI))
DrawText(plotX, 4, "KP (Balken) / MLAT (Linie)")
; X-Skalierung
Protected stepX.f
If n <= 1
stepX = 0
Else
stepX = plotW / (n - 1.0)
EndIf
Protected barW.i
If n <= 1
barW = 18
Else
barW = Int(stepX * 0.6)
If barW < 4 : barW = 4 : EndIf
If barW > 22 : barW = 22 : EndIf
EndIf
; MLAT Linie zeichnen
Protected i.i = 0
Protected prevX.i = -1
Protected prevY.i = -1
ForEach Rows()
Protected x.i
If n <= 1
x = plotX + plotW / 2
Else
x = plotX + Int(i * stepX)
EndIf
; aktuelles Datum markieren (vertikale Linie)
If Rows()\isToday
Line(x, plotY, 1, plotH, RGB(200, 60, 60))
EndIf
; KP Balken
Protected kp.f = Rows()\kp
If kp < 0 : kp = 0 : EndIf
If kp > 9 : kp = 9 : EndIf
Protected barH.i = Int(kp / 9.0 * plotH)
Protected yBar.i = plotY + plotH - barH
Protected colKP.i = RGB(80, 140, 210)
If Rows()\visible
colKP = RGB(40, 180, 120)
ElseIf Rows()\probable
colKP = RGB(230, 150, 60)
EndIf
Box(x - barW / 2, yBar, barW, barH, colKP)
; MLAT Punkt + Linie
If Rows()\mlat > 0
Protected yLine.i = plotY + plotH - Int((Rows()\mlat - mlatMin) / (mlatMax - mlatMin) * plotH)
; Verbindung
If prevX >= 0
LineXY(prevX, prevY, x, yLine, axisColor)
EndIf
; Punkt
Box(x - 2, yLine - 2, 5, 5, axisColor)
prevX = x
prevY = yLine
EndIf
i + 1
Next
; X-Labels (ausdünnen)
DrawingMode(#PB_2DDrawing_Transparent)
Protected every.i = 1
If n > 12
every = Int(n / 12)
If every < 1 : every = 1 : EndIf
EndIf
i = 0
ForEach Rows()
If (i % every) = 0 Or Rows()\isToday
If n <= 1
x = plotX + plotW / 2
Else
x = plotX + Int(i * stepX)
EndIf
; kurze Label-Variante
Protected lab.s = Rows()\datum
; oft reicht dd.mm.
Protected reShort = CreateRegularExpression(#PB_Any, "(\d{1,2}\.\d{1,2}\.)")
If reShort
If ExamineRegularExpression(reShort, lab) And NextRegularExpressionMatch(reShort)
lab = RegularExpressionGroup(reShort, 1)
EndIf
FreeRegularExpression(reShort)
EndIf
DrawText(x - 18, plotY + plotH + 6, lab)
EndIf
i + 1
Next
; Schwelle MLAT=48 (optional als Linie)
If 48.0 >= mlatMin And 48.0 <= mlatMax
Protected y48.i = plotY + plotH - Int((48.0 - mlatMin) / (mlatMax - mlatMin) * plotH)
Line(plotX, y48, plotW, 1, RGB(180, 180, 180))
DrawText(plotX + plotW - 60, y48 - 16, "MLAT 48")
EndIf
; Hover-Infobox (Tooltip)
DrawHoverOverlay(w, h, plotX, plotY, plotW, plotH, stepX, n, barW)
StopDrawing()
EndProcedure
Procedure DrawHoverOverlay(canvasW.i, canvasH.i, plotX.i, plotY.i, plotW.i, plotH.i, stepX.f, n.i, barW.i)
If HoverActive = #False
ProcedureReturn
EndIf
If n <= 0
HoverIndex = -1
ProcedureReturn
EndIf
If HoverMX < plotX Or HoverMX > plotX + plotW Or HoverMY < plotY Or HoverMY > plotY + plotH + 40
HoverIndex = -1
ProcedureReturn
EndIf
Protected idx.i
If n <= 1 Or stepX <= 0.0
idx = 0
Else
Protected pos.f = (HoverMX - plotX) / stepX
idx = Round(pos, #PB_Round_Nearest)
If idx < 0 : idx = 0 : EndIf
If idx > n - 1 : idx = n - 1 : EndIf
EndIf
HoverIndex = idx
If SelectElement(Rows(), idx) = 0
ProcedureReturn
EndIf
; X-Position fuer diese Spalte
Protected x.i
If n <= 1
x = plotX + plotW / 2
Else
x = plotX + Int(idx * stepX)
EndIf
; Marker-Linie
DrawingMode(#PB_2DDrawing_Default)
Line(x, plotY, 1, plotH, RGB(120, 120, 120))
; Balken-Outline (KP)
Protected kp.f = Rows()\kp
If kp < 0 : kp = 0 : EndIf
If kp > 9 : kp = 9 : EndIf
Protected barH.i = Int(kp / 9.0 * plotH)
Protected yBar.i = plotY + plotH - barH
DrawingMode(#PB_2DDrawing_Outlined)
Box(x - barW / 2, yBar, barW, barH, RGB(30, 30, 30))
; Tooltip Text
DrawingMode(#PB_2DDrawing_Transparent)
Protected t1.s = "Datum: " + Rows()\datum
Protected t2.s = "KP: " + StrF(Rows()\kp, 1)
Protected t3.s = "MLAT: " + StrF(Rows()\mlat, 1)
Protected pad.i = 7
Protected lineH.i = TextHeight("Ay") + 2
Protected tw.i = TextWidth(t1)
Protected tmp.i = TextWidth(t2) : If tmp > tw : tw = tmp : EndIf
tmp = TextWidth(t3) : If tmp > tw : tw = tmp : EndIf
Protected bw.i = tw + pad * 2
Protected bh.i = lineH * 3 + pad * 2
Protected bx.i = HoverMX + 16
Protected by.i = HoverMY + 16
; im Canvas halten
If bx + bw > canvasW
bx = HoverMX - bw - 16
EndIf
If by + bh > canvasH
by = HoverMY - bh - 16
EndIf
If bx < 2 : bx = 2 : EndIf
If by < 2 : by = 2 : EndIf
; Farbe: sichtbar / wahrscheinlich / normal (+ heute)
Protected bg.i = RGBA(255, 255, 255, 240)
If Rows()\visible
bg = RGBA(140, 255, 215, 240)
ElseIf Rows()\probable
bg = RGBA(255, 225, 160, 240)
ElseIf Rows()\isToday
bg = RGBA(210, 230, 255, 240)
EndIf
; Tooltip zeichnen
DrawingMode(#PB_2DDrawing_AlphaBlend)
Box(bx, by, bw, bh, bg)
DrawingMode(#PB_2DDrawing_Outlined)
Box(bx, by, bw, bh, RGB(70, 70, 70))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(bx + pad, by + pad + 0 * lineH, t1, RGB(0, 0, 0))
DrawText(bx + pad, by + pad + 1 * lineH, t2, RGB(0, 0, 0))
DrawText(bx + pad, by + pad + 2 * lineH, t3, RGB(0, 0, 0))
EndProcedure
Procedure ResizeUI()
Protected ww.i = WindowWidth(#WinMain)
Protected wh.i = WindowHeight(#WinMain)
Protected listH.i = Int(wh * 0.33)
If listH < 170 : listH = 170 : EndIf
If listH > wh - 120 : listH = wh - 120 : EndIf
ResizeGadget(#GadList, 10, 10, ww - 20, listH)
ResizeGadget(#GadCanvas, 10, 20 + listH, ww - 20, wh - listH - 30)
DrawChart()
EndProcedure
Define url.s = "https://www.heute-am-himmel.de/polarlichter"
Define cookie.s = "locationOption=4; country=Deutschland; city=Dresden; timeZone=Europe%2FBerlin; lat=51.00166; lon=13.64880"
NewMap H.s()
H("User-Agent") = "Mozilla/5.0"
H("Accept-Language") = "de-DE,de;q=0.9"
H("Accept-Encoding") = "identity"
H("Cookie") = cookie
LoadFont(#FontUI, "Arial", 10)
Define req.i = HTTPRequest(#PB_HTTP_Get, url, "", 0, H())
If req = 0
MessageRequester("Polarlicht", "HTTPRequest() fehlgeschlagen.")
End
EndIf
Define status.s = HTTPInfo(req, #PB_HTTP_StatusCode)
Define html.s = HTTPInfo(req, #PB_HTTP_Response)
FinishHTTP(req)
If status <> "200" Or html = ""
MessageRequester("Polarlicht", "HTTP Status: " + status + #LF$ + "Keine Antwortdaten.")
End
EndIf
Define tableHtml.s = ExtractTargetTableHtml(html)
If tableHtml = ""
MessageRequester("Polarlicht", "Zieltabelle nicht gefunden (Text 'Stärke des magnetischen Sturms' fehlt?).")
End
EndIf
ParseRowsFromTable(tableHtml)
If ListSize(Rows()) = 0
MessageRequester("Polarlicht", "Keine Datenzeilen gefunden.")
End
EndIf
PrepareComputedFields()
Define winTitle.s = "Polarlicht – KP/MLAT (" + FormatDate("%dd.%mm.%yyyy %hh:%ii", Date()) + ")"
If OpenWindow(#WinMain, 0, 0, 980, 720, winTitle, #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_ScreenCentered)
ListIconGadget(#GadList, 10, 10, 960, 220, "Datum", 260, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
AddGadgetColumn(#GadList, 1, "KP", 70)
AddGadgetColumn(#GadList, 2, "MLAT", 80)
CanvasGadget(#GadCanvas, 10, 240, 960, 470, #PB_Canvas_Keyboard)
FillListGadget()
ResizeUI()
; Event-Loop
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #GadCanvas
Select EventType()
Case #PB_EventType_MouseMove
HoverMX = GetGadgetAttribute(#GadCanvas, #PB_Canvas_MouseX)
HoverMY = GetGadgetAttribute(#GadCanvas, #PB_Canvas_MouseY)
HoverActive = #True
DrawChart()
Case #PB_EventType_MouseLeave
HoverActive = #False
HoverIndex = -1
DrawChart()
EndSelect
EndSelect
Case #PB_Event_CloseWindow
Break
Case #PB_Event_SizeWindow
ResizeUI()
EndSelect
ForEver
EndIf
this is what I got. (This approach is where AI works pretty well.)