AllBASIC

BASIC Developer & Support Resources => Compilers => Topic started by: cevpegge on September 07, 2010, 11:21:33 AM

Title: Oxygen Basic alpha
Post by: cevpegge on September 07, 2010, 11:21:33 AM

Hello everyone,

May I introduce you to Oxygen Basic, an embeddable JIT compiler which has spent much of its infancy under the wing of thinBasic. I have just released the standalone version and set up a site for it at SourceForge.

Oxygen features flexible syntax approximating to QBasic and understands enough C to read most C headers. It supports OOP with single and multiple inheritance, overloadable functions and operators, has a built-in Assembler, linker and compiles down to x86 machine code.

If you like using line numbers, goto and gosub. Those are available too.

64bit compiling is in its very early stages of development.

The Oxygen nucleus is a single DLL of about 370K and is normally intended to be distributed with applications, since it carries the run time library. It is possible to run programs directly from script without creating an EXE file. Quite substantial programs will compile and be ready for execution in a fraction of a second.

My aim is to bring Oxygen development up to beta level (for MS Windows) in about 3-4 months time. Meanwhile I will be emitting updates at a furious rate, and any feedback would be most welcome.

Charles

http://oxygenbasic.sourceforge.net


Title: Re: Oxygen Basic alpha
Post by: rdc on September 07, 2010, 12:49:39 PM
Look interesting. I'll have to give it a try.
Title: Re: Oxygen Basic alpha
Post by: JRS on September 07, 2010, 02:46:13 PM
Hi Charles,

Thanks for joining the All Basic forum and introducing Oxygen Basic. I downloaded and gave your Basic a try. Here is the results of the hellowin1 example. (4 KB .exe)

(http://files.allbasic.info/O2/hello_o2.png)

Code: [Select]
' Windows Hello World
' with winmain message loop and wndproc
' Revised 22 Jun 2009
' Charles Pegge

basic

type WNDCLASS
  ;40 bytes
  STYLE         as long
  lpfnwndproc   as long
  cbClsextra    as long
  cbWndExtra    as long
  hInstance     as long
  hIcon         as long
  hCursor       as long
  hbrBackground as long
  lpszMenuName  as long
  lpszClassName as long
end type

type point
  x as long
  y as long
end type

type MSG
  ; 28 bytes
  hwnd    as long
  message as long
  wParam  as long
  lParam  as long
  time    as long
  pt      as point
end type

  dim kernel32,user32,GDI32 as long
  kernel32=LoadLibrary `kernel32.dll`
  user32=LoadLibrary `user32.dll`
  GDI32=LoadLibrary `GDI32.dll`

  bind kernel32
  (
    GetCommandLine  GetCommandLineA   ; @0
    GetModuleHandle GetModuleHandleA  ; @4
    ExitProcess     ExitProcess       ; @4
  )

  bind user32
  (
    LoadIcon         LoadIconA         ; @8
    LoadCursor       LoadCursorA       ; @8
    RegisterClass    RegisterClassA    ; @4
    MessageBox       MessageBoxA       ; @4
    CreateWindowEx   CreateWindowExA   ; @48
    ShowWindow       ShowWindow        ; @8
    UpdateWindow     UpdateWindow      ; @4
    GetMessage       GetMessageA       ; @16
    TranslateMessage TranslateMessage  ; @4
    DispatchMessage  DispatchMessageA  ; @4
    PostQuitMessage  PostQuitMessage   ; @4
    BeginPaint       BeginPaint        ; @8
    EndPaint         EndPaint          ; @8
    GetClientRect    GetClientRect     ; @8  
    DrawText         DrawTextA         ; @20
    PostMessage      PostMessageA      ; @16
    DefWindowProc    DefWindowProcA    ; @16
  )


  bind GDI32
  (
    GetStockObject   GetStockObject    ; @4
  )







  declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
  declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
                      '
  def SW_NORMAL 1
  def SW_SHOWDEFAULT 10



  ;=====================================
  
  dim byref cmdline as asciiz,inst as long

  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  'print cmdline `
  '` hex inst

  WinMain inst,0,cmdline,SW_NORMAL
  '
  ExitProcess
  freelibrary kernel32
  freelibrary user32
  freelibrary gdi32
  terminate

  'o2 !10 ; align 16 bytes
  
  ;=====================================
 
  % CS_VREDRAW      1
  % CS_HREDRAW      2
  % IDI_APPLICATION 32512
  % IDC_ARROW       32512
  % WHITE_BRUSH     0
  % MB_ICONERROR    16

  def CW_USEDEFAULT       0x80000000
  def WS_OVERLAPPEDWINDOW 0x00cf0000


  '------------------------------------------------------------
  Function WinMain(byval inst as long ,byval prevInst as long,
  byval cmdline as asciiz , byval show as long) as long
  '===========================================================
                    '
  ; window handle
  
  dim a,b,c,hWnd as long
  dim wc as WndClass
  dim wm as MSG

  with wc.                 '
    style=CS_HREDRAW or CS_VREDRAW
    lpfnWndProc=&WndProc '#long#long#long#long
    cbClsExtra=0
    cbWndExtra=0    
    hInstance=inst
    hIcon=LoadIcon 0, IDI_APPLICATION
    hCursor=LoadCursor 0,IDC_ARROW
    hbrBackground=GetStockObject WHITE_BRUSH '
    lpszMenuName=0
    #view
    lpszClassName=`HelloWin`
    #endv
  end with

  if not RegisterClass &wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if                  '

  hWnd=CreateWindowEx 0,wc.lpszClassName,`Hello Window`,
  WS_OVERLAPPEDWINDOW,
  CW_USEDEFAULT,CW_USEDEFAULT,640,480,
  0,0,inst,0
      
  if not hWnd then
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if
                              '
  ShowWindow hWnd,show
  UpdateWindow hWnd
  ;
    
  
  
  ;MESSAGE LOOP
  ;
  do while GetMessage &wm,0,0,0
    TranslateMessage &wm
    DispatchMessage &wm
    '
    'select wm.hwnd
    'case hwnd
    '  if wm.message=256 then print `key down` : exit do
    'end select
    '
  wend
  ;
  function=wm.wparam

  end function ; end of WinMain


  type RECT
    ; 16 bytes
    left   as long
    top    as long
    right  as long
    bottom as long
  end type

  type rgbacolor
    red   as byte
    green as byte
    blue  as byte
    alpha as byte
  end type
  
  type PAINTSTRUCT
    ; 64 bytes
    hDC        as long
    fErase     as long
    rcPaint    as rect
    fRestore   as long
    fIncUpdate as long
    rgb        as rgbacolor
    Reserved   as 32
  end type

  % WM_CREATE     1
  % WM_DESTROY    2
  % WM_PAINT     15
  % WM_CLOSE     16
  % WM_KEYDOWN  256

  '-----------------------------------------
  function WndProc (  byval hWnd as long,
  byval wMsg as long, byval wParam as long,
  byval lparam as long ) as long callback
  '=========================================

  dim cRect   as rect
  dim Paintst as paintstruct
  dim hDC     as long
  
    select wMsg
        
      '--------------
      case WM_CREATE
      '=============
      
      '--------------  
      case WM_DESTROY
      '===============
          
        PostQuitMessage 0
        
      '------------
      case WM_PAINT
      '============
          
        hDC=BeginPaint hWnd,&Paintst
        GetClientRect  hWnd,&cRect
        ; style
        ; 0x20 DT_SINGLELINE
        ; 0x04 DT_VCENTER
        ; 0x01 DT_CENTER
        ; 0x25
        DrawText hDC,`Hello World!`,-1,&cRect,0x25
        EndPaint hWnd,&Paintst
        
      '--------------  
      case WM_KEYDOWN
      '==============
          
        if wParam=27 then
          PostMessage hWnd,WM_CLOSE,0,0
        end if

      '--------        
      case else
      '========
          
        function=DefWindowProc hWnd,wMsg,wParam,lParam
        
    end select

  end function ' WndProc
Title: Re: Oxygen Basic alpha
Post by: JRS on September 07, 2010, 11:04:59 PM
Here is the OpenGL example from the Oxygen Basic distribution. (12 KB .exe)

(http://files.allbasic.info/O2/opengl.png)

Code: [Select]
' OPENGL /WINDOWS API Example


' Revised 9 July 2010
' Charles Pegge


  #basic
  '#file `PortViewer.exe`
  /*

  Window size wWidth wHeight
  Active view:
    0 = none
    1 = upper left
    2 = upper right
    3 = lower left
    4 = lower right

  */
  
  'SELECT WHICH HEADERS TO USE

  '#def TBheaders
  '#def JRheaders
  #def  CHheaders
  
  #ifdef TBheaders
    include Win32Api.inc
    def included include once `%%APP_INCLUDEPATH%%\thinbasic_%1.inc`
    'included gl
    'included glext
    included glu
    included wgl
  #endif

  #ifdef JRheaders
    includepath "gl\"
    'include once "opengl32.inc"
    include once "gl.inc"
    include once "glu.inc"
    include once "wglext.inc"
    include once "thinbasic_wgl.inc"
    includepath ""
  #endif


  #ifdef CHheaders
    #define WINGDIAPI
    #define APIENTRY
    #define const
    typedef word wchar_t
    typedef sys ptrdiff_t
    includepath ""
    library "opengl32.dll"
    include once "gl\gl.h"
    'include once "gl\glext.h"
    library "glu32.dll"
    include once "gl\glu.h"
    include once "gl\thinbasic_wgl.inc"
    library ""
  #endif
  
  '////////////////////



type WNDCLASS
  ;40 bytes
  STYLE as long
  lpfnwndproc as long
  cbClsextra as long
  cbWndExtra as long
  hInstance as long
  hIcon as long
  hCursor as long
  hbrBackground as long
  lpszMenuName as long
  lpszClassName as long
end type

type point
  x as long
  y as long
end type

type MSG
  ; 28 bytes
  hwnd as long
  message as long
  wParam as long
  lParam as long
  time as long
  pt as point
end type


                         '

  #define SW_NORMAL 1
  % SW_SHOWDEFAULT 10



  % CS_VREDRAW      1
  % CS_HREDRAW      2
  % IDI_APPLICATION 32512
  % IDC_ARROW       32512
  % WHITE_BRUSH     0
  % MB_ICONERROR    16

  % CW_USEDEFAULT       &h80000000
  % WS_OVERLAPPEDWINDOW &h00cf0000




type RECT
  ; 16 bytes
  nleft as long
  ntop as long
  nright as long
  nbottom as long
end type

type rgbacolor
  red as byte
  green as byte
  blue as byte
  alpha as byte
end type
  
type PAINTSTRUCT
  ; 64 bytes
  hDC as long
  fErase as long
  rcPaint as rect
  fRestore as long
  fIncUpdate as long
  rgb as rgbacolor
  Reserved as 32
end type



 % NULL  0
 % FALSE 0
 % TRUE -1


  % WM_ACTIVATE    0
  % WM_CREATE      1
  % WM_DESTROY     2
  % WM_MOVE        3
  % WM_SIZE        5
  % WM_SETFOCUS    7
  % WM_KILLFOCUS   8
  % WM_PAINT      15
  % WM_CLOSE      16
  % WM_ERASEBKGND 20
  
  %WM_KEYDOWN         = &H100
  %WM_KEYUP            = &H101
  %WM_CHAR             = &H102
  %WM_DEADCHAR         = &H103
  %WM_SYSKEYDOWN       = &H104
  %WM_SYSKEYUP         = &H105
  %WM_SYSCHAR          = &H106
  %WM_SYSDEADCHAR      = &H107
  %WM_UNICHAR          = &H109
  %WM_TIMER            = &H113
  %WM_HSCROLL          = &H114
  %WM_VSCROLL          = &H115

  %WM_MOUSEMOVE        = &H200
  %WM_LBUTTONDOWN      = &H201
  %WM_LBUTTONUP        = &H202
  %WM_LBUTTONDBLCLK    = &H203
  %WM_RBUTTONDOWN      = &H204
  %WM_RBUTTONUP        = &H205
  %WM_RBUTTONDBLCLK    = &H206
  %WM_MBUTTONDOWN      = &H207
  %WM_MBUTTONUP        = &H208
  %WM_MBUTTONDBLCLK    = &H209
  %WM_MOUSEWHEEL       = &H20A



TYPE PIXELFORMATDESCRIPTOR
  nSize AS WORD
  nVersion AS WORD
  dwFlags AS DWORD
  iPixelType AS BYTE
  cColorBits AS BYTE
  cRedBits AS BYTE
  cRedShift AS BYTE
  cGreenBits AS BYTE
  cGreenShift AS BYTE
  cBlueBits AS BYTE
  cBlueShift AS BYTE
  cAlphaBits AS BYTE
  cAlphaShift AS BYTE
  cAccumBits AS BYTE
  cAccumRedBits AS BYTE
  cAccumGreenBits AS BYTE
  cAccumBlueBits AS BYTE
  cAccumAlphaBits AS BYTE
  cDepthBits AS BYTE
  cStencilBits AS BYTE
  cAuxBuffers AS BYTE
  iLayerType AS BYTE
  bReserved AS BYTE
  dwLayerMask AS DWORD
  dwVisibleMask AS DWORD
  dwDamageMask AS DWORD
END TYPE




' PIXELFORMATDESCRIPTOR flags
%PFD_TYPE_RGBA       = 0
%PFD_TYPE_COLORINDEX = 1
%PFD_MAIN_PLANE      = 0
%PFD_OVERLAY_PLANE   = 1
%PFD_UNDERLAY_PLANE  =-1
'
%PFD_DOUBLEBUFFER          = &H00000001
%PFD_STEREO                = &H00000002
%PFD_DRAW_TO_WINDOW        = &H00000004
%PFD_DRAW_TO_BITMAP        = &H00000008
%PFD_SUPPORT_GDI           = &H00000010
%PFD_SUPPORT_OPENGL        = &H00000020
%PFD_GENERIC_FORMAT        = &H00000040
%PFD_NEED_PALETTE          = &H00000080
%PFD_NEED_SYSTEM_PALETTE   = &H00000100
%PFD_SWAP_EXCHANGE         = &H00000200
%PFD_SWAP_COPY             = &H00000400
%PFD_SWAP_LAYER_BUFFERS    = &H00000800
%PFD_GENERIC_ACCELERATED   = &H00001000
%PFD_SUPPORT_DIRECTDRAW    = &H00002000

' PIXELFORMATDESCRIPTOR flags for use in ChoosePixelFormat only
%PFD_DEPTH_DONTCARE        = &H20000000
%PFD_DOUBLEBUFFER_DONTCARE = &H40000000
%PFD_STEREO_DONTCARE       = &H80000000

' Font Weights
%FW_DONTCARE   = 0
%FW_THIN       = 100
%FW_EXTRALIGHT = 200
%FW_LIGHT      = 300
%FW_NORMAL     = 400
%FW_MEDIUM     = 500
%FW_SEMIBOLD   = 600
%FW_BOLD       = 700
%FW_EXTRABOLD  = 800
%FW_HEAVY      = 900


%DEFAULT_QUALITY        = 0
%DRAFT_QUALITY          = 1
%PROOF_QUALITY          = 2
%NONANTIALIASED_QUALITY = 3
%ANTIALIASED_QUALITY    = 4

%ANSI_CHARSET        = 0
%DEFAULT_CHARSET     = 1
%SYMBOL_CHARSET      = 2

%OUT_TT_PRECIS       = 4
%CLIP_DEFAULT_PRECIS = 0

%DEFAULT_PITCH   = 0
%FIXED_PITCH     = 1
%VARIABLE_PITCH  = 2
%MONO_FONT       = 8


' Font Families
'
%FF_DONTCARE = 0    ' Don't care or don't know.
%FF_ROMAN    = 16   ' Variable stroke width, serifed.

' Times Roman, Century Schoolbook, etc.
%FF_SWISS    = 32   ' Variable stroke width, sans-serifed.

' Helvetica, Swiss, etc.
%FF_MODERN   = 48   ' Constant stroke width, serifed or sans-serifed.

' Pica, Elite, Courier, etc.
%FF_SCRIPT     = 64 ' Cursive, etc.
%FF_DECORATIVE = 80 ' Old English, etc.


%LF_FACESIZE     = 32

TYPE LOGFONT
  lfHeight AS LONG
  lfWidth AS LONG
  lfEscapement AS LONG
  lfOrientation AS LONG
  lfWeight AS LONG
  lfItalic AS BYTE
  lfUnderline AS BYTE
  lfStrikeOut AS BYTE
  lfCharSet AS BYTE
  lfOutPrecision AS BYTE
  lfClipPrecision AS BYTE
  lfQuality AS BYTE
  lfPitchAndFamily AS BYTE
  lfFaceName AS 32
END TYPE




  dim kernel32,user32,GDI32 as long

  kernel32=LoadLibrary `kernel32.dll`
  user32=LoadLibrary `user32.dll`
  GDI32=LoadLibrary `GDI32.dll`

  bind kernel32
  (
    GetExitCodeProcess GetExitCodeProcess ; @8
    ExitProcess        ExitProcess        ; @4
    GetCommandLine     GetCommandLineA    ; @0
    GetModuleHandle    GetModuleHandleA   ; @4
    QueryPerformanceCounter QueryPerformanceCounter ; @4
  )

  bind user32
  (
    LoadIcon         LoadIconA         ; @8
    LoadCursor       LoadCursorA       ; @8
    RegisterClass    RegisterClassA    ; @4
    MessageBox       MessageBoxA       ; @4
    CreateWindowEx   CreateWindowExA   ; @48
    ShowWindow       ShowWindow        ; @8
    UpdateWindow     UpdateWindow      ; @4
    GetMessage       GetMessageA       ; @16
    TranslateMessage TranslateMessage  ; @4
    DispatchMessage  DispatchMessageA  ; @4
    PostQuitMessage  PostQuitMessage   ; @4
    BeginPaint       BeginPaint        ; @8
    EndPaint         EndPaint          ; @8
    GetClientRect    GetClientRect     ; @8  
    DrawText         DrawTextA         ; @20
    PostMessage      PostMessageA      ; @16
    DefWindowProc    DefWindowProcA    ; @16
    FillRect         FillRect
    GetDC            GetDC             ; @4
    ReleaseDC        ReleaseDC
    SetTimer         SetTimer
    KillTimer        KillTimer
  )


  bind GDI32
  (
    GetStockObject     GetStockObject    ; @4
    CreateSolidBrush   CreateSolidBrush  ; @4
    ChoosePixelFormat  ChoosePixelFormat
    SetPixelFormat     SetPixelFormat
    CreateFontIndirect CreateFontIndirectA
    SelectObject       SelectObject
    DeleteObject       DeleteObject
    SwapBuffers        SwapBuffers
   )


function hiwrd   (byval a as long) as long
  shr a,16 : function=a
end function

function lowrd(byval a as long) as long
  and a,&hffff : function=a
end function

function min(byval a as long, byval b as long) as long
  if a<=b then function=a else function=b
end function

function max(byval a as long, byval b as long) as long
  if a>=b then function=a else function=b
end function

function minmax(byval a as long, byval b as long, byval c as long) as long
  if b<=a then b=a
  if b>=c then b=c
  function=b
end function

function rgb(byval r as long, byval g as long, byval b as long) as long
  r=minmax 0,r,255
  g=minmax 0,g,255
  b=minmax 0,b,255
  function=r+g*256+b*65536  
end function

  '////////////////////





  dim a


  dim gmf(256) AS GLYPHMETRICSFLOAT

  dim as quad
    '
    'TIMING
    '
    grtic1,grtic2,freq
    
  dim as double
    '
    'TIMING
    '
    fps,grlap
  
  dim as long
    '
    'STATE VARIABLES
    '
    refresh,bselect,kselect,keyd,cha,ReqShutDown,
    bLeft,bMid,bRight,bWheel,
    wWidth,wHeight,
    '
    'GL CONTEXT
    '
    hDC,hRC,
    '
    shadows,shadowable,
    antialias, multisampling,
    nPixelFormat,ReqNewMode,arbMultisampleFormat,
    arbMultisampleSupported,
    '
    'TIMING
    '
    timerval, doredraw,
    '
    'POSITIONAL
    '
    xpos, ypos,
    sposx,sposy,mposx,mposy,eposx,eposy,
    '
    'Rotation around each axis
    '
    rot_x, rot_y, rot_z,
    active_view


  
'====================================================================
' DrawTorus() - Draw a solid torus (use a display list for the model)
'====================================================================

sub DrawTorus

  static as double
  
  twopi          = pi()*2,
  torus_major    = 1.5,
  torus_minor    = 0.5,
  torus_major_res= 32,
  torus_minor_res= 32


  static as long

    torus_list, i,j,k
  
  static as single

    a, b, s, t, x, y, z, nx, ny, nz, gscale,tmc,tmd,tme
  
  if not torus_list
    '
    'Record the Torus plot list
    '--------------------------
    '
    torus_list = glGenLists 1
    glNewList( torus_list, GL_COMPILE_AND_EXECUTE )
    '
    'Draw the torus
    '
    for i = 0 TO TORUS_MINOR_RES-1
      '
      glBegin GL_QUAD_STRIP
      '
      for j = 0 TO TORUS_MAJOR_RES
        '
        for k = 1 TO 0 STEP -1
          '
          s = mod( i+k,TORUS_MINOR_RES + 0.5)
          t = mod(j,TORUS_MAJOR_RES)
          '
          'CALCULATE POINT ON SURFACE
          '--------------------------
          '
          tmd=s*twopi/TORUS_MINOR_RES
          tme=t*twopi/TORUS_MAJOR_RES
          tmc=TORUS_MAJOR+TORUS_MINOR * cos tmd
          '
          x = tmc * cos tme
          y = TORUS_MINOR * sin tmd
          z = tmc * sin tme
          '
          'CALCULATE SURFACE NORMAL
          '------------------------
          '
          a=TORUS_MAJOR * cos tme
          nx = x - a
          ny = y
          a=TORUS_MAJOR * sin tme
          nz = z - a
          '
          'SCALING OF NORMALS
          '
          gscale = 1 / SQR( nx*nx + ny*ny + nz*nz )
          nx*=gscale
          ny*=gscale
          nz*=gscale
          '
          glNormal3f nx, ny, nz
          glVertex3f x, y, z
          '
        next
        '
      next
      '
      glEnd()
      '
    next
    '
    glEndList()
    '
  else
    '  
    'Playback displaylist
    '
    glCallList( torus_list )
  end if
end sub



''================================================
'' DrawScene() - Draw the scene (a rotating torus)
''================================================

sub DrawScene

  static as single,
  
  model_diffuse(4)  => (1.0, 0.8, 0.0, 1.0),
  model_specular(4) => (0.0, 0.0, 1.0, 1.0),
  model_shininess=0.1

  glPushMatrix

  'Rotate the object
  
  glRotatef rot_x*0.5, 1.0, 0.0, 0.0
  glRotatef rot_y*0.5, 0.0, 1.0, 0.0
  glRotatef rot_z*0.5, 0.0, 0.0, 1.0

  'Set model color (used for orthogonal views, lighting disabled)
  '
  glColor4fv model_diffuse

  'Set model material (used for perspective view, lighting enabled)
  '
  glMaterialfv GL_FRONT, GL_DIFFUSE,   model_diffuse
  glMaterialfv GL_FRONT, GL_SPECULAR,  model_specular
  glMaterialf  GL_FRONT, GL_SHININESS, model_shininess
  '
  DrawTorus

  glPopMatrix
    
end sub


'============================================================
' DrawBorder() - Draw a 2D border (used for orthogonal views)
'============================================================

sub DrawBorder( byval gscale as single, st as long )
  dim as single x,y
  glPushMatrix

  'Setup modelview matrix (flat XY view)
  '
  glLoadIdentity
  gluLookAt,  
  0.0, 0.0, 1.0,
  0.0, 0.0, 0.0,
  0.0, 1.0, 0.0
  'We don't want to update the Z-buffer
  '
  glDepthMask GL_FALSE

  'Set color
  '---------
  glDisable GL_LIGHTING
  glColor3f 0.7, 0.7, 0.4
  glBegin GL_LINES

  dim h as long
  'h=gsteps*0.5
  h=st*0.5
  x = gscale * h
  y = gscale * h
    
  'Horizontal lines
  '----------------
  
  glVertex3f -x, -y, 0.0
  glVertex3f  x, -y, 0.0
  glVertex3f -x,  y, 0.0
  glVertex3f  x,  y, 0.0

  'Vertical lines
  
  glVertex3f -x, -y, 0.0
  glVertex3f -x,  y, 0.0
  glVertex3f  x, -y, 0.0
  glVertex3f  x,  y, 0.0

  glEnd

  'Enable Z-buffer writing again
  '
  glDepthMask GL_TRUE

  glPopMatrix
  
end sub


'========================================================
' DrawGrid() - Draw a 2D grid (used for orthogonal views)
'========================================================

sub DrawGrid( BYVAL gscale AS SINGLE, BYVAL gsteps AS INTEGER )

  dim as long i
  dim as single x,y

  glPushMatrix

  'Set background color
  '
  glClearColor 0.15, 0.15, 0.3, 0.0
  glClear GL_COLOR_BUFFER_BIT

  'Setup modelview matrix (flat XY view)
  '
  glLoadIdentity
  gluLookAt,
  0.0, 0.0, 1.0,
  0.0, 0.0, 0.0,
  0.0, 1.0, 0.0
  '
  'We don't want to update the Z-buffer
  '
  glDepthMask GL_FALSE

  'Set grid color
    
  glDisable GL_LIGHTING
  glColor3f 0.0, 0.5, 0.5

  glBegin GL_LINES

  dim g,h as long

  g=gsteps+0
  h=g*0.5
    
  '' Horizontal lines
  
  x = gscale * h
  y = (-gscale) * h
  '
  for i = 0 to g
    glVertex3f -x, y, 0.0
    glVertex3f x, y, 0.0
    y+=gscale
  next

  '' Vertical lines
  
  x = -gscale * h
  y = gscale * h
  '
  for i = 0 to g
    glVertex3f x, -y, 0.0
    glVertex3f x, y, 0.0
    x+=gscale
  next

  glEnd

  'Enable Z-buffer writing again
  '
  glDepthMask GL_TRUE

  glPopMatrix
  
end sub

;===============
; DrawAllViews( )
;===============

sub DrawAllViews( )
  dim bb
  static as single,
  
  light_position(4) => (0.0, 8.0, 8.0, 1.0),
  light_diffuse (4) => (0.5, 0.5, 0.5, 1.0),
  light_specular(4) => (0.5, 0.5, 0.5, 1.0),
  light_ambient (4) => (0.5, 0.5, 0.5, 1.0)
  
  static as double aspect
  
  ;
  ;Calculate aspect of window
  ;
  if ( wheight > 0 )
    aspect = wwidth / wheight
  else
    aspect = 1.0
  end if
  '
  glClearColor 0.1, 0, 0.5, 0
  glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
  '
  glEnable GL_SCISSOR_TEST
  ;
  glEnable GL_DEPTH_TEST
  glDepthFunc GL_LEQUAL


  ;======================
  ;** ORTHOGONAL VIEWS **
  ;======================
  

  ;For orthogonal views, use wireframe rendering
  ;---------------------------------------------

  glPolygonMode GL_FRONT_AND_BACK, GL_LINE

  ;Enable line anti-aliasing
  ;
  glEnable GL_LINE_SMOOTH
  glEnable GL_BLEND
  glBlendFunc GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA

  ;Setup orthogonal projection matrix

  glMatrixMode GL_PROJECTION
  glLoadIdentity
  dim as long a
  glOrtho  -3*aspect, 3.0*aspect, -3.0, 3.0, 1.0, 50

  dim w,h as long
  w=wwidth : h=wheight
  sar w : sar h
 
  glMatrixMode GL_MODELVIEW
  glLoadIdentity


  ;Upper left view (TOP VIEW)
  ;--------------------------
  ;
  glViewport 0,h,w,h
  glScissor  0,h,w,h
  DrawGrid 0.4,12
  if active_view=1 then DrawBorder 0.45,12
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  gluLookAt,
  0.0, 10.0, 0.1,  'Eye-position (above)
  0.0,  0.0, 0.0,  'View-point
  0.0,  1.0, 0.0   'Up-vector
  DrawScene

  ;Lower left view (FRONT VIEW)
  ;----------------------------
  ;
  glViewport 0,0,w,h
  glScissor  0,0,w,h
  ;glMatrixMode GL_MODELVIEW
  ;
  DrawGrid 0.4, 12
  if active_view=3 then DrawBorder 0.45,12
  glLoadIdentity
  gluLookAt,
  0.0, 0.0, 10.0,  'Eye-position (in front of)
  0.0, 0.0,  0.0,  'View-point
  0.0, 1.0,  0.0   'Up-vector
  DrawScene

  ;Lower right view (SIDE VIEW)
  ;----------------------------
  ;
  glViewport w,0,w,h
  glScissor  w,0,w,h
  DrawGrid 0.4, 12
  if active_view=4 then DrawBorder 0.45,12
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  
  gluLookAt,
  10.0, 0.0, 0.0,  'Eye-position (to the right)
   0.0, 0.0, 0.0,  'View-point
   0.0, 1.0, 0.0   'Up-vector
  
  DrawScene

  ;Disable line anti-aliasing
  ;
  glDisable GL_LINE_SMOOTH
  glDisable GL_BLEND


  ;======================
  ;** PERSPECTIVE VIEW **
  ;======================

  ;For perspective view, use solid rendering
  ;
  glPolygonMode GL_FRONT_AND_BACK, GL_FILL

  ;Enable face culling (faster rendering)
  ;
  glEnable GL_CULL_FACE
  glCullFace GL_BACK
  glFrontFace GL_CW

  ;Setup perspective projection matrix
  ;
  glMatrixMode GL_PROJECTION
  glLoadIdentity
  gluPerspective 65.0, aspect, 1.0, 50.0

  ;Upper right view (PERSPECTIVE VIEW
  '
  glViewport  w, h, w, h
  glScissor   w, h, w, h
  glMatrixMode GL_MODELVIEW
  glLoadIdentity
  
  gluLookAt,
  3.0, 1.5, 3.0,  'Eye-position
  0.0, 0.0, 0.0,  'View-point
  0.0, 1.0, 0.0   'Up-vector
  '
  'Configure and enable light source 1
  '
  glLightfv GL_LIGHT1, GL_POSITION, light_position
  glLightfv GL_LIGHT1, GL_AMBIENT,  light_ambient
  glLightfv GL_LIGHT1, GL_DIFFUSE,  light_diffuse
  glLightfv GL_LIGHT1, GL_SPECULAR, light_specular

  glEnable GL_LIGHT1
  glEnable GL_LIGHTING

  DrawScene

  glDisable GL_LIGHTING
  glDisable GL_CULL_FACE
  glDisable GL_DEPTH_TEST
  glDisable GL_SCISSOR_TEST


end sub




  'dim keys(256) as long
  'dim mapref(16) as long
  'dim cameraProjectionMatrix(16) as single

  dim as double,
  
  modelview(16),
  projection(16)



sub do_the_next_frame(BYVAL hWnd AS long )  ' construct each frame
                                              '
  static as long signal = 0
  ' timing

  QueryPerformanceCounter &grtic2
  grlap=(grtic2-grtic1)*1e6/freq
  ' fps=0.99*fps+10000/grlap ' moving average frames per sec
  ' screen refresh
  ' if bselect+kselect+refresh=0 then grtic1=grtic2: GOTO xdo_frame ' no need to update frame
  refresh=0
  'glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)

  '=============
  DrawAllViews()
  '=============
  glFinish   ' wait until all operations complete
  SwapBuffers HDC
  'IF firstframe=0 THEN SetWindowPos hWnd,HWND_TOP,100,100,500,500,0: firstframe=1
  grtic1=grtic2
  '
xdo_frame:

end sub                                    '




'include mwinproc.inc
'////////////////////

'---------------------------------------------------------------------------------------------------------------------
function WndProc (byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long callback
'=====================================================================================================================

  STATIC cxClient AS LONG
  STATIC cyClient AS LONG
  LOCAL  hdc AS LONG

    dim viewport(4) AS LONG

    dim as long a,b,c,i,j
    dim as long x,y,z

    if wmsg=wm_paint then refresh=1


  '==========
  select wMsg
  '==========
  '
  
  '---------------
  case WM_ACTIVATE
  '===============
      
    if HIwrd(wParam) then exit function
    
  '--------------      
  case WM_DESTROY
  '==============
      
    goto termination

  '------------    
  case WM_TIMER
  '============
  
    if wParam=1
      do_the_next_frame (hWnd)
      if ReqShutDown then goto termination
    end if

  '---------------
  case WM_KEYDOWN
  '==============
  
    wParam=wParam AND 255
    'keys(wParam) = 1: keyd=wParam: kselect=wParam
    if wParam=27 then ReqShutDown=1 : goto termination


  '---------------
  case WM_DESTROY
  '===============

    goto termination1

  '----------------
  case WM_MOUSEMOVE
  '================

    bselect=bselect OR 1
    mPosX = LOwrd(lParam)
    mPosY = HIwrd(lParam)
    '
    if bleft=1
      '
      x=mPosX : y=mPosY
      '
      'Depending on which view was selected, rotate around different axes
      '
      '=================
      select active_view
      '=================

      '-----
      case 1
      '=====
        '
        rot_x = rot_x + y - ypos
        rot_z = rot_z + x - xpos
        '
      '-----
      case 3
      '=====
      
        rot_x = rot_x + y - ypos
        rot_y = rot_y + x - xpos
        '
      '-----
      case 4
      '=====
        '
        rot_y = rot_y + x - xpos
        rot_z = rot_z + y - ypos
        '
      '--------
      case else
      '========
        '
        'Do nothing for perspective view, or if no view is selected
        '
      '=========
      end select
      '=========
      '
      'Remember mouse position
      '
      xpos = x
      ypos = y
      '
    end if

  '----------------
  case WM_LBUTTONUP
  '================

    bLeft = 0:ePosX=mPosX:ePosY=mPosy
    '
    'Deselect any previously selected view
    '
    active_view = 0

  '----------------
  case WM_MBUTTONUP
  '================

    bMid = 0:ePosX=mPosX:ePosY=mPosy

  '----------------
  case WM_RBUTTONUP
  '================
 
    bRight = 0:ePosX=mPosX:ePosY=mPosy

  '------------------
  case WM_LBUTTONDOWN
  '==================

    bLeft  = 1:sPosX=mPosX:sPosY=mPosy
    bSelect = bselect OR 2
    xpos = LOwrd(lParam)
    ypos = HIwrd(lParam)
    '
    ' Detect which of the four views was clicked
    '
    active_view = 1
    if ( xpos >= wwidth\2 )
      active_view+=1
    end if
    if ( ypos >= wheight\2 )
      active_view = active_view + 2
    end if
    doredraw = TRUE

  '------------------
  case WM_MBUTTONDOWN
  '==================

    bMid  = 1 : sPosX=mPosX:sPosY=mPosy
    bSelect = bselect OR 2

  '------------------
  case WM_RBUTTONDOWN
  '==================

    bRight = 1:sPosX=mPosX:sPosY=mPosY
    bSelect = bselect OR 2

  '-----------------
  case WM_MOUSEWHEEL
  '=================

    bWheel = HIwrd(wParam)
    bselect=1

  '------------    
  case %WM_SIZE
  '============
  
    wWidth = lowrd lParam
    wHeight = hiwrd lParam
    '
    'Set the viewport to new dimensions
    '
    if wHeight > 0 and wWidth > 0
      glViewport 0, 0, wWidth, wHeight
     viewport(1)=>0,0,wWidth,wHeight
      '
      glMatrixMode   GL_PROJECTION
      glLoadIdentity
      gluPerspective 45, wWidth/wHeight, 1.0, 100
      glMatrixMode   GL_MODELVIEW
      glGetDoublev   GL_MODELVIEW_MATRIX, modelview
      glGetDoublev   GL_PROJECTION_MATRIX, projection
    end if


  '------------------
  case %WM_ERASEBKGND
  '==================
  
  function = 1

  
  '--------
  case else
  '========

    function=DefWindowProc hWnd,wMsg,wParam,lParam

  '=========
  end select
  '=========
  ;
  
  exit function
  ;
  termination:
    '
    if ReqShutDown<0 THEN exit function ' dont terminate
    '
  termination1:
    '
    KillTimer hWnd,1
    'CLOSE
    glDeleteLists 1000, 255 ' font
    wglMakeCurrent hDC, NULL
    wglDeleteContext hRC
    ReleaseDC hWnd,hDC
    PostQuitMessage 0

end function ' WndProc



'////////////////////





'--------------------
sub initialise_OpenGL
  (
    BYVAL hWnd AS LONG,
    BYVAL hDC AS LONG,
    BYVAL hRC AS LONG
  )
 '====================

    'BuildFont
    dim glFont       as LOGFONT
    dim glFontHandle as long
    '
    glFont.lfHeight         = 1                            'Height Of Font
    glFont.lfWeight         = FW_BOLD                       'Font Weight
    glFont.lfCharSet        = ANSI_CHARSET                  'Character Set Identifier
    glFont.lfOutPrecision   = OUT_TT_PRECIS                 'Output Precision
    glFont.lfClipPrecision  = CLIP_DEFAULT_PRECIS           'Clipping Precision
    glFont.lfQuality        = ANTIALIASED_QUALITY           'Output Quality
    glFont.lfPitchAndFamily = FF_DONTCARE OR DEFAULT_PITCH  'Family And Pitch
    copy0 &glFont.lfFaceName, `Arial` '`Comic Sans MS`      'Font Name
    '
    glFontHandle = CreateFontIndirect(&glFont)
    glFontHandle = SelectObject(hDC, glFontHandle)
    '
    'wglUseFontOutlines hDC, 0, 255, 1000, 0.0, 0.2, WGL_FONT_POLYGONS, ?gmf)
    '
    DeleteObject(glFontHandle)
end sub




'-------------------------
Function WinMain,

  byval inst as long,
  byval prevInst as long,
  byval cmdline as long,
  byval show as long
  
  as long
'=========================

  ; window handle
  
  dim a,b,c,hWnd as long
  dim wc as WndClass
  dim wm as MSG

  with wc.                 '
    style=CS_HREDRAW or CS_VREDRAW
    lpfnWndProc=&WndProc
    cbClsExtra=0
    cbWndExtra=0    
    hInstance=inst
    hIcon=LoadIcon 0, IDI_APPLICATION
    hCursor=LoadCursor 0,IDC_ARROW
    hbrBackground=GetStockObject WHITE_BRUSH '
    lpszMenuName=0
    lpszClassName=`Opengl`
  end with
  
  if not RegisterClass &wc
    MessageBox 0,`Registration failed`,`Problem`,MB_ICONERROR
    exit function
  end if                  '

  hWnd=CreateWindowEx 0,wc.lpszClassName,`4 Port Viewer Demo`,
  WS_OVERLAPPEDWINDOW,
  CW_USEDEFAULT,CW_USEDEFAULT,480,480,
  0,0,inst,0
      
  if not hWnd
    MessageBox 0,`Unable to create window`,`problem`,MB_ICONERROR
    exit function
  end if  
  
  hDC   = GetDC(hWnd)


  'setup pixel format


  dim pfd AS PIXELFORMATDESCRIPTOR
  '
  pfd.nSize           = SIZEOF PIXELFORMATDESCRIPTOR 'Size of UDT structure
  pfd.nVersion        = 1                            'Version. Always set to 1.
  pfd.dwFlags         = PFD_DRAW_TO_WINDOW OR _      'Support Window
                        PFD_SUPPORT_OPENGL OR _      'Support OpenGL
                        PFD_DOUBLEBUFFER             'Support Double Buffering
  pfd.iPixelType      = PFD_TYPE_RGBA                'Red, Green, Blue, & Alpha Mode
  pfd.cColorBits      = 32                           '32-Bit Color Mode
  pfd.cRedBits        = NULL                         'Ignore Color and Shift Bits...
  pfd.cRedShift       = NULL                         '...
  pfd.cGreenBits      = NULL                         '...
  pfd.cGreenShift     = NULL                         '...
  pfd.cBlueBits       = NULL                         '...
  pfd.cBlueShift      = NULL                         '...
  pfd.cAlphaBits      = NULL                         'No Alpha Buffer
  pfd.cAlphaShift     = NULL                         'Ignore Shift Bit.
  pfd.cAccumBits      = NULL                         'No Accumulation Buffer
  pfd.cAccumRedBits   = NULL                         'Ignore Accumulation Bits...
  pfd.cAccumGreenBits = NULL                         '...
  pfd.cAccumBlueBits  = NULL                         '...
  pfd.cAccumAlphaBits = NULL                         '... Good Cereal! ;)
  pfd.cDepthBits      = 16                            ' bits z-buffer depth 8 16 24
  pfd.cStencilBits    = 1                             'Stencil Buffer
  pfd.cAuxBuffers     = NULL                         'No Auxiliary Buffer
  pfd.iLayerType      = PFD_MAIN_PLANE               'Main Drawing Plane
  pfd.bReserved       = NULL                         'Reserved
  pfd.dwLayerMask     = NULL                         'Ignore Layer Masks...
  pfd.dwVisibleMask   = NULL                         '...
  pfd.dwDamageMask    = NULL                         '...

  nPixelFormat = ChoosePixelFormat(hDC, &pfd) ' First without multisampling
  SetPixelFormat(hDC, nPixelFormat, &pfd)
  hRC = wglCreateContext (hDC)
  wglMakeCurrent hDC, hRC

  ReqNewMode=0 ' done

  'initialise_OpenGL(hWnd,hDC,hRC)


  ShowWindow hWnd,show
  UpdateWindow hWnd
  ;
  timerval=16 ' a bit less than 1/60 sec
  SetTimer hWnd,1,timerval,NULL
  ;
  ;MESSAGE LOOP
  ;
  while GetMessage &wm,0,0,0
    TranslateMessage &wm
    DispatchMessage &wm
  wend
  ;
  function=wm.wparam

end function ; end of WinMain


  a=true

  dim cmdline,inst as long
  cmdline=GetCommandLine
  inst=GetModuleHandle 0
  '
  

  WinMain (inst,0,cmdline,SW_NORMAL)
  '

  freelibrary kernel32
  freelibrary user32
  freelibrary gdi32
  terminate
  
It's amazing what ASM can do.

(http://files.allbasic.info/O2/opengl2.png)

OpenGL ASM Example Source (http://files.allbasic.info/O2/Opengl2.o2bas.txt)
Title: Re: Oxygen Basic alpha
Post by: JRS on September 07, 2010, 11:29:12 PM
Here is an example of OOP in Oxygen Basic. (11.5 KB .exe)

(http://files.allbasic.info/O2/oop1.png)   (http://files.allbasic.info/O2/oop2.png)   (http://files.allbasic.info/O2/oop3.png)

Code: [Select]

'----------------------------------------
'Polyhedral GreenHouse
'========================================

'16:18 03/02/2010

basic

/*

  ROOF PANEL
             /\ apex
            /  \
           /    \
       -------------- truncation
         /        \
        /   main   \
       /            \
       ..............
       \            /  /\
        \   tail   /  /  \
         \        /  /    \
          \      /  /      \
           \    /  /  head  \
            \  /  /          \
             \/  /            \
           ------------------------
                 |    main    | shoulder
                 |            |
   SIDE PANEL    |            |
                 |            |
                 |            |
                 |            |
                 |            |
                 |            |
                 |            |
                 --------------

*/

'===============
class greenhouse
'===============

  protected double

  a,b,n,r,
  w1,w2,h1,h2,rd,sht,
  fr,ta,ra,rm,rtb,sh,s1,s2,v1,sc,ma,
  sina,cosa,tana,sinb,cosb,tanb,
  rptw,rptm,rtam,rsdm,rptr,sdtm,sdbm,sdsm,
  ts1,ts2,ts3,ts4,ts5,tr1,tr2,tr3,tr4,tr5,tl,nfx,
  fa,ssa,rsa,tsa,
  mv,rv,
  wi1,th1

  protected string

  srA,srB,srC


  '=================
  class strut 'INNER
  '=================

    /*
         -------------------------------------
        /                                   /|
       ------------------------------------- |
       |                                   | |
       |                                   | |
       |                                   | |
       |                                   | |
       |                                   | |
       |                                   |/
       -------------------------------------

    */

    protected double

    length,width,thickness,mitre1,bevel1,mitre2,bevel2,
    cx,cy,cz,
    x1,x2,x3,x4,x5,x6,x7,x8,
    y1,y2,y3,y4,y5,y6,y7,y8,
    z1,z2,z3,z4,z5,z6,z7,z8
    '
    protected string srA

    '----------------------------------------------------------------------------------------
    method input(double le, double wi, double th, double m1, double m2, double b1, double b2)
    '========================================================================================
      '
      'FIX COORDINATES OF STRUT
      '------------------------
      '
      length=le : width=wi : thickness=th : mitre1=m1 : mitre2=m2 : bevel1=b1 : bevel2=b2
      '
      x1=0 : x2=le : x3=le-wi*tan(m2) : x4=wi*tan(m1) : x5=x1 : x6=x2 : x7=x3 : x8=x4
      y1=0 : y2=0 : y3=wi : y4=wi : y5=y1+th*tan(b1) : y6=y5 : y7=y3-th*tan(b2) : y8=y7
      z1=0 : z2=0 : z3=0 : z4=0 : z5=th : z6=th : z7=th : z8=th
      '
      cx=x1+le*.5 :cy=0 : cz=0

    end method
    '
    '-----------------
    method calculate()
    '=================

    'FACES (anticlockwise index)
   
    '1 front 1 2 3 4
    '2 back  6 5 8 7
    '3 outer 5 6 2 1
    '4 inner 4 3 7 8
    '5 left  5 1 4 8
    '6 right 2 6 7 3

    'VOLUME (face index)

    '3 outer
    '1 front
    '4 inner
    '2 back
    '5 left  (end)
    '6 right (end)

    end method

    '--------------
    method report()
    '==============

      tab=chr 9
      function vals(double d) as string = left(str(d),5) chr(9)

    srA= `

    Panel Frame Strut Measurements:

    Coordinates
    X` tab     `Y` tab  `Z` tab   `POINT
    --------------------------------------
    ` vals(x1) vals(y1) vals(z1)  `p1
    ` vals(x2) vals(y2) vals(z2)  `p2
    ` vals(x3) vals(y3) vals(z3)  `p3
    ` vals(x4) vals(y4) vals(z4)  `p4
    ` vals(x5) vals(y5) vals(z5)  `p5
    ` vals(x6) vals(y6) vals(z6)  `p6
    ` vals(x7) vals(y7) vals(z7)  `p7
    ` vals(x8) vals(y8) vals(z8)  `p8
    --------------------------------------
    `

    print srA


    end method


  end class


  '--------------------------------------------------------------------------------------------
  method input(double scale, double radius, double SideHeight, double sides, double RoofSlope )
  '============================================================================================

  'INPUTS

  sc=scale            'SCALE
  rd=radius           'FACE RADIUS
  sht=sideheight      'HEIGHT TO START OF ROOF EXLCUDING TAIL
  n=sides             'NUMBER OF SIDES
  a=pi/n              'MAIN ANGLE
  b=rad(RoofSlope)    'ROOF PANEL SLOPE
  rptw=0.2*sc         'ROOF PANEL TRUNCATION WIDTH
  wi1=.05*sc          'FRAME BATTEN WIDTH
  th1=.025*sc         'FRAME BATTEN THICKNESS

  end method


  '-----------------
  method calculate()
  '=================

  'TRIGO PROPORTIONS

  cosa=cos a
  sina=sin a
  tana=tan a
  sinb=sin b
  cosb=cos b
  tanb=tan b


  'MAIN CALCS
  '----------

  r=sc*rd/cos(a)             'CORNER RADIUS
  fr=r*cosa                  'FACE RADIUS
  w1=r*sina                  'SIDE PANEL W1
  w2=w1*cosa                 'ROOF PANEL W2
  h1=w1*sina/cosb            'ROOF PANEL TAIL
  h2=r*cosa/cosb             'ROOF PANEL MAIN
  v1=h1*sinb                 'SIDE PANEL PEAK
  ta=atn(h1/w2)              'TAIL ANGLE
  ma=asin( tana/sin(ta) )*.5 'TAIL BEVEL
  ra=asin(sina*cosa*cosb)    'ROOF ANGLE
  rptr=h2-rptw/tan(ra)       'ROOF PANEL TRUNCATED
  rm=atn(tana*sinb*cos(ra) ) 'ROOF PANEL SIDE BEVEL
  rtb=b/2                    'ROOF PANEL TOP BEVEL

  sh=sc*sht-v1               'SIDE PANEL SHOULDER HEIGHT

  rptm=atn(h2/w2)*.5         'ROOF PANEL TOP MITRE
  rtam=ta                    'ROOF PANEL TAIL MITRE
  rsdm=.5*(pi-atn(h2/w2)-ta) 'ROOF PANEL SIDE MITRE
  sdtm=atn(v1/w1)            'SIDE PANEL TIP MITRE
  sdbm=pi*.25                'SIDE PANEL BASE MITRE
  sdsm=pi*.25-sdtm*.5        'SIDE PANEL SHOULDER MITRE
                             'SIDE BEVEL a


  'DERIVED MEASUREMENTS
  '--------------------


  double vv,tt

  vv=rptw
  tt=1/tana

  fa=n*w1*w1*tt              'FLOOR AREA (POLYGONS)
  ssa=n*(w1*sc*sht*2-v1*w1)  'SIDE SURFACE AREA
  rsa=n*(w2+rptw)*rptr+
  n*w2*h1
                             'ROOF SURFACE AREA
  tsa=n*rptw*rptw/tana       'ROOF TOP OPENING AREA


  mv=fa*sc*sht               'APPROX VOLUME EXCLUDING ROOF SPACE

  rv=n*tt*w2*w2*w2*tt*tanb/3-
     n*tt*vv*vv*vv*tt*tanb/3
                             'APPROX ROOF VOLUME (EXCLUDING APEX)
                             'DIFFERENCE OF CONES



  'FRAME LENGTHS:
  '--------------

  'side frame

  ts1=w1*2              'BASE
  ts2=sh                'RIGHT SIDE
  ts3=sqrt(w1*w1+v1*v1) 'TOP RIGHT
  ts4=ts3               'TOP LEFT
  ts5=ts2               'LEFT SIDE

  'roof panel

  tr1=h1/sin(ta)        'LEFT BASE
  tr2=tr1               'RIGHT BASE
  tr3=rptr/cos(ra)      'RIGHT SIDE
  tr4=rptw*2            'TOP
  tr5=tr3               'LEFT SIDE

  'TOTAL FRAME MEMBER LENGTH

  tl=ts1 ts2 ts3 ts4 ts5 tr1 tr2 tr3 tr4 tr5



  'CREATE STRUTS FOR THE FRAME
  '---------------------------
  '
  strut p1str1,p1str2,p1str3,p1str4,p1str5
  strut p2str1,p2str2,p2str3,p2str4,p2str5
  '
  'GOING ANTICLOCKWISE
  '
  'PARAMS: length,width,thickness,LeftMitre,RightMitre,OuterBevel,InnerBevel
  /*
        /\
       /  \
      /    \
      |    |
      |    |
      |    |
      |    |
      ______
  */
  p1str1.input ts1,wi1,th1,sdbm,sdbm,0,0   'BASE
  p1str2.input ts2,wi1,th1,sdbm,sdsm,a, 0  'RIGHT SIDE
  p1str3.input ts3,wi1,th1,sdsm,sdtm,ma,0  'TOP RIGHT
  p1str4.input ts4,wi1,th1,sdtm,sdsm,ma,0  'TOP LEFT
  p1str5.input ts5,wi1,th1,sdsm,sdbm,a ,0  'LEFT SIDE

  p1str1.report

  /*
       ----
      /    \
     /      \
     \      /
      \    /
       \  /
        \/
  */
  p2str1.input tr1,wi1,th1,rsdm,rtam,ma,0  'LEFT BASE
  p2str2.input tr2,wi1,th1,rtam,rsdm,ma,0  'RIGHT BASE
  p2str3.input tr3,wi1,th1,rsdm,rptm,rm,0  'RIGHT SIDE
  p2str4.input tr4,wi1,th1,rptm,rptm,rtb,0 'TOP SIDE
  p2str5.input tr5,wi1,th1,rptm,rsdm,rm,0  'LEFT SIDE
 



  'FIXINGS:
  '--------

   'JOINT fixings + MEMBER fixings
   '
   nfx= 3*10 + 6*8

 

  end method


  'OUTPUT

  '--------------
  method report()
  '==============

    function degs(double d) as string= left(str(deg(d)),5) chr(9)
    function vals(double d) as string = left(str(d),5) chr(9)


  srA= `

  Polyhedral GreenHouse Measurements:

  ` vals(this.sc)   `scaling
  ` vals(r)    `Corner radius
  ` vals(fr)   `Face radius
  ` vals(n)    `number of sides
  ` degs(b)    `roof slope
  --------------------------------------
  ` vals(w2)   `roof panel half width
  ` vals(h1)   `roof panel tail
  ` vals(h2)   `roof panel main
  ` vals(rptw) `roof panel truncation width
  ` vals(rptr) `roof panel truncated
  --------------------------------------
  ` degs(ta)   `roof tail angle
  ` degs(ra)   `roof panel apex angle
  --------------------------------------
  ` degs(rptm) `roof panel top mitre
  ` degs(rsdm) `roof panel side mitre
  ` degs(rtam) `roof panel tail mitre
  ` degs(rtb)  `roof panel top bevels (top opening)
  ` degs(rm)   `roof panel side bevels
  ` degs(ma)   `roof panel tail bevels
  --------------------------------------
  ` vals(w1)   `side panel half width
  ` vals(sh)   `side panel shoulder
  ` vals(v1)   `side panel head
  ` degs(sdtm) `side panel tip mitre
  ` degs(sdbm) `side panel base mitre
  ` degs(sdsm) `side panel shoulder mitre
  ` degs(a )   `side panel side bevels
  ` degs(ma)   `side panel apex bevels

  `

  srB= `
  Polyhedral GreenHouse:

  Areas:

  ` vals(fa)  `floor area
  ` vals(ssa) `side panels area
  ` vals(rsa) `roof panels area
  ` vals(tsa) `roof opening area

  Volumes:

  ` vals(mv)  `main volume
  ` vals(rv)  `roof volume


  --------------------------------------

  Side Frame members:

  ` vals(ts1) `ts1
  ` vals(ts2) `ts2
  ` vals(ts3) `ts3
  ` vals(ts4) `ts4
  ` vals(ts5) `ts5

  --------------------------------------

  Roof Frame members:

  ` vals(tr1) `tr1
  ` vals(tr2) `tr2
  ` vals(tr3) `tr3
  ` vals(tr4) `tr4
  ` vals(tr5) `tr5

  --------------------------------------

  ` vals(tl)     `total per segment
  ` vals(n )     `segments

  ` vals(tl*n)   `total length

  ` vals(nfx*n) `total fixings

  `

  print srA
  print srB

  end method

end class


  '----
  'MAIN
  '====

  'params are all Double

  greenhouse g
  g.input 1,1,2,6,45 '(Scale, Radius, SideHeight, Sides, RoofSlope )
  g.calculate
  g.report


Title: Re: Oxygen Basic alpha
Post by: JRS on September 08, 2010, 01:51:02 AM
Charles,

Any chance you would be interested in creating a ScriptBasic extension module with your embeddable JIT Basic compiler?


John
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 08, 2010, 03:19:33 AM

Hi John,

We got a bit stuck last time because ScriptBasic expects extension modules to be written in C to map into ScriptBasic variables.  As I recall this is what prompted me to embark upon C header reading capability. My workload is rather high at present but I will certainly add it to my list and revisit what we did about 18 months ago.

Charles

Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 08, 2010, 06:35:29 AM
John,
  Give the man a break and stop soliciting for SB at every opportunity. Sheesse

James

Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 08, 2010, 06:38:29 AM
Charles,
Great stuff. My mind is reeling.

Is instr case insensitive if it is within a #case insensitive block?
How does one actually define a block for use with #case?

I've got a lot more questions especially about oop but one at a time.

James
Title: Re: Oxygen Basic alpha
Post by: JRS on September 08, 2010, 11:05:58 AM
Quote from: cevpegge on September 08, 2010, 03:19:33 AM

Hi John,

We got a bit stuck last time because ScriptBasic expects extension modules to be written in C to map into ScriptBasic variables.  As I recall this is what prompted me to embark upon C header reading capability. My workload is rather high at present but I will certainly add it to my list and revisit what we did about 18 months ago.

Charles

Thanks Charles! I enjoyed the SB embedding challenge you were a major player in. When you get time, please point me in the right direction with embedding Oxygen in ScriptBasic. This will give SB missing Windows functionality that doesn't belong in a cross platform language offering.

@James  :P
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 08, 2010, 12:06:25 PM

Hi James,

#case only applies to program symbol names and does not affect instr, but it sounds a useful function to have and I can provide a case insensitive instr which you can use to override the intrinsic.

Charles


John,

I can't remember all the details but I know that SB is very well documented and with C header reading ability it should now be possible to write the extension module interface in Oxygen Basic itself.

Charles
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 08, 2010, 09:11:47 PM

Okay. Here is a case insensitive instr

I will include it in the examples/dataprocessing folder

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 09, 2010, 09:24:48 AM
Charles,
  I was not soliciting for new features already :) just trying to get my head around O2Bas.

James
Title: Re: Oxygen Basic alpha
Post by: MRBCX on September 09, 2010, 05:02:47 PM
Looks interesting Charles ... I'll be keeping on eye on this as you move it towards beta.

I've noticed in the samples a scarcity of parenthesis ... is there a reason for that?

Also, I presume O2 supports normal BASIC operator precedence Y/N ?

Best Regards,
MrBcx
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 09, 2010, 06:12:08 PM

Hi MrBcx,

Yes, most parentheses are optional in simple expressions. I have a bit more to do in this area but I feel it improves readability and encourages programmers to avoid unnecessary complexity.

Normal operator precedence is used but this can be suppressed by beginning a statement with #noprec in which case expressions a evaluated from left to right and rely on parentheses to establish precedence.

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 11, 2010, 12:25:54 PM
Charles is there a limit with this construct?
James
Code: [Select]
dim as  byte b(600)=>(1,0,255,255,0,0,0,0,0,0,0,0,64,8,202,16,9,0,10,0,10,0,104,1,132,0,0,0,0,0,82,0,67,0,68,0,76,0,71,0,
     50,0,83,0,76,0,76,0,0,0,10,0,144,1,0,0,84,0,97,0,104,0,111,0,109,0,97,0,0,0,0,0,0,0,0,0,0,0,0,0,
     0,0,1,80,240,0,99,0,57,0,15,0,233,3,0,0,255,255,128,0,68,0,105,0,115,0,109,0,105,0,115,0,115,0,0,0,0,0,0,0,
     0,0,0,0,0,0,0,0,7,0,0,80,6,0,3,0,83,1,27,0,234,3,0,0,255,255,128,0,82,0,67,0,32,0,70,0,105,0,108,0,
     101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,18,0,80,15,0,12,0,44,1,12,0,235,3,0,0,255,255,130,0,0,0,0,0,
     0,0,0,0,0,0,0,0,0,0,1,80,68,1,12,0,15,0,12,0,236,3,0,0,255,255,128,0,46,0,46,0,46,0,46,0,46,0,0,0,
     0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,63,0,99,0,57,0,15,0,237,3,0,0,255,255,128,0,67,0,114,0,101,0,97,0,
     116,0,101,0,32,0,67,0,111,0,100,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,80,6,0,39,0,83,1,39,0,
     238,3,0,0,255,255,128,0,83,0,101,0,108,0,101,0,99,0,116,0,32,0,67,0,111,0,100,0,101,0,32,0,67,0,114,0,101,0,97,0,
     116,0,105,0,111,0,110,0,32,0,84,0,121,0,112,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,3,80,27,0,54,0,
     69,0,12,0,239,3,0,0,255,255,128,0,70,0,117,0,108,0,108,0,32,0,83,0,76,0,76,0,32,0,77,0,111,0,100,0,117,0,108,0,
     101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,1,80,120,0,54,0,87,0,15,0,240,3,0,0,255,255,128,0,83,0,76,0,
     76,0,32,0,65,0,83,0,77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,70,0,105,0,108,0,101,0,0,0,0,0,0,0,
     0,0,0,0,0,0,0,0,9,0,1,80,231,0,54,0,105,0,15,0,241,3,0,0,255,255,128,0,83,0,76,0,76,0,32,0,65,0,83,0,
     77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,67,0,108,0,105,0,112,0,66,0,111,0,97,0,114,0,100,0,0,0,0,0)
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 11, 2010, 11:09:42 PM

Many megabytes I would think James. The compiler just builds up a large string of Assembler. But boundary checks are not made on arrays. They are primitive beasts.

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 12, 2010, 05:06:16 AM
Charles, I have unpacked the archive on a Win2K system. If I want to start Oxygen Basic only a requester opens and tells me that this is no Windows executable or something like that. Is this a known problem on Win2K?

Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 12, 2010, 06:27:22 AM

Hi Andreas,

I had one problematic posting. could you try downloading again to get the latest version and see if this works.

thanks

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 12, 2010, 06:59:33 AM
Charles,
  I know this is only an alpha, but because you update so often, would you add a build or ver or something to the upload so we know if we have the latest.

James
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 12, 2010, 07:00:43 AM
Charles,
Listobject4 fails to run after compiling.

James
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 12, 2010, 08:20:12 AM
I've included a log recording the updates as we go.

OxygenUdates.txt
Code: [Select]
OXYGEN UPDATES LOG


03:39 12/09/2010  Resources may now be attached to compiled files. (rsrc is las section in file)
03:39 12/09/2010  File paths containing spaces supported.
04:45 12/09/2010  tools updated: cco2 co2 eo2
Thanks James for letting me know about ListObject4 - the compiled version does not work unlike ListObject3 so I hope to trace the problem fairly quickly.

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 12, 2010, 09:15:11 AM
Actually I meant on the sourceforge site.

James
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 12, 2010, 10:21:42 AM
Charles,
This will not compile.

James

Code: [Select]
#basic
dim as  byte b(600)=>(1,0,255,255,0,0,0,0,0,0,0,0,64,8,202,16,9,0,10,0,10,0,104,1,132,0,0,0,0,0,82,0,67,0,68,0,76,0,71,0,
     50,0,83,0,76,0,76,0,0,0,10,0,144,1,0,0,84,0,97,0,104,0,111,0,109,0,97,0,0,0,0,0,0,0,0,0,0,0,0,0,
     0,0,1,80,240,0,99,0,57,0,15,0,233,3,0,0,255,255,128,0,68,0,105,0,115,0,109,0,105,0,115,0,115,0,0,0,0,0,0,0,
     0,0,0,0,0,0,0,0,7,0,0,80,6,0,3,0,83,1,27,0,234,3,0,0,255,255,128,0,82,0,67,0,32,0,70,0,105,0,108,0,
     101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,18,0,80,15,0,12,0,44,1,12,0,235,3,0,0,255,255,130,0,0,0,0,0,
     0,0,0,0,0,0,0,0,0,0,1,80,68,1,12,0,15,0,12,0,236,3,0,0,255,255,128,0,46,0,46,0,46,0,46,0,46,0,0,0,
     0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,63,0,99,0,57,0,15,0,237,3,0,0,255,255,128,0,67,0,114,0,101,0,97,0,
     116,0,101,0,32,0,67,0,111,0,100,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,7,0,0,80,6,0,39,0,83,1,39,0,
     238,3,0,0,255,255,128,0,83,0,101,0,108,0,101,0,99,0,116,0,32,0,67,0,111,0,100,0,101,0,32,0,67,0,114,0,101,0,97,0,
     116,0,105,0,111,0,110,0,32,0,84,0,121,0,112,0,101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,3,80,27,0,54,0,
     69,0,12,0,239,3,0,0,255,255,128,0,70,0,117,0,108,0,108,0,32,0,83,0,76,0,76,0,32,0,77,0,111,0,100,0,117,0,108,0,
     101,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,9,0,1,80,120,0,54,0,87,0,15,0,240,3,0,0,255,255,128,0,83,0,76,0,
     76,0,32,0,65,0,83,0,77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,70,0,105,0,108,0,101,0,0,0,0,0,0,0,
     0,0,0,0,0,0,0,0,9,0,1,80,231,0,54,0,105,0,15,0,241,3,0,0,255,255,128,0,83,0,76,0,76,0,32,0,65,0,83,0,
     77,0,68,0,65,0,84,0,65,0,32,0,84,0,111,0,32,0,67,0,108,0,105,0,112,0,66,0,111,0,97,0,114,0,100,0,0,0,0,0)

print b(3)
terminate
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 12, 2010, 02:11:24 PM

Yes that was an interesting one James. I use a counter to prevent macro recursion explosions (!), and this was not cleared between multi-assignments.

I have also fixed ListObject4 but I am not certain what causes it - It seems to be associated with string concatenation.

To distinguish Oxygen alpha versions I will serialise the update log and put the same version number on the SourceForge Download button.

Thanks.

Charles

Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 12:51:11 AM
Hi Charles,

Quote from: cevpegge on September 12, 2010, 06:27:22 AM
I had one problematic posting. could you try downloading again to get the latest version and see if this works.

The problem on Win2K is still there. If I doubleclick the file OxideSc.exe I get the requester that this file is not a valid Win32 application.

Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 01:16:58 AM

Ah yes. I think I know what the problem might be. This version of Scit (IDE derived from Scintilla) has compressed sections in its EXE which your OS may not be able to recognise. I will try out the uncompacted version and let you know.

Thanks!

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 02:58:41 AM
Thank you, Charles! Then I will test the next update.
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 04:28:55 AM

Andreas,

I have just posted the other Scit IDE which I hope will work on your OS. This posting also includes fixes for the problems reported here by James.

#Alpha003
http://oxygenbasic.sourceforge.net

Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 04:57:24 AM
Charles,

unfortunately the binary files OxideSc.exe (old) AND SciTE.exe are both from 10-08-28 and still don't work. I think the file or a dll is still compressed?

On which Windows versions is it tested?

Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 05:08:29 AM
I am working on 64bit Vista Andreas.

Do you have a general purpose IDE you work with? If so then I can try to configure a copy for Oxygen.

Notepad++ looks very promising (but also based on Scintilla)

Personally I do most of my work with Notepad, :) which is fine if you are working with familiar code.

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 05:14:32 AM
Could it be that Win2K falls in this category from the Scite history page?
"SciTE is no longer supported on Windows 95, 98 or ME" (version 2.10 entry)

Personally I have no problem to use WindowsXP/Vista. I just wanted to tell my observation.
Thanks!

Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 05:30:01 AM

Win2k support is disappearing rapidly. I have an ancient PC with it sitting in the corner covered in cobwebs. Not sure it would cope with being hooked up to the web.

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 13, 2010, 06:11:40 AM
Charles,
  The byte array problem is still there. It worked fine for the sample posted here, but when I used an array of 1760 bytes it failed with the same error message.

James
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 13, 2010, 06:49:40 AM
Charles,
I thought originally the problems were related to attaching resources but that appears not to be the problem.

Something is messed up with the messaging. Select the close from the system menu and it closes but faults. Will not close with the normal X click.

James

Code: [Select]
#basic



dim as  byte dlgtpl(104)=>(1,0,255,255,0,0,0,0,0,0,0,0,0,8,207,16,1,0,10,0,10,0,150,0,100,0,0,0,0,0,73,0,68,0,68,0,95,0,68,0,
    76,0,71,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,48,0,66,0,51,0,15,0,233,3,0,0,66,0,85,0,84,0,84,0,
    79,0,78,0,0,0,73,0,68,0,67,0,95,0,66,0,84,0,78,0,0,0,0,0)


type MSG
  ; 28 bytes
  hwnd    as long
  message as long
  wParam  as long
  lParam  as long
  time    as long
  pt      as point
end type

  dim kernel32,user32,GDI32 as long
  kernel32=LoadLibrary `kernel32.dll`
  user32=LoadLibrary `user32.dll`
  GDI32=LoadLibrary `GDI32.dll`

  bind kernel32
  (
    GetCommandLine  GetCommandLineA   ; @0
    GetModuleHandle GetModuleHandleA  ; @4
    ExitProcess     ExitProcess       ; @4
  )

  bind user32
  (
    LoadIcon         LoadIconA         ; @8
    LoadCursor       LoadCursorA       ; @8
    RegisterClass    RegisterClassA    ; @4
    MessageBox       MessageBoxA       ; @4
    CreateWindowEx   CreateWindowExA   ; @48
    ShowWindow       ShowWindow        ; @8
    UpdateWindow     UpdateWindow      ; @4
    GetMessage       GetMessageA       ; @16
    TranslateMessage TranslateMessage  ; @4
    DispatchMessage  DispatchMessageA  ; @4
    PostQuitMessage  PostQuitMessage   ; @4
    BeginPaint       BeginPaint        ; @8
    EndPaint         EndPaint          ; @8
    GetClientRect    GetClientRect     ; @8 
    DrawText         DrawTextA         ; @20
    PostMessage      PostMessageA      ; @16
    DefWindowProc    DefWindowProcA    ; @16
    DialogBoxParam   DialogBoxParamA ;@20   
DialogBoxIndirectParam DialogBoxIndirectParamA ;@20   
    EndDialog EndDialogA ;@8   
  )


  bind GDI32
  (
    GetStockObject   GetStockObject    ; @4
  )

% WM_DESTROY    2
% WM_CLOSE     16
% WM_SYSCOMMAND       = 0x0112
% SC_CLOSE        = 0xF060
% WM_COMMAND          = 0x0111
  % CS_VREDRAW      1
  % CS_HREDRAW      2
  % IDI_APPLICATION 32512
  % IDC_ARROW       32512
  % WHITE_BRUSH     0
  % MB_ICONERROR    16





  declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
  declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
                      '
  def SW_NORMAL 1
  def SW_SHOWDEFAULT 10



  ;=====================================
 
  dim byref cmdline as asciiz,inst as long

  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  'print cmdline `
  '` hex inst

  WinMain inst,0,cmdline,SW_NORMAL
  '
  freelibrary kernel32
  freelibrary user32
  freelibrary gdi32
  terminate

Function WinMain(byval inst as long ,byval prevInst as long,byval cmdline as asciiz , byval show as long) as long
Dim RetVal as long

RetVal = DialogBoxIndirectParam(inst,&dlgtpl,0,&WndProc,0)
     
  if RetVal == -1 then
    MessageBox 0,`No Resource` ,`Information`,MB_ICONERROR
    exit function
  end if
 
  function=RetVal


End Function
'==============================================================================
Function WndProc (byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long ) as long callback
select wMsg
case WM_DESTROY
PostQuitMessage 0
'case WM_CLOSE
' EndDialog(hWnd,0)
case WM_SYSCOMMAND
if (wParam AND 0xFFF0) == SC_CLOSE then
EndDialog(hWnd,0)
end if
case WM_COMMAND

end select
End Function
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 10:35:47 AM

Hi James,

I've checked the array alignment (16 byte) and also a sample of the array data offsets against Asm code and it all looks correct.

Are you sure the template data is good?

Charles
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 13, 2010, 11:43:38 AM
I'm pretty sure it's good otherwise it would not show. The reason I went this route is to double check the resource problem. I get the same resuls?

James
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 13, 2010, 12:00:32 PM
I just tried almost identical code with PowerBASIC and it worked fine.

James
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 12:13:48 PM
Charles,

now I have another problem on WinXP SP3. If I want to unpack the archive my antivirus software Avira Antivir Personal tells me that in almost every exe file there is the trojan horse "TR/Crypt.XPACK.Gen2". Is it save to ignore this alert? I just want to be sure before I test the compiler.

Andreas
Title: Re: Oxygen Basic alpha
Post by: JRS on September 13, 2010, 12:23:55 PM
I use Kaspersky Internet Security and have no problems with Charles's compiler or the executables they create. Kaspersky is a gold standard all other anti-virus software try to imitate. I think you are safe to ignore the messages your getting from the anti-virus software your using.

Title: Re: Oxygen Basic alpha
Post by: ahadev on September 13, 2010, 03:07:18 PM
It works without any problem if I ignore the warning, but it is really annoying because this requester shows on every exe file even on the examples. I will try to contact the support of antivir.
Title: Re: Oxygen Basic alpha
Post by: efgee on September 13, 2010, 03:30:58 PM
Used Avira Antivirus for several years (because it was free) but had to ditch it because of the increase of false positives; especially with programs compiled from tcc and other small compilers/assemblers.

IMHO Microsoft is the only entity that has a truly genuine interest to keep the Windows-OS clean from viruses and on the same time the Antivirus software as out-off-the-way as possible in order to keep their own (slow) programs as responsive as possible.

Microsoft Essentials Antivirus does exactly that.

Oxygen compiled programs are fine.

;D
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 04:38:45 PM

You will get some interesting results here:

http://www.virustotal.com/

Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 13, 2010, 06:05:00 PM
James,

Is there a problem invoking a dialog box without a parent window?
Answer: no. I created a window and invoked the dialog modally when the spacebace is pressed. Same result

Charles
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 14, 2010, 04:03:53 PM
James,

At last! Here is the cure: :)

In the binding for User32.dll:

Replace

    EndDialog       EndDialogA      ;@8   

With

    EndDialog       EndDialog      ;@8   

This kind of error should be trapped at run time. I must find out why this is not happening.

Now you should be able to create the dialog direct from a resource.

Charles
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 14, 2010, 11:04:56 PM

You can trap runtime binding errors with this line:

Code: [Select]
  s=error() : if s then print s : goto endprog

where endprog is a label located at the end of the script

Here is the working dialog:
Code: [Select]
#basic



dim as  byte dlgtpl(104)=>(1,0,255,255,0,0,0,0,0,0,0,0,0,8,207,16,1,0,10,0,10,0,150,0,100,0,0,0,0,0,73,0,68,0,68,0,95,0,68,0,
    76,0,71,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,80,48,0,66,0,51,0,15,0,233,3,0,0,66,0,85,0,84,0,84,0,
    79,0,78,0,0,0,73,0,68,0,67,0,95,0,66,0,84,0,78,0,0,0,0,0)


type MSG
  ; 28 bytes
  hwnd    as long
  message as long
  wParam  as long
  lParam  as long
  time    as long
  pt      as point
end type

  dim kernel32,user32,GDI32 as long
  kernel32=LoadLibrary `kernel32.dll`
  user32=LoadLibrary `user32.dll`
  GDI32=LoadLibrary `GDI32.dll`

  bind kernel32
  (
    GetCommandLine  GetCommandLineA   ; @0
    GetModuleHandle GetModuleHandleA  ; @4
    ExitProcess     ExitProcess       ; @4
  )

  bind user32
  (
    LoadIcon         LoadIconA         ; @8
    LoadCursor       LoadCursorA       ; @8
    RegisterClass    RegisterClassA    ; @4
    MessageBox       MessageBoxA       ; @4
    CreateWindowEx   CreateWindowExA   ; @48
    ShowWindow       ShowWindow        ; @8
    UpdateWindow     UpdateWindow      ; @4
    GetMessage       GetMessageA       ; @16
    TranslateMessage TranslateMessage  ; @4
    DispatchMessage  DispatchMessageA  ; @4
    PostQuitMessage  PostQuitMessage   ; @4
    BeginPaint       BeginPaint        ; @8
    EndPaint         EndPaint          ; @8
    GetClientRect    GetClientRect     ; @8 
    DrawText         DrawTextA         ; @20
    PostMessage      PostMessageA      ; @16
    DefWindowProc    DefWindowProcA    ; @16
    DialogBoxParam   DialogBoxParamA ;@20   
DialogBoxIndirectParam DialogBoxIndirectParamA ;@20   
    EndDialog EndDialog ;@8   
  )


  bind GDI32
  (
    GetStockObject   GetStockObject    ; @4
  )

  s=error() : if s then print s : goto endprog


% WM_DESTROY    2
% WM_CLOSE     16
% WM_SYSCOMMAND       = 0x0112
% SC_CLOSE        = 0xF060
% WM_COMMAND          = 0x0111
  % CS_VREDRAW      1
  % CS_HREDRAW      2
  % IDI_APPLICATION 32512
  % IDC_ARROW       32512
  % WHITE_BRUSH     0
  % MB_ICONERROR    16





  declare Function WinMain(byval inst as long ,byval prevInst as long ,byval cmdline as asciiz , byval show as long) as long
  declare function WndProc(byval hWnd as long, byval wMsg as long, byval wParam as long, byval lparam as long) as long
                      '
  def SW_NORMAL 1
  def SW_SHOWDEFAULT 10



  ;=====================================
 
  dim byref cmdline as asciiz,inst as long

  &cmdline=GetCommandLine
  inst=GetModuleHandle 0
  'print cmdline `
  '` hex inst

  WinMain inst,0,cmdline,SW_NORMAL
  '
  freelibrary kernel32
  freelibrary user32
  freelibrary gdi32
  terminate

Function WinMain(byval inst as long ,byval prevInst as long,byval cmdline as asciiz , byval show as long) as long
Dim RetVal as long

RetVal = DialogBoxIndirectParam(inst,&dlgtpl,0,&WndProc,0)
     
  if RetVal == -1 then
    MessageBox 0,`No Resource` ,`Information`,MB_ICONERROR
    exit function
  end if
 
  function=RetVal


End Function
'==============================================================================
Function WndProc (byval hWnd as long,byval wMsg as long, byval wParam as long,byval lparam as long ) as long callback
select wMsg
case WM_DESTROY
PostQuitMessage 0
'case WM_CLOSE
' EndDialog(hWnd,0)
case WM_SYSCOMMAND
if (wParam AND 0xFFF0) == SC_CLOSE then
EndDialog(hWnd,0)
end if
case WM_COMMAND

end select
End Function

endprog:


Charles
Title: Re: Oxygen Basic alpha
Post by: JRS on September 14, 2010, 11:33:28 PM
Charles,

I went to the SourceForge site to download the 03 release and Kaspersky and Virus Total complained.

John

                                                           
AntivirusVersionLast UpdateResult
AhnLab-V32010.09.15.002010.09.14-
AntiVir8.2.4.522010.09.14TR/Crypt.XPACK.Gen2
Antiy-AVL2.0.3.72010.09.15-
Authentium5.2.0.52010.09.15-
Avast4.8.1351.02010.09.14-
Avast55.0.594.02010.09.14-
AVG9.0.0.8512010.09.14-
BitDefender7.22010.09.15-
CAT-QuickHeal11.002010.09.15-
ClamAV0.96.2.0-git2010.09.15-
Comodo60812010.09.15-
DrWeb5.0.2.033002010.09.15-
Emsisoft5.0.0.372010.09.15Trojan.Crypt!IK
eSafe7.0.17.02010.09.14-
eTrust-Vet36.1.78552010.09.14-
F-Prot4.6.1.1072010.09.14-
F-Secure9.0.15370.02010.09.15-
Fortinet4.1.143.02010.09.13-
GData212010.09.15-
IkarusT3.1.1.88.02010.09.15Trojan.Crypt
Jiangmin13.0.9002010.09.15-
K7AntiVirus9.63.25122010.09.14-
Kaspersky7.0.0.1252010.09.15Email-Worm.Win32.Warezov.gxp
McAfee5.400.0.11582010.09.15-
McAfee-GW-Edition2010.1B2010.09.14-
Microsoft1.61032010.09.15-
NOD3254512010.09.14-
Norman6.06.062010.09.14-
nProtect2010-09-14.012010.09.14-
Panda10.0.2.72010.09.14-
PCTools7.0.3.52010.09.15-
Prevx3.02010.09.15-
Rising22.65.02.012010.09.15-
Sophos4.57.02010.09.15-
Sunbelt68772010.09.15-
SUPERAntiSpyware4.40.0.10062010.09.15-
Symantec20101.1.1.72010.09.15-
TheHacker6.7.0.0.0182010.09.15-
TrendMicro9.120.0.10042010.09.15-
TrendMicro-HouseCall9.120.0.10042010.09.15-
VBA323.12.14.02010.09.14-
ViRobot2010.8.25.40062010.09.15-
VirusBuster12.65.6.02010.09.14-
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 15, 2010, 12:18:08 AM
John,

When I make changes to Oxygen the virus profile changes :)

I found other programs give false positives too. (compiling with FreeBasic)

Eros has had the same problem with thinBasic but it is readily resolved by reporting to the antivirus software developers concerned.

Perhaps I should wait until the O2 versions change less often.

Charles
Title: Re: Oxygen Basic alpha
Post by: JRS on September 15, 2010, 12:29:09 AM
Charles,

Please don't get the wrong impression. I trust you and that you wouldn't be careless to develop on a box ridden with viruses and worms. The problem is that these over helpful anti-virus programs disinfect the download before I get a chance to unzip it and mark it as safe.

If your releasing the source to O2 and it's self compiling, maybe distributing the code that way would make things easier. If you include an easy to use build script with the release, I can't see how that will slow anyone down.

I would like to take a peek at your work (source) just out of curiosity.

John
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 15, 2010, 02:16:57 AM


One advantage of C is that you can build everything from source using the resident compiler.

But Oxygen.dll compiles with FreeBasic 0.20 (at present). The utilities compile with Oxygen. And You need at least a co2 compiler already compiled (chicken and egg).

I could include the source code in the zip. It only adds an extra 200k. What do you think?

Charles

PS: I have used Avast Antivirus for many years. Free. Automatic updates daily. No trouble with false positives.

Title: Re: Oxygen Basic alpha
Post by: ahadev on September 15, 2010, 02:32:59 AM
John,

I have already submitted the false alarm to the team of Avira Antivirus yesterday and waiting now for a reply.

The often changing of o2basic in its alpha status is an argument to wait with further reports to antivirus software devs. But I want to test o2basic without this hassle.  ;)

Quote from: JRS on September 14, 2010, 11:33:28 PM
I went to the SourceForge site to download the 03 release and Kaspersky and Virus Total complained.
Title: Re: Oxygen Basic alpha
Post by: JRS on September 15, 2010, 02:49:31 AM
Quote
I could include the source code in the zip. It only adds an extra 200k. What do you think?

It sure would give the project that open source feeling. Make sure you have decided on a licensing scheme before doing so.

I don't think I'm at a skill level that I could contribute to the compiler but I will help with testing and integration with ScriptBasic.

Quote
But Oxygen.dll compiles with FreeBasic ...

That sounds like a BCX code challenge to me.  ;D
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 15, 2010, 03:40:59 AM

Okay :)

I'm not at all concerned with licensing. If any one wants to nick any part of it they are welcome, though a digital signing scheme might be useful to authenticate a fully maintained version.

Its written in very plain Basic and Assembler. Some parts are easier to understand than others. I spend more time annotating the code now than making changes. You will find the Oxygenkeywords in o2keyw.bas which is mostly a database and used to generate the manual. There are also some Architectural notes in the source folder.

FreeBasic compiles my 3 years worth of source code in 2 seconds!

posted as Alpha005

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 15, 2010, 03:58:11 AM
Right now I have got the reply from AVIRA that the following files are reported as 'FALSE POSITIVE':
- cco2.exe
- co2.exe
- eo2.exe

Conclusion: 'The detection pattern will be dropped for one of the next updates of the virus definition file (VDF).'

I hope the same goes for the compiled examples.
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 15, 2010, 04:48:42 AM
Thanks Andreas,

All executables will have a similar startup signature to these programs so there is a fair chance that Avira will accept them. But I don't know how it will react if new data sections are added to the PE file.

Charles
Title: Re: Oxygen Basic alpha
Post by: efgee on September 15, 2010, 07:45:17 AM
Quote from: JRS on September 15, 2010, 12:29:09 AM
... If your releasing the source to O2 and it's self compiling, maybe distributing the code that way would make things easier. If you include an easy to use build script with the release, I can't see how that will slow anyone down.

I would like to take a peek at your work (source) just out of curiosity.

Having the source code handy is nice and many people (myself included) can learn a lot just from staring at it.

But, if the Antivirus Software will recognize a certain pattern as a virus, then it doesn't matter if you download it inside a zip file or compile it yourself; the Antivirus Software will delete it as soon the compiler is done writing it to disk (happened to me with tcc compiled programs).

my $0.02

Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 15, 2010, 08:46:44 AM

I work in notepad so the presentation is optimised for easy reading in monochrome. You will see some graffiti between various sections. This is useful as a navigational aid as well as fun to do. Generally speaking each file represents a different layer of operation in the compiler to make code maintenance as easy as possible. The interesting thing is I did not plan this structure in advance, it emerged of its own accord. This business of lexing parsing and semantics is not an artefact.

Charles
Title: Re: Oxygen Basic alpha
Post by: JRS on September 15, 2010, 09:53:27 AM
Quote
But, if the Antivirus Software will recognize a certain pattern as a virus, then it doesn't matter if you download it inside a zip file or compile it yourself; the Antivirus Software will delete it as soon the compiler is done writing it to disk (happened to me with tcc compiled programs).

I'm having all kinds of problems with Kaspersky enabled and working with Oxygen Basic 05. Is there anything that be changed so that new compiled programs aren't flagged as infected?
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 16, 2010, 06:20:31 AM
I submitted eo2.exe co2.exe and cco2.exe and got this
response from Dr Kaspersky:

Quote
Hello,

Sorry, it was a false detection. It will be fixed in the next update.
Thank you for your help.

-------------------------------------------
Regards, Ivan Kargapoltsev.
Virus analyst , Kaspersky Lab.
Title: Re: Oxygen Basic alpha
Post by: jcfuller on September 16, 2010, 09:22:13 AM
John,
  Try this co2. You will need to add your OxygenBasic directory to your system PATH environment.
I removed the directory code in the source and recompiled.

James
Title: Re: Oxygen Basic alpha
Post by: JRS on September 16, 2010, 10:32:06 AM
Quote
I submitted eo2.exe co2.exe and cco2.exe and got this response from Dr Kaspersky:

I just updated my Kaspersky AV files (1.3 MB update) and the same e-mail worm false positive is still there. Maybe tomorrows update will bring some relief.

@James - Thanks, I'll give it a try.


Title: Re: Oxygen Basic alpha
Post by: JRS on September 16, 2010, 11:45:56 PM
I downloaded Alpha07 and just updated my AV files again and it looks like Kaspersky Lab updated their patterns and the files you submitted are no longer showing up as having a e-mail worm. There are still 2 files (applications) that are showing false positives. Does this mean that new code I compile won't create a patten that Kaspersky will not like?

Side Note: I have to click on the mirror link and select from there to get a zip that doesn't say it's bad. The SourceForge default is bad.


Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 17, 2010, 02:36:25 AM

Well I fear this is going to be a persisten problem. I will try removing pathnames from the compilers as James has done and maybe offer a config file option instead. Hopefully this will make Oxygen programs look less viral.

Charles
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 18, 2010, 05:19:54 AM

I'm working on a new prolog for Oxygen compiled files. Down to 1 false positive on Antivir. I will also try moving all embedded string literals from the code section into their own data section. The idea is that the code section contains nothing else but machine code.

The forthcoming Google Chrome OS requires this for Native code web applications so that the entire binary can be statically analysed and security checked. This goes much deeper than the usual Antivirus.

Keeping data and code separate excludes the possibility of self-modifying code, a trick often used in Malware to disguise its true functionality.

Charles
Title: Re: Oxygen Basic alpha
Post by: JRS on September 18, 2010, 08:25:39 AM
That sucks when all you're trying to do is compile a Basic program. I'm sure glad you're at the helm and have the perseverance to meet the challenge.

Thanks for everything you do!

 
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 23, 2010, 12:53:10 AM
Hi all,

I've got good news from AVIRA. A moderator has replied my mail 3 days ago:
'I will adjust the rule so with Basic Oxygen generated programs will no longer be falsely reported by this rule. The adjustment will be in the next update of AEHEUR.DLL.'

I will test this evening (hopefully).

Regards,
Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 23, 2010, 03:01:51 AM

I've made quite a few changes to the Oxygen program structure with the latest release (Alpha008), removing all embedded data from the code section and placing it in an initialised data section. Automatic path searching behaviour (looking for Oxygen.dll) has also been removed and replaced with an optional Oxygen.cfg file. These changes satisfy all of the antivirus systems at virustotal.com except for Avira which has consistently reported "TR/Crypt.XPACK.Gen2" all all Oxygen compiled files. I hope the latest Avira rule change will still work in favour of the new Oxygen layout.

Thank you Andreas.

Charles
Title: Re: Oxygen Basic alpha
Post by: JRS on September 23, 2010, 01:09:19 PM
I just scanned Alpha08 with Kaspersky and you're out of the woods.

(http://files.allbasic.info/Oxygen/fpfree.png)
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 24, 2010, 12:53:50 AM

Excellent news! Thanks John. I have endeavoured to avoid any coding strategies that might be interpreted as potentially viral. The real test is whether O2 executables will work with Google Chrome OS which disassembles the entire application and performs a safety analysis. It also checks for any possibility that the code could self-modify at run time or execute its own data.  This rules out JIT compiling but we will be able to build EXEs without oxygen dependency for this platform.

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 24, 2010, 01:25:55 PM
Good news, indeed. Thanks, Charles!

The question is: Should I wait (for a beta version) before I contact AVIRA again?
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 24, 2010, 01:53:04 PM

I would send them another sample (Alpha008) Andreas. I can't say at this stage whether further changes are needed but the prolog should be stable for a few months at least.

And the prolog will be completely different for 64bit of course.

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 24, 2010, 03:33:47 PM
OK, Alpha008 is under test from the AVIRA team (again).  :)
Title: Re: Oxygen Basic alpha
Post by: ahadev on September 28, 2010, 01:38:59 AM
AVIRA is still testing compiled programs but the compiler files are already corrected as false alarm in todays update. For compiled programs I hope to have it corrected on Thursday or Friday.
Title: Re: Oxygen Basic alpha
Post by: cevpegge on September 28, 2010, 02:21:10 AM

Andreas,

In the new version (Alpha010a), the new compile tools should not trigger any false positives. I compiled EXO2 and GXO2 with FreeBasic and they passed all the VirusTotal.com tests. I hope this is a stable solution so we make some progress.

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on October 04, 2010, 04:13:30 AM
Charles, the false alarm for the compiler files is already gone, but the AVIRA-alarm for O2(Alpha011)-compiled programs is still there. This will be (hopefully) solved by AVIRA next weekend.

Andreas
Title: Re: Oxygen Basic alpha
Post by: cevpegge on October 04, 2010, 10:03:03 AM
Thanks Andreas,

Avira seems to be the most "sensitive"

Charles
Title: Re: Oxygen Basic alpha
Post by: ahadev on October 11, 2010, 05:15:15 AM
Hi Charles,

with todays update AVIRA doesn't report a false alarm. I did a short test.

Regards,
Andreas