AllBASIC Forum

BASIC Developer & Support Resources => Translators => BaCon => Topic started by: John on May 17, 2014, 01:22:18 PM

Title: BaCon IUP
Post by: John on May 17, 2014, 01:22:18 PM

I tried to introduce IUP to the BaCon open source community (Alex, Joe and vovchik) and the idea was quickly trashed and feelings hurt among the HUG patriots. I'm going to carry on with both the IUP and BaCon for Android efforts that flopped on the BaCon forum. C BASIC took a beating there as well. A rough bunch (Alex, Joe, vovchik and konaexpress(John) their mascot) if you don't play by their rules.

With Peter's new direction with the translator and creating .o object files of the runtime, I'm thinking of extending C BASIC by linking in the needed BaCon runtime objects and eliminating the translation phase altogether. I think BaCon has matured to the point this is actually possible. The only thing that makes sense due to issues with the BaCon boys, is to fork the BaCon project and merge it with C BASIC as an extension.

Here is a couple of BaCon IUP examples I did in the past to help get this thread going.

(http://files.allbasic.info/BaCon/iup_cube.png)

Code: [Select]

' Example of using of 3D OpenGL and IUP

INCLUDE "iup_3dgl.inc"

SUB polygon(NUMBER a, NUMBER b, NUMBER c, NUMBER d)
  DECLARE vertices[][3] = {{-1,-1, 1}, {-1,1,1}, {1,1,1}, {1,-1,1}, \
                          {-1,-1,-1}, {-1,1,-1}, {1,1,-1}, {1,-1,-1}} TYPE double
  glBegin(GL_POLYGON)
    glVertex3dv(vertices[a])
    glVertex3dv(vertices[b])
    glVertex3dv(vertices[c])
    glVertex3dv(vertices[d])
  glEnd()
END SUB

SUB colorCube
  glColor3f(1,0,0)
  glNormal3f(1,0,0)
  polygon(2,3,7,6)

  glColor3f(0,1,0)
  glNormal3f(0,1,0)
  polygon(1,2,6,5)

  glColor3f(0,0,1)
  glNormal3f(0,0,1)
  polygon(0,3,2,1)

  glColor3f(1,0,1)
  glNormal3f(0,-1,0)
  polygon(3,0,4,7)

  glColor3f(1,1,0)
  glNormal3f(0,0,-1)
  polygon(4,5,6,7)

  glColor3f(0,1,1)
  glNormal3f(-1,0,0)
  polygon(5,4,0,1)
END SUB

FUNCTION repaint_cb(Ihandle *self)
  IupGLMakeCurrent(self)
  glClearColor(0.3f, 0.3f, 0.3f, 1.0f)
  glClear(GL_COLOR_BUFFER_BIT | GL_DEPTH_BUFFER_BIT)
  glEnable(GL_DEPTH_TEST)
  glMatrixMode(GL_MODELVIEW)
  glPushMatrix()
    glTranslatef(0.0f, 0.0f , 0.0f)
    glScalef(1.0f, 1.0f, 1.0f)
    glRotatef(t, 0, 0, 1)
    colorCube()
  glPopMatrix()
  IupGLSwapBuffers(self)
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION resize_cb(Ihandle *self, NUMBER new_width, NUMBER new_height)
  IupGLMakeCurrent(self)
  glViewport(0, 0, new_width, new_height)
  glMatrixMode(GL_MODELVIEW)
  glLoadIdentity()
  glMatrixMode(GL_PROJECTION)
  glLoadIdentity()
  gluPerspective(60, 4./3., 1., 15)
  gluLookAt(3, 3, 3, 0, 0, 0, 0, 0, 1)
  width = new_width
  height = new_height
  repaint_cb(canvas)
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION idle_cb
  INCR t
  repaint_cb(canvas)
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION exit_cb
  RETURN IUP_CLOSE
END FUNCTION

' MAIN

IupOpen(NULL, NULL)
IupGLCanvasOpen()
canvas = IupGLCanvas("repaint_cb")
IupSetFunction("repaint_cb", (Icallback)repaint_cb) 
IupSetAttribute(canvas, IUP_RASTERSIZE, "640x480")
IupSetAttribute(canvas, IUP_BUFFER, IUP_DOUBLE)
IupSetCallback(canvas, "RESIZE_CB", (Icallback)resize_cb)
dialog = IupDialog(canvas)
IupSetAttribute(dialog, "TITLE", "IUP_3D_OpenGL")
IupSetCallback(dialog, "CLOSE_CB", (Icallback)exit_cb)
IupSetFunction (IUP_IDLE_ACTION, (Icallback)idle_cb)
IupShowXY(dialog, IUP_CENTER, IUP_CENTER)
IupMainLoop()
IupClose()

iup_3dgl.inc

Code: [Select]

CONST _CRT_SECURE_NO_WARNINGS

PRAGMA OPTIONS -I/usr/include/iup
PRAGMA LDFLAGS iup iupgl GL GLU
PRAGMA INCLUDE iup.h iupgl.h GL/gl.h GL/glu.h

PROTO IupOpen, IupGLCanvasOpen, IupShowXY, IupMainLoop, IupClose
PROTO IupSetFunction, IupSetAttribute, IupSetCallback, IupDialog
PROTO IupGLMakeCurrent, IupGLSwapBuffers
PROTO glBegin, glVertex3dv, glEnd, glColor3f, glNormal3f
PROTO glClearColor, glClear, glEnable, glMatrixMode
PROTO glPushMatrix, glTranslatef, glScalef, glRotatef, glPopMatrix
PROTO glViewport, glLoadIdentity, gluPerspective, gluLookAt

DECLARE *dialog, *canvas TYPE Ihandle
DECLARE width = 640, height = 480 TYPE int
DECLARE t = 0 TYPE float

To compile the original C version use the following command.

gcc iup_3dgl.c -I/usr/include/iup -liup -liupgl -lGL -lGLU -o cube


(http://files.allbasic.info/BaCon/iup_web.png)

Code: [Select]

' IupWebBrowser sample

PRAGMA OPTIONS -I/usr/include/iup
PRAGMA LDFLAGS iup iupweb
PRAGMA INCLUDE iup.h iupweb.h

PROTO IupOpen IupWebBrowserOpen IupSetAttribute IupSetAttributeHandle IupSetCallback IupShow IupMainLoop IupClose

DECLARE web TYPE Ihandle*
DECLARE txt TYPE Ihandle*
DECLARE dlg TYPE Ihandle*
DECLARE btLoad TYPE Ihandle*
DECLARE btReload TYPE Ihandle*
DECLARE btBack TYPE Ihandle*
DECLARE btForward TYPE Ihandle*
DECLARE btStop TYPE Ihandle*
DECLARE self TYPE Ihandle*
DECLARE url TYPE STRING

FUNCTION navigate_cb(Ihandle* self, STRING url)
  PRINT "NAVIGATE_CB: ", url
  self = NULL
  IF INSTR(url, "download") THEN
    RETURN IUP_IGNORE
  ELSE
    RETURN IUP_DEFAULT
  END IF
END FUNCTION

FUNCTION error_cb(Ihandle* self, STRING url)
  PRINT "ERROR_CB: ", url
  self = NULL
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION completed_cb(Ihandle* self, STRING url)
  PRINT "COMPLETED_CB: ", url
  self = NULL
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION newwindow_cb(Ihandle* self, STRING url)
  PRINT "NEWWINDOW_CB: ", url
  IupSetAttribute(self, "VALUE", url)
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION back_cb(Ihandle* self)
  web  = (Ihandle*)IupGetAttribute(self, "MY_WEB")
  IupSetAttribute(web, "BACKFORWARD", "-1")
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION forward_cb(Ihandle* self)
  web  = (Ihandle*)IupGetAttribute(self, "MY_WEB")
  IupSetAttribute(web, "BACKFORWARD", "1")
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION stop_cb(Ihandle* self)
  web  = (Ihandle*)IupGetAttribute(self, "MY_WEB")
  IupSetAttribute(web, "STOP", NULL)
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION reload_cb(Ihandle* self)
  web  = (Ihandle*)IupGetAttribute(self, "MY_WEB")
  IupSetAttribute(web, "RELOAD", NULL)
  ' TEST:
  ' PRINT "STATUS=", IupGetAttribute(web, "STATUS")
  RETURN IUP_DEFAULT
END FUNCTION

FUNCTION load_cb(Ihandle* self)
  txt  = (Ihandle*)IupGetAttribute(self, "MY_TEXT")
  web  = (Ihandle*)IupGetAttribute(self, "MY_WEB")
  IupSetAttribute(web, "VALUE", IupGetAttribute(txt, "VALUE"))
  ' TESTS:
  ' IupSetAttribute(txt, "VALUE", IupGetAttribute(web, "VALUE"))
  ' IupSetAttribute(web, "HTML", "<html><body><b>Hello</b>, World!</body></html>")
  ' IupSetAttribute(web, "VALUE", "http://www.microsoft.com")
  RETURN IUP_DEFAULT
END FUNCTION

IupOpen(NULL, NULL)
IupWebBrowserOpen()             
' Creates an instance of the WebBrowser control
web = IupWebBrowser()
' Creates a dialog containing the control
dlg = IupDialog(IupVbox(IupHbox(btBack = IupButton("Back", NULL), \
                                btForward = IupButton("Forward", NULL), \
                                txt = IupText(""), \
                                btLoad = IupButton("Load", NULL), \
                                btReload = IupButton("Reload", NULL), \
                                btStop = IupButton("Stop", NULL), \
                                NULL), \
                                web, NULL))
IupSetAttribute(dlg, "TITLE", "IupWebBrowser")
IupSetAttribute(dlg, "MY_TEXT", (STRING)txt)
IupSetAttribute(dlg, "MY_WEB", (STRING)web)
IupSetAttribute(dlg, "RASTERSIZE", "800x600")
IupSetAttribute(dlg, "MARGIN", "10x10")
IupSetAttribute(dlg, "GAP", "10")
' IupSetAttribute(web, "HTML", "<html><body><b>Hello</b>World!</body></html>")
' IupSetAttribute(txt, "VALUE", "My HTML")
' IupSetAttribute(txt, "VALUE", "file:///D:/tecgraf/iup/html/index.html")
IupSetAttribute(txt, "VALUE", "http://www.basic-converter.org/")
IupSetAttribute(web, "VALUE", IupGetAttribute(txt, "VALUE"))
IupSetAttributeHandle(dlg, "DEFAULTENTER", btLoad)
IupSetAttribute(txt, "EXPAND", "HORIZONTAL")
IupSetCallback(btLoad, "ACTION", (Icallback)load_cb)
IupSetCallback(btReload, "ACTION", (Icallback)reload_cb)
IupSetCallback(btBack, "ACTION", (Icallback)back_cb)
IupSetCallback(btForward, "ACTION", (Icallback)forward_cb)
IupSetCallback(btStop, "ACTION", (Icallback)stop_cb)
IupSetCallback(web, "NEWWINDOW_CB", (Icallback)newwindow_cb)
IupSetCallback(web, "NAVIGATE_CB", (Icallback)navigate_cb)
IupSetCallback(web, "ERROR_CB", (Icallback)error_cb)
IupSetCallback(web, "COMPLETED_CB", (Icallback)completed_cb)
IupShow(dlg)
IupMainLoop()
IupClose()

jrs@laptop:~/BaCon/B29$ ./iup_web
NAVIGATE_CB: http://www.basic-converter.org/
COMPLETED_CB: http://www.basic-converter.org/
NAVIGATE_CB: http://www.basic-converter.org/
COMPLETED_CB: http://www.basic-converter.org/
NAVIGATE_CB: http://www.basic-converter.org/
COMPLETED_CB: http://www.basic-converter.org/
NAVIGATE_CB: http://www.basic-converter.org/stable/CHANGES
COMPLETED_CB: http://www.basic-converter.org/stable/CHANGES
java version "1.6.0_24"
OpenJDK Runtime Environment (IcedTea6 1.11.5) (6b24-1.11.5-0ubuntu1~12.04.1)
OpenJDK 64-Bit Server VM (build 20.0-b12, mixed mode)
NAVIGATE_CB: http://www.basic-converter.org/
COMPLETED_CB: http://www.basic-converter.org/
jrs@laptop:~/BaCon/B29$

Title: Re: BaCon IUP
Post by: John on May 17, 2014, 08:49:47 PM

Here is an example of Peter's MID runtime function.

bacon.mid.c

Code: [Select]

#include "bacon.bac.generic.h"
char* __b2c__mid(char *__b2c__src, ...){ va_list __b2c__ap; long __b2c__start, __b2c__len, __b2c__l; if(__b2c__src == NULL) return("");
va_start(__b2c__ap, __b2c__src); __b2c__start = va_arg(__b2c__ap, long); if(__b2c__start < 1) return(__b2c__src); __b2c__l = strlen(__b2c__src); if(__b2c__start > __b2c__l) return(""); __b2c__len = va_arg(__b2c__ap, long);
if(__b2c__len < 0 || __b2c__start+__b2c__len > __b2c__l) __b2c__len = __b2c__l-__b2c__start+1; __b2c__sbuffer_ptr++; if(__b2c__sbuffer_ptr >= 256) __b2c__sbuffer_ptr=0; __b2c__sbuffer[__b2c__sbuffer_ptr] = (char*)__sbuf_realloc(__b2c__sbuffer[__b2c__sbuffer_ptr], (__b2c__len+1)*sizeof(char));
memcpy(__b2c__sbuffer[__b2c__sbuffer_ptr], __b2c__src+(__b2c__start-1)*sizeof(char), __b2c__len*sizeof(char)); __b2c__sbuffer[__b2c__sbuffer_ptr][__b2c__len] = '\0'; va_end(__b2c__ap); return (char*)(__b2c__sbuffer[__b2c__sbuffer_ptr]);}

Here is the C BASIC version of it. (cbrt_ = C BASIC Run Time)  Veriadic Function

Code: [Select]

FUNCTION char PTR cbrt_mid(char PTR cbrt_src, ...)
BEGIN_FUNCTION
  DIM AS va_list cbrt_ap;
  DIM AS long cbrt_start, cbrt_len, cbrt_l;
  IF (cbrt_src EQ NULL) THEN_DO RETURN_FUNCTION("");
  va_start(cbrt_ap, cbrt_src);
  cbrt_start = va_arg(cbrt_ap, long);
  IF (cbrt_start < 1) THEN_DO RETURN_FUNCTION(cbrt_src);
  cbrt_l = strlen(cbrt_src);
  IF (cbrt_start > cbrt_l) THEN_DO RETURN_FUNCTION("");
  cbrt_len = va_arg(cbrt_ap, long);
  IF (cbrt_len < 0 OR cbrt_start + cbrt_len > cbrt_l) THEN_DO cbrt_len = cbrt_l - cbrt_start + 1;
  INCR cbrt_sbuffer_ptr;
  IF (cbrt_sbuffer_ptr >= 256) THEN_DO cbrt_sbuffer_ptr = 0;
  cbrt_sbuffer[cbrt_sbuffer_ptr] = (char PTR)__sbuf_realloc(cbrt_sbuffer[cbrt_sbuffer_ptr], (cbrt_len + 1) * sizeof(char));
  memcpy(cbrt_sbuffer[cbrt_sbuffer_ptr], cbrt_src + (cbrt_start - 1) * sizeof(char), cbrt_len * sizeof(char));
  cbrt_sbuffer[cbrt_sbuffer_ptr][cbrt_len] = '\0';
  va_end(cbrt_ap);
  RETURN_FUNCTION (char PTR)(cbrt_sbuffer[cbrt_sbuffer_ptr]);
END_FUNCTION

I'm still undecided if I want to convert the BaCon run time library to C BASIC. The only advantage I see for a C BASIC mask is if a Windows version were in the plans.This would hopefully attract more contributors and make the code easier to read. My plan at the moment is to test of few of the BaCon run time function as #define {function} definitions in cbasic.h using the .o library functions.

Title: Re: BaCon IUP
Post by: John on May 18, 2014, 11:09:07 AM

I don't think it would take that long to convert BaCon's runtime library to C BASIC. I think the effort would expose the brilliance of Peter's design and make the code more portable. Who knows, maybe Peter will start generating C BASIC code for BaCon.  :)