canvas-gd.bac

' =========================
' Purpose of this program
' =========================
'
' This is the CANVAS-GD context. It provides a GIF Canvas
' for demonstration drawing purposes.
'
' It requires the presence of LibGD on your system.
'
' - The top left of the created window has coordinate (0, 0).
' - The API is almost 100% compatible with the High Performance Canvas API.
' - Rotation applies to the visible part of the image only, and cannot merge parts.
' - For animations, use new keyword FRAMES to determine the amount of frames. Default 1 frame is created.
' - The GIF type does not handle alpha or alpha blending.
' - The GIF type supports not more than 256 colors per frame.
' - No mouse interaction.
'
' =========================
' Documentation for the API
' =========================
'
' WINDOW(title$, xsize, ysize)
'  => Create a GIF file with name "title$.gif", x size and y size
'
' 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, xsize, ysize, fill)
'  => Draw a square with center position at x, y and size x size 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. When alpha = 0 then current color is set to transparent.
'
' PEN(x, yesno)
'  => Set the width of the pixel to x (float value), and use anti-aliasing y/n - for GD does nothing
'
' 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. When all frames are done this functions returns FALSE.
'
' 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/
'
' =========================
' GD version specific calls
' =========================
'
' FRAMES(nr)
'  => How many frames should be created in an animated GIF (default: 1).
'
' DELAY(nr)
'  => Delay between the frames in msecs (default: 1 sec).
'
' ===========================
' 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, November-June 2017 - MIT License.
'
' 1.0: Initial release.
' 1.1: Use transparency when alpha value in INK is 0 - suggestion forum member vovchik.
' 1.2: Support for transparent animations, code cleaning
' 1.3: Possibility to set line thickness, added GETINK.
' 1.4: Improved import logic. Improved GETINK.
' 1.5: Better color lookup for transparent animations resulting in smaller file size.
' 1.6: Added FLIP, QBEZIER and CBEZIER. Set default drawing color to black.
' 1.7: Better frame counting allowing non-callback programs. Added DELAY keyword.
' 1.8: DRAW will move turtle even in when in PENUP mode, added TURN
' 1.9: Fixed bug in drawing turtle graphics
' 1.10: Pensize did not work for animations. TURN accepts float.
'---------------------------------------------------------------------------------------------------------------------------------------------

DECLARE canvas_gd_fd TYPE FILE*

RECORD CANVAS_GD
    LOCAL img_current TYPE void*
    LOCAL xsize, ysize, colour, speed, nr_frames, frame_ctr, font_width, rotate, bg, angle, step, transparent
    LOCAL pen_smooth, pen_active, pen_type, flipping
    LOCAL pen_size, scaling, pen_xpos, pen_ypos, pen_direction TYPE float
    LOCAL (*callb)(void) TYPE void
    LOCAL font$[96]
END RECORD

FUNCTION Import_GD_functions

    LOCAL lib$
    LOCAL seq = -1

    CATCH GOTO lib_handle_error

    lib$ = "libgd.so.0"

    LABEL lib_handle_error
        INCR seq

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

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

    CATCH RESET

    IMPORT "gdImageArc(void*,int,int,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageColorAllocate(void*,int,int,int)" FROM lib$ TYPE int
    IMPORT "gdImageColorResolveAlpha(void*,int,int,int,int)" FROM lib$ TYPE int
    IMPORT "gdImageColorTransparent(void*,int)" FROM lib$ TYPE void
    IMPORT "gdImageCopyRotated(void*,void*,double,double,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageDestroy(void*)" FROM lib$ TYPE void
    IMPORT "gdImageFlipBoth(void*)" FROM lib$ TYPE void
    IMPORT "gdImageFlipHorizontal(void*)" FROM lib$ TYPE void
    IMPORT "gdImageFlipVertical(void*)" FROM lib$ TYPE void
    IMPORT "gdImageGifAnimAdd(void*,FILE*,int,int,int,int,int,void*)" FROM lib$ TYPE void
    IMPORT "gdImageGifAnimBegin(void*,FILE*,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageGifAnimEnd(FILE*)" FROM lib$ TYPE void
    IMPORT "gdImageFill(void*,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageFilledArc(void*,int,int,int,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageFilledRectangle(void*,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageLine(void*,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImagePaletteCopy(void*,void*)" FROM lib$ TYPE void
    IMPORT "gdImageRectangle(void*,int,int,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageGetPixel(void*,int,int)" FROM lib$ TYPE int
    IMPORT "gdImageSetPixel(void*,int,int,int)" FROM lib$ TYPE void
    IMPORT "gdImageSetThickness(void*,int)" FROM lib$ TYPE void

    CONST gdArc = 0
    CONST gdDisposalRestorePrevious = 3

    RETURN TRUE

ENDFUNCTION

' 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")

' Primitives available in small letters as well
ALIAS "WINDOW" TO "window"
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 "FRAMES" TO "frames"
ALIAS "DELAY" TO "delay"

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

SUB Read_Font_Data

    LOCAL x

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

END SUB

SUB WINDOW(title$, xsize, ysize)

    IF RIGHT$(title$, 4) <> ".gif" THEN title$ = title$ & ".gif"

    OPEN title$ FOR WRITING AS canvas_gd_fd

    CANVAS_GD.img_current = gdImageCreate(xsize, ysize)
    CANVAS_GD.colour = gdImageColorAllocate(CANVAS_GD.img_current, 255, 255, 255)
    CANVAS_GD.bg = CANVAS_GD.colour

    gdImageGifAnimBegin(CANVAS_GD.img_current, canvas_gd_fd, 0, 0)

    CANVAS_GD.xsize = xsize
    CANVAS_GD.ysize = ysize

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

    ' Pen on by default
    CANVAS_GD.pen_active = 1

    ' Set font width
    CANVAS_GD.font_width = 16

ENDSUB

SUB CLS

    gdImageFilledRectangle(CANVAS_GD.img_current, 0, 0, CANVAS_GD.xsize, CANVAS_GD.ysize, CANVAS_GD.colour)
    CANVAS_GD.bg = CANVAS_GD.colour

END SUB

SUB PEN(size#, flag)

    CANVAS_GD.pen_size = size#
    gdImageSetThickness(CANVAS_GD.img_current, size#)

    ' This value does nothing for now
    CANVAS_GD.pen_smooth = flag

ENDSUB

SUB PENDOWN

    CANVAS_GD.pen_active = 1

END SUB

SUB PENUP

    CANVAS_GD.pen_active = 0

END SUB

SUB PENXY(float xpos, float ypos)

    CANVAS_GD.pen_xpos = xpos
    CANVAS_GD.pen_ypos = ypos

ENDSUB

SUB PENTYPE(type)

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

ENDSUB

SUB TURNRIGHT(float angle)

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

ENDSUB

SUB TURNLEFT(float angle)

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

ENDSUB

SUB TURN(float angle)

    TURNRIGHT(angle)

ENDSUB

SUB RESETANGLE

    CANVAS_GD.pen_direction = 90

ENDSUB

SUB DRAW(float length)

    LOCAL x, y TYPE float
    LOCAL rotate

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

ENDSUB

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

    IF alpha = 0 THEN
        CANVAS_GD.colour = gdImageColorResolveAlpha(CANVAS_GD.img_current, r, g, b, 127)
        CANVAS_GD.transparent = CANVAS_GD.colour
    ELSE
        CANVAS_GD.colour = gdImageColorResolveAlpha(CANVAS_GD.img_current, r, g, b, 0)
    ENDIF

ENDSUB

FUNCTION Create_New_Image

    LOCAL img TYPE void*
    LOCAL colour

    img = gdImageCreate(CANVAS_GD.xsize, CANVAS_GD.ysize)
    colour = gdImageColorAllocate(img, 255, 255, 255)

    gdImagePaletteCopy(img, CANVAS_GD.img_current)
    gdImageFilledRectangle(img, 0, 0, CANVAS_GD.xsize, CANVAS_GD.ysize, CANVAS_GD.bg)

    RETURN img

ENDFUNCTION

SUB MOVE(angle, step)

    CANVAS_GD.angle = angle
    CANVAS_GD.step = step

ENDSUB

SUB ROTATION(angle)

    CANVAS_GD.rotate = -1*angle

ENDSUB

SUB SCALE(factor#)

    CANVAS_GD.scaling = factor#

ENDSUB

FUNCTION Move_X(x)

    IF CANVAS_GD.step <> 0 THEN INCR x, COS(RAD(CANVAS_GD.angle))*CANVAS_GD.step
    RETURN x

ENDFUNCTION

FUNCTION Move_Y(y)

    IF CANVAS_GD.step <> 0 THEN DECR y, SIN(RAD(CANVAS_GD.angle))*CANVAS_GD.step
    RETURN y

ENDFUNCTION

SUB PIXEL(x, y)

    gdImageSetPixel(CANVAS_GD.img_current, x, y, CANVAS_GD.colour)

ENDSUB

SUB LINE(xstart, ystart, xend, yend)

    LOCAL length, newlen, midx, midy
    LOCAL angle#
    LOCAL img_org, img_tmp TYPE void*

    xstart = Move_X(xstart)
    ystart = Move_Y(ystart)

    xend = Move_X(xend)
    yend = Move_Y(yend)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    angle#=ATN(ABS(yend-ystart)/ABS(xend-xstart))

    length = SQR(POW(xend-xstart,2)+POW(yend-ystart,2))
    newlen = length*CANVAS_GD.scaling

    IF xstart < xend THEN
        midx = xstart+ABS(xend-xstart)/2
        xstart = midx-COS(angle#)*newlen/2
        xend = midx+COS(angle#)*newlen/2
    ELSE
        midx = xstart-ABS(xend-xstart)/2
        xstart = midx+COS(angle#)*newlen/2
        xend = midx-COS(angle#)*newlen/2
    FI

    IF ystart < yend THEN
        midy = ystart+ABS(yend-ystart)/2
        ystart = midy-SIN(angle#)*newlen/2
        yend = midy+SIN(angle#)*newlen/2
    ELSE
        midy = ystart-ABS(yend-ystart)/2
        ystart = midy+SIN(angle#)*newlen/2
        yend = midy-SIN(angle#)*newlen/2
    ENDIF

    gdImageLine(CANVAS_GD.img_current, xstart, ystart, xend, yend, CANVAS_GD.colour)

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, midx, midy, xstart, ystart, xend, yend, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL img_org, img_tmp TYPE void*

    x = Move_X(x)
    y = Move_Y(y)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    xrad = xrad*CANVAS_GD.scaling
    yrad = yrad*CANVAS_GD.scaling

    IF fill THEN
        gdImageFilledRectangle(CANVAS_GD.img_current, x-xrad, y-yrad, x+xrad, y+yrad, CANVAS_GD.colour)
    ELSE
        gdImageRectangle(CANVAS_GD.img_current, x-xrad, y-yrad, x+xrad, y+yrad, CANVAS_GD.colour)
    ENDIF

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, x, y, x-xrad, y-yrad, xrad*2, yrad*2, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL img_org, img_tmp TYPE void*

    x = Move_X(x)
    y = Move_Y(y)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    xsize = xsize*CANVAS_GD.scaling
    ysize = ysize*CANVAS_GD.scaling

    IF fill THEN
        gdImageFilledArc(CANVAS_GD.img_current, x, y, xsize*2, ysize*2, 0, 360, CANVAS_GD.colour, gdArc)
    ELSE
        gdImageArc(CANVAS_GD.img_current, x, y, xsize*2, ysize*2, 0, 360, CANVAS_GD.colour)
    ENDIF

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, x, y, x-xsize, y-ysize, xsize*2, ysize*2, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

END SUB

SUB ARC(x, y, xrad, yrad)

    LOCAL img_org, img_tmp TYPE void*

    x = Move_X(x)
    y = Move_Y(y)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    xrad = xrad*CANVAS_GD.scaling
    yrad = yrad*CANVAS_GD.scaling

    gdImageArc(CANVAS_GD.img_current, x, y, xrad*2, yrad*2, 180, 360, CANVAS_GD.colour)

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, x, y, x-xrad, y-yrad, xrad*2, yrad*2, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

END SUB

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

    LOCAL img_org, img_tmp TYPE void*

    x = Move_X(x)
    y = Move_Y(y)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    base = base*CANVAS_GD.scaling
    height = height*CANVAS_GD.scaling

    gdImageLine(CANVAS_GD.img_current, x-base/2, y+height/2, x+base/2, y+height/2, CANVAS_GD.colour)
    gdImageLine(CANVAS_GD.img_current, x+base/2, y+height/2, x, y-height/2, CANVAS_GD.colour)
    gdImageLine(CANVAS_GD.img_current, x, y-height/2, x-base/2, y+height/2, CANVAS_GD.colour)

    IF fill THEN CALL PAINT(x, y)

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, x, y, x-base/2, y-height/2, base, height, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL i, rot, angle, posx, posy, length, x, y
    LOCAL img_org, img_tmp TYPE void*

    xorg = Move_X(xorg)
    yorg = Move_Y(yorg)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    radius = radius*CANVAS_GD.scaling

    angle = INT(360.0 / sides)

    length = INT(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 + INT(COS(RAD(rot))*length)
        y = ypos - INT(SIN(RAD(rot))*length)
        gdImageLine(CANVAS_GD.img_current, xpos, ypos, x, y, CANVAS_GD.colour)
        DECR rot, angle
        xpos = x
        ypos = y
    NEXT

    gdImageLine(CANVAS_GD.img_current, x, y, xorg, yorg-radius, CANVAS_GD.colour)

    IF fill THEN CALL PAINT(xorg, yorg)

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, xorg, yorg, xorg-radius, yorg-radius, radius*2, radius*2, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL i, size_xbox, size_ybox
    LOCAL img_org, img_tmp TYPE void*

    startx = Move_X(startx)
    starty = Move_Y(starty)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    DECR startx, (w*CANVAS_GD.scaling-w)/2
    DECR starty, (h*CANVAS_GD.scaling-h)/2

    w = w*CANVAS_GD.scaling
    h = h*CANVAS_GD.scaling

    size_xbox = INT(w/hboxes)
    size_ybox = INT(h/vboxes)

    FOR i = 0 TO hboxes
        gdImageLine(CANVAS_GD.img_current, startx+i*size_xbox, starty, startx+i*size_xbox, starty+h, CANVAS_GD.colour)
    NEXT
    FOR i = 0 TO vboxes
        gdImageLine(CANVAS_GD.img_current, startx, starty+i*size_ybox, startx+w, starty+i*size_ybox, CANVAS_GD.colour)
    NEXT

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, startx+w/2, starty+h/2, startx, starty, w+1, h+1, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL Ax#, Ay#, Bx#, By#, t#, angle#
    LOCAL length, newlen, midx, midy
    LOCAL img_org, img_tmp TYPE void*

    x0# = Move_X(x0#)
    y0# = Move_Y(y0#)

    x2# = Move_X(x2#)
    y2# = Move_Y(y2#)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    angle#=ATN(ABS(y2#-y0#)/ABS(x2#-x0#))

    length = SQR(POW(x2#-x0#,2)+POW(y2#-y0#,2))
    newlen = length*CANVAS_GD.scaling

    IF x0# < x2# THEN
        midx = x0#+ABS(x2#-x0#)/2
        x0# = midx-COS(angle#)*newlen/2
        x2# = midx+COS(angle#)*newlen/2
    ELSE
        midx = x0#-ABS(x2#-x0#)/2
        x0# = midx+COS(angle#)*newlen/2
        x2# = midx-COS(angle#)*newlen/2
    FI

    IF y0# < y2# THEN
        midy = y0#+ABS(y2#-y0#)/2
        y0# = midy-SIN(angle#)*newlen/2
        y2# = midy+SIN(angle#)*newlen/2
    ELSE
        midy = y0#-ABS(y2#-y0#)/2
        y0# = midy+SIN(angle#)*newlen/2
        y2# = midy-SIN(angle#)*newlen/2
    ENDIF

    Ax# = x0# : Ay# = y0#

    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#

        gdImageLine(CANVAS_GD.img_current, Ax#, Ay#, Bx#, By#, CANVAS_GD.colour)

        Ax# = Bx# : Ay# = By#
    NEXT

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, midx, midy, x0#, y0#, x2#, y2#, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

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

    LOCAL Ax#, Ay#, Bx#, By#, t#, angle#
    LOCAL length, newlen, midx, midy
    LOCAL img_org, img_tmp TYPE void*

    x0# = Move_X(x0#)
    y0# = Move_Y(y0#)

    x3# = Move_X(x3#)
    y3# = Move_Y(y3#)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    angle#=ATN(ABS(y3#-y0#)/ABS(x3#-x0#))

    length = SQR(POW(x3#-x0#,2)+POW(y3#-y0#,2))
    newlen = length*CANVAS_GD.scaling

    IF x0# < x3# THEN
        midx = x0#+ABS(x3#-x0#)/2
        x0# = midx-COS(angle#)*newlen/2
        x3# = midx+COS(angle#)*newlen/2
    ELSE
        midx = x0#-ABS(x3#-x0#)/2
        x0# = midx+COS(angle#)*newlen/2
        x3# = midx-COS(angle#)*newlen/2
    FI

    IF y0# < y3# THEN
        midy = y0#+ABS(y3#-y0#)/2
        y0# = midy-SIN(angle#)*newlen/2
        y3# = midy+SIN(angle#)*newlen/2
    ELSE
        midy = y0#-ABS(y3#-y0#)/2
        y0# = midy+SIN(angle#)*newlen/2
        y3# = midy-SIN(angle#)*newlen/2
    ENDIF

    Ax# = x0# : Ay# = y0#

    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#

        gdImageLine(CANVAS_GD.img_current, Ax#, Ay#, Bx#, By#, CANVAS_GD.colour)

        Ax# = Bx# : Ay# = By#
    NEXT

    IF CANVAS_GD.rotate <> 0 THEN
        gdImageCopyRotated(img_org, CANVAS_GD.img_current, midx, midy, x0#, y0#, x3#, y3#, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

ENDSUB

SUB PAINT(x, y)

    gdImageFill(CANVAS_GD.img_current, x, y, CANVAS_GD.colour)

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_GD.font$[x] = MID$(data$, 6)
        NEXT
        CLOSE FILE hershey_font
    ENDIF

ENDSUB

SUB TEXT(txt$, x, y)

    LOCAL i, ptr, posx, posy, tox, toy, xorg, txt_width
    LOCAL letter$
    LOCAL img_org, img_tmp TYPE void*

    x = Move_X(x)
    y = Move_Y(y)

    IF CANVAS_GD.rotate <> 0 THEN
        img_org = CANVAS_GD.img_current
        img_tmp = Create_New_Image()
        CANVAS_GD.img_current = img_tmp
    ENDIF

    org_width = LEN(txt$)*CANVAS_GD.font_width
    txt_width = LEN(txt$)*CANVAS_GD.font_width*CANVAS_GD.scaling

    x = x-(txt_width-org_width)/2
    xorg = x

    FOR i = 1 TO LEN(txt$)

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

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

        WHILE ptr < LEN(letter$)
            IF MID$(letter$, ptr, 2) = " R" THEN
                INCR ptr, 2
                posx = CANVAS_Coord(MID$(letter$, ptr, 1))*CANVAS_GD.scaling + x
                posy = CANVAS_Coord(MID$(letter$, ptr+1, 1))*CANVAS_GD.scaling + y
            ELSE
                tox = CANVAS_Coord(MID$(letter$, ptr, 1))*CANVAS_GD.scaling + x
                toy = CANVAS_Coord(MID$(letter$, ptr+1, 1))*CANVAS_GD.scaling + y
                gdImageLine(CANVAS_GD.img_current, posx, posy, tox, toy, CANVAS_GD.colour)
                posx = tox
                posy = toy
            ENDIF
            INCR ptr, 2
        WEND
        INCR x, CANVAS_GD.font_width*CANVAS_GD.scaling
    NEXT

    IF CANVAS_GD.rotate <> 0 THEN

        IF xorg-8.0*CANVAS_GD.scaling+txt_width > CANVAS_GD.xsize THEN txt_width = CANVAS_GD.xsize-xorg

        gdImageCopyRotated(img_org, CANVAS_GD.img_current, \
            xorg+txt_width/2-(CANVAS_GD.font_width/2)*CANVAS_GD.scaling, y, \
            xorg-8.0*CANVAS_GD.scaling, y-16.0*CANVAS_GD.scaling, \
            txt_width, 32*CANVAS_GD.scaling, CANVAS_GD.rotate)
        CANVAS_GD.img_current = img_org
        gdImageDestroy(img_tmp)
    ENDIF

END SUB

FUNCTION GETINK(x, y, int mode)

    LOCAL c, r, g, b, a, current, offset

    offset = SIZEOF(char**)+3*SIZEOF(int)
    c = gdImageGetPixel(CANVAS_GD.img_current, x, y)

    OPTION MEMTYPE int
    r = PEEK(CANVAS_GD.img_current+offset+c*SIZEOF(int))
    g = PEEK(CANVAS_GD.img_current+offset+256*SIZEOF(int)+c*SIZEOF(int))
    b = PEEK(CANVAS_GD.img_current+offset+256*SIZEOF(int)+256*SIZEOF(int)+c*SIZEOF(int))

    IF c <> CANVAS_GD.transparent THEN a = 255

    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
            current = ((a & 0x0ff) << 24) | ((b & 0x0ff) << 16) | ((g & 0x0ff) << 8) | (r & 0x0ff)
            RETURN current
    END SELECT

END FUNCTION

SUB FLIP(flag)

    CANVAS_GD.flipping = flag

ENDSUB

FUNCTION SYNC

    LOCAL img TYPE void*

    img = CANVAS_GD.img_current

    SELECT CANVAS_GD.flipping
        CASE 0
            gdImageFlipHorizontal(CANVAS_GD.img_current)
        CASE 1
            gdImageFlipVertical(CANVAS_GD.img_current)
        CASE 2
            gdImageFlipBoth(CANVAS_GD.img_current)
    ENDSELECT

    gdImageColorTransparent(CANVAS_GD.img_current, CANVAS_GD.transparent)
    gdImageGifAnimAdd(CANVAS_GD.img_current, canvas_gd_fd, 1, 0, 0, CANVAS_GD.speed, gdDisposalRestorePrevious, NULL)

    CANVAS_GD.img_current = Create_New_Image()
    gdImageSetThickness(CANVAS_GD.img_current, CANVAS_GD.pen_size)

    gdImageDestroy(img)

    DECR CANVAS_GD.frame_ctr

    IF CANVAS_GD.frame_ctr = 0 THEN RETURN FALSE

    RETURN TRUE

ENDFUNCTION

SUB QUIT

    gdImageGifAnimEnd(canvas_gd_fd)
    gdImageDestroy(CANVAS_GD.img_current)
    CLOSE FILE canvas_gd_fd

    END 0

END SUB

SUB GD_Callback

    IF CANVAS_GD.callb <> NULL THEN CALL (*CANVAS_GD.callb)()
    CALL SYNC()

END SUB

SUB CALLBACK(timeout, void* func)

    CANVAS_GD.callb = func
    CANVAS_GD.speed = IIF(timeout/10 < 1, 1, timeout/10)

ENDSUB

SUB FRAMES(nr)

    CANVAS_GD.nr_frames = nr
    CANVAS_GD.frame_ctr = nr

ENDSUB

SUB DELAY(timeout)

    CANVAS_GD.speed = IIF(timeout/10 < 1, 1, timeout/10)

ENDSUB

SUB WAITKEY

    IF CANVAS_GD.speed > 0 THEN
        REPEAT
            CALL GD_Callback()
            IF WAIT(STDIN_FILENO, 10) THEN
                PRINT "Stopped by key press. Frames generated: ", CANVAS_GD.nr_frames - CANVAS_GD.frame_ctr
                CALL QUIT()
            ENDIF
        UNTIL CANVAS_GD.frame_ctr <= 0
    ELSE
        CALL SYNC()
    ENDIF

    PRINT "All done. Frames generated: ", CANVAS_GD.nr_frames

    CALL QUIT()

ENDSUB

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

IF NOT(Import_GD_functions()) THEN
    PRINT "No GD library found! Image cannot be created."
    END 1
ENDIF

' Get the font
CALL Read_Font_Data()

' Set some default values
CANVAS_GD.nr_frames = 1
CANVAS_GD.frame_ctr = 1
CANVAS_GD.speed = 100
CANVAS_GD.scaling = 1.0
CANVAS_GD.transparent = -1
CANVAS_GD.flipping = 3
CANVAS_GD.pen_size = 1
CANVAS_GD.callb = NULL

Generated by GNU Enscript 1.6.5.90.