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