Oxygen Basic alpha

[cevpegge]

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

[rdc]

Look interesting. I'll have to give it a try.

[JRS]

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)

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


[JRS]

Here is the OpenGL example from the Oxygen Basic distribution. (12 KB .exe)

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.



OpenGL ASM Example Source

[JRS]

Here is an example of OOP in Oxygen Basic. (11.5 KB .exe)

      

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


[JRS]

Charles,

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


John

[cevpegge]

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

[jcfuller]

John,
  Give the man a break and stop soliciting for SB at every opportunity. Sheesse

James

[jcfuller]

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

[JRS]

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 

[cevpegge]

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

[cevpegge]

Okay. Here is a case insensitive instr

I will include it in the examples/dataprocessing folder

Charles

[jcfuller]

Charles,
  I was not soliciting for new features already just trying to get my head around O2Bas.

James

[MRBCX]

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

[cevpegge]

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