'
' This is the BaCon port of the 'Worms' OpenGL program.
'
' See also: http://www.opengl.org/resources/code/samples/glut_examples/contrib/contrib.html
'
' Port by Peter van Eerten - January 2010.
'
' From jallen@cs.hmc.edu  Fri Feb 17 00:49:59 1995
' Received: from giraffe.asd.sgi.com by hoot.asd.sgi.com via SMTP (940816.SGI.8.6.9/940406.SGI.AUTO)
'       for <mjk@hoot.asd.sgi.com> id AAA13591; Fri, 17 Feb 1995 00:49:33 -0800
' Received: from sgi.sgi.com by giraffe.asd.sgi.com via SMTP (920330.SGI/920502.SGI)
'       for mjk@hoot.asd.sgi.com id AA09774; Fri, 17 Feb 95 00:52:30 -0800
' Received: from cs.hmc.edu by sgi.sgi.com via SMTP (950215.405.SGI.8.6.10/910110.SGI)
'       for <mjk@sgi.com> id AAA06439; Fri, 17 Feb 1995 00:52:28 -0800
' Received: by cs.hmc.edu (5.0/SMI-SVR4)
'       id AA13309; Fri, 17 Feb 1995 00:52:10 -0800
' Date: Fri, 17 Feb 1995 00:52:10 -0800
' From: jallen@cs.hmc.edu (Jeff R. Allen)
' Message-Id: <9502170852.AA13309@cs.hmc.edu>
' To: nate@cs.hmc.edu (Nathan Tuck), mjk@sgi.sgi.com, hadas@cs.hmc.edu
' Subject: Re: GLUT demos
' In-Reply-To: <9502100805.AA08487@cs.hmc.edu>
' References: <9502100805.AA08487@cs.hmc.edu>
' Reply-To: Jeff Allen <jeff@hmc.edu>
' Content-Length: 12851
' Status: RO
'
' Below is a program I wrote for the Graphics class at Harvey Mudd. As
' the comments explain, I am currently working on a version in 3D with
' lighting, and a pre-programmed camera flight-path. I also added a
' checker-board-type-thing for the worms to crawl around on, so that
' there is some reference for the viewer.
'
' For now, here is the program.
'
' --
' Jeff R. Allen  |     Senior CS major    |    Support your local
' (fnord)        |    South 351d, x4940   |        unicyclist!
'
' -------------------------  begin worms.c   -------------------------
'
' worms.c -- demos OpenGL in 2D using the GLUT interface to the
'              underlying window system.
'
'   Compile with: [g]cc -O3 -o worms worms.c -lm -lGLU -lglut -lXmu -lX11 -lGL
'
'   This is a fun little demo that actually makes very little use of
'   OpenGL and GLUT. It generates a bunch of worms and animates them as
'   they crawl around your screen. When you click in the screen with
'   the left mouse button, the worms converge on the spot for a while,
'   then go back to their business. The animation is incredibly simple:
'   we erase the tail, then draw a new head, repeatedly. It is so
'   simple, actually, we don't even need double-buffering!
'
'   The behavior of the worms can be controlled via the compile-time
'   constants below. Enterprising indiviuals wil want to add GLUT menus
'   to control these constants at run time. This is left as an exercise
'   to the reader. The only thing that can currently be controlled is
'   wether or not the worms are filled. Use the right button to get a popup
'   menu.
'
'   A future version of this program will make more use of OpenGL by
'   rendering 3d worms crawling in 3-space (or possibly just around on
'   a plane) and it will allow the user to manipulate the viewpoint
'   using the mouse. This will require double-buffering and less
'   optimal updates.
'
'   This program is Copyright 1995 by Jeff R. Allen <jeff@hmc.edu>.
'   Permission is hereby granted to use and modify this code freely,
'   provided it is not sold or redistibuted in any way for profit. This
'   is copyrighted material, and is NOT in the Public Domain.
'
'   $Id: worms.c,v 1.2 1995/02/17 03:29:59 jallen Exp $
'
INCLUDE "gl.bac"
INCLUDE "glu.bac"
INCLUDE "glut.bac"

TRAP LOCAL
CATCH GOTO print_err

' Make symbol 'srand48' known to BaCon converter
IMPORT "srand48" FROM "libc.so" TYPE void

CONST RADIAN = 0.0174532
CONST CIRCLE_POINTS = 25
CONST SIDETOLERANCE = 0.01
CONST INITH = 500
CONST INITW = 500

' worm options
CONST SEGMENTS = 20
CONST SEG_RADIUS = 0.01
CONST STEPSIZE = 0.01
CONST MAXTURN = (20 * RADIAN)
CONST MAXWORMS = 400
CONST INITWORMS = 40
CONST MARKTICKS = 100

RECORD worms[MAXWORMS]
    ' direction in radians
    LOCAL dir TYPE float
    ' location of segments
    LOCAL segx[SEGMENTS] TYPE float  
    LOCAL segy[SEGMENTS] TYPE float
    ' pointer to the RGB color of the worm
    LOCAL color TYPE long
    LOCAL head TYPE int
END RECORD

' colors available for worms... this is a huge mess because I
' originally brought these colors in from rgb.txt as integers,
' but they have to be normalized into floats. And C is stupid
' and truncates them unless I add the annoying .0's

DECLARE colors[][3] = { \
  { 255.0/255.0,   0.0/255.0,   0.0/255.0}, \
  { 238.0/255.0,   0.0/255.0,   0.0/255.0}, \
  { 205.0/255.0,   0.0/255.0,   0.0/255.0}, \
  {   0.0/255.0, 255.0/255.0,   0.0/255.0}, \
  {   0.0/255.0, 238.0/255.0,   0.0/255.0}, \
  {   0.0/255.0, 205.0/255.0,   0.0/255.0}, \
  {   0.0/255.0,   0.0/255.0, 255.0/255.0}, \
  {   0.0/255.0,   0.0/255.0, 238.0/255.0}, \
  {   0.0/255.0,   0.0/255.0, 205.0/255.0}, \
  { 255.0/255.0, 255.0/255.0,   0.0/255.0}, \
  { 238.0/255.0, 238.0/255.0,   0.0/255.0}, \
  { 205.0/255.0, 205.0/255.0,   0.0/255.0}, \
  {   0.0/255.0, 255.0/255.0, 255.0/255.0}, \
  {   0.0/255.0, 238.0/255.0, 238.0/255.0}, \
  {   0.0/255.0, 205.0/255.0, 205.0/255.0}, \
  { 255.0/255.0,   0.0/255.0, 255.0/255.0}, \
  { 238.0/255.0,   0.0/255.0, 238.0/255.0}, \
  { 205.0/255.0,   0.0/255.0, 205.0/255.0}, \
} TYPE float

CONST COLORS = 18

' define's for the menu item numbers
CONST MENU_NULL = 0
CONST MENU_FILLED = 1
CONST MENU_UNFILLED = 2
CONST MENU_QUIT = 3

' flag to determine how to draw worms; set by popup menu -- starts out
' filled in
DECLARE filled TYPE int
filled = 1

' the global worm array
DECLARE curworms TYPE int
curworms = 0

' global window extent variables
DECLARE gleft, gright, gtop, gbottom TYPE float
gleft = -1.0
gright = 1.0
gtop = 1.0
gbottom = -1.0
DECLARE wsize, hsize TYPE int

' globals for marking
DECLARE markx, marky TYPE float
DECLARE marktime TYPE int

' prototypes
DECLARE mydisplay(void) TYPE void
DECLARE drawWorm(void) TYPE void

SUB drawCircle(float x0, float y0, float radius)

    LOCAL i TYPE int
    LOCAL angle TYPE float

    ' a table of offsets for a circle (used in drawCircle)
    LOCAL circlex[CIRCLE_POINTS] TYPE static float
    LOCAL circley[CIRCLE_POINTS] TYPE static float
    LOCAL inited = 0 TYPE static int

    IF NOT(inited) THEN
        FOR i = 0 TO CIRCLE_POINTS - 1
            angle = 2.0 * PI * i / CIRCLE_POINTS
            circlex[i] = COS(angle)
            circley[i] = SIN(angle)
        NEXT
    END IF
    inited = inited + 1

    IF filled THEN glBegin(GL_POLYGON)
    ELSE glBegin(GL_LINE_LOOP)

    FOR i = 0 TO CIRCLE_POINTS - 1
        glVertex2f((radius * circlex[i]) + x0, (radius * circley[i]) + y0)
    NEXT

    glEnd

END SUB

SUB drawWorm

    LOCAL i, j TYPE int

    FOR j = 0 TO curworms - 1
        glColor3fv(worms[j].color)
        FOR i = 0 TO SEGMENTS - 1
            drawCircle(worms[j].segx[i], worms[j].segy[i], SEG_RADIUS)
        NEXT
    NEXT

END SUB

SUB myinit

    LOCAL i, j, thecolor TYPE int
    LOCAL thedir TYPE float

    srand48(NOW)

    curworms = INITWORMS
  
    FOR j = 0 TO curworms - 1
        ' divide the circle up into a number of pieces, and send one worm
        ' each direction.
        worms[j].dir = ((2.0 * PI) / curworms) * j
        thedir = worms[j].dir

        worms[j].segx[0] = 0.0
        worms[j].segy[0] = 0.0

        FOR i = 1 TO SEGMENTS - 1
            worms[j].segx[i] = worms[j].segx[i-1] + (STEPSIZE * COS(thedir))
            worms[j].segy[i] = worms[j].segx[i-1] + (STEPSIZE * SIN(thedir))
        NEXT
        worms[j].head = (SEGMENTS - 1)

        ' make this worm one of the predefined colors
        thecolor = (int) COLORS * drand48()
        worms[j].color = ADDRESS(colors[thecolor])
    NEXT

    ' now that they are all set, draw them as though they have just been
    ' uncovered
    CALL mydisplay

END SUB

' this routine is called after the coordinates are changed to make sure
' worms outside the window come back into view right away. (This behavior
' is arbitrary, but they are my worms, and they'll do what I please!)

SUB warpWorms

    LOCAL j, head TYPE int

    FOR j = 0 TO curworms - 1

        head = worms[j].head

        IF worms[j].segx[head] < gleft THEN worms[j].segx[head] = gleft
        IF worms[j].segx[head] > gright THEN worms[j].segx[head] = gright
        IF worms[j].segx[head] > gtop THEN worms[j].segx[head] = gtop
        IF worms[j].segx[head] < gbottom THEN worms[j].segx[head] = gbottom

    NEXT

END SUB

' a bunch of extra hoopla goes on here to change the Global coordinate
' space at teh same rate that the window itself changes. This give the
' worms more space to play in when the window gets bigger, and vice versa.
' The alternative would be to end up with big worms when the window gets
' big, and that looks silly.

SUB myreshape (int w, int h)

    LOCAL ratiow TYPE float
    LOCAL ratioh TYPE float

    ratiow = (float) w/INITW
    ratioh = (float) h/INITH

    glViewport(0,0,w,h)
    glMatrixMode(GL_PROJECTION)
    glLoadIdentity()

    gleft = -1 * ratiow
    gright = 1 * ratiow
    gbottom = -1 * ratioh
    gtop = 1 * ratioh

    gluOrtho2D(gleft, gright, gbottom, gtop)
    warpWorms

    glMatrixMode(GL_MODELVIEW)
    glLoadIdentity

    wsize = w
    hsize = h

END SUB


' updates the worms -- drawing takes place here, which may actually
' be a bad idea. It will probably be better to update the internal
' state only here, then post a redisplay using GLUT.

SUB myidle

    LOCAL i, tail, newhead TYPE int
    LOCAL prevx, prevy TYPE float
    LOCAL newh, newv TYPE float
    LOCAL num, denom TYPE float

    newh = -1.0
    newv = -1.0

    IF marktime THEN marktime = marktime - 1

    FOR i = 0 TO curworms - 1
        ' first find tail
        tail = (worms[i].head + 1) % SEGMENTS
  
        ' erase tail
        glColor3f(0.0, 0.0, 0.0)
        drawCircle(worms[i].segx[tail], worms[i].segy[tail], SEG_RADIUS)

        ' update head segment position and head pointer

        ' make an easy to reference local copy of head, and update it in
        ' the worm structure. The new head replaces the old tail.

        newhead = (worms[i].head + 1) % SEGMENTS

        prevx = worms[i].segx[worms[i].head]
        prevy = worms[i].segy[worms[i].head]

        ' if there is a mark, home in on it. After this, we still allow
        ' the random adjustment so that the worms play around a bit on the
        ' way to the mark.

        IF marktime THEN
            num = marky - prevy
            denom = markx - prevx
            worms[i].dir = atan2(num,denom)
        ENDIF

        ' make a bit of a turn: between -MAXTURN and MAXTURN degrees change
        ' to dir (actualy worms[i].dir is in radians for later use with
        ' cosf().

        worms[i].dir = worms[i].dir + (MAXTURN - (2 * MAXTURN * (float) drand48()))

        worms[i].segx[newhead] = prevx + (STEPSIZE * COS(worms[i].dir))
        worms[i].segy[newhead] = prevy + (STEPSIZE * SIN(worms[i].dir))

        ' if we are at an edge, change direction so that we are heading away
        ' from the edge in question. There might be a problem here handling
        ' corner cases, but I have never seen a worm get stuck, so what the
        ' heck...

        IF worms[i].segx[newhead] <= gleft THEN worms[i].dir = 0
        IF worms[i].segx[newhead] >= gright THEN worms[i].dir = (180 * RADIAN)
        IF worms[i].segy[newhead] >= gtop THEN worms[i].dir = (270 * RADIAN)
        IF worms[i].segy[newhead] <= gbottom THEN worms[i].dir = (90 * RADIAN)

        IF newv >= 0 OR newh >= 0 THEN
            IF newh < 0 THEN newh = 0
            IF newv < 0 THEN newv = 0
        END IF

        ' update the permanent copy of the new head index
        worms[i].head = newhead

        ' draw head
        glColor3fv(worms[i].color)
        drawCircle(worms[i].segx[worms[i].head], worms[i].segy[worms[i].head], SEG_RADIUS)
    NEXT

    glFlush

    SLEEP 10

END SUB

' redraws the worms from scratch -- called after a window gets obscured

SUB mydisplay

    LOCAL i TYPE int

    ' #ifndef WORMS_EAT_BACKGROUND
    glClearColor(0.0, 0.0, 0.0, 0.0)
    glClear(GL_COLOR_BUFFER_BIT)
    '#endif

    drawWorm

    glFlush

END SUB

' this routine gets called when the mouse is clicked. The incoming
' coordinates are in screen coordinates relative to the upper-left corner
' of the window, and oriented according to X, not to GL. So, here we
' convert the given coordinates into worm-world coordinates, and set the
' mark.

SUB markSpot(int x, int y)

    ' map into the corridinate space I am using
    markx = (float)((x - wsize/2)*(gright - gleft)/wsize)
    marky = -(float)((y - hsize/2)*(gtop - gbottom)/hsize)

    marktime = MARKTICKS

END SUB

SUB handleMouse(int btn, int state, int x, int y)

    SELECT btn

        CASE GLUT_LEFT_BUTTON
            IF state IS GLUT_UP THEN markSpot(x,y)
        DEFAULT
            ' do nothing

    END SELECT

END SUB

SUB menuSelect(int value)

    SELECT value

        CASE MENU_FILLED
            filled = 1
        CASE MENU_UNFILLED
            filled = 0
        CASE MENU_QUIT
            END
    END SELECT

    glutPostRedisplay

END SUB

SUB visibility(int status)

    IF status IS GLUT_VISIBLE THEN glutIdleFunc(ADDRESS(myidle))
    ELSE glutIdleFunc(0)

END SUB

' this is where GLUT is initialized, and the whole thing starts up.
' All animation and redisplay happens via the callbacks registered below.

SUB mainprog

    LOCAL fillmenu TYPE int
    fillmenu = 0

    glutInitDisplayMode(GLUT_SINGLE | GLUT_RGB)
    glutInitWindowSize(INITW, INITH)
    glutCreateWindow("Worms")

    myinit

    glutDisplayFunc(ADDRESS(mydisplay))
    glutVisibilityFunc(ADDRESS(visibility))
    glutReshapeFunc(ADDRESS(myreshape))
    glutMouseFunc(ADDRESS(handleMouse))

    ' popup menu, courtsey of GLUT
    fillmenu = glutCreateMenu(ADDRESS(menuSelect))
    glutAddMenuEntry("Filled", MENU_FILLED)
    glutAddMenuEntry("Unfilled", MENU_UNFILLED)

    glutCreateMenu(ADDRESS(menuSelect))
    glutAddMenuEntry("     WORMS", MENU_NULL)
    glutAddSubMenu("Drawing Mode", fillmenu)
    glutAddMenuEntry("Quit", MENU_QUIT)

    glutAttachMenu(GLUT_RIGHT_BUTTON)

    glutMainLoop

END SUB

mainprog
END

REM Show error if something went wrong
LABEL print_err
    PRINT ERR$(ERROR)
    END