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.
'
' OUTLINE(..., fill)
' => Draw a polygon with a variable amount of coordinates in x,y,x,y,... format.
'
' CIRCLE(x, y, xsize, ysize, fill)
' => Draw a circle with center position at x, y and radius x, y.
'
' ARC(x, y, xsize, ysize, start, end, fill)
' => Draw an arc with center position at x, y and radius x, y, start and end (degrees).
'
' 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
'
' FONTALIGN(x)
' => In case of scaling, align font centered (0 = default) or align font on x-position (1 = left).
'
' TEXTLEN(txt$)
' => Returns the length of the text in pixels.
'
' 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
'
' TURN(angle) / TURNLEFT(angle)
' => Rotate the direction of the pen to the left in degrees
'
' RESETANGLE
' => Put the angle of the turtle back to 90
'
' 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, TURN, DRAW.
'
' (c) Peter van Eerten, September/June 2017 - 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.
' 2.32: DRAW will move turtle even in when in PENUP mode, added TURN
' 2.33: Fixed bug in drawing turtle graphics.
' 2.34: TURN accepts float.
' 2.35: Fixed issue when using BACKEND in small letters.
' 2.36: Updated with XFree call and GL stuff.
' 2.37: Added GL_SCISSOR_TEST and glScissor for Nuklear backend.
' 2.38: Improved font rendering and scaling
' 2.39: Added FONTALIGN command for alignment of scaled text
' 2.40: Changed ARC so it actually draws an arc between degrees (breaks ARC API)
' 2.41: GLUT requires glutDisplayFunc()
' 2.42: Fixes in Allegro library, added default warning when compiled standalone.
' 2.43: Another fix in GLUT, needs glutSwapBuffers() before mainloop.
' 2.44: Added TEXTLEN function.
' 2.45: Improved mouse event handling.
' 2.46: Added OUTLINE directive.
' 2.47: Corrected some C-like variable names.
'---------------------------------------------------------------------------------------------------------------------------------------------
' Default message in case accidentally compiled as a standalone program
IF BASENAME$(ME$) = "canvas" THEN PRINT "This is the canvas include file."
PRAGMA INCLUDE <sys/resource.h>
' Globals used by this context
RECORD CANVAS
LOCAL library$
LOCAL win TYPE void*
LOCAL back_end, rotate, xsize, ysize, timerval, font_width, font_align, step, angle, flipping
LOCAL pen_smooth, pen_active, pen_type
LOCAL pen_size, scaling, pen_xpos, pen_ypos, pen_direction TYPE float
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 = RLIM_INFINITY;
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 "TURN" TO "turn"
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"
ALIAS "BACKEND" TO "backend"
ALIAS "OUTLINE" TO "outline"
' 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
IMPORT "XFree(void*)" 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 "glutReshapeFunc(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
IMPORT "glutDisplayFunc(void*)" 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
IMPORT "al_get_allegro_version(void)" FROM lib$ TYPE unsigned int
CANVAS.library$ = "ALLEGRO"
' ALLEGRO definitions
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 "glScissor(int,int,int,int)" FROM lib$ TYPE void
IMPORT "glTranslatef(float,float,float)" FROM lib$ TYPE void
IMPORT "glVertex2d(double,double)" 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_LINE_STRIP = 0x0003
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_BGRA = 0x80E1
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
CONST GL_STENCIL_TEST = 0x0B90
CONST GL_STENCIL_BUFFER_BIT = 0x00000400
CONST GL_STENCIL_INDEX = 0x1901
CONST GL_EQUAL = 0x0202
CONST GL_ALWAYS = 0x0207
CONST GL_NEVER = 0x0200
CONST GL_DEPTH_COMPONENT = 0x1902
CONST GL_KEEP = 0x1E00
CONST GL_REPLACE = 0x1E01
CONST GL_SCISSOR_TEST = 0x0C11
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.back_end = 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.back_end = TRUE
ENDSUB
SUB INIT_CANVAS(int argc, char* argv[])
LOCAL dpy TYPE void*
IF NOT(Import_X11_functions()) THEN
PRINT "No X11 library found on this system! Canvas cannot be created."
END 1
ENDIF
' Initialize
IF CANVAS.library$ = "GLUT" THEN
glutInit(&argc, argv)
ELIF CANVAS.library$ = "ALLEGRO" THEN
al_install_system(al_get_allegro_version(), 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
dpy = XOpenDisplay(NULL)
CANVAS.xsize = XDisplayWidth(dpy, XDefaultScreen(dpy))
CANVAS.ysize = XDisplayHeight(dpy, XDefaultScreen(dpy))
IF Import_Xrandr_functions() THEN REFRESH = XRRConfigCurrentRate(XRRGetScreenInfo(dpy, XDefaultRootWindow(dpy)))
XCloseDisplay(dpy)
ENDSUB
SUB WINDOW(title$, xsize, ysize)
IF NOT(CANVAS.back_end) 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.back_end) 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
' Determines if the font should be centered (0) or left-aligned (1) when scaling is applied
CANVAS.font_align = 0
' 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|GL_STENCIL_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(float xpos, float 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(float angle)
DECR CANVAS.pen_direction, angle
WHILE CANVAS.pen_direction < 0
INCR CANVAS.pen_direction, 360
WEND
ENDSUB
SUB TURNLEFT(float angle)
INCR CANVAS.pen_direction, angle
WHILE CANVAS.pen_direction > 360
DECR CANVAS.pen_direction, 360
WEND
ENDSUB
SUB TURN(float angle)
TURNRIGHT(angle)
ENDSUB
SUB RESETANGLE
CANVAS.pen_direction = 90
ENDSUB
SUB DRAW(float length)
LOCAL x, y TYPE float
LOCAL rotate
IF CANVAS.pen_type = 0 THEN
x = CANVAS.pen_xpos + COS(RAD(CANVAS.pen_direction))*length
y = CANVAS.pen_ypos - SIN(RAD(CANVAS.pen_direction))*length
IF CANVAS.pen_active THEN 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 + COS(RAD(CANVAS.pen_direction))*(length/2)
y = CANVAS.pen_ypos - SIN(RAD(CANVAS.pen_direction))*(length/2)
rotate = CANVAS.rotate
CANVAS.rotate = -CANVAS.pen_direction
IF CANVAS.pen_active THEN CALL ARC(x, y, length/2, length/2, 0, 360, 0)
CANVAS.rotate = rotate
CANVAS.pen_xpos = CANVAS.pen_xpos + COS(RAD(CANVAS.pen_direction))*length
CANVAS.pen_ypos = CANVAS.pen_ypos - SIN(RAD(CANVAS.pen_direction))*length
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 OUTLINE(VAR arg# SIZE total)
LOCAL i
IF total < 5 THEN
PRINT "Error: outline needs at least 2 coordinate pairs."
END 1
ENDIF
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 arg#[total-1] <> 0 THEN
glBegin(GL_POLYGON)
ELSE
glBegin(GL_LINE_LOOP)
ENDIF
FOR i = 0 TO total-2 STEP 2
glVertex2d(arg#[i], arg#[i+1])
NEXT
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, start, end, fill)
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()
IF fill THEN
glBegin(GL_POLYGON)
ELSE
glBegin(GL_LINE_STRIP)
END IF
FOR i = start TO end
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 x_0, float y_0, float x_1, float y_1, float x_2, float y_2)
LOCAL Ax, Ay, Bx, By, t TYPE float
CALL Draw_Prepare
CALL Check_Scale(x_0, y_0, ABS(x_2-x_0)/2.0, ABS(y_2-y_0)/2.0)
CALL Check_Rotation(x_0, y_0, ABS(x_2-x_0)/2.0, ABS(y_2-y_0)/2.0)
CALL Check_Move()
Ax = x_0 : Ay = y_0
glBegin(GL_LINES)
FOR t = 0 TO 1 STEP 0.01
Bx = POW((1-t), 2)*x_0 + 2*(1-t)*t*x_1 + POW(t,2)*x_2
By = POW((1-t), 2)*y_0 + 2*(1-t)*t*y_1 + POW(t,2)*y_2
glVertex2f(Ax, Ay)
glVertex2f(Bx, By)
Ax = Bx : Ay = By
NEXT
glEnd
ENDSUB
SUB CBEZIER(float x_0, float y_0, float x_1, float y_1, float x_2, float y_2, float x_3, float y_3)
LOCAL Ax, Ay, Bx, By, t TYPE float
CALL Draw_Prepare
CALL Check_Scale(x_0, y_0, ABS(x_3-x_0)/2.0, ABS(y_3-y_0)/2.0)
CALL Check_Rotation(x_0, y_0, ABS(x_3-x_0)/2.0, ABS(y_3-y_0)/2.0)
CALL Check_Move()
Ax = x_0 : Ay = y_0
glBegin(GL_LINES)
FOR t = 0 TO 1 STEP 0.01
Bx = POW((1-t), 3)*x_0 + 3*POW((1-t), 2)*t*x_1 + 3*(1-t)*POW(t,2)*x_2 + POW(t,3)*x_3
By = POW((1-t), 3)*y_0 + 3*POW((1-t), 2)*t*y_1 + 3*(1-t)*POW(t,2)*y_2 + POW(t,3)*y_3
glVertex2f(Ax, Ay)
glVertex2f(Bx, By)
Ax = Bx : Ay = By
NEXT
glEnd
ENDSUB
SUB Fill_Area(unsigned int image[], unsigned int change, unsigned int cnew, 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] = cnew
ELSE
EXIT SUB
FI
' Recursive call for all directions
Fill_Area(image, change, cnew, x+1, y)
Fill_Area(image, change, cnew, x-1, y)
Fill_Area(image, change, cnew, x, y-1)
Fill_Area(image, change, cnew, x, y+1)
ENDSUB
SUB PAINT(x, y)
LOCAL image TYPE unsigned int ARRAY CANVAS.xsize*CANVAS.ysize
LOCAL current, cnew 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)
cnew = (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 cnew <> current THEN
' Call the recursive paint function
Fill_Area(image, current, cnew, 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 FONTALIGN(align)
' Determines if the font should be centered (0) or aligned to xposition (1) when scaling is applied
CANVAS.font_align = align
ENDSUB
FUNCTION TEXTLEN(txt$)
LOCAL i
LOCAL result TYPE float
LOCAL letter$
FOR i = 1 TO LEN(txt$)
letter$ = CANVAS.font$[ASC(MID$(txt$, i, 1) - 32)]
' Increase length with provided values
INCR result, ABS(CANVAS_Coord(MID$(letter$, 4, 1)))*CANVAS.scaling
INCR result, ABS(CANVAS_Coord(MID$(letter$, 5, 1)))*CANVAS.scaling
NEXT
RETURN result
ENDFUNCTION
SUB TEXT(txt$, x, y)
LOCAL i, ptr, posx, posy, tox, toy
LOCAL letter$
CALL Draw_Prepare
IF CANVAS.font_align = 0 THEN
CALL Check_Scale(x-LEN(txt$)*CANVAS.font_width/2, y-15, LEN(txt$)*CANVAS.font_width, 15)
ELSE
CALL Check_Scale(x-LEN(txt$)*CANVAS.font_width, y-15, LEN(txt$)*CANVAS.font_width, 15)
ENDIF
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)]
' Increase canvas position with left hand
INCR x, ABS(CANVAS_Coord(MID$(letter$, 4, 1)))
' Get first coordinate pair
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
' Increase canvas position with right hand
INCR x, ABS(CANVAS_Coord(MID$(letter$, 5, 1)))
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
LOCAL wheel = 0, cache = 0 TYPE static int
' Always catch mouse button events
cache = CANVAS.mbutton
SELECT which
CASE 0
result = CANVAS.mx
CASE 1
result = CANVAS.my
CASE 2
IF cache = 4 OR cache = 5 THEN
result = cache
IF wheel < 4 THEN
INCR wheel
ELSE
CANVAS.mstate = 0
wheel = 0
ENDIF
ELSE
result = CANVAS.mbutton
ENDIF
cache = 0
CASE 3
result = CANVAS.mstate
ENDSELECT
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)
glutDisplayFunc(SYNC)
glutMouseFunc(GLUT_Mouse_But)
glutMotionFunc(GLUT_Mouse_Pos)
glutPassiveMotionFunc(GLUT_Mouse_Pos)
glutSwapBuffers()
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.