Exemples
From PilibWiki
Section Précédente : Le Graphisme | | Retour au sommaire
Calculatrice
Dans cette exemple, nous allons traiter le cas d'une calculatrice toute simple avec 1 zones de texte pour recevoir 2 valeurs, et 4 boutons pour choisir entre additionner, multiplier, soustraire, ou diviser. Voici le programme à taper, les explications sont incorporés dans le code.
program calculatrice
use pimod
implicit none
!!! Un entier pour chaque bouton
integer(kind=kptr) :: plus=0,fois=0,moins=0,diviser=0
integer(kind=kptr) :: Win,iclos,contain,ihvaleur1,butplus
integer(kind=kptr) :: butmoins,butdiv,ihvaleur2,textresultat,resultat
integer(kind=kptr) :: butfois,text1,text2
!!! Les valeurs de zones de textes
real(kind=kdouble) :: valeur1,valeur2,valeur3
!!! 2 tampons que nous utiliserons par la suite
type(string) :: tamponstr
character(LEN=20) :: tamponcha
call piinit
!!!!!Partie Graphique
!!!Je vous conseille de bien discocier les différentes
!!!"étages" de votre fenêtre
call gkwindow(c('Calculatrice'),0,0,Win,iclos)
call gkcontain(1,0,0,3,contain)
call gkxedt(20,ihvaleur1)
call gkput(0,10,-1,-1,contain,ihvaleur1)
call gkbutton(c('+'),butplus,plus)
call gkbutton(c('x'),butfois,fois)
call gkbutton(c('-'),butmoins,moins)
call gkbutton(c('/'),butdiv,diviser)
call gkput(0,50,40,-1,contain,butplus)
call gkput(40,50,40,-1,contain,butfois)
call gkput(80,50,40,-1,contain,butmoins)
call gkput(120,50,40,-1,contain,butdiv)
call gkxedt(20,ihvaleur2)
call gkput(0,90,-1,-1,contain,ihvaleur2)
call gktext(c('Resultat : '),textresultat)
call gkput(0,120,-1,-1,contain,textresultat)
call gkxedt(20,resultat)
call gkput(0,140,-1,-1,contain,resultat)
call gktext(c('Entrez les valeurs'),text1)
call gkput(20,180,-1,-1,contain,text1)
call gktext(c('puis appuyez sur '' + - x / '' '),text2)
call gkput(0,195,-1,-1,contain,text2)
call gkput(1,1,-1,-1,Win,contain)
call gkshow(Win)
!!!Partie Calculs et évènements
do while(iclos.eq.0)
call gkproc
!!! Lorsque un bouton est au repos, l'entier qui lui est associé vaut 0
!!! Une fois que l'on appuis dessus, cet entier passe à 1
!!! Nous allons donc tester les différentes valeurs, et agir en conséquent
!!! Imaginez juste que la boucle while dans làquel nous somme tourne en continus
!!! C'est à dire si l'on a appuyé sur le bouton +
if(plus==1) then
!!! Astuces importantes pour passer de String en float et inverse
!!! Nous allons récupérer les valeurs des 2 zones de texte
!!! procéder à l'opération désiré avant d'afficher le résultat dans
!!! la zone de texte de résultat
!!! on récupère un string dans tamponstr
!!! on le transforme en character dans tamponcha
!!! puis on passe ce character en float
call gkgetstring(tamponstr,ihvaleur1)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur1
call gkgetstring(tamponstr,ihvaleur2)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur2
valeur3=valeur1+valeur2
!!! on écrit ensuite le résultat de l'opération dans un
!!! character (pensez à lui fixer une taille ! )
WRITE(tamponcha,*)valeur3
!!! on place ensuite la valeur dans la zone de texte
call gksetstring(c(tamponcha),resultat)
!!! pensez à remettre les valeurs des boutons à zeros à la fin
plus=0
end if
if(fois==1) then
call gkgetstring(tamponstr,ihvaleur1)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur1
call gkgetstring(tamponstr,ihvaleur2)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur2
valeur3=valeur1*valeur2
WRITE(tamponcha,*)valeur3
call gksetstring(c(tamponcha),resultat)
fois=0
end if
if(moins==1) then
call gkgetstring(tamponstr,ihvaleur1)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur1
call gkgetstring(tamponstr,ihvaleur2)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur2
valeur3=valeur1-valeur2
WRITE(tamponcha,*)valeur3
call gksetstring(c(tamponcha),resultat)
moins=0
end if
if(diviser==1) then
call gkgetstring(tamponstr,ihvaleur1)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur1
call gkgetstring(tamponstr,ihvaleur2)
tamponcha=f_str2char(tamponstr)
READ(tamponcha,*)valeur2
valeur3=valeur1/valeur2
WRITE(tamponcha,*)valeur3
call gksetstring(c(tamponcha),resultat)
diviser=0
end if
end do
call gkdestroy(Win)
end program calculatrice
Une simple calculatrice
Vous remarquerez donc que tous nos éléments sont bien présent, et que les calculs fonctionnent. Je vous l'accorde, ça ne casse pas 3 pattes à un canard, mais il faut bien commencer par quelque chose de simple. (Pour ceux qui n'auraient pas remarqué l'humour glacé et sophistiqué du canard, je ne peut plus rien pour vous ^^)
Jeu de Golf
Dans ce petit programme, nous allons aborder les notions suivantes : Objets : texte, zones de texte, bars d'avancement, boutons, menus et sous menus. Graphique : tracé de rectangles, de vecteurs, fonctions ( y = g(x) ), et affichage d'images. Fenêtres : messages boxes, notion de multi-fenêtrage.
Bien évidement, ce programme ne représente pas la perfection. N'étant pas vraiment surdoué en programmation, je vous invite à éditer ce programme, voir à le modifier entièrement afin de l'optimiser.
Je ne parvient pas par contre à utiliser la fonction random_number sous mingw. Les appels du vent et de la distance sont donc temporairement annulés et les valeurs sont fixées à vent=15 et distance=350.
Vous trouverez l'image de la fenêtre d'otpion ici : [[1]]
program golf
use pimod
character(len=30) :: tamponchar
type(string) :: tamponstr
real(kind=kdouble) :: vent,distance,angle,force,PI=3.14159265358!97932384626433832795,t
integer(kind=kptr) :: newgame=1,quitter=0,options=0,cblanc=((255*256)+255)*256+255
integer(kind=kptr) :: cvert=((0*256)+255)*256+0,cnoir=0
integer(kind=kptr) :: ok=0,crouge=((255*256)+0)*256+0,cbleu=((0*256)+0)*256+255
integer(kind=kptr) :: x1,x2,y1,y2,findeboucle,boutonmsgbox
integer(kind=kptr) :: couleurlancer
call piinit
call gkwindow(c('Golf'),0,0,ihwin,iclos)
call gkcontain(1,0,0,3,ihmaincontain)
call gkcontain(1,0,0,3,ihgraphcontain)
call gkcontain(1,0,0,3,ihselectcontain)
couleurlancer=cbleu
call gkshow(ihwin)
DO WHILE(iclos.eq.0)
if(newgame==1) then
call gkdestroy(ihgraphcontain)
call gkdestroy(ihselectcontain)
call gkdestroy(ihmaincontain)
call gkcontain(1,0,0,3,ihmaincontain)
call gkcontain(1,0,0,3,ihgraphcontain)
call gkcontain(1,0,0,3,ihselectcontain)
!!!! Zone de selection
!!! Menu
call gkmenubar(ihbar)
call gkmenusubmenu(1,c("Fichier"),ihbar,ihsub)
call gkmenuitem(1,c("Nouveau Jeu"),ihsub,ihouvrir,newgame)
call gkmenuitem(2,c("Quitter"),ihsub,ihsauver,quitter)
call gkmenuitem(2,c("Options"),ihbar,ihoptions,options)
call gkput(0,0,-1,-1,ihselectcontain,ihbar)
!!! Donnees a entrer et sortie
call gktext(c('Sortie: '),ihtextoutput)
call gkput(0,40,-1,-1,ihselectcontain,ihtextoutput)
!call random_number(vent)
!vent=int(vent*19.9)
vent=15.0
call gktext(c('Force du vent : '),ihtextForceduvent)
WRITE(tamponchar,*)vent
call gktext(c(tamponchar),ihtextvent)
call gkput(20,60,-1,-1,ihselectcontain,ihtextForceduvent)
call gkput(100,60,-1,-1,ihselectcontain,ihtextvent)
call gkbar(ihbarvent)
call gksetfloat(vent*0.05,ihbarvent)
call gkput(20,75,140,-1,ihselectcontain,ihbarvent)
!call random_number(distance)
!distance=int(distance*290.0)+100
distance=350.0
call gktext(c('Distance : '),ihtextdistance1)
WRITE(tamponchar,*)distance
call gktext(c(tamponchar),ihtextdistance2)
call gkput(20,100,-1,-1,ihselectcontain,ihtextdistance1)
call gkput(100,100,-1,-1,ihselectcontain,ihtextdistance2)
call gkbar(ihbardistance)
call gksetfloat(distance*0.0025,ihbardistance)
call gkput(20,115,140,-1,ihselectcontain,ihbardistance)
call gktext(c('Entree : '),ihtextinput)
call gkput(0,150,-1,-1,ihselectcontain,ihtextinput)
call gktext(c('Angle : '),ihtextangle)
call gkxedt(5,ihangle)
call gkput(20,172,-1,-1,ihselectcontain,ihtextangle)
call gkput(60,170,100,-1,ihselectcontain,ihangle)
call gktext(c('Force : '),ihtextforce)
call gkxedt(5,ihforce)
call gkput(20,192,-1,-1,ihselectcontain,ihtextforce)
call gkput(60,190,100,-1,ihselectcontain,ihforce)
call gkbutton(c('Valider'),ihbutok,ok)
call gkput(60,230,100,-1,ihselectcontain,ihbutok)
call gkput(0,0,-1,-1,ihmaincontain,ihselectcontain)
!!!! Zone graphique
call gkgraph(500,250,ihwin,ihplot,ihgraph)
call grrect(0,0,500,250,cblanc,ihplot)
call grrect(0,0,500,5,cvert,ihplot)
call grvect(20,5,20,15,cnoir,ihplot)
!!!tete a toto
call grvect(19,16,21,16,cnoir,ihplot)
call grvect(18,17,22,17,cnoir,ihplot)
call grvect(17,18,23,18,cnoir,ihplot)
call grvect(17,19,23,19,cnoir,ihplot)
call grvect(17,20,23,20,cnoir,ihplot)
call grvect(18,21,22,21,cnoir,ihplot)
call grvect(19,22,21,22,cnoir,ihplot)
!!!crosse
call grvect(20,10,12,19,cnoir,ihplot) !! crosse gauche
call grvect(12,19,13,20,cnoir,ihplot)
call grvect(12,20,13,21,cnoir,ihplot)
!!!drapeau
call grvect(int(distance),6,int(distance),26,cnoir,ihplot)
call grvect(int(distance),26,int(distance)+6,23,cnoir,ihplot)
call grvect(int(distance),20,int(distance)+6,23,cnoir,ihplot)
call grvect(int(distance)-5,3,int(distance)-5,7,cnoir,ihplot)
call grvect(int(distance)+5,3,int(distance)+5,7,cnoir,ihplot)
call grvect(int(distance)+1,22,int(distance)+1,24,crouge,ihplot)
call grvect(int(distance)+2,22,int(distance)+2,24,crouge,ihplot)
call grvect(int(distance)+3,23,int(distance)+4,23,crouge,ihplot)
call gkput(0,0,-1,-1,ihgraphcontain,ihgraph)
call gkput(200,0,-1,-1,ihmaincontain,ihgraphcontain)
call gkput(160,0,-1,-1,ihwin,ihmaincontain)
call gkshow(ihwin)
call gkproc
newgame=0
end if
if(quitter==1) then !!pour sortir du prog proprement
call gkdestroy(ihwin)
STOP
end if
if(ok==1) then
call gkgetstring(tamponstr,ihforce)
tamponchar=f_str2char(tamponstr)
READ(tamponchar,*)force
call gkgetstring(tamponstr,ihangle)
tamponchar=f_str2char(tamponstr)
READ(tamponchar,*)angle
!!!! Il faut tout redessiner ^^
call gkdestroy(ihgraph)
call gkdestroy(ihgraphcontain)
call gkcontain(1,0,0,3,ihgraphcontain)
call gkgraph(500,250,ihwin,ihplot,ihgraph)
call grrect(0,0,500,250,cblanc,ihplot)
call grrect(0,0,500,5,cvert,ihplot)
call grvect(20,5,20,15,cnoir,ihplot)
!!!tete a toto
call grvect(19,16,21,16,cnoir,ihplot)
call grvect(18,17,22,17,cnoir,ihplot)
call grvect(17,18,23,18,cnoir,ihplot)
call grvect(17,19,23,19,cnoir,ihplot)
call grvect(17,20,23,20,cnoir,ihplot)
call grvect(18,21,22,21,cnoir,ihplot)
call grvect(19,22,21,22,cnoir,ihplot)
!!!crosse
call grvect(20,10,28,19,cnoir,ihplot) !! crosse droite
call grvect(28,19,27,20,cnoir,ihplot)
call grvect(28,20,27,21,cnoir,ihplot)
!!!drapeau
call grvect(int(distance),6,int(distance),26,cnoir,ihplot)
call grvect(int(distance),26,int(distance)+6,23,cnoir,ihplot)
call grvect(int(distance),20,int(distance)+6,23,cnoir,ihplot)
call grvect(int(distance)-5,3,int(distance)-5,7,cnoir,ihplot)
call grvect(int(distance)+5,3,int(distance)+5,7,cnoir,ihplot)
call grvect(int(distance)+1,22,int(distance)+1,24,crouge,ihplot)
call grvect(int(distance)+2,22,int(distance)+2,24,crouge,ihplot)
call grvect(int(distance)+3,23,int(distance)+4,23,crouge,ihplot)
!!!!Parabole du lancer
x1=20
y1=6
t=0.0
findeboucle=1
do while(findeboucle==1)
x2=int((cos(angle*(PI/180)))*force*t+20-vent*0.2*t*t) !!! force du vent presente
y2=int((-1.0/2.0)*9.81*t*t+(sin(angle*(PI/180)))*force*t+6)
if(y2<6) then
x2=x1 !!!! Aproximation due a un "dt" petit
call grvect(x1,y1,x2,6,couleurlancer,ihplot)
findeboucle=0
else
call grvect(x1,y1,x2,y2,couleurlancer,ihplot)
end if
t=t+0.05
x1=x2
y1=y2
end do
call gkput(0,0,-1,-1,ihgraphcontain,ihgraph)
call gkput(200,0,-1,-1,ihmaincontain,ihgraphcontain)
call gkshow(ihwin)
call gkproc
ok=0
if(x1>=distance-5 .AND. x1<=distance+5) then
call gkmsgbox(c('Vous gagnez !!'),1,0,boutonmsgbox)
else
call gkmsgbox(c('Vous perdez !!'),1,3,boutonmsgbox)
end if
end if
!!!!! Fenetre d'options / about
if(options==1) then
call optionswindow(couleurlancer)
options=0
end if
call gkproc
END DO
call gkdestroy(ihwin)
end program golf
subroutine optionswindow(couleur)
use pimod
integer :: R,G,Bl
integer :: save=0
integer,intent(out) :: couleur
character(len=3) :: valuecha
type(string) :: valuestr
call gkwindow(c('Options'),0,0,ihwinoptions,iclos)
call gkcontain(1,0,0,3,ihcontain)
!360x244 !dimensions de l'image
call gkcontain(1,0,0,3,ihcontainImage)
call grpixbuf(360,244,ihpixbuf)
call grpixbufload(c('Wood_putter_iron.jpg'),ihpixbuf,ierr)
print *,"code d'erreur du chargement de l'image : ",ierr
call gkgraph(305,299,ihwinoptions,ihplot1,ihgraph1)
call grpixbufput(0,0,0,0,305,299,ihpixbuf,ihplot1)
call gkput(0,0,-1,-1,ihcontainImage,ihgraph1)
call gkput(0,0,-1,-1,ihcontain,ihcontainImage)
call gktext(c('Couleur du lancer : '),ihtextcouleurlancer)
call gkput(380,10,-1,-1,ihcontain,ihtextcouleurlancer)
call gktext(c('Taux de Rouge : '),ihtextR)
call gktext(c('Taux de Vert : '),ihtextG)
call gktext(c('Taux de Bleu : '),ihtextBl)
call gkxedt(3,ihTextFIeldR)
call gkxedt(3,ihTextFIeldG)
call gkxedt(3,ihTextFIeldBl)
call gkbutton(c('Sauver'),ihbutenrg,save)
call gkput(400,40,-1,-1,ihcontain,ihtextR)
call gkput(400,70,-1,-1,ihcontain,ihtextG)
call gkput(400,100,-1,-1,ihcontain,ihtextBl)
call gkput(490,40,40,-1,ihcontain,ihTextFIeldR)
call gkput(490,70,40,-1,ihcontain,ihTextFIeldG)
call gkput(490,100,40,-1,ihcontain,ihTextFIeldBl)
call gkput(470,150,-1,-1,ihcontain,ihbutenrg)
call gksetstring(c('0'),ihTextFIeldR)
call gksetstring(c('0'),ihTextFIeldG)
call gksetstring(c('0'),ihTextFIeldBl)
call gkput(0,0,-1,-1,ihwinoptions,ihcontain)
call gkshow(ihwinoptions)
DO WHILE(iclos.eq.0)
if(save==1) then
call gkgetstring(valuestr,ihTextFIeldR)
valuecha=f_str2char(valuestr)
READ(valuecha,*)R
call gkgetstring(valuestr,ihTextFIeldG)
valuecha=f_str2char(valuestr)
READ(valuecha,*)G
call gkgetstring(valuestr,ihTextFIeldBl)
valuecha=f_str2char(valuestr)
READ(valuecha,*)Bl
couleur = ((R*256)+G)*256+Bl
EXIT
end if
call gkproc
END DO
call gkdestroy(ihwinoptions)
end subroutine optionswindow
Nous obtenons donc ceci :
Fenêtre principale du jeu de golf
Fenêtre d'options (GNU Liscence/Wiki Commons)
Fenêtre de l'exemple de PILIB
![[1]](http://pilib.beta-centauri.de/images/0/0e/Golf.jpg){kind=link}