Postez vos petits programmes en QBasic

Auteur

Message

gm86

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 04 déc. 2019 15:43

Membre inscrit

Hors-ligne

Messages : 628

Inscription : 01 sept. 2008 19:07

Comme tous les 2/3 ans, un nouveau message.

La touche COS¯¹ des calculatrices n'a pas d'équivalent en BASIC. Heureusement, le guide du GW-BASIC donne la solution :
http://www.antonis.de/qbebooks/gwbasman ... x%20B.html

Prenons par exemple une formule trigonométrique utile en astronomie,
cos A/2 = - tg D . tg L
tirée du lien suivant :
http://oncle.dom.pagesperso-orange.fr/p ... tm#Maisons
Elle donne la valeur angulaire de l'arc que parcourt une étoile dans le ciel sous la forme
A = 2 arc cos (- tg D . tg L)
avec D la déclinaison de l'astre et L la latitude du lieu.

Vu que le BASIC Microsoft travaille en radians, les données en degrés seront converties pour obtenir le résultat intermédiaire T=-TAN(D)*TAN(L).
Avec A=2*FNARCCOS(T),
DEF FNARCCOS(X)=ATN (X/SQR(-X*X+1)) + PI/2
soit ATN (X/SQR(-X*X+1)) + ATN(1)*2
puisque PI=ATN(1)*4 en simple précision (355/113).

Lors de la recopie du code suivant, faites sauter les sauts à l'intérieur des lignes numérotées ! Les éditeurs de texte ne connaissent pas Ctrl+J.

Code : Tout sélectionner

10 REM Déterminer le parcours angulaire d'un astre depuis son lever au coucher.
20 PRINT"Renseignez la position de l'étoile et le lieu d'observation."
30 INPUT "Déclinaison ";D
40 IF D>90 OR D<-90 THEN PRINT"Angle requis entre -90 et 90° !" :GOTO 30
50 INPUT "Latitude ";L
60 IF L>90 OR L<-90 THEN PRINT"Angle requis entre -90 et 90° !" :GOTO 50
70 REM Coordonnées converties en radians sauf cas particuliers des pôles.
80 IF ABS(D)-90 AND ABS(L)-90 THEN T=-TAN(D*ATN(1)/45)*TAN(L*ATN(1)/45)
				ELSE T=(ABS(D-L)<90)*2+1	'T=+/-1 si pôle
90 IF FIX(T) THEN
	IF T<0 THEN PRINT"L'étoile est circumpolaire."		:END
		ELSE PRINT"L'étoile reste sous l'horizon."	:END
100 A=90*-ATN(T/SQR(1-T*T))/ATN(1)+180				'(2.arc cos T)°
110 PRINT"L'étoile décrit un arc de";STR$(A);"° dans le ciel."

La formule traite avec |T|<1 pour renvoyer 0°<A<360°. De même, nous tenons compte des cas spécifiques aux pôles célestes et terrestres.

En attendant 2021 ou 2022...

_________________

C:\ONGRTLNS.W95

Haut

Profil

Citer

glaby91

Sujet du message : Re: Postez vos petits programmes en QBasic

Publié : 17 juil. 2020 21:21

Membre inscrit

Hors-ligne

Messages : 3

Inscription : 17 juil. 2020 20:54

Voila le dernier programme non pas en Qbasic mais en basic compatible CPC 6128.

C'est un editeur de niveau de jeu de labyrinthe et on peut aussi tester les niveaux creer:

Code : Tout sélectionner

10 MODE 1:BORDER 0:INK 0,0:PAPER 0:INK 1,5: PEN 1:INK 3,18,25:SPEED INK 25,25
20 INK 2,17
30 index=1:carac=143
35 PEN 1
40 REM FOR a=110 TO 255:PRINT a;:PRINT CHR$(a)
50 REM IF INKEY$="" THEN GOTO 50
60 REM NEXT
70 FOR a=1 TO 40
80 LOCATE a,1:PRINT CHR$(carac)
85 LOCATE a,25:PRINT CHR$(carac);:
90 NEXT
100 FOR a=1 TO 25 : LOCATE 1,a:PRINT CHR$(carac);:LOCATE 40,a:PRINT CHR$(carac);:NEXT
105 PEN 2:LOCATE 1,1:PRINT CHR$(22)+CHR$(1)+"EDiteur Laby V0.3":PRINT CHR$(22)+CHR$(0)
110 DIM table(40,25)
120 cursx=20:cursy=12
130 PEN 1:LOCATE cursx,cursy:PRINT CHR$(carac)
140 clav$=INKEY$:clav$=LOWER$(clav$)
150 IF clav$="4" THEN GOSUB 210
160 IF clav$="6" THEN GOSUB 260
170  IF clav$="8" THEN GOSUB 310
180  IF clav$="2" THEN GOSUB 350
181 IF clav$="t" THEN GOSUB 1300
190  IF clav$=" " THEN GOSUB 400
191 IF clav$="j" THEN GOSUB 2000
192 IF clav$="s" THEN GOSUB 1000
193 IF clav$="c" THEN CLS:FOR y=1 TO 25:FOR x=1 TO 40:table(x,y)=0:NEXT x:NEXT y:index=1:carac=143:PEN 1:LOCATE cursx,cursy:PRINT CHR$(carac);:FOR a=1 TO 40:LOCATE a,1:PRINT CHR$(carac):LOCATE a,25:PRINT CHR$(carac);:NEXT
194 IF clav$="l" THEN GOSUB 1100
200 GOTO 140
210 'rem gauche
220 GOSUB 600
230 cursx=cursx-1
231 PEN 1
240 IF cursx=0 THEN cursx=1
241 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
242 LOCATE cursx,cursy:PRINT CHR$(carac);:
250 RETURN
260 ' droite
270 GOSUB 600
280 cursx=cursx+1
281 PEN 1
290 IF cursx=41 THEN cursx=40
291 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
300 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN
310 'rem haut
320 GOSUB 600
321 PEN 1
330 cursy=cursy-1:IF cursy=0 THEN cursy=1
331 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
340 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN
350 'rem BAS
360 GOSUB 600    
365 PEN 1
370 cursy=cursy+1:IF cursy=26 THEN cursy=25
371 IF index=1 THEN PEN 1 ELSE IF index=2 THEN PEN 3 ELSE IF index=3 OR INDEX=8 THEN PEN 2
380 LOCATE cursx,cursy:PRINT CHR$(carac);:RETURN  
390 'press space
400 IF table(cursx,cursy)=index THEN table(cursx,cursy)=0 ELSE table(cursx,cursy)=index
410 RETURN
600 PEN 0:LOCATE cursx,cursy:PRINT CHR$(143);
601 IF table(cursx,cursy)=1 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(143)
602 IF table(cursx,cursy)=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)
603 IF table(cursx,cursy)=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(207)
604 IF table(cursx,cursy)=4 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(244)
605 IF table(cursx,cursy)=5 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(245) 
606 IF table(cursx,cursy)=6 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(246) 
607 IF table(cursx,cursy)=7 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(247)
608 IF table(cursx,cursy)=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(228)
610 RETURN
1000 'sauvegarde tableau
1010 OPENOUT"table.lab"
1020 REM PRINT #9,40
1030 FOR x=1 TO 40
1040 FOR y=1 TO 25
1050 PRINT #9,table(x,y)
1060 NEXT y
1070 NEXT x
1080 CLOSEOUT
1090 RETURN
1100 ' charge table
1110 OPENIN"table.lab"
1130 FOR x=1 TO 40
1140 FOR y=1 TO 25
1150 INPUT #9,table(x,y)
1160 NEXT y
1170 NEXT x
1175 CLOSEIN
1180 'affichage
1190 FOR y=1 TO 25
1200 FOR x=1 TO 40
1210 index=table(x,y):IF index=1 THEN PEN 1:carac=143:LOCATE x,y:PRINT CHR$(carac)
1211 IF index=2 THEN PEN 3:carac=231:LOCATE x,y:PRINT CHR$(carac)
1212 IF index=3 THEN PEN 2:carac=207:LOCATE x,y:PRINT CHR$(carac) 
1213 IF index=4 THEN PEN 1:carac=244:LOCATE x,y:PRINT CHR$(carac)
1214 IF index=5 THEN PEN 1:carac=245:LOCATE x,y:PRINT CHR$(carac)
1215 IF index=6 THEN PEN 1:carac=246:LOCATE x,y:PRINT CHR$(carac)     
1216 IF index=7 THEN PEN 1:carac=247:LOCATE x,y:PRINT CHR$(carac)
1217 IF index=8 THEN PEN 2:carac=228:LOCATE x,y:PRINT CHR$(carac)   
1220 NEXT x
1230 NEXT y
1240 LOCATE cursx,cursy:PRINT CHR$(carac);:
1250 RETURN
1300 index=index+1
1310 IF index=9 THEN index=1
1320 IF index=1 THEN carac=143:PEN 1
1321 IF index=8 THEN carac=228:PEN 2
1330 IF index=2 THEN carac=231:PEN 3
1335 IF index=3 THEN carac=207:PEN 2
1336 IF index=4 THEN carac=244:PEN 1
1337 IF index=5 THEN carac=245:PEN 1
1338 IF index=6 THEN carac=246:PEN 1
1339 IF index=7 THEN carac=247:PEN 1
1340 LOCATE cursx,cursy:PRINT CHR$(carac);:
1350 RETURN
2000 REM jeux simulation
2001 tableau=1
2010 vie=3:index=table(cursx,cursy):miam=0
2011 FOR y=1 TO 25
2012 FOR x=1 TO 40
2013 IF table(x,y)=2 THEN miam=miam+1
2014 NEXT x
2015 NEXT y
2020 IF index=0 THEN PEN 0:LOCATE cursx,cursy:PRINT CHR$(143)
2030 IF index=1 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(143)
2040 IF index=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)
2050 IF index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(203)
2051 IF index=4 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(244)
2052 IF index=5 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(245)
2053 IF index=6 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(246)
2054 IF index=7 THEN PEN 1:LOCATE cursx,cursy:PRINT CHR$(247)
2055 IF index=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(228)
2060 REM affichage perso
2070 cursx=2:cursy=24
2080 PEN 2:LOCATE cursx,cursy:PRINT CHR$(224);:
2082 GOSUB 4000
2090 REM test clavier
2100 a$=INKEY$
2110 IF a$="r" THEN RETURN
2120 IF a$="6" THEN GOSUB 2300
2130 IF a$="4" THEN GOSUB 2500
2140 IF a$="8" THEN GOSUB 2700
2150 IF a$="2" THEN GOSUB 2900
2151 IF a$="p" THEN miam=0:vie=3:GOSUB 5000
2200 GOTO 2100
2300  GOSUB 3500
2350 cursx=cursx+1:IF cursx=40 THEN cursx=cursx-1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000
2360 index=table(cursx,cursy)
2370 IF index=0 OR index=2 OR index=3 OR index=8 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursx=cursx-1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000 
2380 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000
2381 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2390 IF miam=0 AND index=3 THEN GOSUB 5000
2400 RETURN
2500 GOSUB 3500:cursx=cursx-1:IF cursx=1 THEN cursx=cursx+1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000 
2510 index=table(cursx,cursy) 
2520 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursx=cursx+1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000     
2530 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000   
2531 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2540 IF miam=0 AND index=3 THEN GOSUB 5000    
2600 RETURN
2700 GOSUB 3500:cursy=cursy-1:IF cursy=1 THEN cursy=cursy+1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000 
2710 index=table(cursx,cursy)   
2720 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursY=cursY+1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000
2730 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000 
2731 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000   
2740 IF miam=0 AND index=3 THEN GOSUB 5000
2800 RETURN
2900 GOSUB 3500:cursY=cursY+1:IF cursy=25 THEN cursy=cursy-1:vie=vie-1:SOUND 2,1200,7:GOSUB 4000
2910 index=table(cursx,cursy)
2920 IF index=8 OR index=0 OR index=2 OR index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(224) ELSE cursY=cursY-1:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224):SOUND 2,1200,7:vie=vie-1:GOSUB 4000      
2930 IF index=2 THEN miam=miam-1:table(cursx,cursy)=0:SOUND 2,150,15:SOUND 2,200,15:SOUND 2,250,15:GOSUB 4000   
2931 IF index=8 THEN table(cursx,cursy)=0:vie=vie+1:GOSUB 4000
2940 IF miam=0 AND index=3 THEN GOSUB 5000
3100 RETURN
3500 index=table(cursx,cursy) 
3510 IF index=0 THEN PEN 0:LOCATE cursx,cursy:PRINT CHR$(143)  
3520 IF index=2 THEN PEN 3:LOCATE cursx,cursy:PRINT CHR$(231)    
3530 IF index=3 THEN PEN 2:LOCATE cursx,cursy:PRINT CHR$(207)   
3540 RETURN
4000 PEN 1:LOCATE 17,25:PRINT CHR$(143);:PRINT CHR$(143):PEN 2:LOCATE 10,25:PRINT CHR$(22)+CHR$(1)+"Vies :"+STR$(vie);:PEN 1:LOCATE 31,25:PRINT CHR$(143);:PRINT CHR$(143);:PRINT CHR$(143):PEN 2:LOCATE 25,25:PRINT"Miam:";:PRINT miam;:PRINT CHR$(22)+CHR$(0)
4010 IF vie=0 THEN END
4020 RETURN
5000 'charge tableau prochaine
5001 IF tableau=1 THEN OPENIN"table1.lab"
5011 IF tableau=2 THEN OPENIN"table2.lab"
5021 IF tableau=3 THEN OPENIN"table3.lab" 
5031 IF tableau=4 THEN OPENIN"table4.lab"   
5041 IF tableau=5 THEN OPENIN"table5.lab"    
5051 IF tableau=6 THEN OPENIN"table6.lab"
5061 IF tableau=7 THEN OPENIN"table7.lab" 
5071 IF tableau=8 THEN OPENIN"table8.lab" 
5081 IF tableau=9 THEN OPENIN"table9.lab"
5091 IF tableau=10 THEN CLS:PRINT" Bravo vous avez fini le jeu":CLOSEIN:END
5092 tableau=tableau+1
5093 CLS
5096 FOR x=1 TO 40
5099 FOR y=1 TO 25
5102 INPUT #9,table(x,y)
5112 NEXT y:NEXT x: CLOSEIN
5122 FOR x=1 TO 40:FOR y=1 TO 25:index=table(x,y)
5123 IF index=2 THEN PEN 3:LOCATE x,y:PRINT CHR$(231);:miam=miam+1
5124 IF index=1 THEN PEN 1:LOCATE x,y:PRINT CHR$(143);:
5133 IF index=3 THEN PEN 2:LOCATE x,y:PRINT CHR$(207);: 
5134 IF index=4 THEN PEN 1:LOCATE x,y:PRINT CHR$(244);:
5135 IF index=5 THEN PEN 1:LOCATE x,y:PRINT CHR$(245);:
5136 IF index=6 THEN PEN 1:LOCATE x,y:PRINT CHR$(246);:
5137 IF index=7 THEN PEN 1:LOCATE x,y:PRINT CHR$(247);:
5138 IF index=8 THEN PEN 2:LOCATE x,y:PRINT CHR$(228);:
5139 NEXT y
5140 NEXT x 
5141 FOR x=1 TO 40:PEN 1:LOCATE x,1:PRINT CHR$(143);:LOCATE x,25:PRINT CHR$(143);:NEXT x:FOR y=1 TO 25:LOCATE 1,y:PRINT CHR$(143);:LOCATE 40,y:PRINT CHR$(143);:NEXT y
5142 cursx=2:cursy=24:PEN 2:LOCATE cursx,cursy:PRINT CHR$(224);:
5143 GOSUB 4000
5144 RETURN

Un petit générateur de courbe de bézier, modifié les valeurs des couples de points x0,y0 x1,y1 x2,y2 et x3,y3 pour changer l'allure de la courbe.

Code : Tout sélectionner

10 REM courbe de bezier
20 MODE 2
30 x0=100:y0=350
40 x1=200:y1=350
50 x2=400:y2=10
51 x3=500:y3=250
60 FOR t=0 TO 1.01 STEP 0.001
70 x=(x0*(1-t)*(1-t)*(1-t))+(3*x1*t*(1-t)*(1-t)*(1-t))+(3*x2*t*t*(1-t))+(x3*t*t*t)
71 y=(y0*(1-t)*(1-t)*(1-t))+(3*y1*t*(1-t)*(1-t)*(1-t))+(3*y2*t*t*(1-t))+(y3*t*t*t)  
75 REM PRINT "T";:PRINT t;:PRINT"X";:PRINT x;:PRINT "Y";:PRINT Y
76 PLOT x,y,1
80 NEXT
90 PLOT x0,y0
100 PLOT x1,y1
110 PLOT x2,y2
120 PLOT x3,y3

Fonctionne sur CPC Basic V1.1 !

Haut

Profil

Citer

Win3x.Org

Règles du forum