PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Petit programme de simulation du daltonisme

https://www.purebasic.fr/french/viewtopic.php?t=12277

Page 1 sur 1

Petit programme de simulation du daltonisme

Publié : sam. 01/oct./2011 10:53
par Octavius
Etant moi-même daltonien j'ai fait ce petit programme pour montrer aux non-daltoniens comment le monde peut être perçu différemment (pour mon cas personnel, le plus courant : deutéranomalie 50%).

Ca n'a rien d'extraordinaire je vous l'accorde, je pense qu'il est possible de trouver sur Internet des programmes qui font déjà quelque chose dans ce genre. Mais au moins j'ai exprimé l'algorithme de manière explicite pour que n'importe qui puisse le reprendre. Cet algorithme je ne l'ai pas inventé, il sort d'une publication scientifique : Viénot F., Brettel H. & Mollon J.D., Digital video colourmaps for checking the legibility of displays by dichromats, Color Research Application (1999), Volume: 24, Issue: 4, Pages: 243-252.

Je suis professeur de SVT en lycée, alors du coup je pensais m'en servir pour illustrer cette partie du programme à mes élèves.

D'ailleurs j'ai une question, j'ai installé PB en 64 bits, est-ce que je peux compiler un exécutable en 32 bits directement (pour les vieux ordis du lycée) ? Est-ce qu'il faut que je désinstalle PB et que je réinstalle une version 32 bits ?

Code : Tout sélectionner

EnableExplicit

Enumeration
  #Open
  #Save
EndEnumeration
Enumeration
  #Normal
  #Dalto
  #Temp
  #O_Protan
  #O_Deutan
  #O_Tritan
  #O_Large
  #O_Medium
  #O_Short
  #S_Large
  #S_Medium
  #S_Short
  #P_Large
  #P_Medium
  #P_Short
EndEnumeration

UseJPEG2000ImageDecoder()
UseJPEG2000ImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

Define i.i
Define Event.i
Define File$

;{
OpenWindow(0,0,0,838,640,"Simulateur de dyschromatopsie (par D. Aubert)",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
ImageGadget(#Normal,10,10,404,404,0,#PB_Image_Border)
ImageGadget(#Dalto,424,10,404,404,0,#PB_Image_Border)

OptionGadget(#O_Protan,10,425,80,20,"Protanopie")
OptionGadget(#O_Deutan,10,455,80,20,"Deutéranopie")
OptionGadget(#O_Tritan,10,485,80,20,"Tritanopie")

OptionGadget(#O_Large,110,425,100,20,"Protanomalie :")
OptionGadget(#O_Medium,110,455,100,20,"Deutéranomalie :")
OptionGadget(#O_Short,110,485,100,20,"Tritanomalie :")

ScrollBarGadget(#S_Large,220,425,400,20,0,101,1)
ScrollBarGadget(#S_Medium,220,455,400,20,0,101,1)
ScrollBarGadget(#S_Short,220,485,400,20,0,101,1)
DisableGadget(#S_Large,1)
DisableGadget(#S_Medium,1)
DisableGadget(#S_Short,1)

TextGadget(#P_Large,630,427,40,14,"0 %")
TextGadget(#P_Medium,630,457,40,14,"0 %")
TextGadget(#P_Short,630,487,40,14,"0 %")

CreateMenu(0,WindowID(0))
MenuTitle("Image")
MenuItem(#Open,"Ouvrir..."+Chr(9)+"Ctrl+O")
MenuItem(#Save,"Enregistrer sous..."+Chr(9)+"Ctrl+S")
DisableMenuItem(0,#Save,1)

AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_O,#Open)
AddKeyboardShortcut(0,#PB_Shortcut_Control|#PB_Shortcut_S,#Save)
;}

Procedure Daltonism()
  Protected L.f,M.f,S.f
  Protected Blue.i,Green.i,Red.i
  Protected NewBlue.i,NewGreen.i,NewRed.i,f.i
  Protected X.i,Y.i,Color.l,bmp.BITMAP,*Address
  If IsImage(#Normal)
    CopyImage(#Normal,#Dalto)
    GetObject_(ImageID(#Dalto),SizeOf(BITMAP),@bmp) : *Address=bmp\bmBits
    If GetGadgetState(#O_Protan) Or GetGadgetState(#O_Large)
      f=100 : If GetGadgetState(#O_Large) : f=GetGadgetState(#S_Large) : EndIf
      For Y=0 To 399
        For X=0 To 399
          CopyMemory(*Address+X*3+(399-Y)*1200,@Color,3)
          Red=(Color&$FF0000)>>16
          Green=(Color&$00FF00)>>8
          Blue=(Color&$0000FF)
          
          Red=(992052*Red+3974)/1000000
          Green=(992052*Green+3974)/1000000
          Blue=(992052*Blue+3974)/1000000
          
          ;L=17.8824*Red+43.5161*Green+4.11935*Blue
          M=3.45565*Red+27.1554*Green+3.86714*Blue
          S=0.0299566*Red+0.184309*Green+1.46709*Blue
          
          L=2.02344*M-2.52581*S
          
          NewRed=0.080944*L-0.130504*M+0.116721*S : If NewRed<0 : NewRed=0 : EndIf : If NewRed>255 : NewRed=255 : EndIf
          NewGreen=-0.0102485*L+0.0540194*M-0.113615*S : If NewGreen<0 : NewGreen=0 : EndIf : If NewGreen>255 : NewGreen=255 : EndIf
          NewBlue=-0.000365294*L-0.00412163*M+0.693513*S : If NewBlue<0 : NewBlue=0 : EndIf : If NewBlue>255 : NewBlue=255 : EndIf
          
          NewRed=(f*NewRed+(100-f)*Red)/100
          NewGreen=(f*NewGreen+(100-f)*Green)/100
          NewBlue=(f*NewBlue+(100-f)*Blue)/100
          
          Color=NewRed<<16+NewGreen<<8+NewBlue
          CopyMemory(@Color,*Address+X*3+(399-Y)*1200,3)
        Next X
      Next Y
    ElseIf GetGadgetState(#O_Deutan) Or GetGadgetState(#O_Medium)
      f=100 : If GetGadgetState(#O_Medium) : f=GetGadgetState(#S_Medium) : EndIf
      For Y=0 To 399
        For X=0 To 399
          CopyMemory(*Address+X*3+(399-Y)*1200,@Color,3)
          Red=(Color&$FF0000)>>16
          Green=(Color&$00FF00)>>8
          Blue=(Color&$0000FF)
          
          Red=(957237*Red+21381)/1000000
          Green=(957237*Green+21381)/1000000
          Blue=(957237*Blue+21381)/1000000
          L=17.8824*Red+43.5161*Green+4.11935*Blue
          ;M=3.45565*Red+27.1554*Green+3.86714*Blue
          S=0.0299566*Red+0.184309*Green+1.46709*Blue
          
          M=0.494207*L+1.24827*S
          
          NewRed=0.080944*L-0.130504*M+0.116721*S : If NewRed<0 : NewRed=0 : EndIf : If NewRed>255 : NewRed=255 : EndIf
          NewGreen=-0.0102485*L+0.0540194*M-0.113615*S : If NewGreen<0 : NewGreen=0 : EndIf : If NewGreen>255 : NewGreen=255 : EndIf
          NewBlue=-0.000365294*L-0.00412163*M+0.693513*S : If NewBlue<0 : NewBlue=0 : EndIf : If NewBlue>255 : NewBlue=255 : EndIf
          
          NewRed=(f*NewRed+(100-f)*Red)/100
          NewGreen=(f*NewGreen+(100-f)*Green)/100
          NewBlue=(f*NewBlue+(100-f)*Blue)/100
          
          Color=NewRed<<16+NewGreen<<8+NewBlue
          CopyMemory(@Color,*Address+X*3+(399-Y)*1200,3)
        Next X
      Next Y
    ElseIf GetGadgetState(#O_Tritan) Or GetGadgetState(#O_Short)
      f=100 : If GetGadgetState(#O_Short) : f=GetGadgetState(#S_Short) : EndIf
      For Y=0 To 399
        For X=0 To 399
          CopyMemory(*Address+X*3+(399-Y)*1200,@Color,3)
          Red=(Color&$FF0000)>>16
          Green=(Color&$00FF00)>>8
          Blue=(Color&$0000FF)
          NewBlue=(Green+Red)/2
          NewRed=Red*772/886
          NewGreen=Green*772/886
          NewRed=(f*NewRed+(100-f)*Red)/100
          NewGreen=(f*NewGreen+(100-f)*Green)/100
          NewBlue=(f*NewBlue+(100-f)*Blue)/100
          Color=NewRed<<16+NewGreen<<8+NewBlue
          CopyMemory(@Color,*Address+X*3+(399-Y)*1200,3)
        Next X
      Next Y
    EndIf
  EndIf
  If IsImage(#Dalto) : SetGadgetState(#Dalto,ImageID(#Dalto)) : EndIf
EndProcedure

Repeat
  
  Event=WaitWindowEvent()
  
  Select Event
      
    Case #PB_Event_Menu
      Event=EventMenu()
      Select Event
        Case #Open
          File$=OpenFileRequester("Charger une image","","Fichier image (BMP, PNG, JPEG, TIFF, TGA)|*.bmp;*.png;*.jpeg;*.jpg;*.tiff;*.tga|Tout type de fichier|*.*",0)
          If File$<>""
            ;Ouverture de l'image normale !
            If LoadImage(#Temp,File$)
              If ImageHeight(#Temp)>400 Or ImageWidth(#Temp)>400
                If ImageHeight(#Temp)>ImageWidth(#Temp)
                  ResizeImage(#Temp,400*ImageWidth(#Temp)/ImageHeight(#Temp),400);,#PB_Image_Raw)
                Else
                  ResizeImage(#Temp,400,400*ImageHeight(#Temp)/ImageWidth(#Temp));,#PB_Image_Raw)
                EndIf
              EndIf
              If CreateImage(#Normal,400,400,24)
                If StartDrawing(ImageOutput(#Normal))
                  DrawImage(ImageID(#Temp),(400-ImageWidth(#Temp))/2,(400-ImageHeight(#Temp))/2)
              StopDrawing() : EndIf : 
              SetGadgetState(#Normal,ImageID(#Normal))
              ;Création de l'image modifiée daltonienne !
              Daltonism()
              EndIf
              DisableMenuItem(0,#Save,0)
            EndIf
          EndIf
        Case #Save
          File$=SaveFileRequester("Enregistrer l'image dyschromatope","","Image BMP|*.bmp",0)
          If File$<>"" And IsImage(#Dalto)
            If LCase(GetExtensionPart(File$))="bmp"
              SaveImage(#Dalto,File$,#PB_ImagePlugin_BMP)
            Else
              SaveImage(#Dalto,File$+".bmp",#PB_ImagePlugin_BMP)
            EndIf
          EndIf
      EndSelect
      
    Case #PB_Event_Gadget
      Event=EventGadget()
      Select Event
        Case #O_Protan,#O_Deutan,#O_Tritan
          DisableGadget(#S_Large,1)
          DisableGadget(#S_Medium,1)
          DisableGadget(#S_Short,1)
          Daltonism()
        Case #O_Large,#O_Medium,#O_Short
          DisableGadget(#S_Large,1)
          DisableGadget(#S_Medium,1)
          DisableGadget(#S_Short,1)
          DisableGadget(Event+3,0)
          Daltonism()
        Case #S_Large,#S_Medium,#S_Short
          SetGadgetText(Event+3,Str(GetGadgetState(Event))+" %")
          Daltonism()
      EndSelect
      
    Case #PB_Event_CloseWindow
      Break
      
  EndSelect
  
ForEver

Re: Petit programme de simulation du daltonisme

Publié : sam. 01/oct./2011 12:05
par case
il faut installer une version 32 bit, pas la peine de désinstaller la version 64 bit, change juste de répertoire lors de l'installation

Re: Petit programme de simulation du daltonisme

Publié : sam. 01/oct./2011 12:39
par falsam
Beau travail fournissant un bel exemple de traitement d'images. Bravo.

Case t'a répondu sur l'installation d'une autre version de PureBasic. j'ajouterais que depuis une des versions, le menu compilateur te permet de sélectionner un compilateur différent de la version actuelle de PureBasic. Cela facilite la compilation d'un programme sous differente achitectures (x86, x64 ou PowerPC) sans avoir à redemarrer une nouvelle instance de l'IDE. Les compilateurs additionnels sont paramètrables dans les préférences (Fichier-> Préférence).

Re: Petit programme de simulation du daltonisme

Publié : sam. 01/oct./2011 16:28
par Octavius
Merci ça marche, j'ai réussi à compiler en x86 !

Re: Petit programme de simulation du daltonisme

Publié : sam. 01/oct./2011 17:45
par Kwai chang caine
Merci pour le partage 8)
Mon père était aussi daltonien, c'est vrai que c'est toujours difficile a comprendre lorsque l'on ne l'est pas :roll:
Grâce a ton programme, je pourrais voir un par ses yeux....encore merci

Re: Petit programme de simulation du daltonisme

Publié : dim. 02/oct./2011 16:36
par sospel
Bonjour !

Merci pour votre post : écrit en bon français sans fautes de grammaire, clairement et logiquement programmé et documenté avec citations des articles de base, il est "en plus" si j'ose dire, d'une grande utilité !
Voilà un bon exemple de ce que peut faire facilement cet excellent langage qu'est PureBasic. Puisse-t-il inspirer de nouveaux programmeurs !

Tout comme falsam, je dis donc: BRAVO :)

Je me permettrai toutefois une remarque de forme : pour ma part, je n'apprécie pas spécialement la présence de plusieurs "IF ...ENDIF" sur la même ligne. Je trouve que cela nuit un peu à la lisibilité du code. Mais bon, ce n'est qu'un goût personnel .

Bref, cela nous change des élucubrations shadockiennes qui encombrent ce forum depuis quelques mois ...

Cordialement
SosPel

Re: Petit programme de simulation du daltonisme

Publié : lun. 03/oct./2011 18:03
par Octavius
Oh eh ben merci !

C'est très encourageant pour moi ! Je suis content de contribuer quand je peux.

Re: Petit programme de simulation du daltonisme

Publié : mer. 05/oct./2011 16:43
par SPH
Resultat, je suis daltonien a tendance borderline suicidaire ! :wink:

Re: Petit programme de simulation du daltonisme

Publié : mer. 05/oct./2011 21:04
par Cool Dji
Merci pour l'appli, je vais montrer aux enfants...

Même si des choses existent sur Internet, je n'avais jamais pensé à regarder et l'idée de ton prog est vraiment intéressante.

Bon cours demain !!
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru