canvas.bac

' =========================
' Purpose of this program
' =========================
'
' This is the CANVAS context. It provides a High Performance Canvas
' for demonstration drawing purposes.
'
' It can be used either with GLUT, ALLEGRO 5, SDL 1.2 or GLFW, and should
' use an OpenGL enabled graphics card for maximum performance.
'
' The top left of the created window has coordinate (0, 0).
'
' =========================
' Documentation for the API
' =========================
'
' BACKEND(type$)
'  => Instead of autodetecting, force the canvas using SDL, GLUT, GLFW or ALLEGRO backend. Used for debug purposes.
'
' WINDOW(title$, xsize, ysize)
'  => Create a window with canvas using a title, x size and y size
'
' FULLSCREEN
'  => Create a full screen canvas using the current screen resolution
'
' PIXEL(x, y)
'  => Put a pixel in the current color on position x, y
'
' LINE(xstart, ystart, xend, yend)
'  => Draw a line from xstart, ystart to xend, yend
'
' SQUARE(x, y, xradius, yradius, fill)
'  => Draw a square with center position at x, y and radius x radius y.
'
' CIRCLE(x, y, xsize, ysize, fill)
'  => Draw a circle with center position at x, y and radius x, y.
'
' ARC(x, y, xsize, ysize)
'  => Draw an arc with center position at x, y and radius x, y.
'
' TRIANGLE(x, y, base, height, fill)
'  => Draw a triangle with center position at x, y and base/height.
'
' POLYGON(x, y, radius, sides, fill)
'  => Draw a polygon with center position at x, y, a radius, and amount of sides.
'
' QBEZIER(xstart, ystart, bendx, bendy, xend, yend)
'  => Draw a quadratic Bezier curve starting at (xstart, ystart), ending at (xend, yend) bended by (bendx, bendy)
'
' CBEZIER(xstart, ystart, bend1x, bend1y, bend2x, bend2y, xend, yend)
'  => Draw a cubic Bezier curve starting at (xstart, ystart), ending at (xend, yend) bended by (bend1x, bend1y) and (bend2x, bend2y).
'
' PAINT(x, y)
'  => Fill with current color starting and x, y
'
' TEXT(txt$, x, y)
'  => Put text txt$ and position x, y
'
' GETINK(x, y, mode)
'  => Obtain color at position x,y. Mode values: 0=r 1=g 2=b 3=alpha, 4=RGBA 5=ABGR quadruple in one integer of 4 bytes
'
' FLIP(x)
'  => Flip the image where x=0: horizontal x=1: vertical x=2: horizontal and vertical. Other values are ignored.
'
' GRID(x, y, w, h, hboxes, vboxes)
'  => Create a grid at x, y topleft, with size w, h and amount of boxes hboxes, vboxes
'
' INK(r, g, b, a)
'  => Set the color to r, g, b and use alpha a (all 0-255)
'
' PEN(x, yesno)
'  => Set the width of the pixel to x (float value), and use anti-aliasing y/n
'
' ROTATION(angle)
'  => Set the default rotation for LINE, CIRCLE, SQUARE, TRIANGLE, ARC, POLYGON, GRID, TEXT to <angle> (in degrees)
'
' SCALE(factor)
'  => Set scaling for LINE, CIRCLE, SQUARE, TRIANGLE, ARC, POLYGON, GRID, TEXT to <factor> (float value)
'
' MOVE(angle, distance)
'  => Move LINE, CIRCLE, SQUARE, TRIANGLE, ARC, POLYGON, GRID, TEXT <distance> pixels in the direction of <angle>.
'
' SYNC
'  => Swap the background buffer to the canvas
'
' QUIT
'  => Quit the canvas module
'
' CLS
'  => Clear the screen in the last color set by INK
'
' CALLBACK(timeout, function)
'  => Call function repeatedly after timeout of millisecs. Usable for moving pictures.
'
' WAITKEY
'  => Wait for a key to be pressed, this will exit the program
'
' PENUP
'  => Take the pen from the canvas
'
' PENDOWN
'  => Put the pen back onto the canvas (default)
'
' PENXY(x, y)
'  => Set the current x and y coordinate of the pen
'
' PENTYPE(type)
'  => Set the type of pen drawing, 0 = line, 1 = arc
'
' TURNRIGHT(angle)
'  => Rotate the direction of the pen to the right in degrees
'
' TURNLEFT(angle)
'  => Rotate the direction of the pen to the left in degrees
'
' RESETANGLE
'  => Put the angle of the turtle back to 0
'
' DRAW(length)
'  => Draw using the pen
'
' LOADFONT("file.jhf")
'  => Load Hershey vector font in "James Hunt Format" - see http://www.whence.com/hershey-fonts/
'
' MOUSE(n)
'  => Query mouse state, n=0: xposition, n=1: yposition, n=2: button press, left button(1), middle(2), right(3), up(4), down(5) n=3: state, pressed(1) released(0)
'
' WIDTH / HEIGHT
'  => Contain the width and height of the canvas
'
' REFRESH
'  => Refresh rate of monitor
'
' ===========================
' License and release history
' ===========================
'
' The concept of the turtle drawing with friendly permission from Tomaaz:
'   PENON, PENOFF, PENXY, TURNRIGHT, TURNLEFT, DRAW.
'
' (c) Peter van Eerten, September/December 2015 - MIT License.
'
' 1.0: Initial release.
' 1.1: Lower case functions, CLS can use last color set by INK.
' 1.2: Fixed alpha blending - thx forum member vovchik. Added SCALE.
' 1.3: Improved anti-aliasing - thx forum member vovchik.
' 1.4: Improved pixel rendering - thx forum member vovchik.
' 1.5: Improved SCALE.
' 1.6: Callback did not obey delay in timer (GLUT).
' 2.0: Added API for turtle handling based on Tomaaz turtle context. Added ARC primitive. CIRCLE and ARC now use radius instead of total size.
' 2.1: Added POLYGON, GRID, fixed crash in PAINT - thx forum member vovchik.
' 2.2: Fixed PAINT issue in 32bit. Improved ARC and CIRCLE.
' 2.3: Fixed TRIANGLE, POLYGON and GRID for rotation and scaling. Improved pixel rendering - thx forum member vovchik.
' 2.4: Improved global variable structure. CALLBACK automatically will use a SYNC after the user function was invoked.
' 2.5: Added support for scalable fonts in "jhf" format - thx forum member vovchik.
' 2.6: Fixed bug in GRID - thx forum member vovchik.
' 2.7: Added MOVE.
' 2.8: Added support for LibGLFW.
' 2.9: Small code improvements. Added GETINK - thx forum member vovchik.
' 2.10: Improved import logic. Improved GETINK - thx forum member vovchik.
' 2.11: Added OpenGL calls for importing images.
' 2.12: Callbacked function should start immediately and not wait for delay.
' 2.13: Added glPixelZoom for image flipping.
' 2.14: Added FLIP, QBEZIER and CBEZIER.
' 2.15: Improved FLIP so it works for plain images too.
' 2.16: More improvemens in FLIP so it works in any order.
' 2.17: POLYGON did not declare xpos,ypos variables locally.
' 2.18: Fixed passing float arguments to Check_Scale and Check_Rotation - thx forum member vovchik.
' 2.19: Casted arguments to 'float' type where necessary. Added GL functions to query driver.
' 2.20: Implemented support for MOUSE events. Call BACKEND to force backend.
' 2.21: Improved mouse support for GLUT.
' 2.22: Improved callback mechanism for GLFW.
' 2.23: Better casting of CIRCLE arguments prevents unexpected results.
' 2.24: Support for fullscreen canvas.
' 2.25: Enable multisampling also for Allegro, SDL, GLFW
' 2.26: Scaling should also apply to glDrawPixel
' 2.27: REFRESH contains refresh rate of current screen.
' 2.28: Added GL_RGB constant.
' 2.29: Support for mouse wheel (GLUT, SDL, GLFW).
' 2.30: Mouse wheel support for Allegro.
' 2.31: Added texture GL calls.
'---------------------------------------------------------------------------------------------------------------------------------------------

PRAGMA INCLUDE <sys/resource.h>

' Globals used by this context
RECORD CANVAS
    LOCAL library$
    LOCAL pen_size, scaling TYPE float
    LOCAL win TYPE void*
    LOCAL backend, rotate, xsize, ysize, timerval, font_width, step, angle, flipping
    LOCAL pen_smooth, pen_active, pen_type, pen_xpos, pen_ypos, pen_direction
    LOCAL mbutton, mstate, mx, my TYPE int
    LOCAL (*callb)(void) TYPE void
    LOCAL font$[96]
END RECORD

' Setting the stack size to 64Mb to allow recursive paint
USEC
    struct rlimit rl;
    getrlimit (RLIMIT_STACK, &rl);
    rl.rlim_cur = 65536*1024;
    setrlimit (RLIMIT_STACK, &rl);
ENDUSEC

' This is the "futurum.jhf" font from the hershey-font package. Their license requires that the following acknowledgements must be distributed with the font data:
' - The Hershey Fonts were originally created by Dr. A. V. Hershey while working at the U. S. National Bureau of Standards.
' - The format of the Font data in this distribution was originally created by James Hurt Cognition, Inc., 900 Technology Park Drive, Billerica, MA 01821
DATA "  1JZ"
DATA " 24MXRFRTST RRFSFST RRXQYQZR[S[TZTYSXRX RRYRZSZSYRY"
DATA " 22I[NFMGMM RNGMM RNFOGMM RWFVGVM RWGVM RWFXGVM"
DATA " 12H]SBLb RYBRb RLOZO RKUYU"
DATA " 51I\\RBR_S_ RRBSBS_ RWIYIWGTFQFNGLILKMMNNVRWSXUXWWYTZQZOYNX RWIVHTGQGNHMIMKNMVQXSYUYWXYWZT[Q[NZLXNX RXXUZ"
DATA " 32F^[FI[ RNFPHPJOLMMKMIKIIJGLFNFPGSHVHYG[F RWTUUTWTYV[X[ZZ[X[VYTWT"
DATA " 49F_[NZO[P\\O\\N[MZMYNXPVUTXRZP[M[JZIXIUJSPORMSKSIRGPFNGMIMKNNPQUXWZZ[[[\\Z\\Y RM[KZJXJUKSMQ RMKNMVXXZZ["
DATA " 11NWSFRGRM RSGRM RSFTGRM"
DATA " 20KYVBTDRGPKOPOTPYR]T`Vb RTDRHQKPPPTQYR\\T`"
DATA " 20KYNBPDRGTKUPUTTYR]P`Nb RPDRHSKTPTTSYR\\P`"
DATA " 39JZRFQGSQRR RRFRR RRFSGQQRR RMINIVOWO RMIWO RMIMJWNWO RWIVINOMO RWIMO RWIWJMNMO"
DATA " 16F_RIRZSZ RRISISZ RJQ[Q[R RJQJR[R"
DATA " 24MXTZS[R[QZQYRXSXTYT\\S^Q_ RRYRZSZSYRY RS[T\\ RTZS^"
DATA "  3E_IR[R"
DATA " 16MXRXQYQZR[S[TZTYSXRX RRYRZSZSYRY"
DATA "  8G^[BIbJb R[B\\BJb"
DATA " 42H\\QFNGLJKOKRLWNZQ[S[VZXWYRYOXJVGSFQF ROGMJLOLRMWOZ RNYQZSZVY RUZWWXRXOWJUG RVHSGQGNH"
DATA " 12H\\NJPISFS[ RNJNKPJRHR[S["
DATA " 34H\\LKLJMHNGPFTFVGWHXJXLWNUQL[ RLKMKMJNHPGTGVHWJWLVNTQK[ RLZYZY[ RK[Y["
DATA " 48H\\MFXFQO RMFMGWG RWFPO RQNSNVOXQYTYUXXVZS[P[MZLYKWLW RPOSOVPXS RTOWQXTXUWXTZ RXVVYSZPZMYLW ROZLX"
DATA " 18H\\UIU[V[ RVFV[ RVFKVZV RUILV RLUZUZV"
DATA " 53H\\MFLO RNGMN RMFWFWG RNGWG RMNPMSMVNXPYSYUXXVZS[P[MZLYKWLW RLOMOONSNVOXR RTNWPXSXUWXTZ RXVVYSZPZMYLW ROZLX"
DATA " 62H\\VGWIXIWGTFRFOGMJLOLTMXOZR[S[VZXXYUYTXQVOSNRNOOMQ RWHTGRGOH RPGNJMOMTNXQZ RMVOYRZSZVYXV RTZWXXUXTWQTO RXSVPSOROOPMS RQONQMT"
DATA " 12H\\KFYFO[ RKFKGXG RXFN[O["
DATA " 68H\\PFMGLILKMMNNPOTPVQWRXTXWWYTZPZMYLWLTMRNQPPTOVNWMXKXIWGTFPF RNGMIMKNMPNTOVPXRYTYWXYWZT[P[MZLYKWKTLRNPPOTNVMWKWIVG RWHTGPGMH RLXOZ RUZXX"
DATA " 62H\\WPURRSQSNRLPKMKLLINGQFRFUGWIXMXRWWUZR[P[MZLXMXNZ RWMVPSR RWNUQRRQRNQLN RPRMPLMLLMIPG RLKNHQGRGUHWK RSGVIWMWRVWTZ RUYRZPZMY"
DATA " 32MXRMQNQORPSPTOTNSMRM RRNROSOSNRN RRXQYQZR[S[TZTYSXRX RRYRZSZSYRY"
DATA " 40MXRMQNQORPSPTOTNSMRM RRNROSOSNRN RTZS[R[QZQYRXSXTYT\\S^Q_ RRYRZSZSYRY RS[T\\ RTZS^"
DATA "  4F^ZIJRZ["
DATA " 16F_JM[M[N RJMJN[N RJU[U[V RJUJV[V"
DATA "  4F^JIZRJ["
DATA " 58I\\LKLJMHNGQFTFWGXHYJYLXNWOUPRQ RLKMKMJNHQGTGWHXJXLWNUORP RMIPG RUGXI RXMTP RRPRTSTSP RRXQYQZR[S[TZTYSXRX RRYRZSZSYRY"
DATA " 56E`WNVLTKQKOLNMMPMSNUPVSVUUVS RQKOMNPNSOUPV RWKVSVUXVZV\\T]Q]O\\L[JYHWGTFQFNGLHJJILHOHRIUJWLYNZQ[T[WZYYZX RXKWSWUXV"
DATA " 20H\\RFJ[ RRIK[J[ RRIY[Z[ RRFZ[ RMUWU RLVXV"
DATA " 44H\\LFL[ RMGMZ RLFTFWGXHYJYMXOWPTQ RMGTGWHXJXMWOTP RMPTPWQXRYTYWXYWZT[L[ RMQTQWRXTXWWYTZMZ"
DATA " 38H]ZKYIWGUFQFOGMILKKNKSLVMXOZQ[U[WZYXZV RZKYKXIWHUGQGOHMKLNLSMVOYQZUZWYXXYVZV"
DATA " 32H]LFL[ RMGMZ RLFSFVGXIYKZNZSYVXXVZS[L[ RMGSGVHWIXKYNYSXVWXVYSZMZ"
DATA " 27I\\MFM[ RNGNZ RMFYF RNGYGYF RNPTPTQ RNQTQ RNZYZY[ RM[Y["
DATA " 21I[MFM[ RNGN[M[ RMFYF RNGYGYF RNPTPTQ RNQTQ"
DATA " 44H]ZKYIWGUFQFOGMILKKNKSLVMXOZQ[U[WZYXZVZRUR RZKYKXIWHUGQGOHNIMKLNLSMVNXOYQZUZWYXXYVYSUSUR"
DATA " 22G]KFK[ RKFLFL[K[ RYFXFX[Y[ RYFY[ RLPXP RLQXQ"
DATA "  8NWRFR[S[ RRFSFS["
DATA " 20J[VFVVUYSZQZOYNVMV RVFWFWVVYUZS[Q[OZNYMV"
DATA " 22H]LFL[M[ RLFMFM[ RZFYFMR RZFMS RPOY[Z[ RQOZ["
DATA " 14IZMFM[ RMFNFNZ RNZYZY[ RM[Y["
DATA " 26F^JFJ[ RKKK[J[ RKKR[ RJFRX RZFRX RYKR[ RYKY[Z[ RZFZ["
DATA " 20G]KFK[ RLIL[K[ RLIY[ RKFXX RXFXX RXFYFY["
DATA " 40G]PFNGLIKKJNJSKVLXNZP[T[VZXXYVZSZNYKXIVGTFPF RQGNHLKKNKSLVNYQZSZVYXVYSYNXKVHSGQG"
DATA " 27H\\LFL[ RMGM[L[ RLFUFWGXHYJYMXOWPUQMQ RMGUGWHXJXMWOUPMP"
DATA " 48G]PFNGLIKKJNJSKVLXNZP[T[VZXXYVZSZNYKXIVGTFPF RQGNHLKKNKSLVNYQZSZVYXVYSYNXKVHSGQG RSXX]Y] RSXTXY]"
DATA " 34H\\LFL[ RMGM[L[ RLFTFWGXHYJYMXOWPTQMQ RMGTGWHXJXMWOTPMP RRQX[Y[ RSQY["
DATA " 43H\\YIWGTFPFMGKIKKLMMNOOTQVRWSXUXXWYTZPZNYMXKX RYIWIVHTGPGMHLILKMMONTPVQXSYUYXWZT[P[MZKX"
DATA " 15J[RGR[ RSGS[R[ RLFYFYG RLFLGYG"
DATA " 24G]KFKULXNZQ[S[VZXXYUYF RKFLFLUMXNYQZSZVYWXXUXFYF"
DATA " 14H\\JFR[ RJFKFRX RZFYFRX RZFR["
DATA " 26E_GFM[ RGFHFMX RRFMX RRIM[ RRIW[ RRFWX R]F\\FWX R]FW["
DATA " 16H\\KFX[Y[ RKFLFY[ RYFXFK[ RYFL[K["
DATA " 17I\\KFRPR[S[ RKFLFSP RZFYFRP RZFSPS["
DATA " 20H\\XFK[ RYFL[ RKFYF RKFKGXG RLZYZY[ RK[Y["
DATA " 12KYOBOb RPBPb ROBVB RObVb"
DATA "  3KYKFY^"
DATA " 12KYTBTb RUBUb RNBUB RNbUb"
DATA "  8G]JTROZT RJTRPZT"
DATA "  3H\\Hb\\b"
DATA "  7LXPFUL RPFOGUL"
DATA " 36H\\WMW[X[ RWMXMX[ RWPUNSMPMNNLPKSKULXNZP[S[UZWX RWPSNPNNOMPLSLUMXNYPZSZWX"
DATA " 36H\\LFL[M[ RLFMFM[ RMPONQMTMVNXPYSYUXXVZT[Q[OZMX RMPQNTNVOWPXSXUWXVYTZQZMX"
DATA " 32I[XPVNTMQMONMPLSLUMXOZQ[T[VZXX RXPWQVOTNQNOONPMSMUNXOYQZTZVYWWXX"
DATA " 36H\\WFW[X[ RWFXFX[ RWPUNSMPMNNLPKSKULXNZP[S[UZWX RWPSNPNNOMPLSLUMXNYPZSZWX"
DATA " 36I[MTXTXQWOVNTMQMONMPLSLUMXOZQ[T[VZXX RMSWSWQVOTNQNOONPMSMUNXOYQZTZVYWWXX"
DATA " 24LZWFUFSGRJR[S[ RWFWGUGSH RTGSJS[ ROMVMVN ROMONVN"
DATA " 48H\\XMWMW\\V_U`SaQaO`N_L_ RXMX\\W_UaSbPbNaL_ RWPUNSMPMNNLPKSKULXNZP[S[UZWX RWPSNPNNOMPLSLUMXNYPZSZWX"
DATA " 25H\\LFL[M[ RLFMFM[ RMQPNRMUMWNXQX[ RMQPORNTNVOWQW[X["
DATA " 24NWRFQGQHRISITHTGSFRF RRGRHSHSGRG RRMR[S[ RRMSMS["
DATA " 24NWRFQGQHRISITHTGSFRF RRGRHSHSGRG RRMRbSb RRMSMSb"
DATA " 22H[LFL[M[ RLFMFM[ RXMWMMW RXMMX RPTV[X[ RQSX["
DATA "  8NWRFR[S[ RRFSFS["
DATA " 42CbGMG[H[ RGMHMH[ RHQKNMMPMRNSQS[ RHQKOMNONQORQR[S[ RSQVNXM[M]N^Q^[ RSQVOXNZN\\O]Q][^["
DATA " 25H\\LML[M[ RLMMMM[ RMQPNRMUMWNXQX[ RMQPORNTNVOWQW[X["
DATA " 36I\\QMONMPLSLUMXOZQ[T[VZXXYUYSXPVNTMQM RQNOONPMSMUNXOYQZTZVYWXXUXSWPVOTNQN"
DATA " 36H\\LMLbMb RLMMMMb RMPONQMTMVNXPYSYUXXVZT[Q[OZMX RMPQNTNVOWPXSXUWXVYTZQZMX"
DATA " 36H\\WMWbXb RWMXMXb RWPUNSMPMNNLPKSKULXNZP[S[UZWX RWPSNPNNOMPLSLUMXNYPZSZWX"
DATA " 21KYOMO[P[ ROMPMP[ RPSQPSNUMXM RPSQQSOUNXNXM"
DATA " 50J[XPWNTMQMNNMPNRPSUUWV RVUWWWXVZ RWYTZQZNY ROZNXMX RXPWPVN RWOTNQNNO RONNPOR RNQPRUTWUXWXXWZT[Q[NZMX"
DATA " 16MXRFR[S[ RRFSFS[ ROMVMVN ROMONVN"
DATA " 25H\\LMLWMZO[R[TZWW RLMMMMWNYPZRZTYWW RWMW[X[ RWMXMX["
DATA " 14JZLMR[ RLMMMRY RXMWMRY RXMR["
DATA " 26F^IMN[ RIMJMNX RRMNX RRPN[ RRPV[ RRMVX R[MZMVX R[MV["
DATA " 16I[LMW[X[ RLMMMX[ RXMWML[ RXMM[L["
DATA " 17JZLMR[ RLMMMRY RXMWMRYNb RXMR[ObNb"
DATA " 20I[VNL[ RXMNZ RLMXM RLMLNVN RNZXZX[ RL[X["
DATA "  4KYUBNRUb"
DATA "  3NVRBRb"
DATA "  4KYOBVROb"
DATA " 24F^IUISJPLONOPPTSVTXTZS[Q RISJQLPNPPQTTVUXUZT[Q[O"
DATA " 35JZJFJ[K[KFLFL[M[MFNFN[O[OFPFP[Q[QFRFR[S[SFTFT[U[UFVFV[W[WFXFX[Y[YFZFZ["

' Needed to parse font data
DEF FN CANVAS_Coord(x$) = ASC(x$)-ASC("R")

CALL Read_Font_Data()

' Primitives available in small letters as well
ALIAS "WINDOW" TO "window"
ALIAS "FULLSCREEN" TO "fullscreen"
ALIAS "PIXEL" TO "pixel"
ALIAS "LINE" TO "line"
ALIAS "CIRCLE" TO "circle"
ALIAS "ARC" TO "arc"
ALIAS "SQUARE" TO "square"
ALIAS "TRIANGLE" TO "triangle"
ALIAS "POLYGON" TO "polygon"
ALIAS "PAINT" TO "paint"
ALIAS "TEXT" TO "text"
ALIAS "GRID" TO "grid"
ALIAS "QBEZIER" TO "qbezier"
ALIAS "CBEZIER" TO "cbezier"
ALIAS "INK" TO "ink"
ALIAS "PEN" TO "pen"
ALIAS "ROTATION" TO "rotation"
ALIAS "SCALE" TO "scale"
ALIAS "MOVE" TO "move"
ALIAS "GETINK" TO "getink"
ALIAS "FLIP" TO "flip"
ALIAS "SYNC" TO "sync"
ALIAS "QUIT" TO "quit"
ALIAS "CLS" TO "cls"
ALIAS "CALLBACK" TO "callback"
ALIAS "WAITKEY" TO "waitkey"
ALIAS "PENDOWN" TO "pendown"
ALIAS "PENUP" TO "penup"
ALIAS "PENXY" TO "penxy"
ALIAS "PENTYPE" TO "pentype"
ALIAS "TURNRIGHT" TO "turnright"
ALIAS "TURNLEFT" TO "turnleft"
ALIAS "RESETANGLE" TO "resetangle"
ALIAS "DRAW" TO "draw"
ALIAS "LOADFONT" TO "loadfont"
ALIAS "MOUSE" TO "mouse"
'ALIAS "WIDTH" TO "width"
'ALIAS "HEIGHT" TO "height"
ALIAS "REFRESH" TO "refresh"

' Default is 60 Hz
REFRESH = 60

'------------------------------------------------------------------

SUB Read_Font_Data

    LOCAL x

    ' Get the fonts for OpenGL
    FOR x = 0 TO 95
        READ CANVAS.font$[x]
    NEXT

END SUB

FUNCTION Import_X11_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libX11.so.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "XOpenDisplay(char*)" FROM lib$ TYPE void*

    CATCH RESET

    IMPORT "XCloseDisplay(void*)" FROM lib$ TYPE int
    IMPORT "XDefaultRootWindow(void*)" FROM lib$ TYPE long
    IMPORT "XDefaultScreen(void*)" FROM lib$ TYPE int
    IMPORT "XDisplayWidth(void*,int)" FROM lib$ TYPE int
    IMPORT "XDisplayHeight(void*,int)" FROM lib$ TYPE int

    RETURN TRUE

END FUNCTION

FUNCTION Import_Xrandr_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libXrandr.so.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "XRRGetScreenInfo(void*,long)" FROM lib$ TYPE void*

    CATCH RESET

    IMPORT "XRRConfigCurrentRate(void*)" FROM lib$ TYPE short

    RETURN TRUE

END FUNCTION

FUNCTION Import_GLUT_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libglut.so.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "glutInit(int*,char**)" FROM lib$ TYPE void

    CATCH RESET

    IMPORT "glutInitDisplayMode(int)" FROM lib$ TYPE void
    IMPORT "glutInitWindowSize(int,int)" FROM lib$ TYPE void
    IMPORT "glutCreateWindow(char*)" FROM lib$ TYPE void*
    IMPORT "glutMainLoop(void)" FROM lib$ TYPE void
    IMPORT "glutMotionFunc(void*)" FROM lib$ TYPE void
    IMPORT "glutMouseFunc(void*)" FROM lib$ TYPE void
    IMPORT "glutPassiveMotionFunc(void*)" FROM lib$ TYPE void
    IMPORT "glutSwapBuffers(void)" FROM lib$ TYPE void
    IMPORT "glutKeyboardFunc(void*)" FROM lib$ TYPE void
    IMPORT "glutTimerFunc(int,void*,int)" FROM lib$ TYPE void

    CATCH GOTO GLUT_No_Fullscreen

    IMPORT "glutGameModeString(char*)" FROM lib$ TYPE void
    IMPORT "glutEnterGameMode(void)" FROM lib$ TYPE void

    CATCH RESET

    CANVAS.library$ = "GLUT"

    ' GLUT definitions
    CONST GLUT_RGBA = 0x0000
    CONST GLUT_DOUBLE = 0x0002
    CONST GLUT_ALPHA = 0x0008
    CONST GLUT_MULTISAMPLE = 0x0080
    CONST GLUT_DEPTH = 0x0010
    CONST GLUT_LEFT_BUTTON = 0x0000
    CONST GLUT_MIDDLE_BUTTON = 0x0001
    CONST GLUT_RIGHT_BUTTON = 0x0002
    CONST GLUT_DOWN = 0x0000
    CONST GLUT_UP = 0x0001

    RETURN TRUE

    LABEL GLUT_No_Mousewheel
        PRINT "Warning: your GLUT library does not support mouse wheel events."
        PROTO glutMouseWheelFunc
        RESUME

    LABEL GLUT_No_Fullscreen
        PRINT "Warning: your GLUT library does not support fullscreen."
        PROTO glutGameModeString
        PROTO glutEnterGameMode
        RESUME

END FUNCTION

FUNCTION Import_ALLEGRO_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "liballegro.so.5.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "al_install_system(int,void*)" FROM lib$ TYPE void

    CATCH RESET

    IMPORT "al_create_display(int,int)" FROM lib$ TYPE void*
    IMPORT "al_create_event_queue(void)" FROM lib$ TYPE void*
    IMPORT "al_create_timer(double)" FROM lib$ TYPE void*
    IMPORT "al_flip_display(void)" FROM lib$ TYPE void
    IMPORT "al_get_display_event_source(void*)" FROM lib$ TYPE void*
    IMPORT "al_get_keyboard_event_source(void)" FROM lib$ TYPE void*
    IMPORT "al_get_mouse_event_source(void)" FROM lib$ TYPE void*
    IMPORT "al_get_mouse_state(void*)" FROM lib$ TYPE void
    IMPORT "al_get_mouse_state_axis(void*,int)" FROM lib$ TYPE int
    IMPORT "al_get_timer_event_source(void*)" FROM lib$ TYPE void*
    IMPORT "al_install_keyboard(void)" FROM lib$ TYPE int
    IMPORT "al_install_mouse(void)" FROM lib$ TYPE int
    IMPORT "al_mouse_button_down(void*,int)" FROM lib$ TYPE int
    IMPORT "al_register_event_source(void*,void*)" FROM lib$ TYPE void
    IMPORT "al_set_new_display_flags(int)" FROM lib$ TYPE void
    IMPORT "al_set_new_display_option(int,int,int)" FROM lib$ TYPE void
    IMPORT "al_set_window_title(void*,char*)" FROM lib$ TYPE void
    IMPORT "al_set_target_bitmap(void*)" FROM lib$ TYPE void
    IMPORT "al_start_timer(void*)" FROM lib$ TYPE void
    IMPORT "al_wait_for_event(void*,long)" FROM lib$ TYPE void

    CANVAS.library$ = "ALLEGRO"

    ' ALLEGRO definitions
    CONST ALLEGRO_VERSION = 5
    CONST ALLEGRO_SUB_VERSION = 0
    CONST ALLEGRO_WIP_VERSION = 10
    CONST ALLEGRO_RELEASE_NUMBER = 1
    CONST ALLEGRO_VERSION_INT = ((ALLEGRO_VERSION << 24) | (ALLEGRO_SUB_VERSION << 16) | (ALLEGRO_WIP_VERSION << 8) | ALLEGRO_RELEASE_NUMBER)
    CONST ALLEGRO_WINDOWED = 1<<0
    CONST ALLEGRO_FULLSCREEN = 1<<1
    CONST ALLEGRO_OPENGL = 1<<2
    CONST ALLEGRO_EVENT_MOUSE_AXES = 20
    CONST ALLEGRO_EVENT_MOUSE_BUTTON_DOWN = 21
    CONST ALLEGRO_EVENT_MOUSE_BUTTON_UP = 22
    CONST ALLEGRO_EVENT_MOUSE_ENTER_DISPLAY = 23
    CONST ALLEGRO_EVENT_TIMER = 30
    CONST ALLEGRO_EVENT_KEY_DOWN = 10
    CONST ALLEGRO_EVENT_DISPLAY_CLOSE = 42
    CONST ALLEGRO_SUGGEST = 2
    CONST ALLEGRO_SAMPLE_BUFFERS = 17
    CONST ALLEGRO_SAMPLES = 18

    RETURN TRUE

END FUNCTION

FUNCTION Import_SDL_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libSDL-1.2.so.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "SDL_Init(int)" FROM lib$ TYPE int

    CATCH RESET

    IMPORT "SDL_AddTimer(int,void*,void*)" FROM lib$ TYPE long
    IMPORT "SDL_GetError(void)" FROM lib$ TYPE char* ALIAS SDL_GetError$
    IMPORT "SDL_GetMouseState(int*,int*)" FROM lib$ TYPE int
    IMPORT "SDL_GL_SetAttribute(int,int)" FROM lib$ TYPE int
    IMPORT "SDL_GL_SwapBuffers(void)" FROM lib$ TYPE void
    IMPORT "SDL_PushEvent(long)" FROM lib$ TYPE int
    IMPORT "SDL_Quit(void)" FROM lib$ TYPE void
    IMPORT "SDL_SetVideoMode(int,int,int,int)" FROM lib$ TYPE void*
    IMPORT "SDL_WaitEvent(long)" FROM lib$ TYPE int
    IMPORT "SDL_WM_SetCaption(char*,char*)" FROM lib$ TYPE void

    CANVAS.library$ = "SDL"

    ' SDL definitions
    CONST SDL_INIT_TIMER = 0x00000001
    CONST SDL_INIT_VIDEO = 0x00000020
    CONST SDL_OPENGL = 0x00000002
    CONST SDL_FULLSCREEN = 0x80000000
    CONST SDL_GL_RED_SIZE = 0
    CONST SDL_GL_GREEN_SIZE = 1
    CONST SDL_GL_BLUE_SIZE = 2
    CONST SDL_GL_DOUBLEBUFFER = 5
    CONST SDL_GL_DEPTH_SIZE = 6
    CONST SDL_QUIT = 12
    CONST SDL_KEYDOWN = 2
    CONST SDL_MOUSEMOTION = 4
    CONST SDL_MOUSEBUTTONDOWN = 5
    CONST SDL_MOUSEBUTTONUP = 6
    CONST SDL_GL_MULTISAMPLEBUFFERS = 13
    CONST SDL_GL_MULTISAMPLESAMPLES = 14

    RETURN TRUE

ENDFUNCTION

FUNCTION Import_GLFW_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libglfw.so.3.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "glfwInit(void)" FROM lib$ TYPE int

    CATCH RESET

    IMPORT "glfwTerminate(void)" FROM lib$ TYPE void
    IMPORT "glfwCreateWindow(int,int,const char*,void*,void*)" FROM lib$ TYPE void*
    IMPORT "glfwSwapBuffers(void*)" FROM lib$ TYPE void
    IMPORT "glfwPollEvents(void)" FROM lib$ TYPE void
    IMPORT "glfwSetKeyCallback(void*,void*)" FROM lib$ TYPE void*
    IMPORT "glfwMakeContextCurrent(void*)" FROM lib$ TYPE void
    IMPORT "glfwSetWindowCloseCallback(void*,void*)" FROM lib$ TYPE void
    IMPORT "glfwSetCursorPosCallback(void*,void*)" FROM lib$ TYPE void
    IMPORT "glfwSetMouseButtonCallback(void*,void*)" FROM lib$ TYPE void
    IMPORT "glfwSetScrollCallback(void*,void*)" FROM lib$ TYPE void
    IMPORT "glfwDefaultWindowHints(void)" FROM lib$ TYPE void
    IMPORT "glfwGetPrimaryMonitor(void)" FROM lib$ TYPE void*
    IMPORT "glfwWindowHint(int,int)" FROM lib$ TYPE void

    CANVAS.library$ = "GLFW"

    CONST GLFW_MOUSE_BUTTON_LEFT = 0
    CONST GLFW_MOUSE_BUTTON_MIDDLE = 2
    CONST GLFW_MOUSE_BUTTON_RIGHT = 1
    CONST GLFW_PRESS = 1
    CONST GLFW_RELEASE = 0
    CONST GLFW_RED_BITS = 0x00021001
    CONST GLFW_GREEN_BITS = 0x00021002
    CONST GLFW_BLUE_BITS = 0x00021003
    CONST GLFW_DEPTH_BITS = 0x00021005
    CONST GLFW_SAMPLES = 0x0002100D

    RETURN TRUE

ENDFUNCTION

FUNCTION Import_GL_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_import_retry

    lib$ = "libGL.so.0"

    LABEL lib_import_retry
        INCR seq

    IF seq > 100 THEN RETURN FALSE
    lib$ = LEFT$(lib$, INSTRREV(lib$, ".")) & STR$(seq)

    IMPORT "glClear(int)" FROM lib$ TYPE void

    CATCH RESET

    IMPORT "glBegin(int)" FROM lib$ TYPE void
    IMPORT "glBitmap(int,int,float,float,float,float,long)" FROM lib$ TYPE void
    IMPORT "glBlendFunc(int,int)" FROM lib$ TYPE void
    IMPORT "glClearColor(float,float,float,float)" FROM lib$ TYPE void
    IMPORT "glColor4ub(char,char,char,char)" FROM lib$ TYPE void
    IMPORT "glDisable(int)" FROM lib$ TYPE void
    IMPORT "glDrawPixels(int,int,int,int,void*)" FROM lib$ TYPE void
    IMPORT "glEnable(int)" FROM lib$ TYPE void
    IMPORT "glIsEnabled(int)" FROM lib$ TYPE int
    IMPORT "glEnd(void)" FROM lib$ TYPE void
    IMPORT "glGetFloatv(int,float*)" FROM lib$ TYPE void
    IMPORT "glGetString(int)" FROM lib$ TYPE char* ALIAS glGetString$
    IMPORT "glHint(int,int)" FROM lib$ TYPE void
    IMPORT "glLineWidth(float)" FROM lib$ TYPE void
    IMPORT "glLoadIdentity(void)" FROM lib$ TYPE void
    IMPORT "glMatrixMode(int)" FROM lib$ TYPE void
    IMPORT "glOrtho(double,double,double,double,double,double)" FROM lib$ TYPE void
    IMPORT "glPixelStorei(int,int)" FROM lib$ TYPE void
    IMPORT "glPixelZoom(float,float)" FROM lib$ TYPE void
    IMPORT "glPointSize(float)" FROM lib$ TYPE void
    IMPORT "glRasterPos2f(float,float)" FROM lib$ TYPE void
    IMPORT "glReadPixels(int,int,int,int,int,int,void*)" FROM lib$ TYPE void
    IMPORT "glRotatef(float,float,float,float)" FROM lib$ TYPE void
    IMPORT "glScalef(float,float,float)" FROM lib$ TYPE void
    IMPORT "glTranslatef(float,float,float)" FROM lib$ TYPE void
    IMPORT "glVertex2f(float,float)" FROM lib$ TYPE void
    IMPORT "glGenTextures(int,int*)" FROM lib$ TYPE void
    IMPORT "glDeleteTextures(int,int*)" FROM lib$ TYPE void
    IMPORT "glBindTexture(int,int)" FROM lib$ TYPE void
    IMPORT "glTexParameteri(int,int,int)" FROM lib$ TYPE void
    IMPORT "glTexImage2D(int,int,int,int,int,int,int,int,void*)" FROM lib$ TYPE void
    IMPORT "glTexCoord2f(float,float)" FROM lib$ TYPE void

    ' GL definitions
    CONST GL_POINTS = 0x0000
    CONST GL_LINES = 0x0001
    CONST GL_LINE_LOOP = 0x0002
    CONST GL_POLYGON = 0x0009
    CONST GL_UNSIGNED_BYTE = 0x1401
    CONST GL_MODELVIEW = 0x1700
    CONST GL_PROJECTION = 0x1701
    CONST GL_RGB = 0x1907
    CONST GL_RGBA = 0x1908
    CONST GL_COLOR_BUFFER_BIT = 0x00004000
    CONST GL_DEPTH_BUFFER_BIT = 0x00000100
    CONST GL_POINT_SMOOTH = 0x0B10
    CONST GL_POINT_SIZE = 0x0B11
    CONST GL_LINE_SMOOTH = 0x0B20
    CONST GL_POLYGON_SMOOTH = 0x0B41
    CONST GL_CURRENT_COLOR = 0x0B00
    CONST GL_TRIANGLES = 0x0004
    CONST GL_BLEND = 0x0BE2
    CONST GL_SRC_ALPHA = 0x0302
    CONST GL_ONE_MINUS_SRC_ALPHA = 0x0303
    CONST GL_MULTISAMPLE = 0x809D
    CONST GL_NICEST = 0x1102
    CONST GL_POINT_SMOOTH_HINT = 0x0C51
    CONST GL_LINE_SMOOTH_HINT = 0x0C52
    CONST GL_POLYGON_SMOOTH_HINT = 0x0C53
    CONST GL_UNPACK_ROW_LENGTH = 0x0CF2
    CONST GL_VENDOR = 0x1F00
    CONST GL_RENDERER = 0x1F01
    CONST GL_VERSION = 0x1F02
    CONST GL_EXTENSIONS = 0x1F03
    CONST GL_QUADS = 0x0007
    CONST GL_TEXTURE_2D = 0x0DE1
    CONST GL_TEXTURE_MAG_FILTER = 0x2800
    CONST GL_TEXTURE_MIN_FILTER = 0x2801
    CONST GL_LINEAR = 0x2601

    RETURN TRUE

ENDFUNCTION

'------------------------------------------------------------------

SUB DETECT_BACKEND

    ' Import functions from system and choose the one available
    IF NOT(Import_GLUT_functions()) THEN
        IF NOT(Import_ALLEGRO_functions()) THEN
            IF NOT(Import_SDL_functions()) THEN
                IF NOT(Import_GLFW_functions()) THEN
                    PRINT "No GLUT or Allegro or SDL or GLFW library found! Canvas cannot be created."
                    END 1
                ENDIF
            ENDIF
        ENDIF
    ENDIF

    'PRINT "Now using: ", CANVAS.library$
    CANVAS.backend = TRUE

ENDSUB

SUB BACKEND(type$)

    SELECT type$
        CASE "GLUT"
            IF NOT(Import_GLUT_functions()) THEN
                PRINT "No GLUT library found! Canvas cannot be created."
                END 1
            ENDIF
        CASE "SDL"
            IF NOT(Import_SDL_functions()) THEN
                PRINT "No SDL library found! Canvas cannot be created."
                END 1
            ENDIF
        CASE "ALLEGRO"
            IF NOT(Import_ALLEGRO_functions()) THEN
                PRINT "No ALLEGRO library found! Canvas cannot be created."
                END 1
            ENDIF
        CASE "GLFW"
            IF NOT(Import_GLFW_functions()) THEN
                PRINT "No GLFW library found! Canvas cannot be created."
                END 1
            ENDIF
        DEFAULT
            PRINT "Incorrect backend specified! Please choose from GLUT, SDL, ALLEGRO or GLFW."
            END 1
    ENDSELECT

    CANVAS.backend = TRUE

ENDSUB

SUB INIT_CANVAS(int argc, char* argv[])

    LOCAL dsp TYPE void*

    IF NOT(Import_X11_functions()) THEN
        PRINT "No X11 library found on this system! Canvas cannot be created."
        END 1
    ENDIF

    dsp = XOpenDisplay(NULL)
    CANVAS.xsize = XDisplayWidth(dsp, XDefaultScreen(dsp))
    CANVAS.ysize = XDisplayHeight(dsp, XDefaultScreen(dsp))

    IF Import_Xrandr_functions() THEN REFRESH = XRRConfigCurrentRate(XRRGetScreenInfo(dsp, XDefaultRootWindow(dsp)))
    XCloseDisplay(dsp)

    ' Initialize
    IF CANVAS.library$ = "GLUT" THEN
        glutInit(&argc, argv)
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        al_install_system(ALLEGRO_VERSION_INT, atexit)
        al_install_keyboard()
        al_install_mouse()
    ELIF CANVAS.library$ = "SDL" THEN
        IF SDL_Init(SDL_INIT_VIDEO|SDL_INIT_TIMER) < 0 THEN
            PRINT SDL_GetError$()
            END 1
        ENDIF
    ELIF CANVAS.library$ = "GLFW" THEN
        IF glfwInit() = 0 THEN
            PRINT "Error initiliazing GLFW."
            END 1
        ENDIF
    ELSE
        PRINT "No suitable backend found."
        END 1
    ENDIF

ENDSUB

SUB WINDOW(title$, xsize, ysize)

    IF NOT(CANVAS.backend) THEN CALL DETECT_BACKEND()

    CALL INIT_CANVAS(0, NULL)

    IF CANVAS.library$ = "GLUT" THEN
        glutInitDisplayMode(GLUT_DOUBLE | GLUT_RGBA | GLUT_DEPTH | GLUT_MULTISAMPLE)
        glutInitWindowSize(xsize, ysize)
        CANVAS.win = glutCreateWindow(title$)
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        al_set_new_display_flags(ALLEGRO_WINDOWED|ALLEGRO_OPENGL)
        al_set_new_display_option(ALLEGRO_SAMPLE_BUFFERS, TRUE, ALLEGRO_SUGGEST)
        al_set_new_display_option(ALLEGRO_SAMPLES, 4, ALLEGRO_SUGGEST)
        CANVAS.win = al_create_display(xsize, ysize)
        al_set_window_title(CANVAS.win, title$)
    ELIF CANVAS.library$ = "SDL" THEN
        SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5)
        SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5)
        SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5)
        SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16)
        SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, TRUE)
        SDL_GL_SetAttribute(SDL_GL_MULTISAMPLEBUFFERS, 1)
        SDL_GL_SetAttribute(SDL_GL_MULTISAMPLESAMPLES, 4)
        CANVAS.win = SDL_SetVideoMode(xsize, ysize, 16, SDL_OPENGL)
        IF CANVAS.win = 0 THEN
            PRINT SDL_GetError$()
            END 1
        ENDIF
        SDL_WM_SetCaption(title$, NULL)
    ELSE
        glfwDefaultWindowHints()
        glfwWindowHint(GLFW_RED_BITS, 5)
        glfwWindowHint(GLFW_GREEN_BITS, 5)
        glfwWindowHint(GLFW_BLUE_BITS, 5)
        glfwWindowHint(GLFW_DEPTH_BITS, 16)
        glfwWindowHint(GLFW_SAMPLES, 4)
        CANVAS.win = glfwCreateWindow(xsize, ysize, title$, NULL, NULL)
        glfwMakeContextCurrent(CANVAS.win)
    ENDIF

    CANVAS.xsize = xsize
    CANVAS.ysize = ysize

    CALL Finalize_Window

END SUB

SUB FULLSCREEN

    IF NOT(CANVAS.backend) THEN CALL DETECT_BACKEND()

    CALL INIT_CANVAS(0, NULL)

    IF CANVAS.library$ = "GLUT" THEN
        glutGameModeString(STR$(CANVAS.xsize) & "x" & STR$(CANVAS.ysize) & ":16@60")
        glutEnterGameMode()
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        al_set_new_display_flags(ALLEGRO_FULLSCREEN|ALLEGRO_OPENGL)
        CANVAS.win = al_create_display(CANVAS.xsize, CANVAS.ysize)
    ELIF CANVAS.library$ = "SDL" THEN
        CANVAS.win = SDL_SetVideoMode(CANVAS.xsize, CANVAS.ysize, 16, SDL_OPENGL|SDL_FULLSCREEN)
        IF CANVAS.win = 0 THEN
            PRINT SDL_GetError$()
            END 1
        ENDIF
    ELSE
        glfwDefaultWindowHints()
        CANVAS.win = glfwCreateWindow(CANVAS.xsize, CANVAS.ysize, "", glfwGetPrimaryMonitor(), NULL)
        glfwMakeContextCurrent(CANVAS.win)
    FI

    CALL Finalize_Window

ENDSUB

SUB Finalize_Window

    IF NOT(Import_GL_functions()) THEN
        PRINT "No OpenGL library found on this system! Canvas cannot be created."
        END 1
    ENDIF

    ' Clear canvas
    glClearColor(1.0f, 1.0f, 1.0f, 0.0f)
    CALL CLS

    ' Enable alpha channel
    glEnable(GL_BLEND)
    glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA)

    ' For anti aliasing (vovchik)
    glEnable(GL_MULTISAMPLE)

    ' Pixel rendering (vovchik)
    glHint(GL_POINT_SMOOTH_HINT, GL_NICEST)
    glHint(GL_LINE_SMOOTH_HINT, GL_NICEST)
    glHint(GL_POLYGON_SMOOTH_HINT, GL_NICEST)

    ' Set default drawing color to black
    CALL INK(0,0,0,255)

    ' Pen on by default
    CANVAS.pen_active = 1

    ' Default scaling
    CANVAS.scaling = 1.0

    ' Set font width
    CANVAS.font_width = 16

    ' No flipping
    CANVAS.flipping = 3

    CONST WIDTH = CANVAS.xsize
    CONST HEIGHT = CANVAS.ysize

END SUB

SUB CLS

    glClear(GL_COLOR_BUFFER_BIT|GL_DEPTH_BUFFER_BIT)

END SUB

SUB INK(unsigned char r, unsigned char g, unsigned char b, unsigned char alpha)

    glClearColor(r/255.0, g/255.0, b/255.0, alpha/255.0)
    glColor4ub(r, g, b, alpha)

ENDSUB

SUB PEN(size#, flag)

    CANVAS.pen_size = size#
    CANVAS.pen_smooth = flag

    IF flag THEN
        glEnable(GL_POINT_SMOOTH)
        glEnable(GL_LINE_SMOOTH)
        glEnable(GL_POLYGON_SMOOTH)
    ELSE
        glDisable(GL_POINT_SMOOTH)
        glDisable(GL_LINE_SMOOTH)
        glDisable(GL_POLYGON_SMOOTH)
    ENDIF

    glPointSize(size#)
    glLineWidth(size#)

ENDSUB

SUB PENDOWN

    CANVAS.pen_active = 1

END SUB

SUB PENUP

    CANVAS.pen_active = 0

END SUB

SUB PENXY(xpos, ypos)

    CANVAS.pen_xpos = xpos
    CANVAS.pen_ypos = ypos

ENDSUB

SUB PENTYPE(type)

    IF type < 0 OR type > 1 THEN type = 0
    CANVAS.pen_type = type

ENDSUB

SUB TURNRIGHT(angle)

    DECR CANVAS.pen_direction, angle
    WHILE CANVAS.pen_direction < 0
        INCR CANVAS.pen_direction, 360
    WEND

ENDSUB

SUB TURNLEFT(angle)

    INCR CANVAS.pen_direction, angle
    WHILE CANVAS.pen_direction > 360
        DECR CANVAS.pen_direction, 360
    WEND

ENDSUB

SUB RESETANGLE

    CANVAS.pen_direction = 0

ENDSUB

SUB DRAW(length)

    LOCAL x, y, rotate

    IF CANVAS.pen_active THEN
        IF CANVAS.pen_type = 0 THEN
            x = CANVAS.pen_xpos + INT(COS(RAD(CANVAS.pen_direction))*length)
            y = CANVAS.pen_ypos - INT(SIN(RAD(CANVAS.pen_direction))*length)
            CALL LINE(CANVAS.pen_xpos, CANVAS.pen_ypos, x, y)
            CANVAS.pen_xpos = x
            CANVAS.pen_ypos = y
        ELIF CANVAS.pen_type = 1 THEN
            x = CANVAS.pen_xpos + INT(COS(RAD(CANVAS.pen_direction))*(length/2))
            y = CANVAS.pen_ypos - INT(SIN(RAD(CANVAS.pen_direction))*(length/2))
            rotate = CANVAS.rotate
            CANVAS.rotate = -CANVAS.pen_direction
            CALL ARC(x, y, length/2, length/2)
            CANVAS.rotate = rotate
            CANVAS.pen_xpos = CANVAS.pen_xpos + INT(COS(RAD(CANVAS.pen_direction))*length)
            CANVAS.pen_ypos = CANVAS.pen_ypos - INT(SIN(RAD(CANVAS.pen_direction))*length)
        ENDIF
    ENDIF

ENDSUB

SUB Check_Move()

    LOCAL x, y

    x = INT(COS(RAD(CANVAS.angle))*CANVAS.step)
    y = INT(SIN(RAD(CANVAS.angle))*CANVAS.step)

    glTranslatef(x, y, 0)

END SUB

SUB MOVE(angle, step)

    CANVAS.angle = angle
    CANVAS.step = step

ENDSUB

SUB Check_Rotation(x, y, xs, ys)

    IF CANVAS.rotate <> 0 THEN
        glTranslatef(x+xs, y+ys, 0)
        glRotatef(CANVAS.rotate, 0, 0, 1)
        glTranslatef(-x-xs, -y-ys, 0)
    ENDIF

END SUB

SUB ROTATION(angle)

    CANVAS.rotate = angle

ENDSUB

SUB Check_Scale(x, y, xs, ys)

    glTranslatef(x+xs, y+ys, 0)
    glScalef(CANVAS.scaling, CANVAS.scaling, 1)
    glPixelZoom(CANVAS.scaling, CANVAS.scaling)
    glTranslatef(-x-xs, -y-ys, 0)

END SUB

SUB SCALE(factor#)

    CANVAS.scaling = factor#

ENDSUB

SUB Draw_Prepare

    glMatrixMode(GL_PROJECTION)
    glLoadIdentity
    SELECT CANVAS.flipping
        CASE 0
            glScalef(-1.0, 1.0, 1.0)
            glPixelZoom(-1.0, 1.0)
            glRasterPos2f(-1.0, -1.0)
        CASE 1
            glScalef(1.0, -1.0, 1.0)
            glPixelZoom(1.0, -1.0)
            glRasterPos2f(-1.0, -1.0)
        CASE 2
            glScalef(-1.0, -1.0, 1.0)
            glPixelZoom(-1.0, -1.0)
            glRasterPos2f(-1.0, -1.0)
    ENDSELECT
    glOrtho(0, CANVAS.xsize, CANVAS.ysize, 0, 0, 1)
    glMatrixMode(GL_MODELVIEW)
    glLoadIdentity
    'glTranslatef(0.375, 0.375, 0)

END SUB

SUB PIXEL(float x, float y)

    CALL Draw_Prepare

    glBegin(GL_POINTS)
    glVertex2f(x, y)
    glEnd

END SUB

SUB LINE(float xstart, float ystart, float xend, float yend)

    CALL Draw_Prepare
    CALL Check_Scale(xstart, ystart, ABS(xend-xstart)/2.0, ABS(yend-ystart)/2.0)
    CALL Check_Rotation(xstart, ystart, ABS(xend-xstart)/2.0, ABS(yend-ystart)/2.0)
    CALL Check_Move()

    glBegin(GL_LINES)
    glVertex2f(xstart, ystart)
    glVertex2f(xend, yend)
    glEnd

ENDSUB

SUB SQUARE(float x, float y, float xrad, float yrad, fill)

    CALL Draw_Prepare
    CALL Check_Scale(x-xrad, y-yrad, xrad, yrad)
    CALL Check_Rotation(x-xrad, y-yrad, xrad, yrad)
    CALL Check_Move()

    IF fill THEN
        glBegin(GL_POLYGON)
    ELSE
        glBegin(GL_LINE_LOOP)
    ENDIF

    glVertex2f(x-xrad, y-yrad)
    glVertex2f(x+xrad, y-yrad)
    glVertex2f(x+xrad, y+yrad)
    glVertex2f(x-xrad, y+yrad)
    glEnd

ENDSUB

SUB CIRCLE(float x, float y, float xsize, float ysize, fill)

    LOCAL i, xt, yt TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(x-xsize, y-ysize, xsize, ysize)
    CALL Check_Rotation(x-xsize, y-ysize, xsize, ysize)
    CALL Check_Move()

    IF fill THEN
        glBegin(GL_POLYGON)
    ELSE
        glBegin(GL_LINE_LOOP)
    END IF

    FOR i = 0 TO 360
        xt = xsize*COS(RAD(i))
        yt = ysize*SIN(RAD(i))
        glVertex2f(x+xt, y+yt)
    NEXT
    glEnd

ENDSUB

SUB ARC(float x, float y, xrad, yrad)

    LOCAL i
    LOCAL xt, yt TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(x-xrad, y-yrad, xrad, yrad)
    CALL Check_Rotation(x-xrad, y-yrad, xrad, yrad)
    CALL Check_Move()

    glBegin(GL_POINTS)
    FOR i = 0 TO 180
        xt# = xrad*COS(RAD(i))
        yt# = yrad*SIN(RAD(i))
        glVertex2f(x+xt#, y-yt#)
    NEXT
    glEnd

ENDSUB

SUB TRIANGLE(float x, float y, float base, float height, fill)

    CALL Draw_Prepare
    CALL Check_Scale(x-base, y-height, base, height)
    CALL Check_Rotation(x-base, y-height, base, height)
    CALL Check_Move()

    IF fill THEN
        glBegin(GL_TRIANGLES)
    ELSE
        glBegin(GL_LINE_LOOP)
    ENDIF

    glVertex2f(x-base/2, y+height/2)
    glVertex2f(x+base/2, y+height/2)
    glVertex2f(x, y-height/2)
    glEnd

ENDSUB

SUB POLYGON(float xorg, float yorg, radius, sides, fill)

    LOCAL i, rot, angle, xpos, ypos, length, x, y TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(xorg-2*radius, yorg-2*radius, radius*2, radius*2)
    CALL Check_Rotation(xorg-2*radius, yorg-2*radius, radius*2, radius*2)
    CALL Check_Move()

    angle = 360.0 / sides

    length = SQR((POW(radius, 2) + POW(radius, 2)) - ((2 * radius * radius) * COS(RAD(angle))))

    rot = -angle/2
    xpos = xorg
    ypos = yorg - radius

    FOR i = 1 TO sides-1
        x = xpos + COS(RAD(rot))*length
        y = ypos - SIN(RAD(rot))*length
        glBegin(GL_LINES)
        glVertex2f(xpos, ypos)
        glVertex2f(x, y)
        glEnd
        DECR rot, angle
        xpos = x
        ypos = y
    NEXT

    glBegin(GL_LINES)
    glVertex2f(x, y)
    glVertex2f(xorg, yorg-radius)
    glEnd

    IF fill THEN CALL PAINT(xorg, yorg)

ENDSUB

SUB GRID(float startx, float starty, float w, float h, hboxes, vboxes)

    LOCAL i, size_xbox, size_ybox TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(startx-w/2, starty-h/2, w, h)
    CALL Check_Rotation(startx-w/2, starty-h/2, w, h)
    CALL Check_Move()

    size_xbox = w/hboxes
    size_ybox = h/vboxes

    FOR i = 0 TO hboxes
        glBegin(GL_LINES)
        glVertex2f(startx+i*size_xbox, starty)
        glVertex2f(startx+i*size_xbox, starty+h)
        glEnd
    NEXT
    FOR i = 0 TO vboxes
        glBegin(GL_LINES)
        glVertex2f(startx, starty+i*size_ybox)
        glVertex2f(startx+w, starty+i*size_ybox)
        glEnd
    NEXT

ENDSUB

SUB QBEZIER(float x0, float y0, float x1, float y1, float x2, float y2)

    LOCAL Ax, Ay, Bx, By, t TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(x0, y0, ABS(x2-x0)/2.0, ABS(y2-y0)/2.0)
    CALL Check_Rotation(x0, y0, ABS(x2-x0)/2.0, ABS(y2-y0)/2.0)
    CALL Check_Move()

    Ax = x0 : Ay = y0

    glBegin(GL_LINES)

    FOR t = 0 TO 1 STEP 0.01

        Bx = POW((1-t), 2)*x0 + 2*(1-t)*t*x1 + POW(t,2)*x2
        By = POW((1-t), 2)*y0 + 2*(1-t)*t*y1 + POW(t,2)*y2

        glVertex2f(Ax, Ay)
        glVertex2f(Bx, By)

        Ax = Bx : Ay = By
    NEXT

    glEnd

ENDSUB

SUB CBEZIER(float x0, float y0, float x1, float y1, float x2, float y2, float x3, float y3)

    LOCAL Ax, Ay, Bx, By, t TYPE float

    CALL Draw_Prepare
    CALL Check_Scale(x0, y0, ABS(x3-x0)/2.0, ABS(y3-y0)/2.0)
    CALL Check_Rotation(x0, y0, ABS(x3-x0)/2.0, ABS(y3-y0)/2.0)
    CALL Check_Move()

    Ax = x0 : Ay = y0

    glBegin(GL_LINES)

    FOR t = 0 TO 1 STEP 0.01

        Bx = POW((1-t), 3)*x0 + 3*POW((1-t), 2)*t*x1 + 3*(1-t)*POW(t,2)*x2 + POW(t,3)*x3
        By = POW((1-t), 3)*y0 + 3*POW((1-t), 2)*t*y1 + 3*(1-t)*POW(t,2)*y2 + POW(t,3)*y3

        glVertex2f(Ax, Ay)
        glVertex2f(Bx, By)

        Ax = Bx : Ay = By
    NEXT

    glEnd

ENDSUB

SUB Fill_Area(unsigned int image[], unsigned int change, unsigned int new, x, y)

    LOCAL yreverse

    ' The memory block is y-reversed
    yreverse = CANVAS.ysize-y

    ' If coordinates are out of scope, exit function
    IF x < 0 OR x > CANVAS.xsize OR yreverse < 0 OR yreverse > CANVAS.ysize THEN EXIT SUB

    ' If current position is the same then change color
    IF image[yreverse*CANVAS.xsize+x] = change THEN
        image[yreverse*CANVAS.xsize+x] = new
    ELSE
        EXIT SUB
    FI

    ' Recursive call for all directions
    Fill_Area(image, change, new, x+1, y)
    Fill_Area(image, change, new, x-1, y)
    Fill_Area(image, change, new, x, y-1)
    Fill_Area(image, change, new, x, y+1)

ENDSUB

SUB PAINT(x, y)

    LOCAL image TYPE unsigned int ARRAY CANVAS.xsize*CANVAS.ysize
    LOCAL current, new TYPE unsigned int
    LOCAL color[4] TYPE float

    Draw_Prepare

    ' Disable current settings
    glDisable(GL_POINT_SMOOTH)
    glDisable(GL_LINE_SMOOTH)
    glDisable(GL_POLYGON_SMOOTH)

    ' Reset to size 1
    glPointSize(1)

    ' We read 4 bytes RGBA canvas into a dynamic array of integers (4 byte size type)
    glReadPixels(0, 0, CANVAS.xsize, CANVAS.ysize, GL_RGBA, GL_UNSIGNED_BYTE, image)

    ' This is the current color to change
    current = image[(CANVAS.ysize-y)*CANVAS.xsize+x]

    ' Get the color set by INK
    glGetFloatv(GL_CURRENT_COLOR, color)

    new = (INT(color[3]*255) << 24) | (INT(color[2]*255) << 16) | (INT(color[1]*255) << 8) | INT(color[0]*255)

    ' Prevent we're painting an area which has this color already
    IF new <> current THEN
        ' Call the recursive paint function
        Fill_Area(image, current, new, x, y)

        ' Put the dynamic array of integers back to the canvas
        glDrawPixels(CANVAS.xsize, CANVAS.ysize, GL_RGBA, GL_UNSIGNED_BYTE, image)
    ENDIF

    ' Restore settings
    glPointSize(CANVAS.pen_size)
    glLineWidth(CANVAS.pen_size)

    IF CANVAS.pen_smooth THEN
        glEnable(GL_POINT_SMOOTH)
        glEnable(GL_LINE_SMOOTH)
        glEnable(GL_POLYGON_SMOOTH)
    ENDIF

ENDSUB

SUB LOADFONT(file$)

    LOCAL x
    LOCAL data$
    LOCAL hershey_font TYPE FILE*

    IF FILEEXISTS(file$) THEN
        OPEN file$ FOR READING AS hershey_font

        FOR x = 0 TO 95
            READLN data$ FROM hershey_font
            CANVAS.font$[x] = MID$(data$, 6)
        NEXT
        CLOSE FILE hershey_font
    ENDIF

ENDSUB

SUB TEXT(txt$, x, y)

    LOCAL i, ptr, posx, posy, tox, toy
    LOCAL letter$

    CALL Draw_Prepare
    CALL Check_Scale(x-LEN(txt$)*CANVAS.font_width/2, y-15, LEN(txt$)*CANVAS.font_width, 15)
    CALL Check_Rotation(x-LEN(txt$)*CANVAS.font_width/2, y-15, LEN(txt$)*CANVAS.font_width, 15)
    CALL Check_Move()

    FOR i = 1 TO LEN(txt$)

        letter$ = CANVAS.font$[ASC(MID$(txt$, i, 1) - 32)]
        'width = ABS(CANVAS_Coord(MID$(letter$, 4,1)) - CANVAS_Coord(MID$(letter$, 5,1)))+2

        posx = CANVAS_Coord(MID$(letter$, 6, 1)) + x
        posy = CANVAS_Coord(MID$(letter$, 7, 1)) + y
        ptr = 8

        WHILE ptr < LEN(letter$)
            IF MID$(letter$, ptr, 2) = " R" THEN
                INCR ptr, 2
                posx = CANVAS_Coord(MID$(letter$, ptr, 1)) + x
                posy = CANVAS_Coord(MID$(letter$, ptr+1, 1)) + y
            ELSE
                tox = CANVAS_Coord(MID$(letter$, ptr, 1)) + x
                toy = CANVAS_Coord(MID$(letter$, ptr+1, 1)) + y
                ' Draw with GL primitives to allow rotation and scaling
                glBegin(GL_LINES)
                glVertex2f(posx, posy)
                glVertex2f(tox, toy)
                glEnd
                posx = tox
                posy = toy
            ENDIF
            INCR ptr, 2
        WEND
        INCR x, CANVAS.font_width
    NEXT

END SUB

FUNCTION GETINK(x, y, int mode)

    LOCAL image TYPE unsigned int ARRAY CANVAS.xsize*CANVAS.ysize
    LOCAL current TYPE unsigned int
    LOCAL r, g, b, a TYPE unsigned int

    CALL Draw_Prepare

    ' We read 4 bytes RGBA canvas into a dynamic array of integers (4 byte size type)
    glReadPixels(0, 0, CANVAS.xsize, CANVAS.ysize, GL_RGBA, GL_UNSIGNED_BYTE, image)

    ' This is the current color
    current = image[(CANVAS.ysize - y) * CANVAS.xsize + x]

    r = current & 0xFF
    g = (current >> 8) & 0xFF
    b = (current >> 16) & 0xFF
    a = (current >> 24) & 0xFF

    SELECT mode
        CASE 0
            RETURN r
        CASE 1
            RETURN g
        CASE 2
            RETURN b
        CASE 3
            RETURN a
        CASE 4
            current = ((r & 0x0ff) << 24) | ((g & 0x0ff) << 16) | ((b & 0x0ff) << 8) | (a & 0x0ff)
            RETURN current
        CASE 5
            RETURN current
    END SELECT

END FUNCTION

SUB FLIP(flag)

    CANVAS.flipping = flag
    CALL Draw_Prepare

ENDSUB

FUNCTION MOUSE(which)

    LOCAL result

    SELECT which
        CASE 0
            result = CANVAS.mx
        CASE 1
            result = CANVAS.my
        CASE 2
            IF CANVAS.mstate THEN result = CANVAS.mbutton
        CASE 3
            result = CANVAS.mstate
    ENDSELECT

    IF CANVAS.mbutton = 4 OR CANVAS.mbutton = 5 THEN CANVAS.mstate = 0

    RETURN result

END FUNCTION

SUB SYNC

    IF CANVAS.library$ = "GLUT" THEN
        glutSwapBuffers()
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        al_flip_display()
    ELIF CANVAS.library$ = "SDL" THEN
        SDL_GL_SwapBuffers()
    ELSE
        glfwSwapBuffers(CANVAS.win)
    ENDIF

ENDSUB

SUB QUIT

    IF CANVAS.library$ = "ALLEGRO" THEN
        al_set_target_bitmap(NULL)
    ELIF CANVAS.library$ = "SDL" THEN
        SDL_Quit()
    ELIF CANVAS.library$ = "GLFW" THEN
        glfwTerminate()
    ENDIF

    END 0

ENDSUB

FUNCTION GLUT_Callback(int timeout)

    CALL (*CANVAS.callb)()
    CALL SYNC()

    glutTimerFunc(timeout, GLUT_Callback, timeout)

    RETURN TRUE

ENDFUNCTION

SUB GLUT_Mouse_But(int button, int state, int x, int y)

    SELECT button
        CASE GLUT_LEFT_BUTTON
            CANVAS.mbutton = 1
        CASE GLUT_MIDDLE_BUTTON
            CANVAS.mbutton = 2
        CASE GLUT_RIGHT_BUTTON
            CANVAS.mbutton = 3
        CASE 3
            CANVAS.mbutton = 4
            state = GLUT_DOWN
        CASE 4
            CANVAS.mbutton = 5
            state = GLUT_DOWN
    END SELECT

    SELECT state
        CASE GLUT_DOWN
            CANVAS.mstate = 1
        CASE GLUT_UP
            CANVAS.mstate = 0
    ENDSELECT

    CANVAS.mx = x
    CANVAS.my = y

ENDSUB

SUB GLUT_Mouse_Pos(int x, int y)

    CANVAS.mx = x
    CANVAS.my = y

ENDSUB

SUB ALLEGRO_Mouse(void* state, int dz)

    IF al_mouse_button_down(state, 1) THEN
        CANVAS.mbutton = 1
        CANVAS.mstate = 1
    ELIF al_mouse_button_down(state, 2) THEN
        CANVAS.mbutton = 3
        CANVAS.mstate = 1
    ELIF al_mouse_button_down(state, 3) THEN
        CANVAS.mbutton = 2
        CANVAS.mstate = 1
    ELIF dz > 0 THEN
        CANVAS.mbutton = 4
        CANVAS.mstate = 1
    ELIF dz < 0 THEN
        CANVAS.mbutton = 5
        CANVAS.mstate = 1
    ELSE
        CANVAS.mstate = 0
    ENDIF

    CANVAS.mx = al_get_mouse_state_axis(state, 0)
    CANVAS.my = al_get_mouse_state_axis(state, 1)

ENDSUB

SUB SDL_Mouse(button)

    LOCAL xpos, ypos TYPE int

    SDL_GetMouseState(&xpos, &ypos)

    SELECT button
        CASE 0
            CANVAS.mstate = 0
        CASE 257
            CANVAS.mbutton = 1
            CANVAS.mstate = 1
        CASE 258
            CANVAS.mbutton = 2
            CANVAS.mstate = 1
        CASE 259
            CANVAS.mbutton = 3
            CANVAS.mstate = 1
        CASE 260
            CANVAS.mbutton = 4
            CANVAS.mstate = 1
        CASE 261
            CANVAS.mbutton = 5
            CANVAS.mstate = 1
    END SELECT

    CANVAS.mx = xpos
    CANVAS.my = ypos

ENDSUB

SUB GLFW_Mouse_Pos(void* window, double xpos, double ypos)

    CANVAS.mx = xpos
    CANVAS.my = ypos

ENDSUB

SUB GLFW_Mouse_But(void* window, int button, int action, int mods)

    SELECT button
        CASE GLFW_MOUSE_BUTTON_LEFT
            CANVAS.mbutton = 1
        CASE GLFW_MOUSE_BUTTON_MIDDLE
            CANVAS.mbutton = 2
        CASE GLFW_MOUSE_BUTTON_RIGHT
            CANVAS.mbutton = 3
    END SELECT

    SELECT action
        CASE GLFW_PRESS
            CANVAS.mstate = 1
        CASE GLFW_RELEASE
            CANVAS.mstate = 0
    ENDSELECT

ENDSUB

SUB GLFW_Mouse_Scroll(void* window, double x, double y)

    SELECT y
        CASE 1
            CANVAS.mbutton = 4
            CANVAS.mstate = 1
        CASE -1
            CANVAS.mbutton = 5
            CANVAS.mstate = 1
    END SELECT

END SUB

FUNCTION SDL_Callback(int interval, void* param)

    RECORD SDL_event
        LOCAL types TYPE unsigned short
        LOCAL which TYPE unsigned short
        LOCAL state TYPE unsigned short
    END RECORD

    SDL_event.types = 0

    SDL_PushEvent(ADDRESS(SDL_event))

    RETURN interval

ENDFUNCTION

SUB CALLBACK(timeout, void* func)

    CANVAS.callb = func

    IF CANVAS.library$ = "GLUT" THEN
        CALL GLUT_Callback(timeout)
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        CALL (*CANVAS.callb)()
        CALL SYNC()
        CANVAS.timerval = timeout
    ELIF CANVAS.library$ = "SDL" THEN
        CALL (*CANVAS.callb)()
        CALL SYNC()
        SDL_AddTimer(timeout, SDL_Callback, 0)
    ELSE
        CANVAS.timerval = timeout
    FI

ENDSUB

SUB WAITKEY

    RECORD SDL_event
        LOCAL types TYPE unsigned short
        LOCAL which TYPE unsigned short
        LOCAL state TYPE unsigned short
    END RECORD

    RECORD ALLEGRO_event
        LOCAL types TYPE unsigned int
        LOCAL other TYPE void*
        LOCAL header, structure TYPE void*
        LOCAL x, y, z, w TYPE int
        LOCAL dx, dy, dz, dw TYPE int
        LOCAL button TYPE int
    END RECORD

    LOCAL queue, altimer TYPE void*

    CALL SYNC()

    IF CANVAS.library$ = "GLUT" THEN
        glutKeyboardFunc(QUIT)
        glutMouseFunc(GLUT_Mouse_But)
        glutMotionFunc(GLUT_Mouse_Pos)
        glutPassiveMotionFunc(GLUT_Mouse_Pos)
        glutMainLoop
    ELIF CANVAS.library$ = "ALLEGRO" THEN
        queue = al_create_event_queue()
        al_register_event_source(queue, al_get_display_event_source(CANVAS.win))
        al_register_event_source(queue, al_get_keyboard_event_source())
        al_register_event_source(queue, al_get_mouse_event_source())
        IF CANVAS.timerval THEN
            altimer = al_create_timer(CANVAS.timerval/1000.0)
            al_register_event_source(queue, al_get_timer_event_source(altimer))
            al_start_timer(altimer)
        ENDIF
        WHILE TRUE
            al_wait_for_event(queue, ADDRESS(ALLEGRO_event))
            SELECT ALLEGRO_event.types
                CASE ALLEGRO_EVENT_TIMER
                    CALL (*CANVAS.callb)()
                    CALL SYNC()
                CASE ALLEGRO_EVENT_DISPLAY_CLOSE;
                CASE ALLEGRO_EVENT_KEY_DOWN
                    QUIT
                DEFAULT
                    al_get_mouse_state(ALLEGRO_event.other)
                    CALL ALLEGRO_Mouse(ALLEGRO_event.other, ALLEGRO_event.dz)
            ENDSELECT
        WEND
    ELIF CANVAS.library$ = "SDL" THEN
        WHILE SDL_WaitEvent(ADDRESS(SDL_event))
            SELECT SDL_event.types
                CASE SDL_QUIT;
                CASE SDL_KEYDOWN
                    QUIT
                CASE SDL_MOUSEMOTION;
                CASE SDL_MOUSEBUTTONUP;
                CASE SDL_MOUSEBUTTONDOWN
                    SDL_Mouse(SDL_event.which)
                CASE 0
                    CALL (*CANVAS.callb)()
                    CALL SYNC()
            ENDSELECT
        WEND
    ELSE
        glfwSetCursorPosCallback(CANVAS.win, GLFW_Mouse_Pos)
        glfwSetMouseButtonCallback(CANVAS.win, GLFW_Mouse_But)
        glfwSetScrollCallback(CANVAS.win, GLFW_Mouse_Scroll)
        glfwSetKeyCallback(CANVAS.win, QUIT)
        glfwSetWindowCloseCallback(CANVAS.win, QUIT)
        WHILE TRUE
            glfwPollEvents()
            IF CANVAS.timerval THEN
                CALL (*CANVAS.callb)()
                CALL SYNC()
                SLEEP CANVAS.timerval
            ENDIF
        WEND
    ENDIF

END SUB

'------------------------------------------------------------------

Generated by GNU Enscript 1.6.5.90.