- Welcome to Interactive PowerBasic Forum.
Your resource for programming with PowerBASIC™
Recent posts
#51
OxygenBasic Examples / Re: on goto / on gosub ..
Last post by Charles Pegge - December 26, 2025, 11:48:13 PMHi Nicola,
There is an entry in inf/oxyDatabase.txt. It also appears in the manual.
It is defined by an internal macro, which might be quite useful for deriving similar constructs:
There is an entry in inf/oxyDatabase.txt. It also appears in the manual.
Code Select
key: "on 18"
action: on x goto / gosub / call { list }
use: branch to an address using a list of locations
example:
procedure f(int isr)
subroutine sr1
...
end subroutine
subroutine sr2
...
end subroutine
subroutine sr3
...
end subroutine
'
on isr gosub {@sr1,@sr2,@sr3}
'
end procedure
remarks: lists of up to 128 subroutines are supported
related: Procedures ,subroutine, label, gosub, call, goto
group: system macro
updated: 02/03/2025
.
It is defined by an internal macro, which might be quite useful for deriving similar constructs:
Code Select
def on
'%1' name of index variable
'%2' goto or gosub
'%3' { @label1,@label2,...}
scope
static sys _st_[128]
if not _st_[1]
_st_[1]={%3}
endif
#if not anymatch " goto gosub call ","%2"
#error "Expecting: goto / gosub / call "
#endif
%2 _st_[%1]
end scope
end def
#52
OxygenBasic Examples / Re: Chances / Probability
Last post by Nicola - December 25, 2025, 02:15:47 PM💪
#53
Discussion / Re: Happy holiday
Last post by Charles Pegge - December 25, 2025, 12:16:47 PMWishing you all a Merry Christmas and good feasting!
In our steep valley, we have the first winter frost today. At this time of year, the sun rises at 10:30 and disappears over the top at 2:30, so I am out to catch a few rays of rare sunshine!
In our steep valley, we have the first winter frost today. At this time of year, the sun rises at 10:30 and disappears over the top at 2:30, so I am out to catch a few rays of rare sunshine!
#54
OxygenBasic Examples / Re: Chances / Probability
Last post by Charles Pegge - December 25, 2025, 11:02:52 AMIt is 1 - (the probability of not having the same birthday as any single person) ^ 49
1.0 - pow( (364/365), 49)
#55
Discussion / Re: Happy holiday
Last post by Zlatko Vid - December 25, 2025, 09:37:51 AMHappy holidays to All o2 users
#56
Discussion / Happy holiday
Last post by Pierre Bellisle - December 25, 2025, 05:44:24 AMJust wanna say happy holiday to all o2 users.
To Charles: I hope life is good and easy, Take care
To Theo: Thanks for hosting this site for so long.
To Charles: I hope life is good and easy, Take care
To Theo: Thanks for hosting this site for so long.
#57
OxygenBasic Examples / Re: Chances / Probability
Last post by Nicola - December 25, 2025, 01:04:13 AMI asked Copilot, and it told me that if I and 49 other people are invited to the same party, the probability that there is another person with the same birthday as mine is 12.5%.
#58
OxygenBasic Examples / Re: on goto / on gosub ..
Last post by Nicola - December 25, 2025, 12:48:35 AMHi Charles,
Have you completed entering these commands into O2?
I would like to include them in my Help.
Anyway, I agree that they can speed up and simplify a program. A sort of IF ... THEN GOSUB/CALL on one line compared to the possible n lines of IF ... THEN ...
Thanks
Have you completed entering these commands into O2?
I would like to include them in my Help.
Anyway, I agree that they can speed up and simplify a program. A sort of IF ... THEN GOSUB/CALL on one line compared to the possible n lines of IF ... THEN ...
Thanks
#59
OxygenBasic Examples / Re: MarkDown (MD) Viewer
Last post by Nicola - December 25, 2025, 12:38:05 AMHi,
I updated the program. I split the different options into dedicated functions so that they can be maintained more easily. I also put a copy of it on GitHub.
Cheers
Md_Viewer
I updated the program. I split the different options into dedicated functions so that they can be maintained more easily. I also put a copy of it on GitHub.
Cheers
Md_Viewer
Code Select
' Markdown VIEWER by N. Piano (nico18n) (12-2025)
' O2basic di Charles Pegge
'================================================
$ filename "md_viewer.exe"
uses WinUtil
uses FileDialogs
uses ParseUtil
' --- CARICAMENTO LIBRERIE ---
sys hRichLib = LoadLibrary("msftedit.dll")
if hRichLib = 0 then hRichLib = LoadLibrary("riched20.dll")
% ID_RICHEDIT = 101
% ID_MENU_OPEN = 201
sys hRichEdit, hFont
type SETTEXTEX
uint flags
uint codepage
end type
% EM_SETTEXTEX = 0x0461
% ST_RTF = 2
% CP_ACP = 0
' Versione manuale di Trim per evitare errori
function trim(string s) as string
return ltrim(rtrim(s))
end function
function UTF8ToAnsi(string s) as string
sys L = len(s)
if L = 0 then return ""
' 1. Calcoliamo quanti caratteri Wide servono
sys wLen = MultiByteToWideChar(65001, 0, strptr(s), L, 0, 0)
' Allocazione buffer Wide (2 byte per carattere)
string ws = space(wLen * 2)
MultiByteToWideChar(65001, 0, strptr(s), L, strptr(ws), wLen)
' 2. Calcoliamo quanto spazio ANSI serve
sys aLen = WideCharToMultiByte(0, 0, strptr(ws), wLen, 0, 0, 0, 0)
string res = space(aLen)
WideCharToMultiByte(0, 0, strptr(ws), wLen, strptr(res), aLen, 0, 0)
return res
end function
function ApplyBullets(string s) as string
string t = ltrim(s)
if left(t, 2) = "* " then
' \li400 = Rientro sinistro, \fi-200 = Prima riga sporgente (per il punto)
return "\pard\li400\fi-200\bullet\tab " + mid(t, 3)
end if
' Se non è una lista, resetta il paragrafo per evitare che il rientro continui
return "\pard " + s
end function
function ApplyBackticks(string xs) as string
sys p1, p2
p1 = 1
string s = xs
do
p1 = instr(p1, s, "`")
if p1 = 0 then exit do
p2 = instr(p1 + 1, s, "`")
if p2 > p1 then
' \f1 = Courier, \cf4 = Verde
string content = mid(s, p1 + 1, p2 - p1 - 1)
string rep = "{\f1\cf4 " + content + "}"
s = left(s, p1 - 1) + rep + mid(s, p2 + 1)
p1 = p1 + len(rep)
else : exit do : end if
loop
return s
end function
function ApplyItalic(string xs) as string
sys p1, p2
' Gestione Asterischi (solo se singoli)
p1 = 1
string s = xs
do
p1 = instr(p1, s, "*")
if p1 = 0 then exit do
p2 = instr(p1 + 1, s, "*")
if p2 > p1 then
s = left(s, p1 - 1) + "\i " + mid(s, p1 + 1, p2 - p1 - 1) + "\i0 " + mid(s, p2 + 1)
p1 = p2 + 4 ' Salta i tag RTF inseriti
else : exit do : end if
loop
' Gestione Underscore
p1 = 1
do
p1 = instr(p1, s, "_")
if p1 = 0 then exit do
p2 = instr(p1 + 1, s, "_")
if p2 > p1 then
s = left(s, p1 - 1) + "\i " + mid(s, p1 + 1, p2 - p1 - 1) + "\i0 " + mid(s, p2 + 1)
p1 = p2 + 4
else : exit do : end if
loop
return s
end function
function ApplyBold(string xs) as string
sys p1, p2
string s = xs
do
p1 = instr(s, "**")
if p1 = 0 then exit do
p2 = instr(p1 + 2, s, "**")
if p2 > p1 then
' Sostituisce **...** con \b ... \b0
s = left(s, p1 - 1) + "\b " + mid(s, p1 + 2, p2 - p1 - 2) + "\b0 " + mid(s, p2 + 2)
else : exit do : end if
loop
return s
end function
' --- lavoriamo la formattazione della linea ---
function ProcessInlineFormatting(string txt) as string
string s = txt
s = ApplyBackticks(s) ' Protegge i termini tecnici
s = ApplyBold(s) ' Gestisce i doppi asterischi
s = ApplyItalic(s) ' Gestisce gli asterischi singoli rimasti
return s
end function
'--- processa solo le tabelle ---
function ProcessTable(string rawLine, sys currentFileLine, bool forceReset = false) as string
static sys lastFileLine, tableRowIndex
if forceReset then : lastFileLine = 0 : tableRowIndex = 0 : return "" : end if
string s = trim(rawLine)
if instr(s, "---") > 0 then : lastFileLine = currentFileLine : return "" : end if
if currentFileLine <> (lastFileLine + 1) then : tableRowIndex = 1 : else : tableRowIndex += 1 : end if
lastFileLine = currentFileLine
' Definizione RTF
string rtfRow = "\trowd\trgaph108\trleft-108"
rtfRow += "\clbrdrt\brdrs\brdrw10\clbrdrl\brdrs\brdrw10\clbrdrb\brdrs\brdrw10\clbrdrr\brdrs\brdrw10\cellx2500"
rtfRow += "\clbrdrt\brdrs\brdrw10\clbrdrl\brdrs\brdrw10\clbrdrb\brdrs\brdrw10\clbrdrr\brdrs\brdrw10\cellx9500"
rtfRow += "\pard\intbl\ql "
if left(s, 1) = "|" then s = mid(s, 2)
if right(s, 1) = "|" then s = left(s, len(s) - 1)
string finalRow = ""
sys p = instr(s, "|")
if p > 0 then
string parte1 = trim(left(s, p - 1))
string parte2 = trim(mid(s, p + 1))
' Pulizia link [dim](#dim)
if left(parte1, 1) = "[" then
sys pC = instr(parte1, "]")
if pC > 1 then parte1 = mid(parte1, 2, pC - 2)
end if
' Formattazione Inline (permette grassetto/corsivo dentro la tabella)
parte1 = ProcessInlineFormatting(parte1)
parte2 = ProcessInlineFormatting(parte2)
if tableRowIndex = 1 then
finalRow = "\b " + parte1 + "\b0\cell \b " + parte2 + "\b0\cell "
else
finalRow = "\b\cf5 " + parte1 + "\cf0\b0\cell " + parte2 + "\cell "
end if
else
finalRow = ProcessInlineFormatting(s) + "\cell\cell "
end if
return rtfRow + finalRow + "\row\pard "
end function
' --- Funzione Parser Markdown ---
function MD_to_RTF(string md) as string
' Header RTF e Tabella Colori
' cf1:Blu, cf2:Rosso, cf3:Grigio, cf4:Verde, cf5:Bordeaux
string rtf = "{\rtf1\ansi\deff0{\fonttbl{\f0 Segoe UI;}{\f1 Courier New;}}"
rtf += "{\colortbl;\red0\green0\blue255;\red255\green0\blue0;\red100\green100\blue100;\red0\green128\blue0;\red128\green0\blue64;}\f0\fs24 "
string ToC = "\b\fs28 INDICE\b0\fs24\line\line "
string contentRTF = ""
string curLine
sys pos = 1, nextPos = 0, rigaFile = 0
bool inCodeBlock = false
' Reset stato tabelle per nuovo file
ProcessTable("", 0, true)
do
rigaFile += 1
nextPos = instr(pos, md, chr(10))
if nextPos > 0 then
curLine = mid(md, pos, nextPos - pos)
pos = nextPos + 1
else
curLine = mid(md, pos) : pos = 0
end if
' Pulizia e protezione caratteri speciali RTF
if instr(curLine, chr(13)) > 0 then replace(curLine, chr(13), "")
replace(curLine, "\", "\\") : replace(curLine, "{", "\{") : replace(curLine, "}", "\}")
' A. BLOCCHI DI CODICE (```)
if left(ltrim(curLine), 3) = "```" then
inCodeBlock = not inCodeBlock
if inCodeBlock then
contentRTF += "\line{\f1\fs18\cf3 "
else
contentRTF += "}\f0\fs24\cf0\line "
end if
continue do
end if
if inCodeBlock then
contentRTF += " " + curLine + "\line "
continue do
end if
' B. TABELLE
if instr(curLine, "|") > 0 then
contentRTF += ProcessTable(curLine, rigaFile)
continue do
end if
' C. TITOLI (#, ##, ###, ####)
string tL = ltrim(curLine)
if left(tL, 2) = "# " then
ToC += "\cf1\b\fs32 # " + mid(tL, 3) + "\b0\fs24\cf0\line "
curLine = "\b\cf1\fs32 " + curLine + "\fs24\cf0\b0"
elseif left(tL, 3) = "## " then
ToC += "\cf1\b\fs28 ## " + mid(tL, 4) + "\b0\fs24\cf0\line "
curLine = "\b\cf1\fs28 " + curLine + "\fs24\cf0\b0"
elseif left(tL, 4) = "### " then
curLine = "\b\cf4 " + curLine + "\cf0\b0" ' Verde
elseif left(tL, 5) = "#### " then
curLine = "\b\cf2 " + curLine + "\cf0\b0" ' Rosso
end if
' D. LISTE PUNTATE
curLine = ApplyBullets(curLine)
' E. FORMATTAZIONE INLINE (Bold, Italic, Backticks)
curLine = ProcessInlineFormatting(curLine)
' Aggiunta riga al contenuto finale
contentRTF += curLine + "\line "
if pos = 0 then exit do
loop
return rtf + ToC + "\line\emdash\line\line " + contentRTF + "}"
end function
' --- Procedura Caricamento ---
sub LoadMD(sys hEdit, string f)
if f = "" then exit sub
' --- 1. SVUOTIAMO LA GUI ---
SendMessage(hEdit, WM_SETTEXT, 0, strptr(""))
string raw = getfile(f)
if len(raw) = 0 then exit sub
' --- 2. CORREZIONE CARATTERI (UTF-8 a ANSI) ---
' Applichiamo la conversione prima di passarlo al parser
'raw = UTF8ToAnsi(raw)
static string sRTF
sRTF = MD_to_RTF(raw)
dim st as SETTEXTEX
st.flags = ST_RTF
st.codepage = 0
SendMessage(hEdit, EM_SETTEXTEX, @st, strptr(sRTF))
SetWindowText(GetParent(hEdit), "O2 Viewer - " + f)
end sub
static string sRTF
' --- WndProc ---
function WndProc(sys hwnd, uMsg, wParam, lParam) as long callback
select umsg
case WM_CREATE
' Menu
sys hMenu = CreateMenu()
sys hSub = CreatePopupMenu()
AppendMenu(hSub, MF_STRING, ID_MENU_OPEN, "&Apri...")
AppendMenu(hMenu, MF_POPUP, hSub, "&File")
SetMenu(hwnd, hMenu)
' Creazione RichEdit
hRichEdit = CreateWindowEx(WS_EX_CLIENTEDGE, "RichEdit50W", "", _
WS_CHILD | WS_VISIBLE | ES_MULTILINE | WS_VSCROLL | 0x0800, _
0, 0, 0, 0, hwnd, ID_RICHEDIT, hinst, null)
hFont = CreateFont(20, 0, 0, 0, 400, 0, 0, 0, 0, 0, 0, 0, 0, "Segoe UI")
SendMessage(hRichEdit, WM_SETFONT, hFont, 1)
if hRichEdit <> 0 then
string testo = "# Ciao Charles" + chr(10) + "O2 is GREAT"
static string sRTF
sRTF = MD_to_RTF(testo)
'usa EM_SETTEXTEX:
dim st as SETTEXTEX
st.flags = ST_RTF
st.codepage = 0
SendMessage(hRichEdit, EM_SETTEXTEX, @st, strptr(sRTF))
SetWindowText(hwnd, "O2 Viewer - Pronto")
end if
case WM_COMMAND
if loword(wParam) = ID_MENU_OPEN then
' Filtro corretto per FileDialogs.inc [cite: 9]
string filt = "Markdown" + chr(0) + "*.md" + chr(0) + "All" + chr(0) + "*.*" + chr(0)
string f = GetFileName("", 0, filt)
'mbox f
if f <> "" then LoadMD(hRichEdit, f)
end if
case WM_SIZE
if hRichEdit then
RECT rc : GetClientRect(hwnd, &rc)
MoveWindow(hRichEdit, 5, 5, rc.right-10, rc.bottom-10, TRUE)
end if
case WM_DESTROY
if hRichLib then FreeLibrary(hRichLib)
PostQuitMessage 0
case else
return DefWindowProc(hwnd, uMsg, wParam, lParam)
end select
end function
MainWindow 800, 600, WS_OVERLAPPEDWINDOW #60