Limitations:
drawPolygon, drawQuadMesh, drawColoredQuadMesh methods: surface edges have slight artifacts
drawMarker method: marker types are ignored; markers are drawn as dots
setDistinguishFacetsFlag method: not implemented
pushMatrix, popMatrix methods: I use the native OpenGL matrix stack, which allows only for a fixed number of matrices to be pushed. This number is guaranteed to be at least 32.
setDepthCueing method:
The arguments frontScale and backScale are ignored, since OpenGL
does not have the concept of a fog scaling factor.
Bugs:
SRC 129 program 18 (page 35) does not work properly!
UNSAFE MODULEX_OpenGL_Base EXPORTSX_OpenGL_Base ,X_OpenGL_BaseProxy ; IMPORT AuxG, AnimServer, Color, ColorPropPrivate, Ctypes, FileRd, FloatMode, GL, GLu, GLX, GO, GOPrivate, GraphicsBase, GraphicsBasePrivate, IntIntTbl, KeyCB, KeyboardKey, Lex, LineTypeProp, M3toC, MarkerGO, MarkerTypeProp, MarkerTypePropPrivate, Math, Matrix4, MouseCB, Mth, OSError, ParseParams, Point, Point3, PositionCB, Process, PropPrivate, RasterModeProp, Rd, RealPropPrivate, RootGOPrivate, ShadingProp, Stdio, SurfaceGO, Text, Thread, VBT, Word, X, Xatom; IMPORT IO; <* FATAL X.Error *> REVEAL T = Public BRANDED OBJECT window : X.Window; context : GLX.GLXContext; drawBuffer : GL.GLenum; winWidth : INTEGER; winHeight : INTEGER; near : REAL; (* Used by glOrtho, gluPerspective, *) far : REAL; (* and for fog calculation. *) phase : INTEGER; (* current drawing phase *) transflag : BOOLEAN; (* transparent parts in scene? *) modifiers : VBT.Modifiers; (* what modifiers are pressed *) buttonDownCount : INTEGER; (* how many buttons are down *) awaitDeleteMu : Thread.Mutex; (* Mutex used by Thread.Wait *) awaitDeleteCV : Thread.Condition; (* CV for awaitDelete method *) stateSize : INTEGER; dlTable : IntIntTbl.T; from : Point3.T; to : Point3.T; up : Point3.T; projType : ProjType; aspect : REAL; fovy : REAL; height : REAL; (*** light management ***) lighting : BOOLEAN := TRUE; lightCount : INTEGER; lightList : GL.GLuint; ambientLight : GLrgba; (*** markers ***) markerColor : Color.T; (* Initialized by "Init" *) markerScale : REAL; (* Initialized by "Init" *) markerType : MarkerTypeProp.Kind; (* Initialized by "Init" *) (*** lines ***) lineType : GL.GLint := Solid; lineWidth : REAL := 1.0; lineColor : Color.T := Color.White; (*** surfaces ***) frontColor : Color.T := Color.White; backColor : Color.T := Color.White; transmission : REAL := 1.0; ambientReflCoeff : REAL := 0.5; diffuseReflCoeff : REAL := 1.0; specularReflCoeff: REAL := 0.0; specularReflColor: Color.T := Color.White; specularReflConc : REAL; (* Initialized by "Init" *) rasterMode := RasterModeProp.Kind.Solid; (*** surface edges ***) edgeFlag : BOOLEAN := FALSE; edgeType : GL.GLint := Solid; edgeWidth : REAL := 1.0; edgeColor : Color.T := Color.White; (*** caching of OpenGL display lists for prototypical objects ***) sphereStructures : StructureList := NIL; coneStructures : StructureList := NIL; cylinderStructures : StructureList := NIL; diskStructures : StructureList := NIL; OVERRIDES (*** Methods that may be called by any thread ***) init := Init; changeTitle := ChangeTitle; (* should be called only by server *) awaitDelete := AwaitDelete; destroy := Destroy; (*** Methods that may be called only by animation server thread ***) processEvents := ProcessEvents; repair := Repair; unmap := Unmap; push := Push; pop := Pop; addAmbientLight := AddAmbientLight; addVectorLight := AddVectorLight; addPointLight := AddPointLight; addSpotLight := AddSpotLight; openDisplayList := OpenDisplayList; closeDisplayList := CloseDisplayList; callDisplayList := CallDisplayList; freeDisplayList := FreeDisplayList; pushMatrix := PushMatrix; popMatrix := PopMatrix; setLookAt := SetLookAt; setOrthoProj := SetOrthoProj; setPerspProj := SetPerspProj; setupCamera := SetupCamera; screenToWorld := ScreenToWorld; setBackgroundColor := SetBackgroundColor; setDepthcueing := SetDepthcueing; setMarkerColor := SetMarkerColor; setMarkerScale := SetMarkerScale; setMarkerType := SetMarkerType; setLineColor := SetLineColor; setLineWidth := SetLineWidth; setLineType := SetLineType; setSurfaceColor := SetSurfaceColor; setSurfaceBackColor := SetSurfaceBackColor; setRasterMode := SetRasterMode; setDistinguishFacetsFlag := SetDistinguishFacetsFlag; setLighting := SetLighting; setShading := SetShading; setSurfaceEdgeFlag := SetSurfaceEdgeFlag; setSurfaceEdgeColor := SetSurfaceEdgeColor; setSurfaceEdgeType := SetSurfaceEdgeType; setSurfaceEdgeWidth := SetSurfaceEdgeWidth; setAmbientReflCoeff := SetAmbientReflCoeff; setDiffuseReflCoeff := SetDiffuseReflCoeff; setSpecularReflCoeff := SetSpecularReflCoeff; setSpecularReflConc := SetSpecularReflConc; setSpecularReflColor := SetSpecularReflColor; setTransmissionCoeff := SetTransmissionCoeff; drawMarker := DrawMarker; drawLine := DrawLine; drawPolygon := DrawPolygon; drawQuadMesh := DrawQuadMesh; drawColoredQuadMesh := DrawColoredQuadMesh; drawProtoSphere := DrawProtoSphere; drawProtoCone := DrawProtoCone; drawProtoCylinder := DrawProtoCylinder; drawProtoDisk := DrawProtoDisk; drawProtoTorus := DrawProtoTorus; END; TYPE ProjType = {Persp, Ortho}; GLrgba = RECORD r, g, b, a: REAL; END; GLpoint3d = ARRAY [1 .. 3] OF GL.GLdouble;
GLpoint3d = RECORD x, y, z: LONGREAL; END;
GLpoint4f = RECORD
x, y, z, w: REAL;
END;
GLmatrixf = ARRAY [0 .. 15] OF GL.GLfloat;
CONST
Solid = 2_1111111111111111;
Dashed = 2_1111000011110000;
Dotted = 2_1010101010101010;
DashDot = 2_1110010011100100;
PROCEDURE Init (self: T; title: TEXT; x, y, w, h: INTEGER): T
RAISES {GraphicsBase.Failure} =
CONST
bw = 1; (* window border width *)
VAR
visual : X.XVisualInfoStar;
cmap : X.Colormap;
wattrs : X.XSetWindowAttributes; (* window attributes *)
wmask : Ctypes.unsigned_long; (* window attr. mask *)
attrList := ARRAY [1 .. 5] OF Ctypes.int {
GLX.GLX_RGBA, (* RGB vs index color *)
GLX.GLX_DEPTH_SIZE, 16, (* depth buf > 16 bits *)
GLX.GLX_DOUBLEBUFFER, (* double buffer *)
X.None}; (* ... that's it! *)
cstr : Ctypes.char_star;
BEGIN
IF conn = NIL THEN
conn := NEW (Connection).init ();
END;
IF NOT conn.avail THEN
RAISE GraphicsBase.Failure;
END;
(*** Initialize awaitDeleteCV ***)
self.awaitDeleteMu := NEW (Thread.Mutex);
self.awaitDeleteCV := NEW (Thread.Condition);
(*** Initialize the display list table ***)
self.dlTable := NEW (IntIntTbl.Default).init ();
TRY
WITH dpy = conn.dpy, window = self.window DO
(*** Ensure single-threaded access to the display connection ***)
LOCK conn DO
(* Find the best visual. Unlike PEX, OpenGL has a routine
that does it for us. *)
visual := GLX.glXChooseVisual (dpy,
X.XDefaultScreen (dpy),
ADR (attrList));
IF visual = NIL THEN
RAISE GraphicsBase.Failure;
END;
(* MK tests if the visual is a TrueColor visual, and bails out if
it's not. That seems to be a bit harsh ... *)
(* Create a GLX rendering context (the equivalent to a PEX renderer).
"NIL" indicates that we don't want to share display lists with
other contexts (this might be unnecessarily conservative);
"True" indicates that we want to access the graphics system
directly (as opposed to through the X server) if possible. *)
self.context := GLX.glXCreateContext (dpy, visual, NIL, X.True);
IF self.context = NIL THEN
RAISE GraphicsBase.Failure;
END;
(* Create a color map *)
cmap := X.XCreateColormap (dpy, X.XRootWindow (dpy, visual.screen),
visual.visual, X.AllocNone);
(* Create a window. The next 20 or thirty lines are identical to the
code in X_PEX_Base. It should be factored out into an auxiliary
module that is shared by both bases. *)
wmask := 0;
wattrs.colormap := cmap;
wmask := Word.Or (wmask, X.CWColormap);
wattrs.background_pixel := X.XBlackPixel(dpy, X.XDefaultScreen(dpy));
wmask := Word.Or (wmask, X.CWBackPixel);
wattrs.border_pixel := X.XWhitePixel (dpy, X.XDefaultScreen (dpy));
wmask := Word.Or (wmask, X.CWBorderPixel);
window := X.XCreateWindow(
dpy, X.XRootWindow (dpy, visual.screen),
x, y, w, h,
bw,
visual.depth,
X.InputOutput,
visual.visual,
wmask, ADR(wattrs));
self.winWidth := w;
self.winHeight := h;
X.XSelectInput(dpy, window,
Word.Or(X.ExposureMask,
Word.Or(X.StructureNotifyMask,
Word.Or(X.KeyPressMask,
Word.Or(X.KeyReleaseMask,
Word.Or(X.ButtonPressMask,
Word.Or(X.ButtonReleaseMask,
X.PointerMotionMask)))))));
(*** set the window's title ***)
cstr := M3toC.SharedTtoS (title);
X.XChangeProperty (dpy, window, Xatom.XA_WM_NAME, Xatom.XA_STRING, 8,
X.PropModeReplace,
LOOPHOLE (cstr,
Ctypes.unsigned_char_star),
Text.Length (title));
M3toC.FreeSharedS(title, cstr);
(* ask the WM to send ClientMessage events when f.kill is chosen *)
EVAL X.XSetWMProtocols (dpy, window, ADR (conn.wm_delete_window), 1);
(*** map the window ***)
X.XMapWindow (dpy, window);
(**********************************************)
(* End of code that's identical to X_PEX_Base *)
(**********************************************)
(* Bind "self.context" to "self.window" *)
WITH status = GLX.glXMakeCurrent (dpy, window, self.context) DO
IF status = X.False THEN
RAISE GraphicsBase.Failure;
END;
END;
(*** Determine the default frame buffer ***)
GL.glGetIntegerv (GL.GL_DRAW_BUFFER, ADR (self.drawBuffer));
(*** Enable depth buffering and set the depth buffer clear value ***)
GL.glEnable (GL.GL_DEPTH_TEST);
GL.glDepthFunc (GL.GL_GREATER);
GL.glClearDepth (0.0d0);
(*** Create the display list for light sources ***)
GL.glEnable (GL.GL_LIGHTING);
GL.glLightModeli(GL.GL_LIGHT_MODEL_TWO_SIDE, GL.GL_TRUE);
self.lightList := GL.glGenLists (1);
IF self.lightList = 0 THEN
RAISE GraphicsBase.Failure;
END;
(* Select flat shading and auto-normalization of normal vectors *)
GL.glShadeModel (GL.GL_FLAT);
GL.glEnable (GL.GL_NORMALIZE);
GL.glEnable (GL.GL_LINE_STIPPLE);
GL.glLineStipple (1, Solid);
END;
END;
self.stacks := PropPrivate.NewStacks ();
self.stateSize := NUMBER (self.stacks^);
(* The rest of this function is copied straight from X_PEX_Base. *)
self.modifiers := VBT.Modifiers {};
self.buttonDownCount := 0;
self.status := GraphicsBasePrivate.Status.Mapped;
(* Initialize the sate variables *)
self.setSpecularReflConc (
SurfaceGO.SpecularReflectionConc.getState (self));
self.setMarkerColor (MarkerGO.Colour.getState (self));
self.setMarkerScale (MarkerGO.Scale.getState (self));
self.setMarkerType (MarkerGO.Type.getState (self));
WITH pp = NEW(ParseParams.T).init(Stdio.stderr) DO
IF pp.keywordPresent("-largeCursor") THEN
LargeCursor(self);
END;
END;
IF MkProxyT # NIL THEN
MkProxyT (self);
END;
RETURN self;
EXCEPT
X.Error => RAISE GraphicsBase.Failure;
END;
END Init;
***************************************************************************
The following procedures are copied pretty much directly from X_PEX_Base
***************************************************************************
PROCEDURE*************************************************************************** End of replicated code ***************************************************************************LargeCursor (self : T) = VAR pm := X.XCreatePixmap (conn.dpy, self.window, 64, 64, 1); fg, bg : X.XColor; hot : X.XPoint; pts : REF ARRAY OF X.XPoint; bg_gcv, fg_gcv : X.XGCValues; bg_gc, fg_gc : X.GC; BEGIN bg_gcv.function := X.GXclear; bg_gc := X.XCreateGC(conn.dpy, pm, X.GCFunction, ADR(bg_gcv)); fg_gcv.function := X.GXset; fg_gc := X.XCreateGC(conn.dpy, pm, X.GCFunction, ADR(fg_gcv)); TRY WITH rd = FileRd.Open("cursordata"), n = Lex.Int(rd) DO pts := NEW (REF ARRAY OF X.XPoint, n); FOR i := FIRST(pts^) TO LAST(pts^) DO pts[i].x := Lex.Int(rd); pts[i].y := Lex.Int(rd); END; hot.x := Lex.Int(rd); hot.y := Lex.Int(rd); fg.red := Lex.Int(rd); fg.green := Lex.Int(rd); fg.blue := Lex.Int(rd); bg.red := Lex.Int(rd); bg.green := Lex.Int(rd); bg.blue := Lex.Int(rd); END; EXCEPT | OSError.E, FloatMode.Trap, Lex.Error, Rd.Failure, Thread.Alerted => pts := NEW (REF ARRAY OF X.XPoint, 7); pts^ := ARRAY OF X.XPoint{X.XPoint{0,0}, X.XPoint{45,15}, X.XPoint{35,25}, X.XPoint{63,53}, X.XPoint{53,63}, X.XPoint{25,35}, X.XPoint{15,45}}; hot.x := 0; hot.y := 0; fg.red := 65535; fg.green := 0; fg.blue := 0; (* red *) bg.red := 0; bg.green := 0; bg.blue := 0; (* black *) END; X.XFillRectangle (conn.dpy, pm, bg_gc, 0, 0, 64, 64); X.XFillPolygon (conn.dpy, pm, fg_gc, ADR(pts[0]), NUMBER(pts^), X.Nonconvex, X.CoordModeOrigin); WITH cursor = X.XCreatePixmapCursor(conn.dpy, pm, pm, ADR(fg), ADR(bg), hot.x, hot.y) DO X.XDefineCursor (conn.dpy, self.window, cursor); END; END LargeCursor; PROCEDUREChangeTitle (self: T; title : TEXT) = VAR cstr : Ctypes.char_star; BEGIN cstr := M3toC.SharedTtoS (title); LOCK conn DO X.XChangeProperty (conn.dpy, self.window, Xatom.XA_WM_NAME, Xatom.XA_STRING, 8, X.PropModeReplace, LOOPHOLE (cstr, Ctypes.unsigned_char_star), Text.Length (title)); END; M3toC.FreeSharedS(title, cstr); END ChangeTitle; PROCEDUREAwaitDelete (self : T) = BEGIN LOCK self.awaitDeleteMu DO Thread.Wait (self.awaitDeleteMu, self.awaitDeleteCV); END; END AwaitDelete; PROCEDUREDestroy (self : T) = BEGIN LOCK AnimServer.internalLock DO self.status := GraphicsBasePrivate.Status.Destroyed; END; END Destroy; PROCEDUREUnmap (self : T) = BEGIN (*** Destroy the window ***) X.XDestroyWindow (conn.dpy, self.window); X.XSync (conn.dpy, X.False); self.window := X.None; self.status := GraphicsBasePrivate.Status.Unmapped; (*** signal all threads that are blocked ***) Thread.Broadcast (self.awaitDeleteCV); END Unmap; PROCEDUREAvailable () : BOOLEAN = BEGIN IF conn = NIL THEN conn := NEW (Connection).init (); END; RETURN conn.avail; END Available;
PROCEDURE*************************************************************************** Phase 1 methods: Camera and light source management ***************************************************************************Push (self : T; caller : GO.T) = VAR props := caller.props; BEGIN <* ASSERT AnimServer.IsServer() *> WHILE props # NIL DO WITH prop = props.head DO prop.n.push (self, prop.v); END; props := props.tail; END; END Push; PROCEDUREPop (self : T; caller : GO.T) = VAR props := caller.props; BEGIN <* ASSERT AnimServer.IsServer() *> WHILE props # NIL DO props.head.n.pop (self); props := props.tail; END; END Pop;
PROCEDURE*************************************************************************** Display-List management ***************************************************************************AddAmbientLight (self: T; color: Color.T) = BEGIN IF self.phase = 1 THEN self.ambientLight := GLrgba {self.ambientLight.r + color.r, self.ambientLight.g + color.g, self.ambientLight.b + color.b, self.ambientLight.a}; END; END AddAmbientLight; PROCEDUREAddVectorLight (self: T; color: Color.T; d: Point3.T) = VAR pos := GLpoint4f {-d.x, -d.y, -d.z, 0.0}; black := GLrgba {0.0, 0.0, 0.0, 1.0}; col := GLrgba {color.r, color.g, color.b, 1.0}; BEGIN IF self.phase = 1 THEN WITH l = GL.GL_LIGHT0 + self.lightCount DO <* ASSERT l < GL.GL_LIGHT0 + GL.GL_MAX_LIGHTS *> GL.glLightfv (l, GL.GL_AMBIENT, ADR (black)); GL.glLightfv (l, GL.GL_DIFFUSE, ADR (col)); GL.glLightfv (l, GL.GL_SPECULAR, ADR (col)); GL.glLightfv (l, GL.GL_POSITION, ADR (pos)); (* Since this is a directional light source, attenuation is disabled, so we don't need to specify "GL_CONSTANT_ATTENUATION", "GL_LINEAR_ATTENUATION", and "GL_QUADRATIC_ATTENUATION". On the other hand, we have to specify "GL_SPOT_CUTOFF" and "GL_SPOT_EXPONENT", since OpenGL allows for directional spotlights (with their effect being undefined). We initialize them for uniform light distribution. Since "GL_SPOT_CUTOFF" is 180 degrees, we don't need to specify "GL_SPOT_DIRECTION". *) GL.glLightf (l, GL.GL_SPOT_EXPONENT, 0.0); GL.glLightf (l, GL.GL_SPOT_CUTOFF, 180.0); GL.glEnable (l); INC (self.lightCount); END; END; END AddVectorLight; PROCEDUREAddPointLight (self : T; color : Color.T; p : Point3.T; att0, att1: REAL) = VAR pos := GLpoint4f {p.x, p.y, p.z, 1.0}; black := GLrgba {0.0, 0.0, 0.0, 1.0}; col := GLrgba {color.r, color.g, color.b, 1.0}; BEGIN IF self.phase = 1 THEN WITH l = GL.GL_LIGHT0 + self.lightCount DO <* ASSERT l < GL.GL_LIGHT0 + GL.GL_MAX_LIGHTS *> GL.glLightfv (l, GL.GL_AMBIENT, ADR (black)); GL.glLightfv (l, GL.GL_DIFFUSE, ADR (col)); GL.glLightfv (l, GL.GL_SPECULAR, ADR (col)); GL.glLightfv (l, GL.GL_POSITION, ADR (pos)); GL.glLightf (l, GL.GL_SPOT_EXPONENT, 0.0); GL.glLightf (l, GL.GL_SPOT_CUTOFF, 180.0); GL.glLightf (l, GL.GL_CONSTANT_ATTENUATION, att0); GL.glLightf (l, GL.GL_LINEAR_ATTENUATION, att1); GL.glLightf (l, GL.GL_QUADRATIC_ATTENUATION, 0.0); GL.glEnable (l); INC (self.lightCount); END; END; END AddPointLight; PROCEDUREAddSpotLight (self: T; color: Color.T; p, d: Point3.T; conc, spread, att0, att1: REAL) = VAR pos := GLpoint4f {p.x, p.y, p.z, 1.0}; black := GLrgba {0.0, 0.0, 0.0, 1.0}; col := GLrgba {color.r, color.g, color.b, 1.0}; BEGIN IF self.phase = 1 THEN WITH l = GL.GL_LIGHT0 + self.lightCount DO <* ASSERT l < GL.GL_LIGHT0 + GL.GL_MAX_LIGHTS *> GL.glLightfv (l, GL.GL_AMBIENT, ADR (black)); GL.glLightfv (l, GL.GL_DIFFUSE, ADR (col)); GL.glLightfv (l, GL.GL_SPECULAR, ADR (col)); GL.glLightfv (l, GL.GL_POSITION, ADR (pos)); GL.glLightfv (l, GL.GL_SPOT_DIRECTION, ADR (d)); GL.glLightf (l, GL.GL_SPOT_EXPONENT, conc); GL.glLightf (l, GL.GL_SPOT_CUTOFF, spread / FLOAT (Math.Degree, REAL)); GL.glLightf (l, GL.GL_CONSTANT_ATTENUATION, att0); GL.glLightf (l, GL.GL_LINEAR_ATTENUATION, att1); GL.glLightf (l, GL.GL_QUADRATIC_ATTENUATION, 0.0); GL.glEnable (l); INC (self.lightCount); END; END; END AddSpotLight; PROCEDURESetLookAt (self: T; from, to, up: Point3.T) = BEGIN IF self.phase = 1 THEN self.from := from; self.to := to; self.up := up; END; END SetLookAt; PROCEDURESetPerspProj (self: T; fovy, aspect: REAL) = BEGIN IF self.phase = 1 THEN self.projType := ProjType.Persp; self.fovy := fovy; self.aspect := aspect; END; END SetPerspProj; PROCEDURESetOrthoProj (self: T; height, aspect: REAL) = BEGIN IF self.phase = 1 THEN self.projType := ProjType.Ortho; self.height := height; self.aspect := aspect; END; END SetOrthoProj;
PROCEDURE*************************************************************************** Matrix Stack management ***************************************************************************OpenDisplayList (self : T; go : GO.T) = VAR dl : INTEGER; BEGIN <* ASSERT AnimServer.IsServer() *> IF self.phase = 2 THEN (*** Extract the display list associated with the GO. ***) IF go.dl = 0 THEN go.dl := AnimServer.NewDisplayList (go); END; IF NOT self.dlTable.get (go.dl, dl) THEN dl := GL.glGenLists (1); <* ASSERT dl # 0 *> EVAL self.dlTable.put (go.dl, dl); END; (*** Open the OpenGL display list ***) GL.glNewList (dl, GL.GL_COMPILE); END; END OpenDisplayList; PROCEDURECloseDisplayList (self : T) = BEGIN IF self.phase = 2 THEN GL.glEndList (); END; END CloseDisplayList; PROCEDURECallDisplayList (self : T; go : GO.T) = VAR dl: INTEGER; BEGIN <* ASSERT AnimServer.IsServer() *> IF self.phase = 2 THEN (*** Extract the display list associated with the GO. ***) IF NOT self.dlTable.get (go.dl, dl) THEN <* ASSERT FALSE *> END; GL.glCallList (dl); END; END CallDisplayList; PROCEDUREFreeDisplayList (self: T; go: GO.T) = VAR dl : INTEGER; BEGIN IF self.dlTable.delete (go.dl, dl) THEN GL.glDeleteLists (dl, 1); END; END FreeDisplayList;
PROCEDURE*************************************************************************** Changing the state of the abstract graphics machine ***************************************************************************PushMatrix (<*UNUSED*> self : T; READONLY matrix : Matrix4.T) = VAR V := FromMatrix4 (matrix); BEGIN GL.glPushMatrix (); GL.glMultMatrixf (ADR (V[0])); END PushMatrix; PROCEDUREPopMatrix (<*UNUSED*> self : T) = BEGIN GL.glPopMatrix (); END PopMatrix;
PROCEDURE*************************************************************************** Event handling ***************************************************************************FromMatrix4 (READONLY M: Matrix4.T): GLmatrixf = BEGIN RETURN GLmatrixf {M[0][0], M[1][0], M[2][0], M[3][0], M[0][1], M[1][1], M[2][1], M[3][1], M[0][2], M[1][2], M[2][2], M[3][2], M[0][3], M[1][3], M[2][3], M[3][3]}; END FromMatrix4; PROCEDUREToMatrix4 (READONLY M: GLmatrixf): Matrix4.T = BEGIN RETURN Matrix4.T {Matrix4.Row {M[0], M[4], M[ 8], M[12]}, Matrix4.Row {M[1], M[5], M[ 9], M[13]}, Matrix4.Row {M[2], M[6], M[10], M[14]}, Matrix4.Row {M[3], M[7], M[11], M[15]}}; END ToMatrix4; PROCEDURESetupCamera (self: T) = CONST epsilon = 0.1; min_far = 0.01; VAR V : GLmatrixf; BEGIN GL.glMatrixMode (GL.GL_MODELVIEW); GL.glLoadIdentity (); GLu.gluLookAt (FLOAT (self.from.x, LONGREAL), FLOAT (self.from.y, LONGREAL), FLOAT (self.from.z, LONGREAL), FLOAT (self.to.x, LONGREAL), FLOAT (self.to.y, LONGREAL), FLOAT (self.to.z, LONGREAL), FLOAT (self.up.x, LONGREAL), FLOAT (self.up.y, LONGREAL), FLOAT (self.up.z, LONGREAL)); GL.glGetFloatv (GL.GL_MODELVIEW_MATRIX, ADR (V[0])); WITH bs = self.getBoundingVolume(), M = ToMatrix4 (V), center = Point3.T { M[0][0] * bs.center.x + M[0][1] * bs.center.y + M[0][2] * bs.center.z + M[0][3], M[1][0] * bs.center.x + M[1][1] * bs.center.y + M[1][2] * bs.center.z + M[1][3], M[2][0] * bs.center.x + M[2][1] * bs.center.y + M[2][2] * bs.center.z + M[2][3]}, radius = bs.radius * Mth.sqrt (M[0][0] * M[0][0] + M[1][0] * M[1][0] + M[2][0] * M[2][0]) DO self.far := MAX (ABS (center.z) - radius - epsilon, min_far); self.near := MAX (ABS (center.z) + radius + epsilon, min_far); END; GL.glMatrixMode (GL.GL_PROJECTION); GL.glLoadIdentity (); WITH aspect = self.aspect * FLOAT(self.winWidth) / FLOAT(self.winHeight) DO CASE self.projType OF | ProjType.Persp => GLu.gluPerspective (FLOAT (self.fovy, LONGREAL) / Math.Degree, FLOAT (aspect, LONGREAL), FLOAT (self.near, LONGREAL), FLOAT (self.far, LONGREAL)); | ProjType.Ortho => GL.glOrtho (FLOAT (-self.height * aspect * 0.5, LONGREAL), FLOAT ( self.height * aspect * 0.5, LONGREAL), FLOAT (-self.height * 0.5, LONGREAL), FLOAT ( self.height * 0.5, LONGREAL), FLOAT (self.near, LONGREAL), FLOAT (self.far, LONGREAL)); END; END; (*** Switch back to model/view matrix ***) GL.glMatrixMode (GL.GL_MODELVIEW); END SetupCamera; PROCEDUREScreenToWorld (self: T; pos: Point.T; zpos: REAL): Point3.T = VAR modelMatrix: ARRAY [0 .. 15] OF GL.GLdouble; projMatrix : ARRAY [0 .. 15] OF GL.GLdouble; viewPort : ARRAY [0 .. 3] OF GL.GLint; rx, ry, rz : GL.GLdouble; status : GL.GLint; BEGIN (*** Retrieve the modelview and the projection matrix ***) GL.glGetDoublev (GL.GL_MODELVIEW_MATRIX, ADR (modelMatrix[0])); GL.glGetDoublev (GL.GL_PROJECTION_MATRIX, ADR (projMatrix[0])); GL.glGetIntegerv(GL.GL_VIEWPORT, ADR (viewPort[0])); (*** Call "UnProject" ***) WITH x = FLOAT (pos.h, LONGREAL), y = FLOAT (self.winHeight - 1 - pos.v, LONGREAL), z = FLOAT (zpos, LONGREAL) DO status := GLu.gluUnProject (x, y, z, ADR (modelMatrix[0]), ADR (projMatrix[0]), ADR (viewPort[0]), ADR (rx), ADR (ry), ADR (rz)); END; <* ASSERT status = GL.GL_TRUE *> (*** Return the result ***) RETURN Point3.T {FLOAT (rx), FLOAT (ry), FLOAT (rz)}; END ScreenToWorld; PROCEDURESetBackgroundColor (<* UNUSED *> self : T; color : Color.T) = BEGIN GL.glClearColor (color.r, color.g, color.b, 1.0); END SetBackgroundColor; PROCEDURESetDepthcueing ( self : T; switch : BOOLEAN; frontPlane : REAL; backPlane : REAL; <*UNUSED*> frontScale : REAL; <*UNUSED*> backScale : REAL; color : Color.T) = VAR rgba := GLrgba {color.r, color.g, color.b, 1.0}; BEGIN IF self.phase = 2 THEN IF switch THEN WITH start = self.far - frontPlane * (self.far - self.near), end = self.far - backPlane * (self.far - self.near) DO GL.glEnable (GL.GL_FOG); GL.glFogi (GL.GL_FOG_MODE, GL.GL_LINEAR); GL.glFogf (GL.GL_FOG_START, start); GL.glFogf (GL.GL_FOG_END, end); GL.glFogfv (GL.GL_FOG_COLOR, ADR (rgba)); (* OpenGL does not have the concept of fog scaling factors. Hence, we have to ignore "frontScale" and "backScale". Conversely, we don't need to specify values for "GL.GL_FOG_INDEX", as we are in RGBA mode, and for "GL.GL_FOG_DENSITY", since we use the linear fog equation. *) END; ELSE GL.glDisable (GL.GL_FOG); END; END; END SetDepthcueing; PROCEDURESetMarkerColor (self: T; col: Color.T) = BEGIN self.markerColor := col; END SetMarkerColor; PROCEDURESetMarkerScale (self : T; scale : REAL) = BEGIN self.markerScale := scale; END SetMarkerScale; PROCEDURESetMarkerType (self : T; type : MarkerTypeProp.Kind) = BEGIN self.markerType := type; END SetMarkerType; PROCEDURESetLineColor (self: T; col: Color.T) = BEGIN self.lineColor := col; END SetLineColor; PROCEDURESetLineWidth (self: T; width: REAL) = BEGIN self.lineWidth := width; END SetLineWidth; PROCEDURESetLineType (self : T; type : LineTypeProp.Kind) = BEGIN CASE type OF | LineTypeProp.Kind.Solid => self.lineType := Solid; | LineTypeProp.Kind.Dashed => self.lineType := Dashed; | LineTypeProp.Kind.Dotted => self.lineType := Dotted; | LineTypeProp.Kind.DashDot => self.lineType := DashDot; END; END SetLineType; PROCEDURESetSurfaceColor (self : T; col : Color.T) = BEGIN self.frontColor := col; END SetSurfaceColor; PROCEDURESetSurfaceBackColor (self : T; col : Color.T) = BEGIN self.backColor := col; END SetSurfaceBackColor; PROCEDURESetRasterMode (self : T; val : RasterModeProp.Kind) = BEGIN self.rasterMode := val; END SetRasterMode; PROCEDURESetDistinguishFacetsFlag (<*UNUSED*> self : T; <*UNUSED*> val : BOOLEAN) = BEGIN IO.Put ("### SetDistinguishFacetsFlag not implemented \n"); END SetDistinguishFacetsFlag; PROCEDURESetLighting (self : T; val : BOOLEAN) = BEGIN self.lighting := val; IF val THEN GL.glEnable (GL.GL_LIGHTING); ELSE GL.glDisable (GL.GL_LIGHTING); END; END SetLighting; PROCEDURESetShading (<*UNUSED*> self : T; val : ShadingProp.Kind) = BEGIN CASE val OF | ShadingProp.Kind.Flat => GL.glShadeModel (GL.GL_FLAT); | ShadingProp.Kind.Gouraud => GL.glShadeModel (GL.GL_SMOOTH); END; END SetShading; PROCEDURESetSurfaceEdgeFlag (self : T; val : BOOLEAN) = BEGIN self.edgeFlag := val; END SetSurfaceEdgeFlag; PROCEDURESetSurfaceEdgeColor (self: T; col: Color.T) = BEGIN self.edgeColor := col; END SetSurfaceEdgeColor; PROCEDURESetSurfaceEdgeType (self : T; val : LineTypeProp.Kind) = BEGIN CASE val OF | LineTypeProp.Kind.Solid => self.edgeType := Solid; | LineTypeProp.Kind.Dashed => self.edgeType := Dashed; | LineTypeProp.Kind.Dotted => self.edgeType := Dotted; | LineTypeProp.Kind.DashDot => self.edgeType := DashDot; END; END SetSurfaceEdgeType; PROCEDURESetSurfaceEdgeWidth (self: T; width: REAL) = BEGIN self.edgeWidth := width; END SetSurfaceEdgeWidth; PROCEDURESetAmbientReflCoeff (self : T; val : REAL) = BEGIN self.ambientReflCoeff := val; END SetAmbientReflCoeff; PROCEDURESetDiffuseReflCoeff (self : T; val : REAL) = BEGIN self.diffuseReflCoeff := val; END SetDiffuseReflCoeff; PROCEDURESetSpecularReflCoeff (self : T; val : REAL) = BEGIN self.specularReflCoeff := val; END SetSpecularReflCoeff; PROCEDURESetSpecularReflConc (self : T; val : REAL) = BEGIN (* I try to make the "GL_SHININESS" value to look as much as possible like the "specularConc" component for "PEXSetReflectionAttributes". This formula is taken essentially out of thin air, but seems to produce reasonably similar images. *) self.specularReflConc := MIN (MAX (val * 2.0 + 4.0, 0.0), 128.0); END SetSpecularReflConc; PROCEDURESetSpecularReflColor (self : T; val : Color.T) = BEGIN self.specularReflColor := val; END SetSpecularReflColor; PROCEDURESetTransmissionCoeff (self: T; val: REAL) = BEGIN self.transmission := 1.0 - val; END SetTransmissionCoeff; PROCEDUREDrawMarker (self : T; p : Point3.T) = BEGIN IF self.phase = 2 THEN (*** SRC 129 says that markers are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.markerColor)); GL.glPointSize (self.markerScale); GL.glBegin (GL.GL_POINTS); GL.glVertex3fv (ADR (p)); GL.glEnd (); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END DrawMarker; PROCEDUREDrawLine (self: T; p1, p2: Point3.T) = BEGIN IF self.phase = 2 THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.lineColor)); (* ... strictly speaking wrong: Color.T # ARRAY [1..3] OF REAL *) GL.glLineWidth (self.lineWidth); GL.glLineStipple (ROUND (self.lineWidth), self.lineType); GL.glBegin (GL.GL_LINES); GL.glVertex3fv (ADR (p1)); GL.glVertex3fv (ADR (p2)); GL.glEnd (); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END DrawLine; PROCEDUREDrawPolygon (self : T; READONLY pts : ARRAY OF Point3.T; shape : GO.Shape) = PROCEDURE DrawHollowPolygon () = BEGIN (*** Draw a line-loop around the contour of the polygon ***) GL.glBegin (GL.GL_LINE_LOOP); FOR i := 0 TO LAST (pts) DO GL.glVertex3fv (ADR (pts[i])); END; GL.glEnd (); END DrawHollowPolygon; PROCEDURE DrawSolidConvexPolygon () = VAR n: Point3.T; BEGIN GL.glBegin (GL.GL_POLYGON); (* If the polygon is non-degenerate, take the first 3 vertices, compute the normal vector, and set it. We don't scale the normal vector to unit length (presumably, OpenGL can do it more efficiently), and we cannot determine which side of the polygon is the "front". *) IF NUMBER (pts) >= 3 THEN n := Point3.CrossProduct (Point3.Minus (pts[1], pts[0]), Point3.Minus (pts[2], pts[0])); GL.glNormal3fv (ADR (n)); END; FOR i := 0 TO LAST (pts) DO GL.glVertex3fv (ADR (pts[i])); END; GL.glEnd (); END DrawSolidConvexPolygon; PROCEDURE DrawSolidNonConvexPolygon () = BEGIN (** Note: We can get around with a single global tesselation object **) WITH tess = GLu.gluNewTess () DO <* ASSERT tess # NIL *> GLu.gluTessCallback (tess, GLu.GLU_BEGIN, LOOPHOLE (GL.glBegin, PROCEDURE ())); GLu.gluTessCallback (tess, GLu.GLU_VERTEX, LOOPHOLE (GL.glVertex3dv, PROCEDURE ())); GLu.gluTessCallback (tess, GLu.GLU_END, LOOPHOLE (GL.glEnd, PROCEDURE ())); GLu.gluBeginPolygon (tess); WITH verts = NEW (REF ARRAY OF GLpoint3d, NUMBER (pts)) DO FOR i := 0 TO LAST (pts) DO WITH v = verts[i], p = pts[i] DO v := GLpoint3d {FLOAT (p.x, LONGREAL), FLOAT (p.y, LONGREAL), FLOAT (p.z, LONGREAL)}; GLu.gluTessVertex (tess, ADR (v), ADR (v)); END; END; END; GLu.gluEndPolygon (tess); GLu.gluDeleteTess (tess); END; END DrawSolidNonConvexPolygon; PROCEDURE DrawSolidComplexPolygon () = (* This procedure uses a trick described in the "Red Book" (the OpenGL Programming Guide by the OpenGL Architecture Review Board) on page 398f. *) VAR n: Point3.T; BEGIN (*** Clear the stencil buffer ***) GL.glClearStencil (0); GL.glClear (GL.GL_STENCIL_BUFFER_BIT); (* If the polygon is non-degenerate, take the first 3 vertices, and compute the normal vector. We don't scale the normal vector to unit length (presumably, OpenGL can do it more efficiently), and we cannot determine which side of the polygon is the "front". *) IF NUMBER (pts) >= 3 THEN n := Point3.CrossProduct (Point3.Minus (pts[1], pts[0]), Point3.Minus (pts[2], pts[0])); END; (* (p2 - p0) x (p1 - p0) -> Lower side is dark *) (* (p1 - p0) x (p2 - p0) -> Upper side is dark *) (*** Enable the stencil test. For each fragment of the triangles to come, invert the corresponding stencil buffer entry, but leave the frame buffer entry unchanged. ***) GL.glStencilFunc (GL.GL_NEVER, 0, 0); GL.glStencilOp (GL.GL_INVERT, GL.GL_KEEP, GL.GL_KEEP); GL.glEnable (GL.GL_STENCIL_TEST); (*** Draw series of triangles (affecting only stencil buffer) ***) GL.glBegin (GL.GL_TRIANGLE_FAN); FOR i := 0 TO LAST (pts) DO GL.glVertex3fv (ADR (pts[i])); END; GL.glEnd (); (*** For each fragment of the triangles to come, modify the corresponding frame buffer entry iff the stencil buffer entry is non-zero. Leave the stencil buffer entry unchanged. ***) GL.glStencilFunc (GL.GL_EQUAL, 1, 1); GL.glStencilOp (GL.GL_KEEP, GL.GL_KEEP, GL.GL_KEEP); (* Draw series of triangles (affecting frame buffer). Note that we have to specify a normal vector, and that OpenGL will invert the normal of polygons that are specified through clockwise vertices *) FOR i := 1 TO LAST (pts) - 1 DO GL.glBegin (GL.GL_TRIANGLES); n := Point3.CrossProduct (Point3.Minus (pts[i], pts[0]), Point3.Minus (pts[i+1], pts[0])); GL.glNormal3fv (ADR (n)); GL.glVertex3fv (ADR (pts[0])); GL.glVertex3fv (ADR (pts[i])); GL.glVertex3fv (ADR (pts[i+1])); GL.glEnd (); END; (*** Disable stencil test ***) GL.glDisable (GL.GL_STENCIL_TEST); END DrawSolidComplexPolygon; PROCEDURE DrawSolidPolygon () = BEGIN CASE shape OF | GO.Shape.Convex => DrawSolidConvexPolygon(); | GO.Shape.NonConvex => DrawSolidNonConvexPolygon(); | GO.Shape.Complex => DrawSolidComplexPolygon(); | GO.Shape.Unknown => DrawSolidComplexPolygon(); END; END DrawSolidPolygon; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => DrawSolidPolygon (); | RasterModeProp.Kind.Hollow => DrawHollowPolygon (); | RasterModeProp.Kind.Empty => (*** a no-op ***) END; UnsetSurfaceMaterial (self); END; IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); DrawHollowPolygon (); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END DrawPolygon; PROCEDUREDrawQuadMesh (self : T; READONLY pts : ARRAY OF ARRAY OF Point3.T; shape : GO.Shape) = PROCEDURE DrawHollowQuadMesh () = BEGIN FOR i := 0 TO LAST (pts) DO GL.glBegin (GL.GL_LINE_STRIP); FOR j := 0 TO LAST(pts[i]) DO GL.glVertex3fv (ADR (pts[i][j])); END; GL.glEnd (); END; FOR j := 0 TO LAST(pts[0]) DO GL.glBegin (GL.GL_LINE_STRIP); FOR i := 0 TO LAST (pts) DO GL.glVertex3fv (ADR (pts[i][j])); END; GL.glEnd (); END; END DrawHollowQuadMesh; PROCEDURE DrawSolidQuadMesh () = BEGIN IF shape = GO.Shape.Convex THEN DrawSolidConvexQuadMesh (); ELSE DrawSolidGeneralQuadMesh (); END; END DrawSolidQuadMesh; PROCEDURE DrawSolidConvexQuadMesh () = BEGIN FOR i := 0 TO LAST (pts) - 1 DO WITH line1 = pts[i], line2 = pts[i+1] DO GL.glBegin (GL.GL_QUAD_STRIP); FOR j := 0 TO LAST(line1) DO (* We don't specify any normal vectors here. Probably we should! *) GL.glVertex3fv (ADR (line1[j])); GL.glVertex3fv (ADR (line2[j])); END; GL.glEnd (); END; END; IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); DrawHollowQuadMesh (); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END DrawSolidConvexQuadMesh; PROCEDURE DrawSolidGeneralQuadMesh () = BEGIN FOR i := 0 TO LAST (pts) - 1 DO WITH line1 = pts[i], line2 = pts[i+1] DO FOR j := 0 TO LAST(line1) - 1 DO WITH quad = ARRAY OF Point3.T {line1[j], line2[j], line2[j+1], line1[j+1]} DO DrawPolygon (self, quad, shape); END; END; END; END; END DrawSolidGeneralQuadMesh; BEGIN <* ASSERT AnimServer.IsServer() *> IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => DrawSolidQuadMesh (); | RasterModeProp.Kind.Hollow => DrawHollowQuadMesh (); | RasterModeProp.Kind.Empty => (*** a no-op ***) END; UnsetSurfaceMaterial (self); END; END DrawQuadMesh; PROCEDUREDrawColoredQuadMesh ( self : T; READONLY points: ARRAY OF ARRAY OF Point3.T; READONLY colors: ARRAY OF ARRAY OF Color.T; shape : GO.Shape) = PROCEDURE DrawHollowQuadMesh (lit: BOOLEAN) = PROCEDURE EmitColoredVertex (i, j: INTEGER) = VAR rgba : GLrgba; n : Point3.T; BEGIN WITH x = MIN (i, LAST(colors)), y = MIN (j, LAST(colors[x])), c = colors [x][y] DO (*** Compute a normal vector ***) WITH a = points[x][y], b = points[x+1][y], c = points[x][y+1] DO n := Point3.CrossProduct (Point3.Minus(b, a), Point3.Minus(c, a)); GL.glNormal3fv (ADR (n)); END; (*** Set the color-related material properties ***) rgba := GLrgba {self.ambientReflCoeff * c.r, self.ambientReflCoeff * c.g, self.ambientReflCoeff * c.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_AMBIENT, ADR (rgba)); rgba := GLrgba {self.diffuseReflCoeff * c.r, self.diffuseReflCoeff * c.g, self.diffuseReflCoeff * c.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_DIFFUSE, ADR (rgba)); rgba := GLrgba {self.specularReflCoeff * self.specularReflColor.r, self.specularReflCoeff * self.specularReflColor.g, self.specularReflCoeff * self.specularReflColor.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_SPECULAR, ADR (rgba)); (*** Set the color -- no idea why I have to do it ... ***) GL.glColor3fv (ADR (c)); (*** Emit the vertex ***) GL.glVertex3fv (ADR (points[i][j])); END; END EmitColoredVertex; BEGIN FOR i := 0 TO LAST (points) DO GL.glBegin (GL.GL_LINE_STRIP); FOR j := 0 TO LAST(points[i]) DO IF lit THEN EmitColoredVertex (i, j); ELSE GL.glVertex3fv (ADR (points[i][j])); END; END; GL.glEnd (); END; FOR j := 0 TO LAST(points[0]) DO GL.glBegin (GL.GL_LINE_STRIP); FOR i := 0 TO LAST (points) DO IF lit THEN EmitColoredVertex (i, j); ELSE GL.glVertex3fv (ADR (points[i][j])); END; END; GL.glEnd (); END; END DrawHollowQuadMesh; PROCEDURE DrawSolidQuadMesh () = BEGIN IF shape = GO.Shape.Convex THEN DrawSolidConvexQuadMesh (); ELSE DrawSolidGeneralQuadMesh (); END; END DrawSolidQuadMesh; PROCEDURE DrawSolidConvexQuadMesh () = BEGIN FOR i := 0 TO LAST (points) - 1 DO WITH line1 = points[i], line2 = points[i+1] DO GL.glBegin (GL.GL_QUAD_STRIP); FOR j := 0 TO LAST(line1) DO (* We don't specify any normal vectors here. Probably we should! *) IF j > 0 THEN GL.glColor3fv (ADR (colors[i][j-1])); END; GL.glVertex3fv (ADR (line1[j])); GL.glVertex3fv (ADR (line2[j])); END; GL.glEnd (); END; END; IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); DrawHollowQuadMesh (FALSE); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END DrawSolidConvexQuadMesh; PROCEDURE DrawSolidGeneralQuadMesh () = VAR fc, bc : Color.T; BEGIN FOR i := 0 TO LAST (points) - 1 DO WITH line1 = points[i], line2 = points[i+1] DO FOR j := 0 TO LAST(line1) - 1 DO WITH quad = ARRAY OF Point3.T {line1[j], line2[j], line2[j+1], line1[j+1]} DO fc := self.frontColor; bc := self.backColor; self.frontColor := colors[i][j]; self.backColor := colors[i][j]; DrawPolygon (self, quad, shape); self.frontColor := fc; self.backColor := bc; END; END; END; END; END DrawSolidGeneralQuadMesh; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => DrawSolidQuadMesh (); | RasterModeProp.Kind.Hollow => DrawHollowQuadMesh (TRUE); | RasterModeProp.Kind.Empty => (*** a no-op ***) END; UnsetSurfaceMaterial (self); END; END DrawColoredQuadMesh; PROCEDURESetSurfaceMaterial (self: T) = VAR rgba : GLrgba; BEGIN IF self.transmission < 1.0 THEN (* If the sphere is transparent, disable depth buffer writing (so transparent fragments won't mask out opaque ones behind them), enable blending, and set up the blending function *) GL.glDepthMask (GL.GL_FALSE); GL.glEnable (GL.GL_BLEND); GL.glBlendFunc (GL.GL_SRC_ALPHA, GL.GL_ONE_MINUS_SRC_ALPHA); END; (* We could keep track of the color value set by the last call to "glColor", and call it only if there is a change. For now, I use the conservative (aka brute force) approach -- always call it! *) (* If "GL_LIGHTING" is disabled, the color of a polygon is set through "glColor"; otherwise, it is set through "glMaterial". It seems that "glColor" does not distinguish between front faces and back faces. *) GL.glColor3fv (ADR (self.frontColor)); rgba := GLrgba {self.ambientReflCoeff * self.frontColor.r, self.ambientReflCoeff * self.frontColor.g, self.ambientReflCoeff * self.frontColor.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_AMBIENT, ADR (rgba)); rgba := GLrgba {self.diffuseReflCoeff * self.frontColor.r, self.diffuseReflCoeff * self.frontColor.g, self.diffuseReflCoeff * self.frontColor.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_DIFFUSE, ADR (rgba)); rgba := GLrgba {self.specularReflCoeff * self.specularReflColor.r, self.specularReflCoeff * self.specularReflColor.g, self.specularReflCoeff * self.specularReflColor.b, self.transmission}; GL.glMaterialfv (GL.GL_FRONT_AND_BACK, GL.GL_SPECULAR, ADR (rgba)); GL.glMaterialf (GL.GL_FRONT_AND_BACK, GL.GL_SHININESS, self.specularReflConc); END SetSurfaceMaterial; PROCEDUREUnsetSurfaceMaterial (self: T) = BEGIN IF self.transmission < 1.0 THEN GL.glDepthMask (GL.GL_TRUE); GL.glDisable (GL.GL_BLEND); END; END UnsetSurfaceMaterial; CONST NoList = 0; TYPE StructureList = REF RECORD prec : INTEGER; fillId : GL.GLuint := NoList; lineId : GL.GLuint := NoList; next : StructureList; END; PROCEDUREDrawProtoSphere (self: T; prec: INTEGER) = TYPE Kind = {Line, Fill}; PROCEDURE Draw (kind: Kind) = VAR list : StructureList := self.sphereStructures; prev : StructureList := NIL; BEGIN (* Iterate over "list" until we find a cell with the right precision, or fall off the back of the list. *) WHILE list # NIL AND list.prec # prec DO prev := list; list := list.next; END; (* At this point, "list" is either NIL, or points to a cell with the right precision. *) (* Move the cell to the front of "self.sphereStructures". *) IF list = NIL THEN (* Not found in "self.sphereStructures" (which might be NIL). Create a new cell, and insert it at the head of the list. *) list := NEW (StructureList, prec := prec); list.next := self.sphereStructures; self.sphereStructures := list; ELSIF prev # NIL THEN (* Found in "self.sphereStructures" (not at head). Move cell to head. *) prev.next := list.next; list.next := self.sphereStructures; self.sphereStructures := list; END; (* At this point, "list" is non-NIL, and point to a cell "c" such that "c.prec = prec". "c.fillId" and "c.lineId" contain either "NoList" or a valid display list. *) (* If we have the right display lists cached, call them and return. *) CASE kind OF | Kind.Fill => IF list.fillId # NoList THEN GL.glCallList (list.fillId); RETURN; END; | Kind.Line => IF list.lineId # NoList THEN GL.glCallList (list.lineId); RETURN; END; END; (* Did not find a matching sphere in the cache -- need to create one *) WITH dlid = GL.glGenLists (1) DO IF dlid # NoList THEN GL.glNewList (dlid, GL.GL_COMPILE_AND_EXECUTE); END; WITH quad = GLu.gluNewQuadric () DO <* ASSERT quad # NIL *> CASE kind OF | Kind.Fill => GLu.gluQuadricDrawStyle (quad, GLu.GLU_FILL); GLu.gluSphere (quad, 1.0d0, prec, prec); list.fillId := dlid; | Kind.Line => GLu.gluQuadricDrawStyle (quad, GLu.GLU_LINE); GLu.gluSphere (quad, 1.005d0, prec, prec); (* 0.5 % larger *) list.lineId := dlid; END; END; IF dlid # NoList THEN GL.glEndList (); END; END; END Draw; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => Draw (Kind.Fill); | RasterModeProp.Kind.Hollow => Draw (Kind.Line); | RasterModeProp.Kind.Empty => (*** no-op ***) END; UnsetSurfaceMaterial (self); IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); Draw (Kind.Line); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END; END DrawProtoSphere; PROCEDUREDrawProtoCone (self: T; prec: INTEGER) = TYPE Kind = {Line, Fill}; PROCEDURE Draw (kind: Kind) = VAR list : StructureList := self.coneStructures; prev : StructureList := NIL; BEGIN (* Iterate over "list" until we find a cell with the right precision, or fall off the back of the list. *) WHILE list # NIL AND list.prec # prec DO prev := list; list := list.next; END; (* At this point, "list" is either NIL, or points to a cell with the right precision. *) (* Move the cell to the front of "self.coneStructures". *) IF list = NIL THEN (* Not found in "self.coneStructures" (which might be NIL). Create a new cell, and insert it at the head of the list. *) list := NEW (StructureList, prec := prec); list.next := self.coneStructures; self.coneStructures := list; ELSIF prev # NIL THEN (* Found in "self.coneStructures" (not at head). Move cell to head. *) prev.next := list.next; list.next := self.coneStructures; self.coneStructures := list; END; (* At this point, "list" is non-NIL, and point to a cell "c" such that "c.prec = prec". "c.fillId" and "c.lineId" contain either "NoList" or a valid display list. *) (* If we have the right display lists cached, call them and return. *) CASE kind OF | Kind.Fill => IF list.fillId # NoList THEN GL.glCallList (list.fillId); RETURN; END; | Kind.Line => IF list.lineId # NoList THEN GL.glCallList (list.lineId); RETURN; END; END; (* Did not find a matching cone in the cache -- need to create one *) WITH dlid = GL.glGenLists (1) DO IF dlid # NoList THEN GL.glNewList (dlid, GL.GL_COMPILE_AND_EXECUTE); END; WITH quad = GLu.gluNewQuadric () DO <* ASSERT quad # NIL *> CASE kind OF | Kind.Fill => GLu.gluQuadricDrawStyle (quad, GLu.GLU_FILL); GLu.gluCylinder (quad, 1.0d0, 0.0d0, 1.0d0, prec, prec); list.fillId := dlid; | Kind.Line => GLu.gluQuadricDrawStyle (quad, GLu.GLU_LINE); GLu.gluCylinder (quad, 1.005d0, 0.0d0, 1.005d0, prec, prec); list.lineId := dlid; END; END; IF dlid # NoList THEN GL.glEndList (); END; END; END Draw; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => Draw (Kind.Fill); | RasterModeProp.Kind.Hollow => Draw (Kind.Line); | RasterModeProp.Kind.Empty => (*** no-op ***) END; UnsetSurfaceMaterial (self); IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); Draw (Kind.Line); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END; END DrawProtoCone; PROCEDUREDrawProtoCylinder (self: T; prec: INTEGER) = TYPE Kind = {Line, Fill}; PROCEDURE Draw (kind: Kind) = VAR list : StructureList := self.cylinderStructures; prev : StructureList := NIL; BEGIN (* Iterate over "list" until we find a cell with the right precision, or fall off the back of the list. *) WHILE list # NIL AND list.prec # prec DO prev := list; list := list.next; END; (* At this point, "list" is either NIL, or points to a cell with the right precision. *) (* Move the cell to the front of "self.cylinderStructures". *) IF list = NIL THEN (* Not found in "self.cylinderStructures" (which might be NIL). Create a new cell, and insert it at the head of the list. *) list := NEW (StructureList, prec := prec); list.next := self.cylinderStructures; self.cylinderStructures := list; ELSIF prev # NIL THEN (* Found in "self.cylinderStructures" (not at head). Move cell to head. *) prev.next := list.next; list.next := self.cylinderStructures; self.cylinderStructures := list; END; (* At this point, "list" is non-NIL, and point to a cell "c" such that "c.prec = prec". "c.fillId" and "c.lineId" contain either "NoList" or a valid display list. *) (* If we have the right display lists cached, call them and return. *) CASE kind OF | Kind.Fill => IF list.fillId # NoList THEN GL.glCallList (list.fillId); RETURN; END; | Kind.Line => IF list.lineId # NoList THEN GL.glCallList (list.lineId); RETURN; END; END; (* Did not find a matching cylinder in the cache -- need to create one *) WITH dlid = GL.glGenLists (1) DO IF dlid # NoList THEN GL.glNewList (dlid, GL.GL_COMPILE_AND_EXECUTE); END; WITH quad = GLu.gluNewQuadric () DO <* ASSERT quad # NIL *> CASE kind OF | Kind.Fill => GLu.gluQuadricDrawStyle (quad, GLu.GLU_FILL); GLu.gluCylinder (quad, 1.0d0, 1.0d0, 1.0d0, prec, prec); list.fillId := dlid; | Kind.Line => GLu.gluQuadricDrawStyle (quad, GLu.GLU_LINE); GLu.gluCylinder (quad, 1.005d0, 1.005d0, 1.0d0, prec, prec); list.lineId := dlid; END; END; IF dlid # NoList THEN GL.glEndList (); END; END; END Draw; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => Draw (Kind.Fill); | RasterModeProp.Kind.Hollow => Draw (Kind.Line); | RasterModeProp.Kind.Empty => (*** no-op ***) END; UnsetSurfaceMaterial (self); IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); Draw (Kind.Line); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END; END DrawProtoCylinder; PROCEDUREDrawProtoDisk (self: T; prec: INTEGER) = TYPE Kind = {Line, Fill}; PROCEDURE Draw (kind: Kind) = VAR list : StructureList := self.diskStructures; prev : StructureList := NIL; BEGIN (* Iterate over "list" until we find a cell with the right precision, or fall off the back of the list. *) WHILE list # NIL AND list.prec # prec DO prev := list; list := list.next; END; (* At this point, "list" is either NIL, or points to a cell with the right precision. *) (* Move the cell to the front of "self.diskStructures". *) IF list = NIL THEN (* Not found in "self.diskStructures" (which might be NIL). Create a new cell, and insert it at the head of the list. *) list := NEW (StructureList, prec := prec); list.next := self.diskStructures; self.diskStructures := list; ELSIF prev # NIL THEN (* Found in "self.diskStructures" (not at head). Move cell to head. *) prev.next := list.next; list.next := self.diskStructures; self.diskStructures := list; END; (* At this point, "list" is non-NIL, and point to a cell "c" such that "c.prec = prec". "c.fillId" and "c.lineId" contain either "NoList" or a valid display list. *) (* If we have the right display lists cached, call them and return. *) CASE kind OF | Kind.Fill => IF list.fillId # NoList THEN GL.glCallList (list.fillId); RETURN; END; | Kind.Line => IF list.lineId # NoList THEN GL.glCallList (list.lineId); RETURN; END; END; (* Did not find a matching disk in the cache -- need to create one *) WITH dlid = GL.glGenLists (1) DO IF dlid # NoList THEN GL.glNewList (dlid, GL.GL_COMPILE_AND_EXECUTE); END; WITH quad = GLu.gluNewQuadric () DO <* ASSERT quad # NIL *> CASE kind OF | Kind.Fill => GLu.gluQuadricDrawStyle (quad, GLu.GLU_FILL); GLu.gluDisk (quad, 0.0d0, 1.0d0, prec, prec); list.fillId := dlid; | Kind.Line => GLu.gluQuadricDrawStyle (quad, GLu.GLU_LINE); GLu.gluDisk (quad, 0.0d0, 1.0d0, prec, prec); (* lies in same plane ==> surface edges have slight artifacts *) list.lineId := dlid; END; END; IF dlid # NoList THEN GL.glEndList (); END; END; END Draw; BEGIN IF self.phase = 2 THEN IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); (* Set up edge color, width, and type ("stipple" in OpenGL) *) GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); (*** Clear the stencil buffer ***) GL.glClearStencil (0); GL.glClear (GL.GL_STENCIL_BUFFER_BIT); (* First, set all entries in the stencil buffer to 0. Then, set up the stencil test: for each fragment of the surface edges that passes the Z-buffer test, set the stencil buffer entry to 1. *) GL.glStencilFunc (GL.GL_ALWAYS, 1, 1); GL.glStencilOp (GL.GL_KEEP, GL.GL_KEEP, GL.GL_REPLACE); GL.glEnable (GL.GL_STENCIL_TEST); Draw (Kind.Line); (*** Reset GL lighting to its previous state ***) SetLighting (self, self.lighting); (* Set up the stencil test: Draw any future fragment only if the corresponding stencil buffer entry is 0. In other words, mask out the surface edges. *) GL.glStencilFunc (GL.GL_EQUAL, 0, 1); END; SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => Draw (Kind.Fill); | RasterModeProp.Kind.Hollow => Draw (Kind.Line); | RasterModeProp.Kind.Empty => (*** no-op ***) END; UnsetSurfaceMaterial (self); IF self.edgeFlag THEN GL.glDisable (GL.GL_STENCIL_TEST); END; END; END DrawProtoDisk; TYPE VertexData = RECORD pt : Point3.T; norm : Point3.T; END; TorusVertices = REF ARRAY OF ARRAY OF VertexData; PROCEDUREDrawProtoTorus (self : T; prec : INTEGER; radiusRatio : REAL ) = PROCEDURE DrawHollowTorus () = BEGIN WITH verts = ComputeUnitTorus (prec, radiusRatio * 1.005) DO FOR i := 0 TO LAST (verts^) DO GL.glBegin (GL.GL_LINE_STRIP); FOR j := 0 TO LAST(verts[i]) DO GL.glNormal3fv (ADR (verts[i][j].norm)); GL.glVertex3fv (ADR (verts[i][j].pt)); END; GL.glEnd (); END; FOR j := 0 TO LAST(verts[0]) DO GL.glBegin (GL.GL_LINE_STRIP); FOR i := 0 TO LAST (verts^) DO GL.glNormal3fv (ADR (verts[i][j].norm)); GL.glVertex3fv (ADR (verts[i][j].pt)); END; GL.glEnd (); END; END; END DrawHollowTorus; PROCEDURE DrawSolidTorus () = BEGIN WITH verts = ComputeUnitTorus (prec, radiusRatio) DO FOR i := 0 TO LAST (verts^) - 1 DO WITH line1 = verts[i], line2 = verts[i+1] DO GL.glBegin (GL.GL_QUAD_STRIP); FOR j := 0 TO LAST(line1) DO WITH point1 = line1[j], point2 = line2[j] DO GL.glNormal3fv (ADR (point1.norm)); GL.glVertex3fv (ADR (point1.pt)); GL.glNormal3fv (ADR (point2.norm)); GL.glVertex3fv (ADR (point2.pt)); END; END; GL.glEnd (); END; END; END; END DrawSolidTorus; BEGIN IF self.phase = 2 THEN SetSurfaceMaterial (self); CASE self.rasterMode OF | RasterModeProp.Kind.Solid => DrawSolidTorus (); | RasterModeProp.Kind.Hollow => DrawHollowTorus (); | RasterModeProp.Kind.Empty => (*** no-op ***) END; UnsetSurfaceMaterial (self); IF self.edgeFlag THEN (*** SRC 129 says that lines are not affected by lighting ... ***) GL.glDisable (GL.GL_LIGHTING); GL.glColor3fv (ADR (self.edgeColor)); GL.glLineWidth (self.edgeWidth); GL.glLineStipple (ROUND (self.edgeWidth), self.edgeType); DrawHollowTorus (); (*** Reset GL lighting to its previous state *) SetLighting (self, self.lighting); END; END; END DrawProtoTorus; PROCEDUREComputeUnitTorus (prec : INTEGER; radius2 : REAL) : TorusVertices = VAR verts : TorusVertices := NEW (TorusVertices, prec+1, prec+1); BEGIN WITH u = AuxG.GetUnitCirclePoints (prec), (* normal of unit circle is z-axis *) normal = Point3.T {0.0, 0.0, 1.0} DO FOR i := 0 TO prec DO WITH aux = u[i], a2 = Point3.Plus (aux, Point3.ScaleToLen (normal, radius2)), b2 = Point3.Plus (aux, Point3.ScaleToLen (aux, radius2)), c2 = Point3.Plus (aux, Point3.CrossProduct(aux, normal)), N = Matrix4.TransformUnitCube (aux, a2, b2, c2) DO FOR j := 0 TO prec DO WITH p = Matrix4.TransformPoint3 (N, u[j]), n = Point3.Minus (aux, p) DO verts[i][j] := VertexData {p, n}; END; END; END; END; END; RETURN verts; END ComputeUnitTorus;
PROCEDURE*************************************************************************** Animation Server ***************************************************************************ProcessEvents (self : T) = PROCEDURE CheckTypedWindowEvent (self : T; type : Ctypes.int; VAR event : X.XEvent) : X.Bool = BEGIN LOCK conn DO RETURN X.XCheckTypedWindowEvent (conn.dpy, self.window, type, ADR (event)); END; END CheckTypedWindowEvent; PROCEDURE CheckWindowEvent (self : T; mask : Ctypes.long; VAR event : X.XEvent) : X.Bool = BEGIN LOCK conn DO RETURN X.XCheckWindowEvent (conn.dpy, self.window, mask, ADR (event)); END; END CheckWindowEvent; VAR ev : X.XEvent; button : VBT.Button; clickType : VBT.ClickType; mask : Ctypes.long; BEGIN (*** Set up the mask for events we are interested in. ***) mask := 0; mask := Word.Or (mask, X.ExposureMask); (* for X.Expose *) mask := Word.Or (mask, X.PointerMotionMask); (* for X.MotionNotify *) mask := Word.Or (mask, X.ButtonPressMask); (* for X.ButtonPress *) mask := Word.Or (mask, X.ButtonReleaseMask); (* for X.ButtonRelease *) mask := Word.Or (mask, X.KeyPressMask); (* for X.KeyPress *) mask := Word.Or (mask, X.KeyReleaseMask); (* for X.KeyRelease *) mask := Word.Or (mask, X.StructureNotifyMask); (* for X.ConfigureNotify *) (* * For some reason, ClientMessage events are not picked up by * X.XCheckWindowEvent, so I take care of them here. *) IF CheckTypedWindowEvent (self, X.ClientMessage, ev) = X.True THEN WITH e = ClientMessageEvent(ev) DO IF e.message_type = conn.wm_protocols AND e.format = 32 THEN IF e.data[0] = conn.wm_delete_window THEN self.destroy (); RETURN; END; END; END; END; (* * If there is no ClientMessage event indicating a "delete window" * request by the window manager, I look for other events pending: *) WHILE CheckWindowEvent (self, mask, ev) = X.True DO CASE ButtonEvent(ev).type OF | X.Expose => (*** damage the root object to force a redraw ***) IF self.root # NIL THEN self.root.damaged := TRUE; END; | X.ConfigureNotify => WITH w = LOOPHOLE (ADR (ev), X.XConfigureEventStar).width, h = LOOPHOLE (ADR (ev), X.XConfigureEventStar).height DO self.winWidth := w; self.winHeight := h; GL.glViewport (0, 0, w, h); (* adjust the viewport *) END; | X.MotionNotify => (*** If several motions in queue, jump to last ***) WHILE CheckWindowEvent(self, X.PointerMotionMask, ev) # X.False DO END; WITH mev = MotionEvent (ev), posrec = PositionCB.Rec {pos2D := Point.T {mev.x, mev.y}, modifiers := self.modifiers} DO self.root.invokePositionCB (posrec); END; | X.ButtonPress => WITH bev = ButtonEvent(ev) DO CASE bev.button OF | X.Button1 => button := VBT.Modifier.MouseL; | X.Button2 => button := VBT.Modifier.MouseM; | X.Button3 => button := VBT.Modifier.MouseR; ELSE Process.Crash ("G.WaitForEvent: Unknown button event"); END; IF self.buttonDownCount = 0 THEN clickType := VBT.ClickType.FirstDown; ELSE clickType := VBT.ClickType.OtherDown; END; INC (self.buttonDownCount); WITH mouserec = MouseCB.Rec {pos2D := Point.T {bev.x, bev.y}, whatChanged := button, modifiers := self.modifiers, clickType := clickType} DO self.root.invokeMouseCB (mouserec); self.modifiers := self.modifiers + VBT.Modifiers {button}; END; END; | X.ButtonRelease => WITH bev = ButtonEvent(ev) DO CASE bev.button OF | X.Button1 => button := VBT.Modifier.MouseL; | X.Button2 => button := VBT.Modifier.MouseM; | X.Button3 => button := VBT.Modifier.MouseR; ELSE Process.Crash ("G.WaitForEvent: Unknown button event"); END; DEC (self.buttonDownCount); IF self.buttonDownCount = 0 THEN clickType := VBT.ClickType.LastUp; ELSE clickType := VBT.ClickType.OtherUp; END; WITH mouserec = MouseCB.Rec {pos2D := Point.T {bev.x, bev.y}, whatChanged := button, modifiers := self.modifiers, clickType := clickType} DO self.root.invokeMouseCB (mouserec); self.modifiers := self.modifiers - VBT.Modifiers {button}; END; END; | X.KeyPress => WITH keysym = GetKeySym (ev), keyrec = KeyCB.Rec { whatChanged := keysym, wentDown := TRUE, modifiers := self.modifiers} DO self.root.invokeKeyCB (keyrec); self.modifiers := self.modifiers + KeySymToModifierSet (keysym); END; | X.KeyRelease => WITH keysym = GetKeySym (ev), keyrec = KeyCB.Rec { whatChanged := keysym, wentDown := FALSE, modifiers := self.modifiers} DO self.root.invokeKeyCB (keyrec); self.modifiers := self.modifiers - KeySymToModifierSet (keysym); END; ELSE (* some other X event *) END; END; END ProcessEvents; PROCEDUREKeySymToModifierSet (keysym : VBT.KeySym) : VBT.Modifiers = BEGIN CASE keysym OF | KeyboardKey.Shift_L, KeyboardKey.Shift_R => RETURN VBT.Modifiers {VBT.Modifier.Shift}; | KeyboardKey.Shift_Lock => RETURN VBT.Modifiers {VBT.Modifier.Lock}; | KeyboardKey.Control_L, KeyboardKey.Control_R => RETURN VBT.Modifiers {VBT.Modifier.Control}; | KeyboardKey.Meta_L, KeyboardKey.Meta_R => RETURN VBT.Modifiers {VBT.Modifier.Option}; ELSE RETURN VBT.Modifiers {}; END; END KeySymToModifierSet; <* INLINE *> PROCEDUREGetKeySym (VAR ev : X.XEvent) : VBT.KeySym = BEGIN RETURN X.XLookupKeysym (LOOPHOLE (ADR (ev), X.XKeyEventStar), 0); END GetKeySym; <* INLINE *> PROCEDUREMotionEvent (VAR ev : X.XEvent) : X.XMotionEventStar = BEGIN RETURN LOOPHOLE (ADR (ev), X.XMotionEventStar); END MotionEvent; <* INLINE *> PROCEDUREButtonEvent (VAR ev : X.XEvent) : X.XButtonEventStar = BEGIN RETURN LOOPHOLE (ADR (ev), X.XButtonEventStar); END ButtonEvent; <* INLINE *> PROCEDUREClientMessageEvent (VAR ev : X.XEvent) : X.XClientMessageEvent_l_star = BEGIN RETURN LOOPHOLE (ADR (ev), X.XClientMessageEvent_l_star); END ClientMessageEvent;
PROCEDURE*************************************************************************** Connection Management ***************************************************************************Setup (self: T) = BEGIN <* ASSERT AnimServer.IsServer() *> WITH status = GLX.glXMakeCurrent (conn.dpy, self.window, self.context) DO <* ASSERT status = X.True *> END; (*** Clear the color and the depth buffer ***) GL.glClear (Word.Or (GL.GL_COLOR_BUFFER_BIT, GL.GL_DEPTH_BUFFER_BIT)); END Setup; PROCEDURERepair (self : T; VAR damaged : BOOLEAN) = BEGIN (*** Redraw the scene only if there is one and it was damaged ***) IF self.root # NIL AND self.root.damaged THEN damaged := TRUE; LOCK conn DO (*** determine the object's current transparency ***) self.transflag := self.root.needsTransparency(0.0); (* 0.0 is the default transmission coeff *) (*** set up the rendering pipeline for a new round ***) Setup (self); (*** reset the bounding volume and the light state ***) self.resetBoundingVolume(); (*** switch off all GL lights ***) FOR i := 0 TO GL.GL_MAX_LIGHTS - 1 DO GL.glDisable (GL.GL_LIGHT0 + i); END; (*** reset "self.lightCount" and "self.ambientLight" ***) self.lightCount := 0; self.ambientLight := GLrgba {0.0, 0.0, 0.0, 1.0}; (*** Put all light sources into a display list. As a side effect, determine the relevant parameters of the current camera. ***) GL.glNewList (self.lightList, GL.GL_COMPILE); self.phase := 1; self.root.draw (self); GL.glEndList (); (*** Now set up the camera ***) SetupCamera (self); (*** Switch on the light sources by executing the display list ***) GL.glLightModelfv (GL.GL_LIGHT_MODEL_AMBIENT, ADR (self.ambientLight)); GL.glCallList (self.lightList); (*** Then draw everything else ***) self.phase := 2; self.root.draw (self); (*** Finally, swap the buffers to update the display ***) GLX.glXSwapBuffers (conn.dpy, self.window); X.XSync (conn.dpy, X.False); END; END; END Repair;
TYPE
Connection = MUTEX OBJECT (* mutex synchronizes access to dpy *)
dpy : X.DisplayStar;
avail : BOOLEAN;
wm_protocols : X.Atom;
wm_delete_window : X.Atom;
METHODS
init (): Connection := InitConnection;
END;
VAR conn: Connection := NIL;
PROCEDURE InitConnection (self : Connection) : Connection =
VAR
errBase : Ctypes.int;
evtBase : Ctypes.int;
cstr1 : Ctypes.char_star;
cstr2 : Ctypes.char_star;
BEGIN
(*** open the display ***)
self.dpy := X.XOpenDisplay (NIL);
IF self.dpy = NIL THEN
Process.Crash ("Could not open display");
END;
(*** "internalize" some X atoms ***)
cstr1 := M3toC.CopyTtoS ("WM_PROTOCOLS");
cstr2 := M3toC.CopyTtoS ("WM_DELETE_WINDOW");
self.wm_protocols :=
X.XInternAtom(self.dpy, cstr1, X.False);
self.wm_delete_window :=
X.XInternAtom(self.dpy, cstr2, X.False);
M3toC.FreeCopiedS(cstr1);
M3toC.FreeCopiedS(cstr2);
(* Check whether the GL extension is available on the server *)
WITH res = GLX.glXQueryExtension (self.dpy, ADR(errBase), ADR(evtBase)) DO
self.avail := res = X.True;
END;
RETURN self;
END InitConnection;
BEGIN
END X_OpenGL_Base.