Polygones, DPI et echelle

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
SPH
Messages : 4937
Inscription : mer. 09/nov./2005 9:53

Polygones, DPI et echelle

Message par SPH »

Salut a tous,

Je travaille sur les polygones et leur mise à l'echelle quand la résolution et/ou le DPI est différent de mes paramètres.
Pouvez vous executer ce code et me dire si l'encadrement rouge est bien au bord de votre ecran ?
Comme ca :
http://xmas.free.fr/aw.jpg

N'oubliez pas de me copier le contenu de la note PB créée avec ce code.

Grand merci

PS : Enable DPI doit etre activé dans vos options du compilateur

Code : Tout sélectionner

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code : Mise a l'echelle   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PB6.0 - SPH(2022) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;EnableExplicit

;-CONSTANTS
Enumeration
  #MainWindow
  #OpenGLGadget
EndEnumeration

;These two GL constants are used for texture creation. Don't change their values.
#GL_BGR = $80E0
#GL_BGRA = $80E1

If ExamineDesktops()
  ddw=DesktopWidth(0)
  ddh=DesktopHeight(0)
Else
  ddw=1024
  ddh=768
EndIf

;********************* DPI *********************
dpix.f=DesktopResolutionX()
dpiy.f=DesktopResolutionY()

echelle_xf.f=(1920/ddw)*dpix
echelle_yf.f=(1080/ddh)*dpiy

Debug "Send me that :"
Debug Str(ddw)+" / "+Str(ddh)
Debug StrD(echelle_xf,3)+" / "+StrD(echelle_yf,3)
Debug "==="
;**********************************************

;-STRUCTURES
Structure Integer2
  X.i
  Y.i
EndStructure
Global.Integer2 WindowDim
WindowDim\X = ddw
WindowDim\Y = ddh


;-DEFINES
Define.i Event
Define.i WindowFlags = #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget


;-DECLARES
Declare Render()
Declare Render2DQuad(OGLTexture.i, StartX.d, StartY.d, Width.i, Height.i, Z.d)
Declare SetupOpenGL()
Declare SetupGLTexture(ImageHandle.i)


;-MAIN WINDOW
win=OpenWindow(#MainWindow, 0, 0,ddw,ddh, "Picasso_SPH",#PB_Window_Maximize|#PB_Window_BorderLess)
If win=0
  Beep_(500,250) : Delay(150) : Beep_(500,250)
  MessageRequester("Erreur","OpenWindow() impossible")
  End
EndIf

screenGL=OpenGLGadget(#OpenGLGadget,0,0,ddw,ddh)
If screenGL=0
  Beep_(500,250) : Delay(150) : Beep_(500,250)
  MessageRequester("Erreur","OpenGLGadget() impossible")
  End
EndIf


SetupOpenGL()

AddKeyboardShortcut(0,  #PB_Shortcut_Escape, 666) ; quitter

glOrtho_(0,ddw,ddh,0,-1,1)
glMatrixMode_(#GL_MODELVIEW)
glLoadIdentity_()
glClear_(0)

;*********************************************************************************************************************************

;;;;;;;;;;;
timer=ElapsedMilliseconds()

glClearColor_(0,0,0, 1.0)
ShowCursor_(0)
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
Repeat
  
  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
  
  
  ;*****
  Repeat
    Event = WindowEvent()
    
    Select Event
      Case #PB_Event_Gadget
        Select EventGadget()
          Case 1
            Resx = GetGadgetAttribute(1, #PB_OpenGL_MouseX)
            Resy = GetGadgetAttribute(1, #PB_OpenGL_MouseY)
            ;;;;;;;         
            Select EventType()
                ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;             
            EndSelect
        EndSelect
      Case #PB_Event_Menu
        Select EventMenu()
          Case 666
            timer=ElapsedMilliseconds()-timer
            ;MessageRequester("Timer", Str(timer)+" ms - "+Str(scene)+" frames",2)
            ;           Debug scene
            ;           Debug timer
            ShowCursor_(1)
            End
        EndSelect
    EndSelect
    
  Until Event = 0
  
  
  ;##############################################
  ;##############################################
  ;##############################################
  ;##############################################
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Restore sph_data

Read.w sph_nombre_poly
Read.w sph_cmb
; Debug sph_nombre
; Debug sph_cmb
sph_cmb_mem=sph_cmb

Dim sph_xx.w(sph_cmb)
Dim sph_yy.w(sph_cmb)
sph_la=0

Repeat
                      glBegin_(#GL_POLYGON);
                      glBlendFunc_(#GL_SRC_ALPHA,#GL_ONE_MINUS_SRC_ALPHA)
If sph_la<>0
;   Debug "==="
  sph_cmb_mem+sph_cmb
;  Debug sph_cmb_mem
  ReDim sph_xx.w(sph_cmb_mem)
  ReDim sph_yy.w(sph_cmb_mem)
EndIf

sph_xx(la)=sph_nombre
sph_yy(la)=sph_cmb

For i=1 To 4;sph_cmb
Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
; Debug sph_xx(sph_la+i)
; Debug sph_yy(sph_la+i)
Next
glColor4f_(sph_xx(sph_la+1)/255,sph_xx(sph_la+2)/255,sph_xx(sph_la+3)/255,sph_xx(sph_la+4)/255)

For i=5 To sph_cmb-1
Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
                      glVertex2f_(sph_xx(sph_la+i)/echelle_xf,sph_yy(sph_la+i)/echelle_yf);
Next
                      glEnd_()                      ; 

Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
; Debug "=="
sph_cmb=sph_yy(sph_la+i)
; Debug "sph_cmb = "+Str(sph_cmb)
sph_la+i
Until sph_yy(sph_la)=0
;;;;;;;;;;;;;;;
 
  SetGadgetAttribute(#OpenGLGadget, #PB_OpenGL_FlipBuffers, #True)
  
ForEver

End


Procedure Render()
  
  ;Clearing buffers and resetting clear color to remove old graphics from the last frame.
  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
  ;  glClearColor_(0.2, 0.2, 0.2, 1.0)
  glClearColor_(0,0,0,1)
  
  ;## DRAWING TEXTURES/IMAGES
  ;First enable the Texture system.
  glEnable_(#GL_TEXTURE_2D)
  
  ;This procedure will create a quad and apply a texture to it.
  ;The Texture variable contains the texture created earlier using SetupGLTexture().
  Render2DQuad(Texture1, 0, 0, ImageWidth(Image1), ImageHeight(Image1), -2)
  ; Render2DQuad(Texture2, 0, 0, ImageWidth(Image2), ImageHeight(Image2), -1)
  
  ;After all the textures have been displayed disable the texture system.
  ;Otherwise it will conflict with the non texture graphics.
  glDisable_(#GL_TEXTURE_2D)
  
EndProcedure

Procedure Render2DQuad(OGLTexture.i, StartX.d, StartY.d, Width.i, Height.i, Z.d)
  
  ;The texture is first bound which tells OpenGL to use this texture for any future rendering.
  glBindTexture_(#GL_TEXTURE_2D, OGLTexture)
  glBegin_(#GL_QUADS)
  glColor4f_   (1,1,1,1)
  glNormal3f_  (0,0,1.0)
  glTexCoord2f_(1.0,1.0)
  glVertex3f_  (StartX+Width,StartY,Z)
  glTexCoord2f_(0.0,1.0)
  glVertex3f_  (StartX,StartY,Z)
  glTexCoord2f_(0.0,0.0)
  glVertex3f_  (StartX,StartY+Height,Z)
  glTexCoord2f_(1.0,0.0)
  glVertex3f_  (StartX+Width,StartY+Height,Z)
  glEnd_()
  
EndProcedure

Procedure SetupOpenGL()
  
  glMatrixMode_(#GL_PROJECTION)
  
  glOrtho_(0.0, WindowDim\X, WindowDim\Y, 0.0, -1000.0, 1000.0)
  
  glMatrixMode_(#GL_MODELVIEW)
  
  ; glEnable_(#GL_DEPTH_TEST)
  
  glEnable_(#GL_BLEND)
  glBlendFunc_(#GL_SRC_ALPHA, #GL_ONE_MINUS_SRC_ALPHA)
  
EndProcedure


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

DataSection
sph_data:
Data.w 25,9,51,0,71,0,115,0,255,0,0,0,0,1079,1919,1079,1919,0,0,22
Data.w 66,0,89,0,153,0,255,0,235,0,156,551,165,601,296,814,430,849,484,900
Data.w 726,902,711,883,1184,858,1236,829,1418,847,1463,847,1575,814,1689,599,1695,545,1650,320
Data.w 1625,0,0,17,64,0,110,0,239,0,255,0,373,0,264,244,236,326,261,498
Data.w 291,554,427,730,679,844,1185,769,1516,516,1509,350,1401,203,1343,0,0,17,0,0
Data.w 138,0,255,0,255,0,389,0,304,233,291,355,344,522,506,612,653,722,714,740
Data.w 1176,744,1517,513,1508,344,1394,188,1345,0,0,13,36,0,39,0,59,0,255,0
Data.w 67,960,213,887,274,892,333,967,1520,964,1644,1079,0,1079,0,966,0,11,36,0
Data.w 39,0,59,0,255,0,1919,816,1828,813,1775,834,1719,897,1607,1079,1919,1079,0,10
Data.w 36,0,39,0,59,0,255,0,1721,895,1525,951,1513,988,1621,1079,1712,1079,0,9
Data.w 51,0,71,0,115,0,255,0,341,834,347,649,377,650,403,889,0,9,0,0
Data.w 0,0,4,0,255,0,0,1008,0,1079,1919,1079,1919,1010,0,23,0,0,0,0
Data.w 4,0,255,0,402,610,416,705,530,960,685,981,638,691,599,610,631,588,1174,43
Data.w 1033,10,828,10,716,41,646,163,555,233,517,348,440,411,422,497,389,517,379,554
Data.w 0,16,0,0,0,0,4,0,255,0,911,951,935,886,1213,134,1171,42,623,580
Data.w 745,895,728,953,512,1079,914,1079,924,1007,927,986,0,9,0,0,0,0,4,0
Data.w 255,0,529,956,438,1018,738,1037,677,969,0,21,0,0,0,0,4,0,255,0
Data.w 949,945,930,864,1212,125,1223,155,1307,239,1358,339,1420,396,1253,584,1153,743,1121,892
Data.w 1122,947,1171,964,1200,1079,914,1079,932,1008,931,965,0,19,0,0,0,0,4,0
Data.w 255,0,1278,621,1231,553,1420,397,1452,480,1483,489,1495,534,1460,619,1458,639,1442,771
Data.w 1368,979,1367,1079,1205,1079,1220,974,1231,762,0,11,0,0,0,0,4,0,255,0
Data.w 1224,974,1169,1003,1156,1079,1409,1079,1404,1001,1360,970,0,9,172,0,135,0,115,0
Data.w 255,0,828,689,846,688,841,641,835,641,0,9,172,0,135,0,115,0,255,0
Data.w 912,705,901,706,907,665,913,665,0,9,172,0,135,0,115,0,255,0,942,514
Data.w 937,578,943,579,959,514,0,9,172,0,135,0,115,0,255,0,817,502,828,535
Data.w 833,536,833,504,0,9,111,0,26,0,0,0,255,0,789,438,794,454,811,454
Data.w 804,438,0,9,111,0,26,0,0,0,255,0,967,425,984,425,978,441,963,440
Data.w 0,9,89,0,0,0,0,0,255,0,0,0,0,1079,12,1079,12,0,0,9
Data.w 89,0,0,0,0,0,255,0,0,0,1919,0,1919,15,0,15,0,9,89,0
Data.w 0,0,0,0,255,0,1919,0,1919,1079,1907,1079,1906,0,0,9,89,0,0,0
Data.w 0,0,255,0,1919,1079,0,1079,0,1067,1919,1065,0,0
EndDataSection

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
G-Rom
Messages : 3641
Inscription : dim. 10/janv./2010 5:29

Re: Polygones, DPI et echelle

Message par G-Rom »

ok ici.
Send me that :
3840 / 2160
0.750 / 0.750
===
manababel
Messages : 144
Inscription : jeu. 14/mai/2020 7:40

Re: Polygones, DPI et echelle

Message par manababel »

3440 / 1440
0.558 / 0.750
Avatar de l’utilisateur
Ar-S
Messages : 9539
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Polygones, DPI et echelle

Message par Ar-S »

2560 / 1440
0.938 / 0.938
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Mouillard
Messages : 79
Inscription : mer. 13/sept./2017 14:35
Localisation : Picardie (Somme)

Re: Polygones, DPI et echelle

Message par Mouillard »

Bonjour à vous tous,
;Send me that :
;3840 / 2160
;0.875 / 0.875
Avatar de l’utilisateur
threedslider
Messages : 452
Inscription : dim. 01/juil./2018 22:38

Re: Polygones, DPI et echelle

Message par threedslider »

Send me that :
2560 / 1440
0.938 / 0.938


PS: Dis SPH, comment tu fais pour avoir l'image another world dans ce code ? Merci.
Avatar de l’utilisateur
Micoute
Messages : 2583
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Polygones, DPI et echelle

Message par Micoute »

Send me that :
2560 / 1080
0.750 / 1.000
===
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 6.20 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Polygones, DPI et echelle

Message par Ollivier »

Send me rien du tout... Pas testé, juste lu : il te manque une vérif. J'ai tâché (largement perfectible bien sûr) d'afficher une ligne de 16 chiffres BCD dont je veux des proportions de taille fixe quelque soit l'ordinateur : en l'occurence dans cet exemple, les chiffres font 1/9 de la hauteur de l'écran, et la ligne fait en largeur, 100% de la largeur de l'écran, tout ceci, ni plus, ni moins.

Code

Pour arriver à ça, j'ai dû (et c'est bien lourd mais bon...) mettre dix ligne en tête de programme :

Code : Tout sélectionner

Define tempWin = OpenWindow(#PB_Any, ExamineDesktops(), 0, 0, 0, "", #PB_Window_Maximize | #PB_Window_BorderLess | #PB_Window_Invisible)
If DesktopWidth(0) <> WindowWidth(tempWin) * DesktopResolutionX()
    If #PB_Compiler_OS = #PB_OS_Windows And OSVersion() > 70
        MessageRequester("Don't forget to...", "switch the user option ! (menu Compiler)")
        End
    EndIf
    MessageRequester("Please switch...", "the dpi option on ! (menu Compiler)")
    End
EndIf
CloseWindow(tempWin)
C'était le seul moyen de s'assurer que les proportions soient respectées sur n'importe quel matériel.
Avatar de l’utilisateur
SPH
Messages : 4937
Inscription : mer. 09/nov./2005 9:53

Re: Polygones, DPI et echelle

Message par SPH »

Vraiment, ollivier, tu aimes faire compliqué ! Et puis, ton code n'est pas complet... Du coup, je ne sais même pas où tu veux aller avec ça...

Pis t'es méchant : "Send me rien du tout..." !! :D

Mais bon, j'ai eu plusieurs retour montrant que mon calcul d'échelle était perfect. Donc 8)

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Polygones, DPI et echelle

Message par Ollivier »

Il est perfect ton calcul dpi. Juste, il n'est pas complet. Il faut prendre en compte la bêtise humaine de Microsoft. D'où mes 10 lignes de code de suggestion.

Pour l'oeuvre, elle mérite des félicitations. Mais rajoutes quelques repères de date, de matériel d'origine et d'auteur pour les ignorants ou indifférents qui sont et seront de plus en plus nombreux. Qu'ils réalisent l'avancée technique de l'époque !
Avatar de l’utilisateur
SPH
Messages : 4937
Inscription : mer. 09/nov./2005 9:53

Re: Polygones, DPI et echelle

Message par SPH »

Ollivier a écrit : jeu. 21/juil./2022 23:17 Il faut prendre en compte la bêtise humaine de Microsoft. D'où mes 10 lignes de code de suggestion.
?? 8O
.... Quelle bêtise ?

ps : je t'ai envoyé un message mais tu ne m'as pas répondu. (Ollivier : mytho ou homme à plaindre ?) :P

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Polygones, DPI et echelle

Message par Ollivier »

Repose-toi un peu peut-être. Pas le temps de t'expliquer les stratégies pittoresques de Microsoft. "DPI" chez eux, ça ne veut rien dire. Alors qu'il y en a besoin pour les grandeurs natures en impression.

Aussi, même Fred s'est emmelé les pinceaux avec le tour de magie de Microsoft, et son DesktopResolution est bugué.

Pour obtenir une valeur stable, tu regardes mon code de 10 lignes. Il y a une comparaison, c'est explicite.

À +
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Polygones, DPI et echelle

Message par Ollivier »

sph a écrit :ps : je t'ai envoyé un message mais tu ne m'as pas répondu. (Ollivier : mytho ou homme à plaindre ?) :P
Ma messagerie est saturée : il reste celle du forum anglais ou par mail (tu mets ton adresse mail sur la messagerie du forum anglais, je réponds assez vite). Je n'ai pas trop le temps de rester faire le tri. Il y a des messages de personnes qui ne donnent plus signe de vie, donc ce n'est pas un simple tri...
Avatar de l’utilisateur
SPH
Messages : 4937
Inscription : mer. 09/nov./2005 9:53

Re: Polygones, DPI et echelle

Message par SPH »

Tu as tant d'amis que ça ? 😁

Bon, pourrais tu être gentil en n'oubliant pas ceci :
N'oubliez pas de me copier le contenu de la note PB créée avec ce code.
Thx

!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.12LTS- 64 bits
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Re: Polygones, DPI et echelle

Message par Ollivier »

Dans ce correctif, tout le monde (sauf sur machine virtuelle fenêtrée) verra 1919 x 1079 s'afficher quand la souris est déplacée en bas à droite de l'écran. Ceci quelque soit la résolution d'écran, quelque soient les options de compilation, quelque soit l'OS, quelque soit le dpi, quelque soit la version de Windows, quelque soit le répertoire où est exécuté l'exécutable final et quelque soit la version LTS de pureBasic.

J'ai viré tous les trucs concernant le dpi, le pourquoi étant déjà expliqué et répété.

Bon courage

Code : Tout sélectionner

;{ gl en pureBasic Demo : ajout prototypes }
; A degager si licence pureBasic

Global.I gl = OpenLibrary(#PB_Any, "opengl32.dll")
Global *glTemp = AllocateMemory(1024)

Prototype.I glGetIntegerv(IntegerName.I, Param.I)
Global glGetIntegerv_.glGetIntegerv = GetFunction(gl, "glGetIntegerv")

Prototype.I glBindTexture(ValueA.I, ValueB.I)
Global glBindTexture_.glBindTexture = GetFunction(gl, "glBindTexture")



Prototype.I glVertex2i(X.I, Y.I)
Global glVertex2i_.glVertex2i = GetFunction(gl, "glVertex2i")

Prototype.I glVertex4i(X.I, Y.I, x2.I, y2.I)
Global glVertex4i_.glVertex4i = GetFunction(gl, "glVertex4i")

Prototype.I glViewport(X.I, Y.I, x2.I, y2.I)
Global glViewport_.glViewport = GetFunction(gl, "glViewport")

Prototype.I glOrtho(x1.d, x2.d, y2.d, y1.d, near.d, far.d)
Global glOrtho_.glOrtho = GetFunction(gl, "glOrtho")

Prototype.I glClearColor(r.F, g.F, b.F, a.F)
Global glClearColor_.glClearColor = GetFunction(gl, "glClearColor")

Prototype.I glClear(Flags.I)
Global glClear_.glClear = GetFunction(gl, "glClear")

Prototype.I glMatrixMode(Value.I)
Global glMatrixMode_.glMatrixMode = GetFunction(gl, "glMatrixMode")

Prototype.I glBegin(Value.I)
Global glBegin_.glBegin = GetFunction(gl, "glBegin")

Prototype.I glEnable(Value.I)
Global glEnable_.glEnable = GetFunction(gl, "glEnable")

Prototype.I glDisable(Value.I)
Global glDisable_.glDisable = GetFunction(gl, "glDisable")

Prototype.I glLoadIdentity()
Global glLoadIdentity_.glLoadIdentity = GetFunction(gl, "glLoadIdentity")

Prototype.I glEnd()
Global glEnd_.glEnd = GetFunction(gl, "glEnd")

Prototype.I glColor3f(r.F, g.F, b.F)
Global glColor3f_.glColor3f = GetFunction(gl, "glColor3f")

Prototype.I glColor4f(r.F, g.F, b.F, a.F)
Global glColor4f_.glColor4f = GetFunction(gl, "glColor4f")

Prototype.I glVertex2f(x.F, y.F)
Global glVertex2f_.glVertex2f = GetFunction(gl, "glVertex2f")

Prototype.I glVertex3f(x.F, y.F, z.F)
Global glVertex3f_.glVertex3f = GetFunction(gl, "glVertex3f")

Prototype.I glBlendFunc(sFactor.I, dFactor.I)
Global glBlendFunc_.glBlendFunc = GetFunction(gl, "glBlendFunc")

Prototype.I glNormal3f(x.F, y.F, z.F)
Global glNormal3f_.glNormal3f = GetFunction(gl, "glNormal3f")

Prototype.I glTexCoord2f(u.F, v.F)
Global glTexCoord2f_.glTexCoord2f = GetFunction(gl, "glTexCoord2f")

; fin des prototypes
;}

Global win, sgl

Procedure.d xGet(x.d)
    ProcedureReturn x * 1920 / GadgetWidth(sgl)
EndProcedure

Procedure.d yGet(y.d)
    ProcedureReturn y * 1080 / GadgetHeight(sgl)
EndProcedure

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code : Mise a l'echelle   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; PB6.0 - SPH(2022) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; pb5.73 LTS DEMO X64 - Olliv
;;; Inspiré de ANOTHER WORLD 1991 (ERIC CHAHI)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


DisableExplicit ; autant se l'avouer...

;These two GL constants are used for texture creation. Don't change their values.
#GL_BGR = $80E0
#GL_BGRA = $80E1


;********************* DPI *********************



;-DEFINES
Define.i Event
Define.i WindowFlags = #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget


;-DECLARES
Declare Render()
Declare Render2DQuad(OGLTexture.i, StartX.d, StartY.d, Width.i, Height.i, Z.d)
Declare SetupOpenGL()
Declare SetupGLTexture(ImageHandle.i)


;-MAIN WINDOW
Global ww, wh
win=OpenWindow(#PB_Any,0,0,0,0, "Picasso_SPH",#PB_Window_Maximize|#PB_Window_BorderLess)
ww = WindowWidth(win)
wh = WindowHeight(win)
sgl=OpenGLGadget(#PB_Any,0,0,ww,wh)
wBoard=OpenWindow(#PB_Any, ww * 0.1, wh * 0.9, ww * 0.2, wh * 0.05, "", #PB_Window_BorderLess)
gBoard=TextGadget(#PB_Any, 0, 0, WindowWidth(wBoard), WindowHeight(wBoard), "")
StickyWindow(wboard, 1)
SetActiveWindow(win)

SetupOpenGL()

AddKeyboardShortcut(win,  #PB_Shortcut_Escape, 666) ; quitter

glOrtho_(0,1920,1080,0,-1,1)
glMatrixMode_(#GL_MODELVIEW)
glLoadIdentity_()
glClear_(0)

;*********************************************************************************************************************************

;;;;;;;;;;;
Define timer=ElapsedMilliseconds()

glClearColor_(0,0,0, 1.0)

;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
;-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;#################**********************************************
Repeat
  
  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
  
  
  ;*****
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_Gadget
        Select EventGadget()
          Case sgl         
            Define Resx = xGet(GetGadgetAttribute(sgl, #PB_OpenGL_MouseX) )
            Define Resy = yGet(GetGadgetAttribute(sgl, #PB_OpenGL_MouseY) )
            SetGadgetText(gBoard, Str(resx) + " x " + Str(resy) )
            ;;;;;;;         
            Select EventType()
                ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;             
            EndSelect
        EndSelect
      Case #PB_Event_Menu
        Select EventMenu()
          Case 666
            timer=ElapsedMilliseconds()-timer
            ;MessageRequester("Timer", Str(timer)+" ms - "+Str(scene)+" frames",2)
            ;           Debug scene
            ;           Debug timer

            End
        EndSelect
    EndSelect
    
  Until Event = 0
  
  
  ;##############################################
  ;##############################################
  ;##############################################
  ;##############################################

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Restore sph_data

Read.w sph_nombre_poly
Read.w sph_cmb
; Debug sph_nombre
; Debug sph_cmb
sph_cmb_mem=sph_cmb

Dim sph_xx.w(sph_cmb)
Dim sph_yy.w(sph_cmb)
sph_la=0

Repeat
                      glBegin_(#GL_POLYGON);
                      glBlendFunc_(#GL_SRC_ALPHA,#GL_ONE_MINUS_SRC_ALPHA)
If sph_la<>0
;   Debug "==="
  sph_cmb_mem+sph_cmb
;  Debug sph_cmb_mem
  ReDim sph_xx.w(sph_cmb_mem)
  ReDim sph_yy.w(sph_cmb_mem)
EndIf

sph_xx(la)=sph_nombre
sph_yy(la)=sph_cmb

For i=1 To 4;sph_cmb
Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
; Debug sph_xx(sph_la+i)
; Debug sph_yy(sph_la+i)
Next
glColor4f_(sph_xx(sph_la+1)/255,sph_xx(sph_la+2)/255,sph_xx(sph_la+3)/255,sph_xx(sph_la+4)/255)

For i=5 To sph_cmb-1
Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
                      glVertex2f_(sph_xx(sph_la+i),sph_yy(sph_la+i) );
Next
                      glEnd_()                      ; 

Read.w sph_xx(sph_la+i)  
Read.w sph_yy(sph_la+i)  
; Debug "=="
sph_cmb=sph_yy(sph_la+i)
; Debug "sph_cmb = "+Str(sph_cmb)
sph_la+i
Until sph_yy(sph_la)=0
;;;;;;;;;;;;;;;
 
  SetGadgetAttribute(sgl, #PB_OpenGL_FlipBuffers, #True)
  
ForEver

End


Procedure Render()
  
  ;Clearing buffers and resetting clear color to remove old graphics from the last frame.
  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT)
  ;  glClearColor_(0.2, 0.2, 0.2, 1.0)
  glClearColor_(0,0,0,1)
  
  ;## DRAWING TEXTURES/IMAGES
  ;First enable the Texture system.
  glEnable_(#GL_TEXTURE_2D)
  
  ;This procedure will create a quad and apply a texture to it.
  ;The Texture variable contains the texture created earlier using SetupGLTexture().
  Render2DQuad(Texture1, 0, 0, ImageWidth(Image1), ImageHeight(Image1), -2)
  ; Render2DQuad(Texture2, 0, 0, ImageWidth(Image2), ImageHeight(Image2), -1)
  
  ;After all the textures have been displayed disable the texture system.
  ;Otherwise it will conflict with the non texture graphics.
  glDisable_(#GL_TEXTURE_2D)
  
EndProcedure

Procedure Render2DQuad(OGLTexture.i, StartX.d, StartY.d, Width.i, Height.i, Z.d)
  
  ;The texture is first bound which tells OpenGL to use this texture for any future rendering.
  glBindTexture_(#GL_TEXTURE_2D, OGLTexture)
  glBegin_(#GL_QUADS)
  glColor4f_   (1,1,1,1)
  glNormal3f_  (0,0,1.0)
  glTexCoord2f_(1.0,1.0)
  glVertex3f_  (StartX+Width,StartY,Z)
  glTexCoord2f_(0.0,1.0)
  glVertex3f_  (StartX,StartY,Z)
  glTexCoord2f_(0.0,0.0)
  glVertex3f_  (StartX,StartY+Height,Z)
  glTexCoord2f_(1.0,0.0)
  glVertex3f_  (StartX+Width,StartY+Height,Z)
  glEnd_()
  
EndProcedure

Procedure SetupOpenGL()
  
  glMatrixMode_(#GL_PROJECTION)
  glOrtho_(0.0, 1920, 1080, 0.0, -1000.0, 1000.0)
  glMatrixMode_(#GL_MODELVIEW)
  
  ; glEnable_(#GL_DEPTH_TEST)
  
  glEnable_(#GL_BLEND)
  glBlendFunc_(#GL_SRC_ALPHA, #GL_ONE_MINUS_SRC_ALPHA)
  
EndProcedure


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

DataSection
sph_data:
Data.w 25,9,51,0,71,0,115,0,255,0,0,0,0,1079,1919,1079,1919,0,0,22
Data.w 66,0,89,0,153,0,255,0,235,0,156,551,165,601,296,814,430,849,484,900
Data.w 726,902,711,883,1184,858,1236,829,1418,847,1463,847,1575,814,1689,599,1695,545,1650,320
Data.w 1625,0,0,17,64,0,110,0,239,0,255,0,373,0,264,244,236,326,261,498
Data.w 291,554,427,730,679,844,1185,769,1516,516,1509,350,1401,203,1343,0,0,17,0,0
Data.w 138,0,255,0,255,0,389,0,304,233,291,355,344,522,506,612,653,722,714,740
Data.w 1176,744,1517,513,1508,344,1394,188,1345,0,0,13,36,0,39,0,59,0,255,0
Data.w 67,960,213,887,274,892,333,967,1520,964,1644,1079,0,1079,0,966,0,11,36,0
Data.w 39,0,59,0,255,0,1919,816,1828,813,1775,834,1719,897,1607,1079,1919,1079,0,10
Data.w 36,0,39,0,59,0,255,0,1721,895,1525,951,1513,988,1621,1079,1712,1079,0,9
Data.w 51,0,71,0,115,0,255,0,341,834,347,649,377,650,403,889,0,9,0,0
Data.w 0,0,4,0,255,0,0,1008,0,1079,1919,1079,1919,1010,0,23,0,0,0,0
Data.w 4,0,255,0,402,610,416,705,530,960,685,981,638,691,599,610,631,588,1174,43
Data.w 1033,10,828,10,716,41,646,163,555,233,517,348,440,411,422,497,389,517,379,554
Data.w 0,16,0,0,0,0,4,0,255,0,911,951,935,886,1213,134,1171,42,623,580
Data.w 745,895,728,953,512,1079,914,1079,924,1007,927,986,0,9,0,0,0,0,4,0
Data.w 255,0,529,956,438,1018,738,1037,677,969,0,21,0,0,0,0,4,0,255,0
Data.w 949,945,930,864,1212,125,1223,155,1307,239,1358,339,1420,396,1253,584,1153,743,1121,892
Data.w 1122,947,1171,964,1200,1079,914,1079,932,1008,931,965,0,19,0,0,0,0,4,0
Data.w 255,0,1278,621,1231,553,1420,397,1452,480,1483,489,1495,534,1460,619,1458,639,1442,771
Data.w 1368,979,1367,1079,1205,1079,1220,974,1231,762,0,11,0,0,0,0,4,0,255,0
Data.w 1224,974,1169,1003,1156,1079,1409,1079,1404,1001,1360,970,0,9,172,0,135,0,115,0
Data.w 255,0,828,689,846,688,841,641,835,641,0,9,172,0,135,0,115,0,255,0
Data.w 912,705,901,706,907,665,913,665,0,9,172,0,135,0,115,0,255,0,942,514
Data.w 937,578,943,579,959,514,0,9,172,0,135,0,115,0,255,0,817,502,828,535
Data.w 833,536,833,504,0,9,111,0,26,0,0,0,255,0,789,438,794,454,811,454
Data.w 804,438,0,9,111,0,26,0,0,0,255,0,967,425,984,425,978,441,963,440
Data.w 0,9,89,0,0,0,0,0,255,0,0,0,0,1079,12,1079,12,0,0,9
Data.w 89,0,0,0,0,0,255,0,0,0,1919,0,1919,15,0,15,0,9,89,0
Data.w 0,0,0,0,255,0,1919,0,1919,1079,1907,1079,1906,0,0,9,89,0,0,0
Data.w 0,0,255,0,1919,1079,0,1079,0,1067,1919,1065,0,0
EndDataSection
Répondre