-- 3-D gear wheels. -- ----------------------------------------------------- -- A more simple version of this program was originaly -- created in C by Brian Paul. -- ----------------------------------------------------- -- Conversion to Ada + SDL, and extensions, written by: -- Antonio F. Vargas - Ponta Delgada - Azores - Portugal -- avargas@adapower.net -- www.adapower.net/~avargas -- ----------------------------------------------------- -- This program is in the public domain -- ----------------------------------------------------- -- Command line options: -- -info Print GL implementation information -- (this is the original option). -- -slow To slow down velocity under acelerated -- hardware. -- -window GUI window. Fullscreen is the default. -- -nosound To play without sound. -- -800x600 To create a video display of 800 by 600 -- the default mode is 640x480 -- -1024x768 To create a video display of 1024 by 768 -- ----------------------------------------------------- with Interfaces.C; with Ada.Numerics.Generic_Elementary_Functions; with Ada.Command_Line; with Ada.Text_IO; use Ada.Text_IO; with GNAT.OS_Lib; with SDL.Video; with SDL.Timer; with SDL.Error; with SDL.Events; with SDL.Keyboard; with SDL.Keysym; with SDL.Types; use SDL.Types; with SDL_Mixer; with SDL.Audio; with gl_h; use gl_h; with AdaGL; use AdaGL; procedure gears is package CL renames Ada.Command_Line; package C renames Interfaces.C; use type C.unsigned; use type C.int; use type SDL.Init_Flags; package Vd renames SDL.Video; use type Vd.Surface_ptr; use type Vd.Surface_Flags; package Tm renames SDL.Timer; package Er renames SDL.Error; package Ev renames SDL.Events; package Kb renames SDL.Keyboard; package Ks renames SDL.Keysym; package Au renames SDL.Audio; use type Ks.SDLMod; package Mix renames SDL_Mixer; use type Mix.Chunk_ptr; T0 : GLint := 0; Frames : GLint := 0; -- =================================================================== -- Draw a gear wheel. You'll probably want to call this function when -- building a display list since we do a lot of trig here. -- Input: inner_radius - radius of hole at center -- outer_radius - radius at center of teeth -- width - width of gear -- teeth - number of teeth -- tooth_depth - depth of tooth -- =================================================================== procedure gear ( inner_radius : GLfloat; outer_radius : GLfloat; width : GLfloat; teeth : GLint; tooth_depth : GLfloat) is r0, r1, r2 : GLfloat; angle, da : GLfloat; u, v, len : GLfloat; Pi : constant := Ada.Numerics.Pi; package GLfloat_Math is new Ada.Numerics.Generic_Elementary_Functions (GLfloat); use GLfloat_Math; begin r0 := inner_radius; r1 := outer_radius - tooth_depth / 2.0; r2 := outer_radius + tooth_depth / 2.0; da := 2.0 * Pi / GLfloat (teeth) / 4.0; glShadeModel (GL_FLAT); glNormal3f (0.0, 0.0, 1.0); -- Draw front face glBegin (GL_QUAD_STRIP); for i in GLint range 0 .. teeth loop angle := GLfloat (i) * 2.2 * Pi / GLfloat (teeth); glVertex3f (r0 * Cos (angle), r0 * Sin (angle), width * 0.5); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), width * 0.5); if i < teeth then glVertex3f (r0 * Cos (angle), r0 * Sin (angle), width * 0.5); glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), width * 0.5); end if; end loop; glEnd; -- draw front sides of teeth glBegin (GL_QUADS); da := 2.0 * Pi / GLfloat (teeth) / 4.0; for i in GLint range 0 .. teeth - 1 loop angle := GLfloat (i) * 2.0 * Pi / GLfloat (teeth); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), width * 0.5); glVertex3f (r2 * Cos (angle + da), r2 * Sin (angle + da), width * 0.5); glVertex3f (r2 * Cos (angle + 2.0 * da), r2 * Sin (angle + 2.0 * da), width * 0.5); glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), width * 0.5); end loop; glEnd; glNormal3f (0.0, 0.0, -1.0); -- draw back face glBegin (GL_QUAD_STRIP); for i in GLint range 0 .. teeth loop angle := GLfloat (i) * 2.0 * Pi / GLfloat (teeth); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), -width * 0.5); glVertex3f (r0 * Cos (angle), r0 * Sin (angle), -width * 0.5); if i < teeth then glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), -width * 0.5); glVertex3f (r0 * Cos (angle), r0 * Sin (angle), -width * 0.5); end if; end loop; glEnd; -- draw back sides of teeth glBegin (GL_QUADS); da := 2.0 * Pi / GLfloat (teeth) /4.0; for i in GLint range 0 .. teeth - 1 loop angle := GLfloat (i) * 2.0 * Pi / GLfloat (teeth); glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), -width * 0.5); glVertex3f (r2 * Cos (angle + 2.0 * da), r2 * Sin (angle + 2.0 * da), -width * 0.5); glVertex3f (r2 * Cos (angle + da), r2 * Sin (angle + da), -width * 0.5); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), -width * 0.5); end loop; glEnd; -- draw outward face of teeth glBegin (GL_QUAD_STRIP); for i in GLint range 0 .. teeth - 1 loop angle := GLfloat (i) * 2.0 * Pi / GLfloat (teeth); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), width * 0.5); glVertex3f (r1 * Cos (angle), r1 * Sin (angle), -width * 0.5); u := r2 * Cos (angle + da) - r1 * Cos (angle); v := r2 * Sin (angle + da) - r1 * Sin (angle); len := Sqrt (u**2 + v**2); u := u / len; v := v / len; glNormal3f (v, -u, 0.0); glVertex3f (r2 * Cos (angle + da), r2 * Sin (angle + da), width * 0.5); glVertex3f (r2 * Cos (angle + da), r2 * Sin (angle + da), -width * 0.5); glNormal3f (Cos (angle), Sin (angle), 0.0); glVertex3f (r2 * Cos (angle + 2.0 * da), r2 * Sin (angle + 2.0 * da), width * 0.5); glVertex3f (r2 * Cos (angle + 2.0 * da), r2 * Sin (angle + 2.0 * da), -width * 0.5); u := r1 * Cos (angle + 3.0 * da) - r2 * Cos (angle + 2.0 * da); v := r1 * Sin (angle + 3.0 * da) - r2 * Sin (angle + 2.0 * da); glNormal3f (v, -u, 0.0); glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), width * 0.5); glVertex3f (r1 * Cos (angle + 3.0 * da), r1 * Sin (angle + 3.0 * da), -width * 0.5); glNormal3f (Cos (angle), Sin (angle), 0.0); end loop; glVertex3f (r1 * Cos (0.0), r1 * Sin (0.0), width * 0.5); glVertex3f (r1 * Cos (0.0), r1 * Sin (0.0), -width * 0.5); glEnd; glShadeModel (GL_SMOOTH); -- draw inside radius cylinder glBegin (GL_QUAD_STRIP); for i in GLint range 0 .. teeth loop angle := GLfloat (i) * 2.0 * Pi / GLfloat (teeth); glNormal3f (-Cos (angle), -Sin (angle), 0.0); glVertex3f (r0 * Cos (angle), r0 * Sin (angle), -width * 0.5); glVertex3f (r0 * Cos (angle), r0 * Sin (angle), width * 0.5); end loop; glEnd; end gear; -- =================================================================== view_rotx : GLfloat := 20.0; view_roty : GLfloat := 30.0; view_rotz : GLfloat := 0.0; gear1, gear2, gear3 : GLuint; angle : GLfloat := 0.0; -- =================================================================== procedure draw is begin glClear (GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); glPushMatrix; glRotatef (view_rotx, 1.0, 0.0, 0.0); glRotatef (view_roty, 0.0, 1.0, 0.0); glRotatef (view_rotz, 0.0, 0.0, 1.0); glPushMatrix; glTranslatef (-3.0, -2.0, 0.0); glRotatef (angle, 0.0, 0.0, 1.0); glCallList (gear1); glPopMatrix; glPushMatrix; glTranslatef (3.1, -2.0, 0.0); glRotatef (-2.0 * angle - 9.0, 0.0, 0.0, 1.0); glCallList (gear2); glPopMatrix; glPushMatrix; glTranslatef (-3.1, 4.2, 0.0); glRotatef (-2.0 * angle - 25.0, 0.0, 0.0, 1.0); glCallList (gear3); glPopMatrix; glPopMatrix; Vd.GL_SwapBuffers; Frames := Frames + 1; declare t : GLint := GLint (Tm.GetTicks); begin if t - T0 >= 5000 then declare seconds : GLfloat := GLfloat (t - T0) / 1000.0; fps : GLfloat := GLfloat (Frames) / seconds; package GLfloat_IO is new Ada.Text_IO.Float_IO (GLfloat); use GLfloat_IO; begin Put (GLint'Image (Frames) & " frames in "); Put (seconds, 4, 2, 0); Put (" seconds = "); Put (fps, 4, 2, 0); Put_Line (" FPS"); T0 := t; Frames := 0; end; end if; end; -- declare end draw; -- =================================================================== procedure idle is begin angle := angle + 2.0; end idle; -- =================================================================== -- New window size of exposure procedure reshape (width : C.int; height : C.int) is h : GLdouble := GLdouble (height) / GLdouble (width); begin glViewport (0, 0, GLint (width), GLint (height)); glMatrixMode (GL_PROJECTION); glLoadIdentity; glFrustum (-1.0, 1.0, -h, h, 5.0, 60.0); glMatrixMode (GL_MODELVIEW); glLoadIdentity; glTranslatef (0.0, 0.0, -40.0); end reshape; -- =================================================================== procedure init (info : Boolean) is pos : Four_GLfloat_Vector := (5.0, 5.0, 10.0, 0.0); red : Four_GLfloat_Vector := (0.8, 0.1, 0.0, 1.0); green : Four_GLfloat_Vector := (0.0, 0.8, 0.2, 1.0); blue : Four_GLfloat_Vector := (0.2, 0.2, 1.0, 1.0); begin glLightfv (GL_LIGHT0, GL_POSITION, pos); glEnable (GL_CULL_FACE); glEnable (GL_LIGHTING); glEnable (GL_LIGHT0); glEnable (GL_DEPTH_TEST); -- make the gears gear1 := glGenLists (1); glNewList (gear1, GL_COMPILE); glMaterialfv (GL_FRONT, GL_AMBIENT_AND_DIFFUSE, red); gear (1.0, 4.0, 1.0, 20, 0.7); glEndList; gear2 := glGenLists (1); glNewList (gear2, GL_COMPILE); glMaterialfv (GL_FRONT, GL_AMBIENT_AND_DIFFUSE, green); gear (0.5, 2.0, 2.0, 10, 0.7); glEndList; gear3 := glGenLists (1); glNewList (gear3, GL_COMPILE); glMaterialfv (GL_FRONT, GL_AMBIENT_AND_DIFFUSE, blue); gear (1.3, 2.0, 0.5, 10, 0.7); glEndList; glEnable (GL_NORMALIZE); if info then Put_Line ("GL_RENDER = " & glGetString (GL_RENDER)); Put_Line ("GL_VERSION = " & glGetString (GL_VERSION)); Put_Line ("GL_VENDOR = " & glGetString (GL_VENDOR)); Put_Line ("GL_EXTENSIONS = " & glGetString (GL_EXTENSIONS)); end if; end init; -- =================================================================== procedure Load_Sound (wave : in out Mix.Chunk_ptr; file : String) is begin wave := Mix.Load_WAV (file); if wave = Mix.null_Chunk_ptr then Put_Line ("Couldn't load " & file & ": " & Mix.Get_Error); GNAT.OS_Lib.OS_Exit (2); end if; end Load_Sound; -- =================================================================== procedure Stop_Sound (wave : in out Mix.Chunk_ptr) is begin if wave /= Mix.null_Chunk_ptr then Mix.FreeChunk (wave); wave := Mix.null_Chunk_ptr; end if; end Stop_Sound; -- =================================================================== screen : Vd.Surface_ptr; done : Boolean; keys : Uint8_ptr; Screen_Width : C.int := 640; Screen_Hight : C.int := 480; Slowly : Boolean := False; Info : Boolean := False; Full_Screen : Boolean := True; Sound : Boolean := True; argc : Integer := CL.Argument_Count; Video_Flags : Vd.Surface_Flags := 0; Initialization_Flags : SDL.Init_Flags := 0; -- =================================================================== procedure Manage_Command_Line is begin while argc > 0 loop if CL.Argument (argc) = "-slow" then Slowly := True; argc := argc - 1; elsif CL.Argument (argc) = "-window" then Full_Screen := False; argc := argc - 1; elsif CL.Argument (argc) = "-1024x768" then Screen_Width := 1024; Screen_Hight := 768; argc := argc - 1; elsif CL.Argument (argc) = "-800x600" then Screen_Width := 800; Screen_Hight := 600; argc := argc - 1; elsif CL.Argument (argc) = "-info" then Info := True; argc := argc - 1; elsif CL.Argument (argc) = "-nosound" then Sound := False; argc := argc - 1; else Put_Line ("Usage: " & CL.Command_Name & " " & "[-slow] [-nosound] [-window] [-h] " & "[[-800x600] | [-1024x768]]"); argc := argc - 1; GNAT.OS_Lib.OS_Exit (0); end if; end loop; end Manage_Command_Line; -- =================================================================== Gears_Working_Wave : Mix.Chunk_ptr := Mix.null_Chunk_ptr; System_Rotation_Wave : Mix.Chunk_ptr := Mix.null_Chunk_ptr; -- =================================================================== procedure Initialize_Sound is begin if Sound then if Mix.OpenAudio (22050, Au.AUDIO_S16, 2, 4096) < 0 then Put_Line ("Couldn't open audio " & Mix.Get_Error); GNAT.OS_Lib.OS_Exit (2); end if; Load_Sound (Gears_Working_Wave, "gears_working.wav"); Mix.PlayChannel (0, Gears_Working_Wave, -1); Load_Sound (System_Rotation_Wave, "system_rotation.wav"); end if; -- Sound end Initialize_Sound; -- =================================================================== procedure Main_System_Loop is begin while not done loop declare event : Ev.Event; PollEvent_Result : C.int; begin idle; loop Ev.PollEventVP (PollEvent_Result, event); exit when PollEvent_Result = 0; case event.the_type is when Ev.VIDEORESIZE => screen := Vd.SetVideoMode ( event.resize.w, event.resize.h, 16, Vd.OPENGL or Vd.RESIZABLE); if screen /= null then reshape (screen.w, screen.h); else -- Uh oh, we couldn't set the new video mode?? null; end if; when Ev.QUIT => done := True; when others => null; end case; end loop; keys := Kb.GetKeyState (null); if Kb.Is_Key_Pressed (keys, Ks.K_ESCAPE) then done := True; end if; if Kb.Is_Key_Pressed (keys, Ks.K_UP) then view_rotx := view_rotx + 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); end if; if Kb.Is_Key_Pressed (keys, Ks.K_DOWN) then view_rotx := view_rotx - 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); end if; if Kb.Is_Key_Pressed (keys, Ks.K_LEFT) then view_roty := view_roty + 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); end if; if Kb.Is_Key_Pressed (keys, Ks.K_RIGHT) then view_roty := view_roty - 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); end if; if Kb.Is_Key_Pressed (keys, Ks.K_z) then if (Kb.GetModState and Ks.KMOD_SHIFT) /= 0 then view_rotz := view_rotz - 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); else view_rotz := view_rotz + 5.0; Mix.PlayChannel (-1, System_Rotation_Wave, 0); end if; end if; -- Allow the user what's happening if Slowly then Tm.SDL_Delay (23); end if; draw; end; -- declare end loop; end Main_System_Loop; -- =================================================================== -- Gears Procedure body -- =================================================================== begin Manage_Command_Line; Initialization_Flags := SDL.INIT_VIDEO; if Sound then Initialization_Flags := Initialization_Flags or SDL.INIT_AUDIO; end if; if SDL.Init (Initialization_Flags) < 0 then Put_Line ("Couldn't load SDL: " & Er.Get_Error); GNAT.OS_Lib.OS_Exit (1); end if; Video_Flags := Vd.OPENGL or Vd.RESIZABLE; if Full_Screen then Video_Flags := Video_Flags or Vd.FULLSCREEN; end if; screen := Vd.SetVideoMode (Screen_Width, Screen_Hight, 16, Video_Flags); if screen = null then Put_Line ("Couldn't set " & C.int'Image (Screen_Width) & "x" & C.int'Image (Screen_Hight) & " GL video mode: " & Er.Get_Error); SDL.SDL_Quit; GNAT.OS_Lib.OS_Exit (2); end if; Vd.WM_Set_Caption ("Gears", "gears"); Initialize_Sound; init (Info); reshape (screen.w, screen.h); done := False; Main_System_Loop; if Sound then Stop_Sound (Gears_Working_Wave); Mix.CloseAudio; end if; -- Sound SDL.SDL_Quit; end gears;