 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
steff
Anmeldungsdatum: 24.03.2007
Beiträge: 11
|
 Verfasst am: 05.04.2007, 20:58 Titel: GLU-primitives |
 |
|
Grüße!
Ein simples Programm zur Demostration von diversen glu-primitives Variationen.
Mehr als Ergänzung zu Stormys OpenGL tutorial " Anfängertutorial: 2D-Anwendungen mit OpenGL und FreeBASIC" gedacht.
Es basiert auf Relsofts "glu_quadrics.bas" , ist aber stark vereinfacht (kein sdl,kein lighting,kein texturing etc)
LMB:
Schaltet durch insgesamt 20 Formen (jeweils 5 pro primitive :gluSphere, gluDisk, gluCylinder, gluPartialDisk)
RMB:
Ändert drawmode (GLU_SILHOUETTE,GLU_FILL,GLU_LINE,GLU_POINT)
| Code: |
'glu_primitives
'by stef
'LMB:change primitive
'RMB:change drawmode
const SCREENW = 800
const SCREENH = 600
screenres SCREENW,SCREENH,32 , 1 ,2 or 1
option explicit
'$include: "GL/gl.bi"
'$include: "GL/glu.bi"
declare sub drawscene()
declare sub getinput()
dim shared drawmode as integer
dim shared mode as integer
dim shared shape as integer=0
dim shared mousestatus as integer
dim shared buttons as integer
glViewport 0, 0, SCREENW, SCREENH
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 20, SCREENW / SCREENH, 1, 100
dim shared qobj_sphere as GLUquadricObj ptr
dim shared qobj_Cylinder as GLUquadricObj ptr
dim shared qobj_Disk as GLUquadricObj ptr
dim shared qobj_Pdisk as GLUquadricObj ptr
qobj_sphere = gluNewQuadric
qobj_Cylinder = gluNewQuadric
qobj_Disk = gluNewQuadric
qobj_Pdisk = gluNewQuadric
do
getinput()
drawscene()
flip
loop until multikey(1)
gluDeleteQuadric qObj_sphere
gluDeleteQuadric qObj_cylinder
gluDeleteQuadric qObj_disk
gluDeleteQuadric qObj_pdisk
end
private sub DrawScene
static angle as single
gluQuadricDrawStyle qobj_sphere, drawmode
gluQuadricDrawStyle qobj_Cylinder, drawmode
gluQuadricDrawStyle qobj_Disk, drawmode
gluQuadricDrawStyle qobj_Pdisk, drawmode
glClear GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT
glPushMatrix
glTranslatef 0.0, 0.0, -1.0
glPushMatrix
glRotatef angle, 1.0, 0.0, 0.0
glRotatef angle, 0.0, 1.0, 0.0
glRotatef angle, 0.0, 0.0, 1.0
select case shape
case 0
gluSphere qobj_sphere, 1.0, 20, 20 ' sphere
case 1
gluSphere qobj_sphere, 1.0, 3, 20
case 2
gluSphere qobj_sphere, 1.0, 4, 6
case 3
gluSphere qobj_sphere, 1.0, 3, 2
case 4
gluSphere qobj_sphere, 1.0, 6, 3
case 5
gluDisk qobj_Disk,0.0, 1.0, 3, 1'triangle
case 6
gluDisk qobj_Disk,0.9, 1.0, 4, 1'square
case 7
gluDisk qobj_Disk,0.6, 0.8, 30, 1'ring
case 8
gluDisk qobj_Disk,0.6, 1.0, 5, 1'pentagon
case 9
gluDisk qobj_Disk,0.4, 1.0, 8, 1'octagon
case 10
gluCylinder qobj_Cylinder, 0.4, 0.4, 1.0, 20, 20
case 11
gluCylinder qobj_Cylinder, 0.4, 0.4, 1.0, 4, 20
case 12
gluCylinder qobj_Cylinder, 0.4, 0.0, 1.0, 20, 20'cone
case 13
gluCylinder qobj_Cylinder, 0.4, 0.0, 1.0, 4, 20'pyramid
case 14
gluCylinder qobj_Cylinder, 0.8, 0.4, 1.0, 6, 6
case 15
gluPartialDisk qobj_Pdisk,0.0, 1.0, 30, 1, -45, 270'pacman
case 16
gluPartialDisk qobj_Pdisk,0.0, 1.0, 2, 1, 0, 240'arrow
case 17
gluPartialDisk qobj_Pdisk,0.6, 1.0, 3, 1,0,270
case 18
gluPartialDisk qobj_Pdisk,0.8, 1.0, 7, 1,0,300
case 19
gluPartialDisk qobj_Pdisk,0.6, 1.0, 2, 1,0, 240
end select
glPopMatrix
glFlush
angle = angle + 0.1
end sub
sub getinput()
dim x,y as integer
GETMOUSE x,y, , buttons
locate 1,1
if buttons=0 then
mousestatus=0
endif
if mousestatus=0 then
IF Bit(buttons, 0) THEN
mousestatus=1
shape = shape+1
if shape>19 then shape=0
endif
IF Bit(buttons, 1) THEN
mousestatus=1
mode +=1
if mode> 3 then mode=0
endif
endif
select case mode
case 0
drawmode= GLU_SILHOUETTE
case 1
drawmode= GLU_FILL
case 2
drawmode= GLU_LINE
case 3
drawmode= GLU_POINT
end select
end sub
|
|
|
| Nach oben |
|
 |
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 19.05.2007, 12:38 Titel: |
|
|
Hi,
ein wirklich gelungenes Beispiel.
Ich habe kleine Änderungen eingebracht, um das Beispiel auch auf FB017b lauffähig zu machen.
| Code: | 'glu_primitives
'by stef
'LeftMouseBotton: change primitive
'RightMouseBotton: change drawmode
Const SCREENW = 800
Const SCREENH = 600
Screenres SCREENW, SCREENH, 32, 1 ,2
#include "GL/gl.bi"
#include "GL/glu.bi"
Declare Sub drawscene()
Declare Sub getinput()
Dim Shared As Integer drawmode, mode, shape=0, mousestatus, buttons
glViewport 0, 0, SCREENW, SCREENH
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 20, SCREENW / SCREENH, 1, 100
Dim Shared As GLUquadricObj Ptr qobj_sphere, qobj_Cylinder, qobj_Disk, qobj_Pdisk
qobj_sphere = gluNewQuadric
qobj_Cylinder = gluNewQuadric
qobj_Disk = gluNewQuadric
qobj_Pdisk = gluNewQuadric
Do
getinput()
drawscene()
Flip
Loop Until Multikey(1)
gluDeleteQuadric qObj_sphere
gluDeleteQuadric qObj_cylinder
gluDeleteQuadric qObj_disk
gluDeleteQuadric qObj_pdisk
End
Private Sub DrawScene
Static angle As Single
gluQuadricDrawStyle qobj_sphere, drawmode
gluQuadricDrawStyle qobj_Cylinder, drawmode
gluQuadricDrawStyle qobj_Disk, drawmode
gluQuadricDrawStyle qobj_Pdisk, drawmode
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glPushMatrix
glTranslatef 0.0, 0.0, -1.0
glPushMatrix
glRotatef angle, 1.0, 0.0, 0.0
glRotatef angle, 0.0, 1.0, 0.0
glRotatef angle, 0.0, 0.0, 1.0
Select Case shape
Case 0
gluSphere qobj_sphere, 1.0, 20, 20 ' sphere
Case 1
gluSphere qobj_sphere, 1.0, 3, 20
Case 2
gluSphere qobj_sphere, 1.0, 4, 6
Case 3
gluSphere qobj_sphere, 1.0, 3, 2
Case 4
gluSphere qobj_sphere, 1.0, 6, 3
Case 5
gluDisk qobj_Disk,0.0, 1.0, 3, 1'triangle
Case 6
gluDisk qobj_Disk,0.9, 1.0, 4, 1'square
Case 7
gluDisk qobj_Disk,0.6, 0.8, 30, 1'ring
Case 8
gluDisk qobj_Disk,0.6, 1.0, 5, 1'pentagon
Case 9
gluDisk qobj_Disk,0.4, 1.0, 8, 1'octagon
Case 10
gluCylinder qobj_Cylinder, 0.4, 0.4, 1.0, 20, 20
Case 11
gluCylinder qobj_Cylinder, 0.4, 0.4, 1.0, 4, 20
Case 12
gluCylinder qobj_Cylinder, 0.4, 0.0, 1.0, 20, 20'cone
Case 13
gluCylinder qobj_Cylinder, 0.4, 0.0, 1.0, 4, 20'pyramid
Case 14
gluCylinder qobj_Cylinder, 0.8, 0.4, 1.0, 6, 6
Case 15
gluPartialDisk qobj_Pdisk,0.0, 1.0, 30, 1, -45, 270'pacman
Case 16
gluPartialDisk qobj_Pdisk,0.0, 1.0, 2, 1, 0, 240'arrow
Case 17
gluPartialDisk qobj_Pdisk,0.6, 1.0, 3, 1,0,270
Case 18
gluPartialDisk qobj_Pdisk,0.8, 1.0, 7, 1,0,300
Case 19
gluPartialDisk qobj_Pdisk,0.6, 1.0, 2, 1,0, 240
End Select
glPopMatrix
glFlush
angle = angle + 0.1
End Sub
Sub getinput()
Dim As Integer x,y
Getmouse x,y, , buttons
Locate 1,1
If buttons=0 Then mousestatus=0
If mousestatus=0 Then
If buttons=1 Then
mousestatus=1
shape = shape+1
If shape>19 Then shape=0
End If
If buttons=2 Then
mousestatus=1
mode +=1
If mode> 3 Then mode=0
End If
End If
Select Case mode
Case 0
drawmode= GLU_SILHOUETTE
Case 1
drawmode= GLU_FILL
Case 2
drawmode= GLU_LINE
Case 3
drawmode= GLU_POINT
End Select
End Sub |
Viel Spass damit!
Volta
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
ytwinky
Anmeldungsdatum: 28.05.2005
Beiträge: 2624
Wohnort: Machteburch
|
| Verfasst am: 19.05.2007, 18:51 Titel: |
|
|
Hi,
das is ja doll, beide Programme, wobei mir die Version von Volta ein wenig besser gefällt 
Es ging mir nicht darum, auf Teufel komm' raus(*grußanlutz_ifer*)hier IIF() 'reinzubasteln(das ist mein persönliches Spielzeug  )..
Nee, ich habe gesehen, daß Mode nur im Bereich 0..3 sein kann und da bietet sich eine andere Lösung an,
als die aufwendige Select..End Select Konstruktion: | Code: | Sub GetInput()
Static As Integer x, y, Which(3)={GLU_SILHOUETTE, GLU_FILL, GLU_LINE, GLU_POINT}
Getmouse x, y,, Buttons
Locate 1, 1
If Buttons=0 Then Mousestatus=0
If Mousestatus=0 Then
Select Case Buttons
Case 1
Mousestatus=1
Shape=IIf((Shape+1)>19, 0, Shape+1)
Case 2
Mousestatus=1
Mode=IIf((Mode+1)>3, 0 , Mode+1)
End Select
End If
DrawMode=Which(Mode)
End Sub |
..getestet under FB0.16b, sollte aber auch unter FB0.17f laufen
Wie ich immer sage: Komplizierte Berechnungen in Schleifen weitgehend vermeiden..
Gruß
ytwinky
_________________
| v1ctor hat Folgendes geschrieben: | | Yeah, i like INPUT$(n) as much as PRINT USING.. |
..also ungefähr so, wie ich GOTO.. |
|
| Nach oben |
|
|
robbifan
Anmeldungsdatum: 18.05.2007
Beiträge: 43
|
| Verfasst am: 21.05.2007, 18:05 Titel: |
|
|
geile sache , es geeeeeht los. weiter so. opengl.
mfg |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
