'

' programme eclipse

'Programme en basic GFA de mesures de température et de lumière et de déclenchement d'appareils photos.

' ***** initialisation *****

CLIP 0,0,640,200

DEFFILL 3,1

ecrancls

DIM entree$(40)' tableau pour menu

DIM duree1$(40)' tableau pour heure photo1

DIM duree2$(40)'tableau pour heure photo2

DIM he$(5)' tableau pour heure contacts

DIM dhe(5) 'tableau pour heure contacts

DIM the$(5) 'tableau pour heure contacts

OPEN "i",#1,"heurepg1.dat"'fichier heure photos1

FOR i=0 TO 40

INPUT #1,duree1$(i)

NEXT i

CLOSE #1

OPEN "i",#1,"heurepg2.dat" heurepg1.dat"'fichier heure photos2

FOR i=0 TO 40

INPUT #1,duree2$(i)

NEXT i

CLOSE #1

TIME$="10:12:00"'mise à heure et date fictives pour démarrer

DATE$="11.08.1999"

nphoto1=36'nb photos

nphoto2=25

adres=&HFB0000'adresse mémoire pour piloter le montage électronique

adree=&HFA0001

reset=adres+&X11111111

tmesure=300'durée entre mesures

hmesure=@heuren+tmesure'heure prochaine mesure

tnorm=0.7'durée contact pour photo

tbip1=60' durée bip avant photo

validp1=0'validation photo1

tbip2=60

validp2=0

he$(1)="11:05:51"'heure contact

he$(2)="12:23:23"

he$(3)="12:25:38"

he$(4)="13:46:34"

he$(5)="24:00:00"

FOR i=1 TO 5

dhe(i)=3600*VAL(LEFT$(he$(i),2))+60*VAL(MID$(he$(i),4,2))+VAL(RIGHT$(he$(i),2))

NEXT i

the$(1)="1øcontact … "

the$(2)="2øcontact … "

the$(3)="3øcontact … "

the$(4)="4øcontact … "

GOSUB quand

i%=-1

REPEAT'lecture écran menu

INC i%

READ entree$(i%)

UNTIL entree$(i%)="marque de fin"

entree$(i%)=""

'

actua

' ************************************

'

REPEAT

ALERT 0,"resultat ou fonctionnement ?",0,"resultat|marche|quitter",chx1

IF chx1=1 THEN

ALERT 0,"lecture",0,"mesure|photo|retour",chx2

ON chx2 GOSUB prglectmes,prglectphoto

ENDIF

IF chx1=2 THEN

GOSUB marche

ENDIF

UNTIL chx1=3

END

'

PROCEDURE marche

sortie=0

ALERT 1," attention |effacement des mesures ?",2,"efface|poursuite",chx2

IF chx2=1 THEN

OPEN "O",#2,"MESURE.DAT"

OPEN "O",#3,"HPHOTO.DAT"

ENDIF

IF chx2=2 THEN

OPEN "A",#2,"MESURE.DAT"'ouverture en ajout

OPEN "A",#3,"HPHOTO.DAT"

ENDIF

MENU 31,2

ON MENU GOSUB choix

OPENW 0

REPEAT

ON MENU 500

GOSUB chrono

PRINT AT(27,11);"il est ";TIME$

PRINT AT(27,12);the$(c);he$(c);USING " dans #### secondes ",durcont

PRINT AT(27,13);USING "temperature : ###.## degr‚s",tempe

PRINT AT(27,14);USING "lumiere : ###### lux ",lux

PRINT AT(15,17);"PHOTO 1"

PRINT AT(4,19);"heure photo programm‚e … ";duree1$(rg1)

IF validp1=-1 THEN

PRINT AT(4,20);USING "photo dans ###### secondes",duree1

PRINT AT(4,21);"contact photo valid‚ "

ELSE

PRINT AT(4,21);"contact photo non valid‚ "

ENDIF

PRINT AT(4,22);USING "il reste ### photos ",nphoto1

PRINT AT(55,17);"PHOTO 2"

PRINT AT(44,19);"heure photo programm‚e … ";duree2$(rg2)

IF validp2=-1 THEN

PRINT AT(44,20);USING "photo dans ###### secondes",duree2

PRINT AT(44,21);"contact photo valid‚ "

ELSE

PRINT AT(44,21);"contact photo non valid‚ "

ENDIF

PRINT AT(44,22);USING "il reste ### photos ",nphoto2

IF durmesure>2 THEN

GOSUB mesure

ENDIF

UNTIL sortie

OPEN "o",#1,"heurepg1.dat"'sauvegarde heure photo1

FOR i=0 TO 40

PRINT #1,duree1$(i)

NEXT i

CLOSE #1

OPEN "o",#1,"heurepg2.dat"

FOR i=0 TO 40

PRINT #1,duree2$(i)

NEXT i

CLOSE #1

CLOSE #2

CLOSE #3

MENU KILL

ecrancls

RETURN

'

DEFFN heuren=3600*VAL(LEFT$(TIME$,2))+60*VAL(MID$(TIME$,4,2))+VAL(RIGHT$(TIME$,2))'mise en valeur numérique de l'heure

'

PROCEDURE chrono

duree1=hprogram1-@heuren

duree2=hprogram2-@heuren

durmesure=hmesure-@heuren

durcont=dhe(c)-@heuren

IF durmesure<1 THEN

hmesure=@heuren+tmesure

GOSUB stmesure

ENDIF

IF durcont<10 THEN'bruit de sirene avant contact

mus=0

acquit=-1

freq=NOT freq

IF freq THEN

note=5

ELSE

note=7

ENDIF

SOUND 1,15,note,6

ELSE

mus=-1

ENDIF

IF mus AND acquit THEN

SOUND 1,0,0,0,0

acquit=0

ENDIF

IF durcont<1 THEN'positionnement pour heure contact

c=c+1

ENDIF

IF duree1<2 THEN 'positionnement pour heure photo1

rg1=rg1+1

hprogram1=3600*VAL(LEFT$(duree1$(rg1),2))+60*VAL(MID$(duree1$(rg1),4,2))+VAL(RIGHT$(duree1$(rg1),2))

flag1=-1

ENDIF

IF duree2<2 THEN

rg2=rg2+1

hprogram2=3600*VAL(LEFT$(duree2$(rg2),2))+60*VAL(MID$(duree2$(rg2),4,2))+VAL(RIGHT$(duree2$(rg2),2))

flag2=-1

ENDIF

IF flag1 OR flag2 THEN

GOSUB photo

ENDIF

son=0

IF validp1 THEN 'bip pour prévenir photo

IF duree1<tbip1+1 THEN

IF flagbip1 THEN

son=1

ENDIF

ELSE

flagbip1=-1

ENDIF

ENDIF

IF validp2 THEN

IF duree2<tbip2+1 THEN

IF flagbip2 THEN

son=son+2

ENDIF

ELSE

flagbip2=-1

ENDIF

ENDIF

IF son>0 AND mus THEN

IF son=1 THEN

SOUND 1,15,5,4,25

SOUND 1,0,0,0,0

flagbip1=0

ENDIF

IF son=2

SOUND 1,15,5,5,25

SOUND 1,0,0,0,0

flagbip2=0

ENDIF

IF son=3

SOUND 1,15,5,4,25

SOUND 1,15,5,5,25

SOUND 1,0,0,0,0

flagbip1=0

flagbip2=0

ENDIF

ENDIF

RETURN

'

PROCEDURE choix

MENU OFF

m=MENU(0)

SELECT m

CASE 1

GOSUB quitter

CASE 11

GOSUB heureact

CASE 12

GOSUB heurcontact1

CASE 13

GOSUB heurcontact2

CASE 14

GOSUB heurcontact3

CASE 15

GOSUB heurcontact4

CASE 18

GOSUB imphoto1

CASE 19

GOSUB imphoto2

CASE 20

GOSUB stmesure

CASE 23

GOSUB durmesure

CASE 24

GOSUB durappui

CASE 27

GOSUB durbip1

CASE 28

GOSUB durprog1

CASE 29

GOSUB valprog1

CASE 30

GOSUB nbphoto1

CASE 33

GOSUB durbip2

CASE 34

GOSUB durprog2

CASE 35

GOSUB valprog2

CASE 36

GOSUB nbphoto2

DEFAULT

PRINT m

ENDSELECT

ecrancls

RETURN

'

PROCEDURE quitter

ALERT 1,"Etes vous sur| de vouloir quitter ?",2,"oui|non",choix

IF choix=1

sortie=-1

ENDIF

RETURN

'

PROCEDURE heureact

d$=DATE$

h$=TIME$

LOCATE 5,5

PRINT "donner l'heure sous la forme hh:mm:ss "

FORM INPUT 8 AS h$

SETTIME h$,d$

GOSUB quand

RETURN

'

PROCEDURE quand'mise à jour des heures et tempo aprés modif de l'heure

rg1=0

WHILE TIME$>duree1$(rg1) AND rg1<37

rg1=rg1+1

WEND

hprogram1=3600*VAL(LEFT$(duree1$(rg1),2))+60*VAL(MID$(duree1$(rg1),4,2))+VAL(RIGHT$(duree1$(rg1),2))

rg2=0

WHILE TIME$>duree2$(rg2) AND rg2<37

rg2=rg2+1

WEND

hprogram2=3600*VAL(LEFT$(duree2$(rg2),2))+60*VAL(MID$(duree2$(rg2),4,2))+VAL(RIGHT$(duree2$(rg2),2))

c=1

WHILE TIME$>he$(c) AND c<5

c=c+1

WEND

FOR i=1 TO 4

dhe(i)=3600*VAL(LEFT$(he$(i),2))+60*VAL(MID$(he$(i),4,2))+VAL(RIGHT$(he$(i),2))

NEXT i

RETURN

'

PROCEDURE heurcontact1

LOCATE 5,5

PRINT "donner l'heure du 1øcontact sous la forme hh:mm:ss "

FORM INPUT 8 AS he$(1)

GOSUB quand

RETURN

'

PROCEDURE heurcontact2

LOCATE 5,5

PRINT "donner l'heure du 2øcontact sous la forme hh:mm:ss "

FORM INPUT 8 AS he$(2)

GOSUB quand

RETURN

'

PROCEDURE heurcontact3

LOCATE 5,5

PRINT "donner l'heure du 3øcontact sous la forme hh:mm:ss "

FORM INPUT 8 AS he$(3)

GOSUB quand

RETURN

'

PROCEDURE heurcontact4

LOCATE 5,5

PRINT "donner l'heure du 4øcontact sous la forme hh:mm:ss "

FORM INPUT 8 AS he$(4)

GOSUB quand

RETURN

'

PROCEDURE imphoto1'photo1 immédiate

flag=validp1

flag1=-1

validp1=-1

GOSUB photo

validp1=flag

RETURN

'

PROCEDURE imphoto2

flag=validp2

flag2=-1

validp2=-1

GOSUB photo

validp2=flag

RETURN

'

PROCEDURE stmesure

mesure

PRINT #2,TIME$,STR$(tempe),STR$(lux)

RETURN

'

PROCEDURE durmesure

LOCATE 5,5

INPUT "dur‚e entre les mesures : ";tmesure

actua

RETURN

'

PROCEDURE durbip1

LOCATE 5,5

INPUT "dur‚e entre bip et photo ";tbip1

actua

RETURN

'

PROCEDURE durappui

LOCATE 5,5

INPUT "dur‚e normale d'appui de d‚clenchement ";tnorm

actua

RETURN

'

PROCEDURE durprog1'modifcation des heures photo1

REPEAT

ecrancls

FOR i=1 TO 35 STEP 2

PRINT "temps nø";i;" … ";duree1$(i-1);

PRINT TAB(40);"temps nø";i+1;" … ";duree1$(i)

NEXT i

PRINT

INPUT "nø … supprimer (0 pour sortir) ";num

IF num>0 AND num<37 THEN

duree1$(num-1)="24:00:00"

QSORT duree1$(),37

ENDIF

UNTIL num=0

REPEAT

ecrancls

FOR i=1 TO 35 STEP 2

PRINT "temps nø";i;" … ";duree1$(i-1);

PRINT TAB(40);"temps nø";i+1;" … ";duree1$(i)

NEXT i

PRINT

PRINT "heure ? ";

FORM INPUT 8,duree$

duree1$(36)=duree$

QSORT duree1$(),37

UNTIL duree$=""

GOSUB quand

RETURN

'

PROCEDURE valprog1'validation photo1

validp1=NOT (validp1)

RETURN

'

PROCEDURE nbphoto1

LOCATE 5,5

INPUT " nombre de photos ";nphoto1

RETURN

'

PROCEDURE durbip2

LOCATE 5,5

INPUT "dur‚e entre bip et photo ";tbip2

actua

RETURN

'

PROCEDURE durappui2

LOCATE 5,5

INPUT "dur‚e normale d'appui de d‚clenchement ";tnorm2

actua

RETURN

'

PROCEDURE durprog2

REPEAT

ecrancls

FOR i=1 TO 35 STEP 2

PRINT "temps nø";i;" … ";duree2$(i-1);

PRINT TAB(40);"temps nø";i+1;" … ";duree2$(i)

NEXT i

PRINT

INPUT "nø … supprimer (0 pour sortir) ";num

IF num>0 AND num<37 THEN

duree2$(num-1)="24:00:00"

QSORT duree2$(),37

ENDIF

UNTIL num=0

REPEAT

ecrancls

FOR i=1 TO 35 STEP 2

PRINT "temps nø";i;" … ";duree2$(i-1);

PRINT TAB(40);"temps nø";i+1;" … ";duree2$(i)

NEXT i

PRINT

PRINT "heure ? ";

FORM INPUT 8,duree$

duree2$(36)=duree$

QSORT duree2$(),37

UNTIL duree$=""

GOSUB quand

RETURN

'

PROCEDURE valprog2

validp2=NOT (validp2)

RETURN

'

PROCEDURE nbphoto2

LOCATE 5,5

INPUT " nombre de photos ";nphoto2

RETURN

'

PROCEDURE photo

n1=0

n2=0

cde1=&X11111111

cde2=&X11111111

IF validp1 AND flag1 THEN

nphoto1=nphoto1-1

IF nphoto1<0 THEN

nphoto1=0

ENDIF

n1=1

cde1=&X1111111'mise à 0 bit 7

ENDIF

IF validp2 AND flag2 THEN

nphoto2=nphoto2-1

IF nphoto2<0 THEN

nphoto2=0

ENDIF

n2=1

cde2=&X10111111'mise à 0 bit 6

ENDIF

IF cde1<>cde2 THEN

PRINT #3,TIME$,n1,n2

cde=cde1 AND cde2

prepa=adres+cde

a=PEEK(prepa)'mise à 0 bits 6 et 7

DELAY tnorm'durée photo

a=PEEK(reset)'remise à 1

ENDIF

flag1=0

flag2=0

RETURN

'

PROCEDURE mesure

' temperature

prepa=adres+&X11111011

wr=adres+&X11111010

rd=adres+&X11111001

GOSUB saisie

tempe=b*0.1+15

' lumiere

prepa=adres+&X11110111

wr=adres+&X11110110

rd=adres+&X11110101

GOSUB saisie

d=1

g=800

IF b<25 THEN

prepa=adres+&X11100111

wr=adres+&X11100110

rd=adres+&X11100101

GOSUB saisie

d=1

g=80

ENDIF

IF b<25 THEN

prepa=adres+&X11010111

wr=adres+&X11010110

rd=adres+&X11010101

GOSUB saisie

d=2

g=8

ENDIF

IF b<25 THEN

prepa=adres+&X11000111

wr=adres+&X11000110

rd=adres+&X11000101

GOSUB saisie

d=12

g=0.8

ENDIF

a=PEEK(reset)

lux=(b-d)*g

RETURN

'

'

PROCEDURE saisie

a=PEEK(prepa)

DELAY 0.1

a=PEEK(wr)

a=PEEK(prepa)

a=PEEK(rd)

a=PEEK(prepa)

b=PEEK(adree)

RETURN

'

PROCEDURE creafich

' pour cr‚er le fichier n‚cessaire

' s'appelle en mode direct par "gosub creafich"

OPEN "o",#1,"heurepg.dat"

FOR i=0 TO 40

PRINT #1,"24;00;00"

NEXT i

CLOSE #1

RETURN

'

PROCEDURE prglectmes'lecture des mesures

OPEN "i",#2,"MESURE.DAT"

ecrancls

PRINT " heure temperature lumiere"

WHILE NOT EOF(#2)

PRINT INPUT$(1,#2);

WEND

PRINT "appuyer sur une touche"

KEYGET ras

CLOSE #2

ecrancls

RETURN

'

PROCEDURE prglectphoto'lecture des heures photos

OPEN "i",#3,"HPHOTO.DAT"

ecrancls

PRINT " heure photo1 photo2"

WHILE NOT EOF(#3)

PRINT INPUT$(1,#3);

WEND

PRINT "fin - appuyer sur une touche"

KEYGET ras

CLOSE #3

ecrancls

RETURN

'

PROCEDURE rien

RETURN

'

PROCEDURE actua'mise à jour écran menu

entree$(27)=" dur‚e entre bip et photo "+STR$(tbip1)

entree$(24)=" dur‚e appui "+STR$(tnorm)

entree$(33)=" dur‚e entre bip et photo "+STR$(tbip2)

entree$(23)=" dur‚e entre mesures "+STR$(tmesure)

MENU entree$()

RETURN

'

PROCEDURE ecrancls

CLS

PBOX 0,0,640,200

RETURN

' -------------------------------------------------'

' $$$$$$$$$$$$$ data pour les menus

DATA desk, quitter,------------------------,1,2,3,4,5,6,

DATA heure, heure actuelle, 1øcontact, 2øcontact, 3øcontact, 4øcontact,

DATA immediat, photo1, photo2, mesure,

DATA g‚n‚ral, , ,

DATA photo1, , programme, validation, nombre photos,

DATA photo2, , programme, validation, nombre photos,

DATA marque de fin

'

' --------------------------------------------