My Oxigen BASIC impression...

Started by Pierre Bellisle, July 07, 2022, 06:57:54 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Pierre Bellisle

Hi Charles!

It's been a long time since I played with o2. I remember thinking it was promising.
Well, I did try it again...

You did a fantastic job! Impressive! The way you implement it is pure joy. Finally somebody wrote a bright BASIC, doing the job in an intelligent way. More I look to it, the more I find candys and little treasures.
Kudos!

For the fun of it, here is my first try, converting some code I already had.
I compiled a 32 bit and a 64 bit version under Windows 7, both compiled exe work under W7 and W10. I got problems trying to compile under W10, you may try and tell me if it goes fine or not.

Regards,
Pierre


$ filename "CaptionIcon.exe"
% COLOR_BTNFACE 15
% SPI_GETNONCLIENTMETRICS 41
% GCL_HICON (-14)
% Timer01 201

'Adapt next line to your path
includepath "../inc/" 'Define a filepath for source files specified by include.
include "MinWin.inc"

#lookahead 'Internally creates header declarations for all procedures. Allows procedure calls to forward reference.

type NONCLIENTMETRICS
   cbSize           as long
   iBorderWidth     as long
   iScrollWidth     as long
   iScrollHeight    as long
   iCaptionWidth    as long
   iCaptionHeight   as long
   lfCaptionFont    as LOGFONT
   iSMCaptionWidth  as long
   iSMCaptionHeight as long
   lfSMCaptionFont  as LOGFONT
   iMenuWidth       as long
   iMenuHeight      as long
   lfMenuFont       as LOGFONT
   lfStatusFont     as LOGFONT
   lfMessageFont    as LOGFONT
end type

! SystemParametersInfo lib "user32.dll" alias "SystemParametersInfoA" (byVal uAction as long, byVal uParam as long, byRef lpvParam as any, byVal fuWinIni as long) as long
! DestroyIcon lib "user32.dll" alias "DestroyIcon" (byVal hIcon as long) as long
! ExtractIcon lib "shell32.dll" alias "ExtractIconA" (byVal hInst as long, byVal lpszExeFileName as string, byVal nIconIndex as long) as long

#if sizeof(sys) = 8 then '64 bit exe

#def Win64 = true
! SetClassLongPtr lib "user32.dll" alias "SetClassLongPtrW" (byVal hWnd as sys, byVal nIndex as long, byVal dwNewLong as long) as long

#else 'sizeof(sys) = 4 so 32 bit exe

! SetClassLongPtr lib "user32.dll" alias "SetClassLongW" (byVal hWnd as sys, byVal nIndex as long, byVal dwNewLong as long) as long

#endif
'_____________________________________________________________________________

function WinVerAsm() as string
'Windows 7 is 6.1, Windows 8.0 is 6.2, Windows 8.1 is 6.3, Windows 10 is 10.0
DWORD Major, Minor

#if defined Win64 '64 bit exe

   push rax                'Save register
   push edx                'Save register
   push ebx                'Save register

   'Acces TEB (Thread Environment Block), aka mov rax, gs:0x30 in 64 bit
   db 0x65, 0x48, 0x8B, 0x04, 0x25, 0x30, 0x00, 0x00, 0x00
   mov rax, [rax + 0x60]   'Acces PEB structure aka Process Environment Block
   mov edx, [rax + 0x0118] 'Get major
   mov Major, edx          'Copy edx
   mov ebx, [eax + 0x011c] 'Get minor
   mov Minor, ebx          'Copy edx

   pop ebx                 'Restore register
   pop edx                 'Restore register
   pop rax                 'Restore register

#else '32 bit exe

   push eax              'Save register
   push ebx              'Save register
   push edx              'Save register

   'Acces TEB (Thread Environment Block), aka mov eax, fs:[0x18] 32 bit
   db 0x64, 0xa1, 0x18, 0x00, 0x00, 0x00
   mov eax, [eax + 0x30] 'Acces PEB structure aka Process Environment Block
   mov edx, [eax + 0xA4] 'Get major
   mov Major, edx        'Copy edx
   mov ebx, [eax + 0xA8] 'Get minor
   mov Minor, ebx        'Copy edx

   pop edx               'Restore register
   pop ebx               'Restore register
   pop eax               'Restore register

#endif

function = STR(Major) & "." & STR(Minor)

END FUNCTION
'_____________________________________________________________________________

function WndProc(sys hWnd, wMsg, wParam, lparam) as sys callback
static as long looper, FirstEarthIcon, flip
static as sys  hIcon

select wMsg

   case WM_CREATE
     select WinVerAsm() 
       case 6.1  : FirstEarthIcon = 181 'Windows 7
       case 6.2  : FirstEarthIcon = 168 'Windows 8
       case 6.3  : FirstEarthIcon = 168 'Windows 8.1
       case else : FirstEarthIcon = 137 'Windows 10, might be 170 on older W10 version
     end select
     Looper = FirstEarthIcon

   case WM_COMMAND 'ControlId = LO(WORD, wParam), Msg = HI(WORD, wParam)
     select loword(wParam)                                             'ControlId
       case IDOK :                                                     'IDOK is th button id
         flip xor= 1                                                   'Will flip each time it is XORed
         if flip then
           SetTimer hWnd, Timer01, 200, NULL                           'Set a 200 miliseconds timer
         else
           KillTimer hWnd, Timer01                                     'Cleanup
           IF hIcon THEN DestroyIcon hIcon                             'Cleanup
           hIcon = ExtractIcon GETMODULEHANDLE(""), "Shell32.dll", 294 'Get the icon 294 from Shell32.dll
           SetClassLongPtr(hWnd, GCL_HICON, hIcon)                     'Set the caption window icon
         endif
     end select

   case WM_TIMER
     select wParam
       case Timer01 :
         Looper += 1
         IF Looper = FirstEarthIcon + 15 THEN Looper = FirstEarthIcon 'Restart with first icon number
         IF hIcon THEN DestroyIcon hIcon                              'Cleanup
         hIcon = ExtractIcon GetModuleHandle(0), "Wmploc.dll", Looper 'Get the icon from Wmploc.dll
         SetClassLongPtr hWnd, GCL_HICON, hIcon                       'Set the caption window icon
     end select

   case WM_KEYDOWN
     Select wParam
    Case 27 : SendMessage hwnd, WM_CLOSE, 0, 0 'Escape key to exit
     End Select

   case WM_DESTROY
     KillTimer hWnd, Timer01         'Cleanup
     IF hIcon THEN DestroyIcon hIcon 'Cleanup
     PostQuitMessage 0

   case else
     function = DefWindowProc hWnd, wMsg, wParam, lParam

end select

end function
'_____________________________________________________________________________

Function WinMain() as sys
NONCLIENTMETRICS NonClient
sys      inst, hwnd, hWndChild, hIcon, hFont
SYS      WindowWidth, WindowHeight, WindowPosX, WindowPosY
WndClass wc
MSG      wm

WindowWidth  = 320
WindowHeight = 200
WindowPosX   = (GetSystemMetrics(SM_CXSCREEN) - WindowWidth)  / 2
WindowPosY   = (GetSystemMetrics(SM_CYSCREEN) - WindowHeight) / 2

NonClient.cbSize = SIZEOF(NONCLIENTMETRICS)
SystemParametersInfo SPI_GETNONCLIENTMETRICS, SIZEOF(NONCLIENTMETRICS), @NonClient, 0
hFont            = CreateFontIndirect(NonClient.lfCaptionFont)

hIcon            = ExtractIcon GETMODULEHANDLE(""), "Shell32.dll", 294 'o

inst             = GetModuleHandle 0

wc.style         = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc   = @WndProc
wc.cbClsExtra    = 0
wc.cbWndExtra    = 0
wc.hInstance     = inst
wc.hIcon         = hIcon 'LoadIcon 0, IDI_APPLICATION
wc.hCursor       = LoadCursor 0, IDC_ARROW
wc.hbrBackground = COLOR_BTNFACE + 1
wc.lpszMenuName  = null
wc.lpszClassName = strptr "OXYGEN BASIC"

RegisterClass (@wc)

hwnd = CreateWindowEx 0, wc.lpszClassName, "Caption icons " & sizeof(sys) * 8 & " bit",
                       WS_OVERLAPPED OR WS_BORDER OR WS_DLGFRAME OR WS_CAPTION OR WS_SYSMENU OR
                       WS_MINIMIZEBOX OR WS_CLIPSIBLINGS OR WS_VISIBLE,
                       WindowPosX, WindowPosY,
                       WindowWidth, WindowHeight, 0, 0, inst, 0

hWndChild = CreateWindowEx WS_EX_WINDOWEDGE,                            'Extended styles
                            "Button",                                    'Class name
                            "Icon",                                      'Caption
                            WS_CHILD OR WS_VISIBLE OR WS_TABSTOP OR      'Window styles
                            BS_DEFPUSHBUTTON OR BS_CENTER OR BS_VCENTER, 'Class styles
                            122, 65,                                     'Left, top
                            75, 25,                                      'Width, height
                            hWnd, IDOK,                                  'Handle of parent, control ID
                            inst, NULL                                   'Handle of instance, creation parameters
SendMessage hWndChild, WM_SETFONT, hFont, TRUE

ShowWindow hwnd, SW_SHOW
UpdateWindow hwnd

sys bRet
do while bRet := GetMessage(@wm, 0, 0, 0)
   if bRet <> -1 then
     TranslateMessage @wm
     DispatchMessage @wm
   end if
wend

End Function
'_____________________________________________________________________________

'string WinVer = WinVerAsm() : mbox WinVer
WinMain()
end
'_____________________________________________________________________________
'
  •  

Zlatko Vid

Very nice program Pierre
and is let say "large" ...little bit written in PB style but that is fine .

my question goes to here :

hIcon            = ExtractIcon GETMODULEHANDLE(""), "Shell32.dll", 294 'o

inst             = GetModuleHandle 0

wc.style         = CS_HREDRAW or CS_VREDRAW
wc.lpfnWndProc   = @WndProc
wc.cbClsExtra    = 0
wc.cbWndExtra    = 0
wc.hInstance     = inst
wc.hIcon         = hIcon 'LoadIcon 0, IDI_APPLICATION


Is there a way to load icon from file and add it under
hIcon handler ?

I was tried but without succses...
  •  

Pierre Bellisle

#2
Zlatko,
Do you mean a file like MyIcon.ico loaded by your exe at run time to be shown in the caption title bar?
Or is it the same question you asked in the Change exe icon post?

Charles,
I found the solution for the problems I had to compile under W10.
I got a multi boot computer with a drive common to both W7 and W10.
I had the impression that o2 installation was portable and used the same installation.
This was the source of my troubles. I did a fresh unzip for W10 and voilĂ !

You really created something nice. A dream come true!

Pierre
  •  

Charles Pegge

Many thanks, Pierre,

I will examine it with my magnifying glass :)

I had to make 2 small alterations for the latest o2:

Change #if def to #ifdef or #if defined

Provide the type (sys)  for the wndproc proto:
''function WndProc(hWnd, wMsg, wParam, lparam) as sys callback
function WndProc(sys hWnd, wMsg, wParam, lparam) as sys callback

Pierre Bellisle

#4
Hi Charles,

Above code updated...

-

Lets say I want to use a custom precompiler and use an editor like UltraEdit or Notepad++.
To customize the precompiler I saw only the following options for co2.exe and gxo2.exe...

<filename>       compile and execute directly in memory 
-a <filename>    list assembly code
-b <filename>    list o2 machine script
-c <filename>    <optional filename>  compile to a binary 
-i <filename>     list intermediate code 
-m                     output to console 

I see nothing about 32/64 bit, or other options that could be interesting...

Where can I find this kind of info?

Thank you, Pierre


Added:
Reading some posts on this forum I found Making an OxygenBasic compiler with PB
So I guess it is the way to go for a precompiler, directly via the dll.
Any other informations about using some other editor will be welcome...
Thanks in advance.

Pierre

Added:
Looking at oxygen.dll I see 4 more functions, can you give some info about the last 3

DECLARE FUNCTION o2_asmo     LIB oxy ALIAS "o2_asmo"     (BYVAL STRING) AS STRING      ' compile
DECLARE FUNCTION o2_basic    LIB oxy ALIAS "o2_basic"    (BYVAL STRING) AS STRING      ' compile
DECLARE FUNCTION o2_exec     LIB oxy ALIAS "o2_exec"     (OPTIONAL BYVAL LONG) AS LONG ' run compile program
DECLARE FUNCTION o2_link     LIB oxy ALIAS "o2_link"     (BYVAL STRING) AS STRING      ' o2 link **
DECLARE FUNCTION o2_view     LIB oxy ALIAS "o2_view"     (BYVAL STRING) AS STRING      ' o2 coding
DECLARE FUNCTION o2_prep     LIB oxy ALIAS "o2_prep"     (BYVAL STRING) AS STRING      ' assembly code (x86)
DECLARE FUNCTION o2_abst     LIB oxy ALIAS "o2_abst"     (BYVAL STRING) AS STRING      ' abstract assembly code
DECLARE FUNCTION o2_error    LIB oxy ALIAS "o2_error"    ()AS STRING                   ' error message if any
DECLARE FUNCTION o2_errno    LIB oxy ALIAS "o2_errno"    ()AS LONG                     ' error number or zero
DECLARE FUNCTION o2_len      LIB oxy ALIAS "o2_len"      ()AS LONG                     ' length of returned string
DECLARE FUNCTION o2_buf      LIB oxy ALIAS "o2_buf"      (BYVAL LONG)AS LONG           ' buffer selector 0..511 (returns pointer)
DECLARE SUB      o2_mode     LIB oxy ALIAS "o2_mode"     (BYVAL LONG)                  ' set string i/o mode: 1 asciiz 9  bstring (pb)
DECLARE SUB      o2_put      LIB oxy ALIAS "o2_put"      (BYVAL STRING)                ' load code into an exec buffer
DECLARE FUNCTION o2_get      LIB oxy ALIAS "o2_get"      ()AS LONG                     ' get pointer to code in exec buffer

DECLARE FUNCTION o2_version  LIB oxy ALIAS "o2_version"  ()AS STRING                   'Return: A43 2017-06-05 T 08:45:14
'DECLARE FUNCTION o2_lib      LIB oxy ALIAS "o2_lib"      (BYVAL STRING ?) AS STRING ?  'Info needed
'DECLARE FUNCTION o2_pathcall LIB oxy ALIAS "o2_pathcall" (BYVAL STRING ?) AS STRING ?  'Info needed
'DECLARE FUNCTION o2_varcall  LIB oxy ALIAS "o2_varcall"  (BYVAL STRING ?) AS STRING ?  'Info needed
  •  

Charles Pegge

#5
Hi Pierre,

You must have quite an old version of OxygenBasic.. You can get version 0.4.0 from GitHub, and I am currently working on version 0.5.0.

https://github.com/Charles-Pegge/OxygenBasic

The co2 compiler has these options:


  pr.in "
  compiler options:
  <filename>       compile and execute directly in memory
  -a <filename>    list assembly code
  -b <filename>    list o2 machine script
  -c <filename>    <optional filename>  compile to 32bit binary
  -32 <filename>   <optional filename>  compile to 32bit binary
  -64 <filename>   <optional filename>  compile to 64bit binary
  -i <filename>    list intermediate code
  -m               output to console
  -d               compile to DLL instead of EXE
  -r               run compiled file
  add <filename.res> to link resources
  "




Here's the source code for co2. It's modest!



'Compiler for OxygenBasic
'========================

'Charles Pegge
'11/06/2015
'06/03/2017
'13/01/2018
'26/08/2018
'29/05/2019
'28/06/2019
'28/07/2019

  #compact
  $ Filename "co2.exe"
  uses RTL32
  %NoConsole
  uses SysUtil
  uses console
  uses oxygen.res

  extern lib "oxygen.dll"
  uses oxygenAPI
  end extern

  StrBuffer pr

  sys    a,i
  string s,t,u
  sys    swa,swc,swl,swm,swr,sws  'COMPILER SWITCHES
  string fname,mname,xname    'SOURCE FILE NAME COMPONENTS
  string bfname,bmname,rfname 'PE FILE NAME COMPONENTS
  string er                   'ERROR MESSAGES
  '
  int utfc=248 'embedded unicode mark
  '
  function ConvertToUnicode(string*src)
  =====================================
  'converts ansi with encoded symbols to unicode
  '
  int le=len(src)
  string dst=nuls(le*2)
  byte bs at strptr(src)
  byte bd at strptr(dst)
  int a,b,i,j
  indexbase 1
  jmp fwd begin
  '
  convertuni: 'subroutine
  =======================
  'hex conversion
  b=bs-48
  if b>9 then b-=7
  a=b<<4
  @bs++ : i++
  b=bs-48
  if b>9 then b-=7
  a+=b
  @bs++ : i++
  bd=a : @bd++ : j++
  ret
  '
  begin:
  ======
  while i<le
    a=bs
    if a=248
      @bs++ : i++
      gosub convertuni 'lower byte
      gosub convertuni 'upper byte
    else
      bd=bs : @bs++ : i++ : @bd+=2 : j+=2
      'upper byte is left as null
    endif
  wend
  src=left(dst,j)
  end function

  s=lcase CommandLineArgs() 

  if not s then goto nofile
  '
  'SWITCHES
  '========
  i=0
  do
    i++ : skiplspace s,i
    if ascb<>45 then exit do
    i++ : skiplspace s,i
    select ascb
    case "i" : swa=ascb '-i intermediate output
    case "a" : swa=ascb '-a asm output
    case "b" : swa=ascb       '-b o2 output
    case "c" : swc=ascb       '-c compile 32bit
    case "3" : swc=ascb : i++ '-c compile 32bit
    case "6" : swc=ascb : i++ '-c compile 64bit
    case "m" : swm=1          '-m do not show messagebox
    case "d" : swl=1          '-d dll binary
    case "r" : swr=1          '-r run binary file
    end select
  end do
  '
  s=mid(s,i)
  '
  nofile: 'check
  '=============
  '
  if not s then
  pr.in "
  compiler options:
  <filename>       compile and execute directly in memory
  -a <filename>    list assembly code
  -b <filename>    list o2 machine script
  -c <filename>    <optional filename>  compile to 32bit binary
  -32 <filename>   <optional filename>  compile to 32bit binary
  -64 <filename>   <optional filename>  compile to 64bit binary
  -i <filename>    list intermediate code
  -m               output to console
  -d               compile to DLL instead of EXE
  -r               run compiled file
  add <filename.res> to link resources
  "
  jmp fwd done
  end if
  '
  'GET FILENAMES
  '=============
  '
  string s2,s3
  i=1
  s2=getword(s,i)
  s2=unquote(s2)
  s3=right(s2,6)
  a=len(s2)
  if s3=".o2bas"
    fname=s2
    a-=6
  else
    s3=right(s2,4)
    if s3=".bas"
      fname=s2
      a-=4
    else
      fname=s2+".o2bas"
    endif
  endif
  mname=left(fname,a)
  '
  do
    s2=getword(s,i)
    if lenw=0
      exit do
    endif
    s3=right(s2,4)
    if s3=".exe"
      bfname=s2
      swl=0
      if swc=0
        swc=0x33 '-32
      endif
    elseif s3=".dll"
      bfname=s2
      swl=1
      if swc=0
        swc=0x33 '-32
      endif
    elseif s3=".res"
      rfname=s2
      sws=1
    else 'assume no extension name
      bfname=s2+".exe"
      swl=0
      if swc=0
        swc=0x33 '-32
      endif
    endif
  loop
  '
  '
  'ATTEMPT TO GET FILE
  '===================
  '
  t=getfile fname
  if not t then
    pr.in "error: file empty or not found: "+fname
    jmp fwd done
  endif
  '
  u=""
  '
  if swc or swl
    string cf
    if bfname="" then
      if swl
        bfname=".dll"
      else
        bfname=".exe"
      endif
      bfname=mname+bfname
    endif
    cf="uses RTL32"
    select swc
    case "6"     : cf="uses RTL64"
    end select
    if swl
      u+="$dll"+cr
    endif
    if sws
      cf+=cr+"uses "+rfname
    endif
    u+="$filename "+qu+bfname+qu+cr+cf+cr
  endif
  '
  if u
    t=u+"uses "+fname+cr
  endif
  '
  '
  'NORMAL COMPILE
  '==============

'o2_mode 0  'read/return null terminated ascii strings
  o2_mode 9   'ascii string (1: byte characters) (8: ole string)
  '
  select swa
  case "a"  : pr.in o2_prep(t) 'OUTPUT ASSEMBLY CODE
  case "b"  : pr.in o2_view(t) 'OUTPUT O2 MACHINE SCRIPT (AFTER ASSEMBLY CODE)
  case "i"  : pr.in o2_abst(t) 'OUTPUT INTERMEDIATE CODE (BEFORE ASSEMBLY CODE)
  case else :       o2_basic t 'COMPILE TO EXECUTABLE BINARY
  end select
  '
  int exitcode=o2_errno()
  '
  if exitcode then
    pr.in cr+o2_error()
    jmp fwd done
  else
    if swc=0 then
      exitcode=o2_exec 0 'JIT mode
    else 'swc<>0 'COMPILED MODES
      'if sws
      '  exitcode=AddResources(rfname,bfname)
      'endif
      if swr
        if exitcode=0
          exitcode=exec(bfname,0) 'EXEC FILE 0 do not wait
        endif
      else
        if swm
          pr.in cr+"Okay"
        endif
      endif
    end if
  end if

  done:
  'DISPLAY RESULTS
  sys ho,lew
  string prs=pr.out
  if len(prs) then
      int wdm=(instr(prs,chr(utfc))>0) or (instr(prs,chr(34,127))>0)
   if swm=0 then
      if wdm
        ConvertToUnicode prs
        MessageBoxW 0,prs,L"o2 unicode",0
      else
        mbox prs
      endif
    else
      'sys p=GetCurrentProcess() '-1 parent process
      AttachConsole(-1) 'attach to console of parent process
      output prs
      sys ho=GetStdHandle( STD_OUTPUT_HANDLE )
      if ho<>consout then consout=ho : output prs 'windows 10
      sleep 10
      FreeConsole
    end if
  end if
  '
  return exitcode

Pierre Bellisle

Hi,

Good, now that I have a little better idea on how all this is structured, I will clean up my installation.

Whats come to mind is what your seeing of o2 today, I mean, how compleeted do you think it is, is there still big missing piece to code? Any important issues?

The more I look at your work, the more I like, the more I'm impress.

Many, many thanks Charles!
  •  

Charles Pegge

Hi Pierre,

I think o2 is fairly complete but there is a long evolutionary path ahead, including a built-in resource compiler in the short term. I am also dividing the compiler into more distinct modules which can be redeployed in other projects.


Bernard Kunzy

Charles

What is the good e-mail to contact you ?
  •  

Pierre Bellisle

#9
Hey Charles,

A resource compiler will be great!
Fairly complete is good news. ~:-)
Wating for version o5o.
Meanwhile I will play and learn o2 o43.

Thanks,
Pierre
  •  

Zlatko Vid

040 version is too old and have really odd quirks
i am using o2 043 which is very good
  •  

Pierre Bellisle

Yep, I guess I should have written o43, correction made...
  •  

Charles Pegge

I refer to the latest version 0.4.0 from github, not to be confused with earlier A series - Alpha versions.

@Bernard. we can communicate via Personal Message if you wish.



Nicola

Hi Charles,
please, is this the latest version?
Thank you.
Cheers

Charles Pegge

Yes Nicola,

print version gives you the latest version for oxygen.dll including the timestamp