Win3x.Org

Windows & DOS Community

Postez vos petits programmes en QBasic

Règles du forum

Pour tout sujet impliquant un système d'exploitation daté de 2000 à nos jours, merci de le publier dans la section intitulée « Informatique moderne ».

Répondre   Page 5 sur 5  [ 44 messages ]
Aller sur la page « 1 2 3 4 5
Auteur Message
gm86
Sujet du message : Re: Postez vos petits programmes en QBasic
Publié : 04 déc. 2019 15:43
Membre inscrit
Avatar de l’utilisateur
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.
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:
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.
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
remax17
Sujet du message : Re: Postez vos petits programmes en QBasic
Publié : 18 juil. 2020 10:03
Membre inscrit
Avatar de l’utilisateur
Hors-ligne
 
Messages : 1073
Inscription : 22 sept. 2010 15:03
PC Rétro : PIII 500mhz -384Mb RAM - Voodoo 2 en SLI
 
C'est du Locomotive Basic ;)

_________________

Mon OneDrive


Haut
Profil Citer
glaby91
Sujet du message : Re: Postez vos petits programmes en QBasic
Publié : 18 juil. 2020 22:28
Membre inscrit
Hors-ligne
 
Messages : 3
Inscription : 17 juil. 2020 20:54
 
Oui et je programme aussi en Z80. C'est juste qu'en basic on peut faire des petites choses assez vite.
Pour le côté vitesse c'est toutefois mieux avec l'ASM, j'ais noté 42s pour charger/afficher un niveau du petit jeu en basic et à peine 8 pour faire la même action en ASM. Toutefois il es certainement possible d'optimisé le code mais pour le moment je m'attelle à le faire fonctionner !


En faite j'ais commençé assez jeune avec le CPC et son manuel a programmé en basic ou plutot recopié les programmes du manuel puis j'ais fait du qbasic sur un IBM PS1 je croit bien, et ceci jusqu'au dernier Qbasic compilable meme windows 10 je crois bien. Aujourdhui je me remet au CPC et surtout son asm , de formation bts electronique , j'ais fait pas mal de programmation pour du Atmel / Pic / 6809 et du C / VHDL mais je ne me souviens plus de grand chose. Maintenant c'est Z80 et ses banques memoire de 64 Ko qui m'appele, le pilotage du gate array , crtrc, puce sonore yamaha. C'est ce que j'aime dans la programmation, maitrisé le bazarre de A à Z et etre independant de tout autre systeme. Si ça ne marche pas ça n'est que de ma faute !
Bonne soirée à tous !

Dernière modification par glaby91 le 18 juil. 2020 22:34, modifié 1 fois.

Haut
Profil
Afficher : Trier par : Ordre :
Répondre   Page 5 sur 5  [ 44 messages ]
Revenir à « Informatique des vieux systèmes » | Aller sur la page « 1 2 3 4 5
Aller :