diff --git a/%.BAS b/%.BAS new file mode 100644 index 0000000..32323c0 --- /dev/null +++ b/%.BAS @@ -0,0 +1,51 @@ +10 N$=CHR$(219) +20 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +30 REM :::::::::::::::::::::::::::: % % % % % % % :::::::::::::::::::::::::::::: +40 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +50 CLS:CLEAR,,,32768!:SCREEN 6:PALETTE 1,2:PALETTE 2,4:PALETTE 3,5 +60 LOCATE 5,5:PRINT " Ce programme consiste calculer le pousentage " +70 INPUT "Donnez le titre au BILAN ",A$ +80 INPUT "Donnez le trois parties ` titre 1,titre 2,titre 3 '",B$,C$,D$ +90 PRINT "valeur pour : ";B$;:INPUT ;B +100 PRINT :PRINT "valeur pour : ";C$;:INPUT ;C +110 PRINT :PRINT "valeur pour : ";D$;:INPUT ;D +120 A1=B+C+D +130 B1=B*100/A1 +140 C1=C*100/A1 +150 D1=D*100/A1 +160 REM A1 = Somme de B+C+D +170 REM B1 = % de b +180 REM C1 = % de C +190 REM D1 = % de D +200 CLS +210 XX=0:XX1=120 +220 B2=XX1-B1 +230 C2=XX1-C1 +240 D2=XX1-D1 +250 GOTO 300 +260 INPUT "epace entre les traits du graphique ",XX2 +270 IF XX2>10 THEN PRINT CHR$(7):PRINT "<10 s.v.p ":GOTO 260 +280 IF XX2<1 THEN PRINT CHR$(7):PRINT ">1 s.v.p ":GOTO 260 +290 IF XX2 MOD 2=1 THEN XX2=XX2-1 +300 CLS +310 LINE (1,70)-(400,70),1:LINE(1,20)-(400,20),2:LINE (1,120)-(400,120),3 +320 LOCATE 3,54:COLOR 2:PRINT "100 %":LOCATE 9,54:COLOR 1:PRINT " 50 % ":LOCATE 15,54:COLOR 3:PRINT " 0 %" +330 IF B2<1 OR C2 <1 OR D2<1 THEN PRINT :PRINT "erreur !!! pas possible ":GOTO 90 +340 COLOR 1 +350 LINE (106,XX1)-(156,B2),1,BF +360 LINE (206,XX1)-(256,C2),2,BF +370 IF D2<1 THEN LINE (306,XX1)-(356,D2),0 :GOTO 390 +380 LINE (306,XX1)-(356,D2),3,BF +390 REM +400 H=INT(LEN(A$)):HH=80-H:HHH=HH/2 +410 LOCATE 19,HHH:PRINT A$ +420 LOCATE 17,13:COLOR 1:PRINT B1;"%":COLOR 2:LOCATE 17,26:PRINT C1;"%":COLOR 3:LOCATE 17,38:PRINT D1;"%" +430 N$=CHR$(219) +440 LOCATE 22,1:COLOR 1:PRINT N$;" ";B$;SPC(2);:COLOR 2:PRINT N$;" ";C$;SPC(2);:COLOR 3:PRINT N$;" ";D$ +450 COLOR 2:PRINT "appuyer sur une touche pour sortire ou R Pour recommancer" +460 REM +470 AMP$=INKEY$:IF AMP$="" THEN 470 +480 IF AMP$="r" OR AMP$="R" THEN RUN +490 LOAD"MENU",R +500 RUN + \ No newline at end of file diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..dfe0770 --- /dev/null +++ b/.gitattributes @@ -0,0 +1,2 @@ +# Auto detect text files and perform LF normalization +* text=auto diff --git a/3DJEUX.BAS b/3DJEUX.BAS new file mode 100644 index 0000000..19430c5 Binary files /dev/null and b/3DJEUX.BAS differ diff --git a/3DLAB.BAS b/3DLAB.BAS new file mode 100644 index 0000000..a021cc9 Binary files /dev/null and b/3DLAB.BAS differ diff --git a/3DREVOL1.BAS b/3DREVOL1.BAS new file mode 100644 index 0000000..6ab75ae --- /dev/null +++ b/3DREVOL1.BAS @@ -0,0 +1,26 @@ + +' PROGRAMME DE REVOLUTION D'UN OU PLUSIEURS POINT(S) dans l'espace +' par DARCHE Yoann ( 27/11/90 ) +'========================================================================= +' VERSION Numro 1.1 3DREVOL1.BAS (.EXE) +'========================================================================= + + +' programme de saisie : + + CLS: + PRINT "Programme : 3DREVOL1.BAS ( ou .EXE ) " + PRINT "Date de dbut : 27/11/90" + PRINT "Date de cette ver : 27/11/90" + PRINT "Version : 1.1 " + PRINT "Programmeur : Darche Yoann" + PRINT "Adresse : 71 avenue d'Orlans 91800 BRUNOY (FRANCE) + PRINT "Tlphone : 69-39-51-26 aprs 18h " + PRINT + PRINT " Appuyez sur Y (comme Yoann) pour continuer " + + IlseFoutDeMoi : + A$=input$(1):if a$="Y" or a$="y" then goto PRENDONNES else goto ilsefoutdemoi + + PRENDONNES : + diff --git a/ADR.BAS b/ADR.BAS new file mode 100644 index 0000000..aa6696b Binary files /dev/null and b/ADR.BAS differ diff --git a/ADR.DAT b/ADR.DAT new file mode 100644 index 0000000..e69de29 diff --git a/ADRE b/ADRE new file mode 100644 index 0000000..e69de29 diff --git a/ADREPLUS.BAS b/ADREPLUS.BAS new file mode 100644 index 0000000..12bdb01 --- /dev/null +++ b/ADREPLUS.BAS @@ -0,0 +1,152 @@ +10 DEFINT A-B,D-Z:X=1:Y=1:MY=1:MX=9:CLS:KEY OFF:NFICH$="essai.adr":GOSUB 1330 +20 DIM N$(1000),P$(1000),D$(1000),C(1000),V$(1000),T$(1000),R(100):COLOR 7,0 +30 B$=" ENREGISTRER MODIFIER EFFACER RECHERCHER QUITTER " +40 GOSUB 1110 +50 CLS:GOSUB 180:GOSUB 1220:LOCATE 2,1:PRINT B$:J=0:GOSUB 1240 +60 LOCATE 2,70:PRINT NF:DX=9+12*(X-1):COLOR 7,0:LOCATE 2,MX:IF Y>NF THEN Y=1 +70 PRINT MID$(B$,MX,11);:COLOR 0,7:LOCATE 2,DX:PRINT MID$(B$,DX,11);:MX=DX +80 COLOR 7,0:NE=NF:J=0:T$=INPUT$(1):IF T$=CHR$(27) THEN 1090 +90 IF T$="6" AND X<5 THEN X=X+1:GOTO 60 +100 IF T$="4" AND X>1 THEN X=X-1:GOTO 60 +110 IF T$=CHR$(13) THEN ON X GOTO 220,360,540,630,1090 +120 IF T$="2" AND (Y1 THEN Y=Y-1:GOSUB 1240 +140 IF T$="9" AND P>0 THEN P=P-1:Y=1:MY=1:GOSUB 1320:GOSUB 1220:GOSUB 1240 +150 IF T$="3" AND P pour abandon confirmer recommencer" +310 A$=INPUT$(1):IF A$="n" OR A$="N" THEN 220 +320 IF A$=CHR$(27) THEN IF NE<>NF THEN GOTO 350 ELSE 50 +330 LOCATE 21,10:PRINT " Dsirez-vous encore enregistrer une fiche ? ":NF=NF+1 +340 A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 350 ELSE 220 +350 LOCATE 2,23:PRINT "Patientez ! ":GOSUB 1280:GOSUB 1140:GOTO 50 +360 CLS:GOSUB 180:LOCATE 2,34:PRINT "MODIFICATIONS":IK=Y+P*20 +370 LOCATE 5,10:PRINT "Pour ne pas changer appuyez sur ENTRE " +380 LOCATE 7,3:PRINT "Nom [";N$(IK);:INPUT "] :",M$ +390 IF M$="" THEN NE$=N$(IK) ELSE GOSUB 1160:NE$=M$ +400 LOCATE 9,3:PRINT "Prnom [";P$(IK);:INPUT "] :",M$ +410 IF M$="" THEN PE$=P$(IK) ELSE GOSUB 1160:PE$=M$ +420 LOCATE 11,3:PRINT "Adresse [";D$(IK);:INPUT "] :",M$ +430 IF M$="" THEN DE$=D$(IK) ELSE DE$=M$ +440 LOCATE 13,3:PRINT "Code Post [";C(IK);:INPUT "] :",M$ +450 IF M$="" THEN C=C(IK) ELSE C=VAL(M$) +460 LOCATE 15,3:PRINT "Ville [";V$(IK);:INPUT "] :",M$ +470 IF M$="" THEN VE$=V$(IK) ELSE GOSUB 1160:VE$=M$ +480 LOCATE 17,3:PRINT "Tlphonne [";T$(IK);:INPUT "] :",M$ +490 IF M$="" THEN TE$=T$(IK) ELSE TE$=M$ +500 LOCATE 19,20:PRINT "Confirmer :O/N":A$=INPUT$(1):IF A$=CHR$(27) THEN 50 +510 IF A$="n" OR A$="N" THEN 360 ELSE IF A$<>"o" AND A$<>"O" THEN GOTO 500 +520 N$(IK)=NE$:P$(IK)=PE$:D$(IK)=DE$:C(IK)=C:V$(IK)=VE$:T$(IK)=TE$:GOSUB 1280 +530 GOSUB 1140:GOTO 50 +540 CLS:GOSUB 180:LOCATE 2,36:PRINT "EFFACER" +550 LOCATE 5,5:COLOR 14:PRINT "Etes vous certain de vouloir ";:COLOR 30 +560 PRINT "EFFACER";:COLOR 14:PRINT " ce qui suit ?":COLOR 7 +570 LOCATE 8,20:I=Y+PA*20:PRINT N$(I);" ";P$(I) +580 LOCATE 9,15:PRINT D$(I):LOCATE 10,20:PRINT C(I);V$(I):LOCATE 11,20 +590 PRINT T$(I):A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 50 +600 IF A$<>"o" AND A$<>"O" THEN BEEP:LOCATE 14,25:PRINT "Oui/Non":GOTO 580 +610 FOR I=Y+20*P TO NF:N$(I)=N$(I+1):P$(I)=P$(I+1):D$(I)=D$(I+1):C(I)=C(I+1) +620 V$(I)=V$(I+1):T$(I)=T$(I+1):NEXT I:NF=NF-1:GOSUB 1140:GOTO 50 +630 CLS:GOSUB 180:LOCATE 2,36:PRINT "RECHERCHE":I=0 +640 LOCATE 5,20:COLOR 3:PRINT "Vous repondez uniquement ce que vous savez !" +650 LOCATE 6,10:COLOR 4:PRINT "La recherche s'effectue par filtre dfinie "; +660 PRINT "par vos rponses .":TD=0 +670 COLOR 30:LOCATE 25,1:PRINT "N.B si le code postal comporte que"; +680 PRINT " 2 chiffres la recherche portera sur le dep";:COLOR 7 +690 LOCATE 8,10:INPUT "Nom :",M$:GOSUB 1160:NE$=M$ +700 LOCATE 9,10:INPUT "Prnom :",M$:GOSUB 1160:PE$=M$ +710 LOCATE 10,10:INPUT "Code Postal :",C$:C=VAL(C$) +720 LOCATE 11,10:INPUT "Ville :",M$:GOSUB 1160:VE$=M$ +730 LOCATE 12,10:INPUT "Tlphonne :",TE$ +740 IF C=0 AND C$<>"" THEN LOCATE 13,1:PRINT "Code postal annul":C$="" +750 IF C<100 THEN LOCATE 14,2:PRINT "Recherche sur tout le dpartement":TD=1 +760 R=0:FOR I=1 TO NF +770 IF NE$<>"" THEN IF NE$<>N$(I) THEN 840 +780 IF PE$<>"" THEN IF PE$<>P$(I) THEN 840 +790 IF VE$<>"" THEN IF VE$<>V$(I) THEN 840 +800 IF C$<>"" AND TD=0 THEN IF C<>C(I) THEN 840 +810 IF C$<>"" AND TD=1 THEN IF C<>INT(C(I)/1000) THEN 840 +820 IF TE$<>"" THEN IF TE$<>T$(I) THEN 840 +830 R=R+1:R(R)=I +840 NEXT I +850 CLS:GOSUB 180:LOCATE 2,36:PRINT "RESULTATS" +860 IF R<>0 THEN 890 +870 LOCATE 12,5:PRINT " Aucune fiche ne correspond vos critres ..." +880 A$=INPUT$(1):GOTO 50 +890 LOCATE 25,1:PRINT " Il y a ";R;" rponses "; +900 LOCATE 4,1:PA=0:Y=1:MY=1 +910 NPA=INT(R/20)+1*SGN(R MOD 20)-1:IF PA>NPA THEN PA=0 +920 FOR F=1+20*PA TO 20+20*PA:I=R(F):J=F-20*PA:GOSUB 1250:IF F<=R THEN NEXT +930 GOTO 1000 +940 T$=INPUT$(1):COLOR 7,0:IF T$=CHR$(27) THEN 50 +950 IF T$="2" AND (Y1 THEN Y=Y-1 +970 IF T$="9" AND PA>0 THEN PA=PA-1:Y=1:GOSUB 1320:GOTO 920 +980 IF T$="3" AND PA pour menu principal ou autre pour retour" +1080 A$=INPUT$(1):IF A$=CHR$(27) THEN 50 ELSE 850 +1090 COLOR 7,0:CLS:PRINT "Vous avez l'agrable bonjour de ";NCO$;" et il vous ":PRINT "flicite d'avoir choisi son logigiel ADRESSE + Ver 1.2 Programme n U1 ." +1095 PRINT " Ce logiciel est entirement gratuit et appartient au DOMAINE PUBLIQUE":PRINT" Si il vous a plus ne vous gner pas pour en donner une copie vos ami(e)(s)" :PRINT +1096 PRINT:PRINT "Programme crit en GWBASIC par :" +1097 PRINT NCO$;" : 71 avenue d' Orlans 91800 BRUNOY tel:69-39-51-26 ":PRINT +1098 PRINT " Salut .... Y.D." +1100 END +1110 OPEN "I",#1,NFICH$:NF=0 +1120 IF EOF(1) THEN CLOSE:RETURN ELSE NF=NF+1 +1130 INPUT #1,N$(NF),P$(NF),D$(NF),C$,V$(NF),T$(NF):C(NF)=VAL(C$):GOTO 1120 +1140 OPEN "O",#1,NFICH$:FOR I=1 TO NF +1150 WRITE #1,N$(I),P$(I),D$(I),STR$(C(I)),V$(I),T$(I):NEXT I:CLOSE:RETURN +1160 IF M$="" THEN RETURN ELSE FOR I=1 TO LEN(M$):L$=MID$(M$,I,1):L=ASC(L$) +1170 IF L<65 OR (L>90 AND L<97) OR L>122 THEN 1200 ELSE IF L>90 THEN L=L-32 +1180 N$=N$+CHR$(L) +1190 NEXT:M$=N$:N$="":RETURN +1200 L$=MID$("' UUUUUEEEEEAAAAOOOY-/C",INSTR("' -/",L$)+1,1) +1210 IF L$="" THEN 1190 ELSE L=ASC(L$):GOTO 1180 +1220 NP=INT(NF/20)+1*SGN(NF MOD 20)-1:J=0:IF P>NP THEN P=0 +1230 FOR I=1+20*P TO 20+20*P:GOSUB 1250:IF I=>NF THEN RETURN ELSE NEXT:RETURN +1240 J=MY:I=MY+P*20:GOSUB 1250:COLOR 0,7:I=Y+P*20:J=Y:GOSUB 1250:MY=Y:RETURN +1250 IF J=0 THEN J=I-20*P +1260 LOCATE J+3,2:PRINT N$(I):LOCATE J+3,15:PRINT P$(I); +1270 LOCATE J+3,28:PRINT T$(I);:LOCATE J+3,44:PRINT V$(I):J=0:RETURN +1280 FOR I=1 TO NF:FOR J=I TO NF:IF N$(I)>N$(J) THEN 1300 +1290 NEXT J:LOCATE 2,42:PRINT I+1;"/";NF:NEXT I:RETURN +1300 SWAP N$(I),N$(J):SWAP P$(I),P$(J):SWAP D$(I),D$(J):SWAP C(I),C(J) +1310 SWAP V$(I),V$(J):SWAP T$(I),T$(J):GOTO 1290 +1320 FOR KL=4 TO 23:LOCATE KL,2:PRINT SPACE$(78);:NEXT KL:LOCATE 1,1:RETURN +1330 CLS:NCO$=CHR$(68)+CHR$(65)+CHR$(82)+CHR$(67)+CHR$(72)+CHR$(69)+CHR$(32)+CHR$(89)+CHR$(111)+CHR$(97)+CHR$(110)+CHR$(110) +1340 LOCATE 1,28:COLOR 14:PRINT NCO$;" prsente :":LOCATE 7 +1350 PRINT " " +1360 PRINT " ۱۱۱۱۱۱۱" +1370 PRINT " ۱۱۰۱۰۱۰۱۱۱۱۰۱" +1380 PRINT " ۰۰۰۱۰۰۰۰۰۰۰" +1390 PRINT " ۰۰۰۱۱۱۱۱۱" +1400 PRINT " ۰۰۰۰۰۰۰۱۱۰۰" +1410 PRINT " ۰۰۰۱۰۱۰۱۰۱۰۰۰" +1420 PRINT " ۰۰۱۰۱۱۱۱۱" +1430 PRINT " " +1440 PRINT " " +1450 PRINT:PRINT " Version 1.2 " +1460 LOCATE 20,4:PRINT " Mr ";NCO$;" 71 av. d'Orlans 91800 BRUNOY tel: 69-39-51-26 aprs 19H" +1470 A$=INPUT$(1):RETURN + \ No newline at end of file diff --git a/ADREPLUS.TXT b/ADREPLUS.TXT new file mode 100644 index 0000000..2dc563d --- /dev/null +++ b/ADREPLUS.TXT @@ -0,0 +1,114 @@ + Ŀ + DOCUMENTATION D'ADRESSE PLUS + + + ADREPLUS.EXE (ou .BAS) est un utilitaire de gestion d'adresse, autrement +dit c'est un carnet d'adresse. + + Ce programme vous propose plusieurs menus : Enregistrer, Modifier, EFFACER, +Rechercher, Quitter. Ces menus sont slectionnables par l'intermdiaire du +curseur voluant dans le sens horizontal. + Les menus suivie de nesscite la slection d'une adresse (dans la +fentre dessous la bar des menu ) sur laquelle l'option interviendra . La +slection de cette adresse s'tablie au moyen d'un autre curseur qui ce +trouve dans cette fentre, et par consquent se dplacent dans le sens +vertical. + + Mouvement des deux curseurs : + ----------------------------- + Le curseur qui se dplace horizontalement dans la barre des menus, se +ralise au moyen des touches du pav numerique : 4 et 6 . + Le second curseur qui se trouve dans la fentre o figure le listing des +adresses enregistres , se dplace dans la page au moyen des touches + 2 et 8 . Pour changer de page au cas o vous auriez enregistr plus +de 20 adresses, utilisez les touches 9 et 3 pour effectuer un dfile- +ment des pages. + + N.B. le pav numrique DOIT tre BLOQUE en NUMLOCK . + +Explication des diffrents menus : +---------------------------------- + ENREGISTRER : + ~~~~~~~~~~~~~ Cette option vous permettera d' ajouter une fiche adresse + dans votre banque de donnes. Un cran de saisie s'affiche : + En premier lieu on vous demande d'entrer le Nom de la nouvelle personne. + Si vous n'entrez aucun caractre avant d'appuyer sur ENTER l'ordinateur + pensera que vous avez fait une erreur de selection d 'option, donc il vous + demendera si vous dsirez continuer la saisie. Si vous rpondez ngativement + vous serez automatiquement dans le menu de dpart. + Dans le cas o vous avez entirement ( ou partiellement ) rempli le + questionnaire, on vous demande une confirmation, Si vous repondez ngativement + vous recommencez au dpart . Dans le cas contraire on vous demandera si vous + dsirez nouveau enregistrer une adresse. + Toute adresse confirme est automatiquement classe par Ordre alphab- + tique et enregistre au moment o vous retournerez au menu principal. + + MODIFIER : + ~~~~~~~~~~~~ Cette option sert modifier une fiche adresse dj enregis- + tre. La selection de la fiche modifier s'effectue dans le menu principal + au moyen du second curseur. Donc l' adresse qui sera modifie est celle que + le curseur pointe . + L'ordinateur vous affichera les diffrents champs les un aprs les autres + et attendra votre modification. Si vous appuyez sur ENTER sans avoir + inscrit aucun caractre, l'ordinateur prendra en compte l'ancienne valeur. + A la fin, l'ordinateur vous demande une confirmation. + + EFFACER : + ~~~~~~~~~~~ Ce menu vous permet de d' effacer une fiche. La fiche qui + doit tre effacer devra tre au pralable slectionne dans la page o se + trouve l'ensemble des adresses grce au pointeur. L' ordinateur vous demande + confirmation . + + RECHERCHER : + ~~~~~~~~~~~~ Ce dernier est le menu le plus intressant du programme. + Il permet de vous ressortir toutes les fiches de votre fichier + correspondant au(x) critre(s) que vous aurez dfini(s) . La touche + ENTER , sans avoir crit un seul caractre , annulera le champ en question + pour le filtre de la recherche. + Pour le code postal , si vous dsirez effectuer une recherche dans tout un + dpartement il vous suffira d'entrer que les deux premiers chiffres . + + ATTENTION : pour les dpartement dont le code est inferieur dix, veillez + ~~~~~~~~~~~ mettre un zro devant son chiffre. + Ex : Le Dep. de l'AISNE code 2, il faut introduire 02 ! + + Une fois que l' ordinateur vous affiche les adresse correspondant votre + filtre, si il y en a plusieurs, vous pourrez choisir celle que vous dsirez + voire compltement, au moyen du pav numrique et de ENTER . + Si vous avez afficher une adresse l' cran et que vous dsirez en + slectionner une autre, appuyez sur n' importe quelle touche, sauf ESC + qui vous ramnera au menu principal. + + QUITTER : + ~~~~~~~~~ Cette option permet de quitter ADREPLUS pour retourner au DOS. + + Les petit TRUC EN PLUS ...: + ~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * Dans le menu principal tout droite de la barre des menus un nombre est + inscrit . Ce dernier correspond au nombre de fiches enregistres. + + * En appuyant sur la BARRE d' ESPACE vous affichez l'adresse complte + selectionne dans la fentre o se trouve l'ensemble de ces adresses. + + * Au menu principal en appuyant sur ESC vous sortirez du logiciel. + + + PETIT PROGRAMME SUP. POUR CREE LE FICHIER ESSAI.ADR + + 10 OPEN "O",#1,"ESSAI.ADR" + 20 PRINT #1,"NOM,PRENOM,RUE,99999,VILLE,TEL" + 30 CLOSE + 40 END + + Effectuer un RUN de ce petit prog. + + Ce programme est indispensable avant le premier lancement d' ADREPLUS ! + + + + PROGRAMME ECRIT EN GWBASIC VER 3.2 + COMPILABLE PAR TURBO-BASIC + + Mr DARCHE Yoann, 71 avenue d'Orlans 91800 BRUNOY Tel: 69-39-51-26 + + \ No newline at end of file diff --git a/ADRESSE.BAS b/ADRESSE.BAS new file mode 100644 index 0000000..259ac4f --- /dev/null +++ b/ADRESSE.BAS @@ -0,0 +1,320 @@ +10 LOCATE ,,1,0,7 +20 CLS +30 DFGH=1 +40 DIM N2$(1000),N$(1000),P$(1000),AD$(1000),CO$(1000),C1$(1000),TEL$(1000) +50 KEY OFF +60 DIM N1$(1000),P1$(1000),AD1$(1000),CO1$(1000),C11$(1000),TEL1$(1000) +70 PO$=CHR$(179):AZ$=CHR$(195):AY$=CHR$(180):AW$=CHR$(197):AK$=CHR$(196) +80 OPEN "qte.adr" FOR INPUT AS #1 +90 IF EOF(1) THEN CLOSE :GOTO 130 +100 PM=PM+1 +110 INPUT #1,N$(PM),P$(PM),AD$(PM),CO$(PM),C1$(PM),TEL$(PM) +120 GOTO 90 +130 II=1:IJ=1:IF PM=0 THEN PRINT "il n'y a aucune adresse de ce fichier ":GOTO 240 +140 COLOR 1: PRINT PO$;"Nom ";:COLOR 2:PRINT PO$;"Prenom ";:COLOR 3:PRINT PO$;"adresse +";:COLOR 4:PRINT " code postal ";:COLOR 5:PRINT PO$;"Tlphone" +150 COLOR 1:PRINT AZ$;:FOR I=2 TO 13:PRINT AK$;:NEXT :COLOR 2:PRINT AW$;:FOR I=15 TO 26:PRINT AK$;:NEXT:COLOR 3:PRINT AW$;:FOR I=28 TO 68 :PRINT AK$;:NEXT:COLOR 5:PRINT AW$;:FOR I=70 TO 80:PRINT AK$;:NEXT +160 IF IJ > 19 THEN 200 +170 COLOR 1:PRINT PO$;N$(II);:COLOR 2:LOCATE ,14:PRINT PO$;P$(II);:COLOR 3:LOCATE ,27:PRINT PO$;AD$(II);" ";:COLOR 4:PRINT CO$(II);" ";C1$(II);:COLOR 5:LOCATE ,69:PRINT PO$;TEL$(II) +180 IF II = PM THEN 250 +190 IJ=IJ+1:II=II+1:GOTO 160 +200 DFGH=DFGH+1:LOCATE 21:COLOR 30:PRINT "Attention !!! ":COLOR 3:PRINT "si vous appuyez sur une touche nous passons au ";DFGH;" me tableaux " +210 IF DFGH >2 THEN KLM=1:COLOR 5:PRINT " R pour retour en arrire " +220 A$=INKEY$:IF A$="" THEN 220 +230 IF KLM=1 AND A$="r" OR A$="R" THEN II=II-19:DFGH = DFGH - 2:KLM=0:IJ=1:CLS:GOTO 140 +240 CLS:II=II-1:IJ=1 :GOTO 140 +250 COLOR 14:PRINT "voulez-vous 1 retour au premier tableau,2 pour sortir ,3 effacer des noms etc..,4 enregitrer de nom etc... ,5 pour faire une recherche d'un Nom ,6 pour listing 7 pour TRIE ALPHABETIQUE 8 pour ENTETE DE FEUILLE " +260 A$=INKEY$:IF A$="" THEN 260 +270 IF A$="1" THEN CLS:GOTO 130 +280 IF A$="2" THEN SYSTEM +290 IF A$="3" THEN 350 +300 IF A$="4" THEN 610 +310 IF A$="5" THEN 770 +320 IF A$="6" THEN 2120 +330 IF A$="7" GOTO 2170 +331 IF A$="8" GOTO 4000 +340 BEEP:GOTO 260 +350 CLS:COLOR 5:LOCATE 5,5:PRINT "pour detruire l'adresse il faut inscrire Le Nom et le Prenom comme il sont inscrits sur la disquette " +360 LOCATE 10,20:COLOR 14:PRINT "NOM :";:COLOR 3:INPUT "",N1$ +370 LOCATE 12,20:COLOR 14:PRINT "PRENOM :";:COLOR 1:INPUT "",P1$ +380 IF N1$="" THEN AZ=1:GOTO 400 +390 IF P1$="" THEN AZ=2:GOTO 400 +400 FOR I=1 TO PM +410 IF AZ=1 AND N$(I)=N1$ THEN 480 +420 IF AZ=2 AND P$(I)=P1$ THEN 480 +430 IF N1$=N$(I) AND P$(I)=P1$ THEN 480 +440 NEXT :PRINT "dsol je n'ai pas trouvez A pour abondonner R pour recommancer " +445 A$=INKEY$:IF A$="" THEN 445 +450 IF A$="a" OR A$="A" THEN RUN +460 IF A$="r" OR A$="R" THEN 350 +470 BEEP:GOTO 445 +480 COLOR 2:PRINT "Celle que j'ai trouv c'est :" +490 PRINT N$(I);" ";P$(I);" ";AD$(I);" ";CO$(I);" ";C1$(I);" . Tel :";TEL$(I) +500 COLOR 14:PRINT " Est-ce celle-ci O/N " +510 A$=INKEY$:IF A$="" THEN 510 +520 IF A$="n" OR A$="N" THEN PRINT "Dommage !!!":GOTO 440 +530 FOR MM=I+1 TO PM +540 N$(MM-1)=N$(MM):P$(MM-1)=P$(MM):AD$(MM-1)=AD$(MM):CO$(MM-1)=CO$(MM):C1$(MM-1)=C1$(MM):TEL$(MM-1)=TEL$(MM):C1$(MM)="":N$(MM)="":P$(MM)="":AD$(MM)="":CO$(MM)="":TEL$(MM)="" +550 NEXT +560 OPEN "QTE.ADR" FOR OUTPUT AS #1 +570 FOR I=1 TO PM-1 +580 PRINT #1,N$(I);",";P$(I);",";AD$(I);",";CO$(I);",";C1$(I);",";TEL$(I) +590 NEXT :CLOSE +600 PRINT " A pour abondon R pour recommancer":GOTO 445 +610 REM +620 SE=PM :CLS +630 SE=SE+1 +640 COLOR 5,1:PRINT "N O M : ":LOCATE 1,8:INPUT "",N$(SE):PRINT "P R E N O M : ":LOCATE 2,14:INPUT "",P$(SE) +650 INPUT "Adresse + N :",AD$(SE) +660 INPUT "Code Postal : ",CO$(SE):INPUT " Ville : ",C1$(SE) +670 LINE INPUT "N de tlphone : ",TEL$(SE) +680 PRINT "fin O/N " +690 A$=INKEY$:IF A$="" THEN 690 +700 IF A$="O" OR A$="o" THEN COLOR 1,0:CLS:GOTO 720 +710 COLOR 1,0:CLS :GOTO 630 +720 OPEN "QTE.ADR" FOR OUTPUT AS #1 +730 FOR I=1 TO SE +740 PRINT #1,N$(I);",";P$(I);",";AD$(I);",";CO$(I);",";C1$(I);",";TEL$(I) +750 NEXT :CLOSE +760 RUN +770 CLS:PRINT "Cette partie consite a rechercher un nom,un prenom,un code postale,un N de tlphone " +780 COLOR 1:PRINT "-1- pour recherche d'un nom " +790 COLOR 2:PRINT "-2- pour recherche d'un prenom " +800 COLOR 3:PRINT "-3- pour recherche d'un code postal" +810 COLOR 4:PRINT "-4- pour recherche d'un N de tlphonne" +820 COLOR 5:PRINT "-5- pour recherche des code potal commenant par le deux mme n " +830 PRINT "faites votre choix" +840 A$=INKEY$:IF A$="" THEN 840 +850 IF A$="5" THEN 1890 +860 IF A$="1" THEN 910 +870 IF A$="2" THEN 1200 +880 IF A$="3" THEN 1430 +890 IF A$="4" THEN 1660 +900 BEEP:GOTO 830 +910 CLS:PRINT " R E C H E R C H E D E N O M ":BVC=1 +920 LOCATE 10,20:COLOR 14:PRINT " N O M : ";:COLOR 3:INPUT "",N1$ +930 P=1:FPM=0 +940 FOR I=1 TO PM +950 IF N$(I)=N1$ THEN 970 +960 NEXT :IF FPM=1 THEN FPM=0:GOTO 1000 ELSE PRINT "dsol je n'ai rien trouv ":GOTO 1110 +970 IF FPM=0 THEN FPM=1 +980 N1$(P)=N$(I):P1$(P)=P$(I):AD1$(P)=AD$(I):CO1$(P)=CO$(I):C11$(P)=C1$(I):TEL1$(P)=TEL$(I) +990 P=P+1:GOTO 960 +1000 PRINT "Ce que j'ai trouv :" +1010 FOR I=1 TO P-1 +1020 PRINT N1$(I);" ";P1$(I);" ";AD1$(I);" ";CO1$(I);" ";C11$(I);" .Tel ";TEL1$(I) +1030 NEXT +1040 PRINT "Voulez-vous une trace crite O/N " +1050 A$=INKEY$:IF A$="" THEN 1050 +1060 IF A$="o" OR A$="O" THEN 1080 +1070 GOTO 1110 +1080 FOR I=1 TO P-1 +1090 LPRINT CHR$(27);CHR$(29);" ";CHR$(15);N1$(I);" ";P1$(I):LPRINT +1091 LPRINT CHR$(14);" ";AD1$(I) +1092 LPRINT " ";CO1$(I);" ";C11$(I) +1093 LPRINT " ";"Tel : ";TEL1$(I):LPRINT:LPRINT +1100 NEXT +1110 PRINT "voulez-vous recommencer (1),allez au menu `recherche' (2),ou lire les adresses n'importe quelle touche " +1120 A$=INKEY$:IF A$="" THEN 1120 +1130 IF A$="1" AND BVC=1 THEN BVC=0:GOTO 910 +1140 IF A$="1" AND BVC=2 THEN BVC=0:GOTO 1200 +1150 IF A$="1" AND BVC=3 THEN BVC=0:GOTO 1430 +1160 IF A$="1" AND BVC=4 THEN BVC=0:GOTO 1660 +1170 IF A$="1" AND BVC=5 THEN BVC=0:GOTO 1890 +1180 IF A$="2" THEN 770 +1190 RUN +1200 CLS:PRINT " R e c h e r c h e d e P R E N O M ":BVC=2 +1210 LOCATE 10,20:COLOR 14:PRINT "P R E N O M : ";:COLOR 3:INPUT "",P1$ +1220 P=1:FPM=0 +1230 FOR I=1 TO PM +1240 IF P$(I)=P1$ THEN 1280 +1250 NEXT +1260 IF FPM=1 THEN FPM=0:GOTO 1310 +1270 PRINT "desol je n'ai rien trouv....":GOTO 1110 +1280 IF FPM=0 THEN FPM=1 +1290 N1$(P)=N$(I):P1$(P)=P$(I):AD1$(P)=AD$(I):CO1$(P)=CO$(I):C11$(P)=C1$(I):TEL1$(P)=TEL$(I) +1300 P=P+1:GOTO 1250 +1310 PRINT "Ce que j'ai trouv :" +1320 FOR I=1 TO P-1 +1330 PRINT N1$(I);" ";P1$(I);" ";AD1$(I);" ";CO1$(I);" ";C11$(I);" .Tel ";TEL1$(I) +1340 NEXT +1350 PRINT "Voulez-vous une trace crite O/N " +1360 A$=INKEY$:IF A$="" THEN 1360 +1370 IF A$="o" OR A$="O" THEN 1390 +1380 GOTO 1110 +1390 FOR I=1 TO P-1 +1400 LPRINT CHR$(27);CHR$(29);" ";CHR$(15);N1$(I);" ";P1$(I):LPRINT +1401 LPRINT CHR$(14);" ";AD1$(I) +1402 LPRINT " ";CO1$(I);" ";C11$(I) +1403 LPRINT " ";"Tel : ";TEL1$(I):LPRINT:LPRINT +1410 NEXT +1420 GOTO 1110 +1430 CLS:PRINT " R E C H E R C H E D U C O D E P O S T A L " :BVC=3 +1440 LOCATE 10,20:COLOR 14:PRINT "C O D E P O S T A L : ";:COLOR 3:INPUT "",CO1$ +1450 P=1:FPM=0 +1460 FOR I=1 TO PM +1470 IF CO$(I)=CO1$ THEN 1510 +1480 NEXT +1490 IF FPM=1 THEN FPM=0:GOTO 1540 +1500 PRINT "desol je n'ai rien trouv....":GOTO 1110 +1510 IF FPM=0 THEN FPM=1 +1520 N1$(P)=N$(I):P1$(P)=P$(I):AD1$(P)=AD$(I):CO1$(P)=CO$(I):C11$(P)=C1$(I):TEL1$(P)=TEL$(I) +1530 P=P+1:GOTO 1480 +1540 PRINT "Ce que j'ai trouv :" +1550 FOR I=1 TO P-1 +1560 PRINT N1$(I);" ";P1$(I);" ";AD1$(I);" ";CO1$(I);" ";C11$(I);" .Tel ";TEL1$(I) +1570 NEXT +1580 PRINT "Voulez-vous une trace crite O/N " +1590 A$=INKEY$:IF A$="" THEN 1590 +1600 IF A$="o" OR A$="O" THEN 1620 +1610 GOTO 1110 +1620 FOR I=1 TO P-1 +1630 LPRINT CHR$(27);CHR$(29);" ";CHR$(15);N1$(I);" ";P1$(I):LPRINT +1631 LPRINT CHR$(14);" ";AD1$(I) +1632 LPRINT " ";CO1$(I);" ";C11$(I) +1633 LPRINT " ";"Tel : ";TEL1$(I):LPRINT:LPRINT +1640 NEXT +1650 GOTO 1110 +1660 CLS:PRINT " R E C H E R C H E D U N D E T E L E P H O N" :BVC=4 +1670 LOCATE 10,20:COLOR 14:PRINT "N D E T E L E P H O N : ";:COLOR 3:INPUT "",TEL1$ +1680 P=1:FPM=0 +1690 FOR I=1 TO PM +1700 IF TEL$(I)=TEL1$ THEN 1740 +1710 NEXT +1720 IF FPM=1 THEN FPM=0:GOTO 1770 +1730 PRINT "dsol je n'ai rien trouv....":GOTO 1110 +1740 IF FPM=0 THEN FPM=1 +1750 N1$(P)=N$(I):P1$(P)=P$(I):AD1$(P)=AD$(I):CO1$(P)=CO$(I):C11$(P)=C1$(I):TEL1$(P)=TEL$(I) +1760 P=P+1:GOTO 1710 +1770 PRINT "Ce que j'ai trouv :" +1780 FOR I=1 TO P-1 +1790 PRINT N1$(I);" ";P1$(I);" ";AD1$(I);" ";CO1$(I);" ";C11$(I);" .Tel ";TEL1$(I) +1800 NEXT +1810 PRINT "Voulez-vous une trace crite O/N " +1820 A$=INKEY$:IF A$="" THEN 1820 +1830 IF A$="o" OR A$="O" THEN 1850 +1840 GOTO 1110 +1850 FOR I=1 TO P-1 +1860 LPRINT CHR$(27);CHR$(29);" ";CHR$(15);N1$(I);" ";P1$(I):LPRINT +1861 LPRINT CHR$(14);" ";AD1$(I) +1862 LPRINT " ";CO1$(I);" ";C11$(I) +1863 LPRINT " ";"Tel : ";TEL1$(I):LPRINT:LPRINT +1870 NEXT +1880 GOTO 1110 +1890 CLS:PRINT " R E C H E R C H E D U N D E C O D E P O S T A L" :BVC=5 +1900 LOCATE 10,20:COLOR 14:PRINT "N D U C O D E P O S T A L : ";:COLOR 3:INPUT "",CO2$ +1910 P=1:FPM=0 +1920 FOR I=1 TO PM +1930 IF LEFT$ (CO$(I),2)= CO2$ THEN 1970 +1940 NEXT +1950 IF FPM=1 THEN FPM=0:GOTO 2000 +1960 PRINT "dsol je n'ai rien trouv....":GOTO 1110 +1970 IF FPM=0 THEN FPM=1 +1980 N1$(P)=N$(I):P1$(P)=P$(I):AD1$(P)=AD$(I):CO1$(P)=CO$(I):C11$(P)=C1$(I):TEL1$(P)=TEL$(I) +1990 P=P+1:GOTO 1940 +2000 PRINT "Ce que j'ai trouv :" +2010 FOR I=1 TO P-1 +2020 PRINT N1$(I);" ";P1$(I);" ";AD1$(I);" ";CO1$(I);" ";C11$(I);" .Tel ";TEL1$(I) +2030 NEXT +2040 PRINT "Voulez-vous une trace crite O/N " +2050 A$=INKEY$:IF A$="" THEN 2050 +2060 IF A$="o" OR A$="O" THEN 2080 +2070 GOTO 1110 +2080 FOR I=1 TO P-1 +2090 LPRINT CHR$(27);CHR$(29);" ";CHR$(15);N1$(I);" ";P1$(I):LPRINT +2091 LPRINT CHR$(14);" ";AD1$(I) +2092 LPRINT " ";CO1$(I);" ";C11$(I) +2093 LPRINT " ";"Tel : ";TEL1$(I):LPRINT:LPRINT +2100 NEXT +2110 GOTO 1110 +2120 FOR A=1 TO PM +2130 LPRINT N$(A);:LPRINT CHR$(27);CHR$(16);CHR$(0);CHR$(73);P$(A); +2140 LPRINT CHR$(27);CHR$(16);CHR$(0);CHR$(151);AD$(A);" ";CO$(A);" ";C1$(A);" . Tel :";TEL$(A) +2150 REM LPRINT CHR$(27);CHR$(16);CHR$(0);CHR$(300);TEL$(A) +2160 NEXT :RUN +2170 CLS :PRINT " T R I A L P H A B E T I Q U E " +2180 PRINT "CONVERSIONS EN CARACTERE MAJUSCULE ............................:" +2190 FOR I=1 TO PM +2200 N1$(I)=N$(I):P1$(I)=P$(I):AD1$(I)=AD$(I):CO1$(I)=CO$(I):C11$(I)=C1$(I):TEL1$(I)=TEL$(I) +2210 NEXT +2220 FOR I=1 TO PM :FOR Y=1 TO LEN(N1$(I)) +2230 REM FOR Y=1 TO LEN (N1$(I)) +2240 A$=LEFT$(N1$(I),Y):AP$=RIGHT$(A$,1):A$="" +2250 IF AP$="" THEN PRINT I:GOTO 2520 +2260 IF AP$="" THEN AP$="E" +2270 IF AP$="" THEN AP$="E" +2280 IF AP$="" THEN AP$="E" +2290 IF AP$="" THEN AP$="E" +2300 IF AP$="" THEN AP$="C" +2310 IF AP$="" THEN AP$="A" +2320 IF AP$="" THEN AP$="A" +2330 IF AP$="" THEN AP$="A" +2340 IF AP$="" THEN AP$="U" +2350 IF AP$="" THEN AP$="U" +2360 IF AP$="" THEN AP$="Y" +2370 IF AP$="" THEN AP$="I" +2380 IF AP$="" THEN AP$="I" +2390 IF AP$="" THEN AP$="O" +2400 IF AP$="" THEN AP$="O" +2410 IF AP$="" THEN AP$="O" +2420 IF AP$="" THEN AP$="U" +2430 IF AP$="" THEN AP$="A" +2440 IF AP$="" THEN AP$="U" +2450 AP = ASC(AP$) +2460 IF AP >= 97 AND AP <= 122 THEN AP=AP-32:AP$=CHR$(AP) +2470 IF AP >= 91 AND AP <= 96 THEN AP$="" +2480 IF AP >= 123 AND AP <= 128 OR AP >= 155 THEN AP$="" +2490 IF AP >= 32 AND AP <= 64 THEN AP$="" +2500 N2$(I)=N2$(I)+AP$ +2510 NEXT Y:PRINT I,N2$(I),N1$(I):NEXT I +2520 GOTO 2560:REM FOR I=1 TO PM +2530 P=P+1:IF P=15 THEN P=1:COLOR P ELSE COLOR P +2540 PRINT I,N2$(I),N1$(I):NEXT +2550 PRINT "TRI ALPHABETIQUE ...............................................:" +2560 CLS:PRINT "--------------------------- TRI ----------------------------" +2570 FOR X=1 TO PM-1 +2580 X1=ASC(LEFT$(N2$(X),1)) +2590 FOR Y=X+1 TO PM +2600 Y1=ASC(LEFT$ (N2$(Y),1)) +2610 LOCATE 11,1:PRINT " " +2620 LOCATE 11,1:PRINT X:LOCATE 11,5:PRINT N1$(X) +2621 REM II +2630 LOCATE 11,42:PRINT N1$(Y) +2640 REM comparaison 1 lettre +2650 IF X1 > Y1 THEN X$ = N1$(X):N1$(X) = N1$(Y):N1$(Y) = X$:X$ = N2$(X):N2$(X)=N2$(Y):N2$(Y)=X$:X1 = ASC ( LEFT$ ( N2$(X),1)):GOTO 2800 +2660 IF X1 LX THEN 2800 +2730 IF K > LY THEN X$=N1$(X):N1$(X)=N1$(Y):N1$(Y)=X$:X$= N2$(X):N2$(X)=N2$(Y):N2$(Y)=X$:X1=ASC(LEFT$(N2$(X),1)):GOTO 2800 +2740 X2=ASC(MID$(N2$(X),K,1)) +2750 Y2=ASC(MID$(N2$(Y),K,1)) +2760 IF X2>Y2 THEN X$=N1$(X):N1$(X)=N1$(Y):N1$(Y)=X$:X$=N2$(X):N2$(X)=N2$(Y):N2$(Y)=X$:X1=ASC(LEFT$(C$(X),1)):GOTO 2800 +2770 REM +2780 IF X2 < Y2 THEN 2800 +2790 K=K+1:GOTO "???" +2800 NEXT Y +2810 NEXT X +2815 PRINT "finie pour le tri..................................." +2816 PRINT " je tri les adresses les prenoms,les codes postaux ... patientez ..." +2817 FOR I= 1 TO PM +2820 N2$(I)=N1$(I):NEXT I +2830 FOR I=1 TO PM +2840 FOR S=1 TO PM +2850 IF N$(S)=N2$(I) THEN 2860 ELSE NEXT S +2860 N1$(I)=N$(S):P1$(I)=P$(S):AD1$(I)=AD$(S):CO1$(I)=CO$(S):C11$(I)=C1$(S):TEL1$(I)=TEL$(S) +2870 NEXT I +2880 PRINT "fin de rassemblement ... " +2890 FOR I=1 TO PM +2900 N$(I)=N1$(I):P$(I)=P1$(I):AD$(I)=AD1$(I):CO$(I)=CO1$(I):C1$(I)=C11$(I):TEL$(I)=TEL1$(I) +2910 NEXT I +2920 OPEN "QTE.ADR" FOR OUTPUT AS #1 +2930 FOR I=1 TO PM +2940 PRINT #1,N$(I);",";P$(I);",";AD$(I);",";CO$(I);",";C1$(I);",";TEL$(I) +2950 NEXT :CLOSE:RUN +4000 REM E N T E T E DE F E U I L L E ( I M P R I M A N T E ) +4010 LPRINT CHR$(27);CHR$(14);CHR$(27);CHR$(31);" D I V U L G U E S":LPRINT " -----------------";:LPRINT CHR$(27);CHR$(15);CHR$(27);CHR$(20);" Tel : 69 39 51 26 " +4020 RUN + \ No newline at end of file diff --git a/ADRESSE.TXT b/ADRESSE.TXT new file mode 100644 index 0000000..d285c19 --- /dev/null +++ b/ADRESSE.TXT @@ -0,0 +1,79 @@ + Ŀ + Documentation du programme ADRESSE.BAS (ou .EXE) Ŀ + + + + Ce programme est un utilitaire simple qui permet de grer un carnet + d'adresse. Il intgre les fonctions suivantes : + - Recherche par filtre dfinie par l'utilisteur chaque recherche + - Tri alphabtique de la banque de donn + - Modification d'une donne dj enregistre + - Enregistrement et Supression d'une fiche adresse. + + La slection du service dsir ce fait par le pav numerique en utilisant + 8 9 + slectionne le service o se trouve le curseur + 4 6 affiche l'adresse complte du non point + + 2 3 + + Le curseur dans la bar des menus ansi que dans le fichier est reprsent + par la couleur invers ( Font blanc, caractres noirs ) + Les touches 4 et 6 vous permettent des vous dplacer dans la bar des menus + et de valider votre choix + Les touches 8 et 2 vous permettent de selectionner une adresse, et + de l'afficher entirement. + Les touches 9 et 3 sont actives que si votre fichier comporte plus de 20 + adresses. Elles permettent d'effectuer un dfilement de page + + Description de chaques menus : + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + 1) Enregistrer : + ----------------- + Ce menu vous permetera d'enregistrer des nouvelles fiches. + + N.B. : Ne vous procuper pas pour les Mininuscules/Majuscules pour les noms + prnons et villes l'ordinateur ce charge de tout mettre en majuscule. + + N.B.2 : Si vous pressez la ligne d'entre du NOM sans avoir mis + un seule caractres, l'ordinateur considra que c'est une fiche Vide donc + elle ne sera pas mmoris. + + A la question : pour Abandon confirmer recommencer + ~~~~~~~~~~~~~~~ + si vous rpondez ou la fiche sera mmorise. + si vous rpondez vous devrez la rintroduire. + si vous rpondez la dernire fiche ne sera pas memorise mais les + prcdantes le seront (si il y en a). + + Pour la seconde question : Dsirez-vous encore enregistr une fiche ? + ~~~~~~~~~~~~~~~~~~~~~~~~~~ + si vous rpondez ou vous recommencer introduire une nouvelle + fiche. + si vous rpondez ou les fiches seront tries et enregistres. + + 2) Modifier : + -------------- + Ce menu vous permetera de modifier entirement ou une partie d'une fiche. + Si vous ne voulez rien modifier appuyer 6 fois sur et confirmer + par . + Si vous ne voulez pas modifier un terme de la fiche il vous suffira + d'appuyer sur sans rien mettre + + La fiche modifier est slectionne par le pointeur au menu principal. + + 3) Effacer : + ------------- + Ce menu vous permetera d'effacer entirement une fiche . + L'ordinaeur vous demande une simple confirmation Oui ou Non + La fiche effacer est slectionne par le pointeur au menu principal. + + 4) Rechercher : + ---------------- + Ce menu vous permetera de resortir un certain nombre de fiche corespondant + un filtre dfinie par l'utilistateur + Si vous appuyez sur sans mettre aucun caractre un champ d'entr + celui-ci sera annul pour le filtre + + + \ No newline at end of file diff --git a/ADRESSE2.BAS b/ADRESSE2.BAS new file mode 100644 index 0000000..eac157b --- /dev/null +++ b/ADRESSE2.BAS @@ -0,0 +1,148 @@ +10 DEFINT A-B,D-Z:X=1:Y=1:MY=1:MX=9:CLS:KEY OFF:NFICH$="essai.adr":GOSUB 1330 +20 DIM N$(1000),P$(1000),D$(1000),C(1000),V$(1000),T$(1000),R(100):COLOR 7,0 +30 B$=" ENREGISTRER MODIFIER EFFACER RECHERCHER QUITTER " +40 GOSUB 1110 +50 CLS:GOSUB 180:GOSUB 1220:LOCATE 2,1:PRINT B$:J=0:GOSUB 1240 +60 LOCATE 2,70:PRINT NF:DX=9+12*(X-1):COLOR 7,0:LOCATE 2,MX:IF Y>NF THEN Y=1 +70 PRINT MID$(B$,MX,11);:COLOR 0,7:LOCATE 2,DX:PRINT MID$(B$,DX,11);:MX=DX +80 COLOR 7,0:NE=NF:J=0:T$=INPUT$(1):IF T$=CHR$(27) THEN 1090 +90 IF T$="6" AND X<5 THEN X=X+1:GOTO 60 +100 IF T$="4" AND X>1 THEN X=X-1:GOTO 60 +110 IF T$=CHR$(13) THEN ON X GOTO 220,360,540,630,1090 +120 IF T$="2" AND (Y1 THEN Y=Y-1:GOSUB 1240 +140 IF T$="9" AND P>0 THEN P=P-1:Y=1:MY=1:GOSUB 1320:GOSUB 1220:GOSUB 1240 +150 IF T$="3" AND P pour abandon confirmer recommencer" +310 A$=INPUT$(1):IF A$="n" OR A$="N" THEN 220 +320 IF A$=CHR$(27) THEN IF NE<>NF THEN GOTO 350 ELSE 50 +330 LOCATE 21,10:PRINT " Dsirez-vous encore enregistrer une fiche ? ":NF=NF+1 +340 A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 350 ELSE 220 +350 LOCATE 2,23:PRINT "Patientez ! ":GOSUB 1280:GOSUB 1140:GOTO 50 +360 CLS:GOSUB 180:LOCATE 2,34:PRINT "MODIFICATIONS":IK=Y+P*20 +370 LOCATE 5,10:PRINT "Pour ne pas changer appuyez sur ENTRE " +380 LOCATE 7,3:PRINT "Nom [";N$(IK);:INPUT "] :",M$ +390 IF M$="" THEN NE$=N$(IK) ELSE GOSUB 1160:NE$=M$ +400 LOCATE 9,3:PRINT "Prnom [";P$(IK);:INPUT "] :",M$ +410 IF M$="" THEN PE$=P$(IK) ELSE GOSUB 1160:PE$=M$ +420 LOCATE 11,3:PRINT "Adresse [";D$(IK);:INPUT "] :",M$ +430 IF M$="" THEN DE$=D$(IK) ELSE DE$=M$ +440 LOCATE 13,3:PRINT "Code Post [";C(IK);:INPUT "] :",M$ +450 IF M$="" THEN C=C(IK) ELSE C=VAL(M$) +460 LOCATE 15,3:PRINT "Ville [";V$(IK);:INPUT "] :",M$ +470 IF M$="" THEN VE$=V$(IK) ELSE GOSUB 1160:VE$=M$ +480 LOCATE 17,3:PRINT "Tlphonne [";T$(IK);:INPUT "] :",M$ +490 IF M$="" THEN TE$=T$(IK) ELSE TE$=M$ +500 LOCATE 19,20:PRINT "Confirmer :O/N":A$=INPUT$(1):IF A$=CHR$(27) THEN 50 +510 IF A$="n" OR A$="N" THEN 360 ELSE IF A$<>"o" AND A$<>"O" THEN GOTO 500 +520 N$(IK)=NE$:P$(IK)=PE$:D$(IK)=DE$:C(IK)=C:V$(IK)=VE$:T$(IK)=TE$:GOSUB 1280 +530 GOSUB 1140:GOTO 50 +540 CLS:GOSUB 180:LOCATE 2,36:PRINT "EFFACER" +550 LOCATE 5,5:COLOR 14:PRINT "Etes vous certain de vouloir ";:COLOR 30 +560 PRINT "EFFACER";:COLOR 14:PRINT " ce qui suit ?":COLOR 7 +570 LOCATE 8,20:I=Y+PA*20:PRINT N$(I);" ";P$(I) +580 LOCATE 9,15:PRINT D$(I):LOCATE 10,20:PRINT C(I);V$(I):LOCATE 11,20 +590 PRINT T$(I):A$=INPUT$(1):IF A$="n" OR A$="N" OR A$=CHR$(27) THEN 50 +600 IF A$<>"o" AND A$<>"O" THEN BEEP:LOCATE 14,25:PRINT "Oui/Non":GOTO 580 +610 FOR I=Y+20*P TO NF:N$(I)=N$(I+1):P$(I)=P$(I+1):D$(I)=D$(I+1):C(I)=C(I+1) +620 V$(I)=V$(I+1):T$(I)=T$(I+1):NEXT I:NF=NF-1:GOSUB 1140:GOTO 50 +630 CLS:GOSUB 180:LOCATE 2,36:PRINT "RECHERCHE":I=0 +640 LOCATE 5,20:COLOR 3:PRINT "Vous repondez uniquement ce que vous savez !" +650 LOCATE 6,10:COLOR 4:PRINT "La recherche s'effectue par filtre dfinie "; +660 PRINT "par vos rponses .":TD=0 +670 COLOR 30:LOCATE 25,1:PRINT "N.B si le code postal comporte que"; +680 PRINT " 2 chiffres la recherche portera sur le dep";:COLOR 7 +690 LOCATE 8,10:INPUT "Nom :",M$:GOSUB 1160:NE$=M$ +700 LOCATE 9,10:INPUT "Prnom :",M$:GOSUB 1160:PE$=M$ +710 LOCATE 10,10:INPUT "Code Postal :",C$:C=VAL(C$) +720 LOCATE 11,10:INPUT "Ville :",M$:GOSUB 1160:VE$=M$ +730 LOCATE 12,10:INPUT "Tlphonne :",TE$ +740 IF C=0 AND C$<>"" THEN LOCATE 13,1:PRINT "Code postal annul":C$="" +750 IF C<100 THEN LOCATE 14,2:PRINT "Recherche sur tout le dpartement":TD=1 +760 R=0:FOR I=1 TO NF +770 IF NE$<>"" THEN IF NE$<>N$(I) THEN 840 +780 IF PE$<>"" THEN IF PE$<>P$(I) THEN 840 +790 IF VE$<>"" THEN IF VE$<>V$(I) THEN 840 +800 IF C$<>"" AND TD=0 THEN IF C<>C(I) THEN 840 +810 IF C$<>"" AND TD=1 THEN IF C<>INT(C(I)/1000) THEN 840 +820 IF TE$<>"" THEN IF TE$<>T$(I) THEN 840 +830 R=R+1:R(R)=I +840 NEXT I +850 CLS:GOSUB 180:LOCATE 2,36:PRINT "RESULTATS" +860 IF R<>0 THEN 890 +870 LOCATE 12,5:PRINT " Aucune fiche ne correspond vos critres ..." +880 A$=INPUT$(1):GOTO 50 +890 LOCATE 25,1:PRINT " Il y a ";R;" rponses "; +900 LOCATE 4,1:PA=0:Y=1:MY=1 +910 NPA=INT(R/20)+1*SGN(R MOD 20)-1:IF PA>NPA THEN PA=0 +920 FOR F=1+20*PA TO 20+20*PA:I=R(F):J=F-20*PA:GOSUB 1250:IF F<=R THEN NEXT +930 GOTO 1000 +940 T$=INPUT$(1):COLOR 7,0:IF T$=CHR$(27) THEN 50 +950 IF T$="2" AND (Y1 THEN Y=Y-1 +970 IF T$="9" AND PA>0 THEN PA=PA-1:Y=1:GOSUB 1320:GOTO 920 +980 IF T$="3" AND PA pour menu principal ou autre pour retour" +1080 A$=INPUT$(1):IF A$=CHR$(27) THEN 50 ELSE 850 +1090 COLOR 7,0:CLS:PRINT "Vous avez l'agrable bonjour de ";NCO$;" et il vous ":PRINT "flicite d'avoir choisi son logigiel ADRESSE + Ver 1.2 Programme n U1 ." +1100 PRINT :PRINT NCO$;" 71 av. d'Orlans 91800 BRUNOY, tel: 69.39.51.26":END +1110 OPEN "I",#1,NFICH$:NF=0 +1120 IF EOF(1) THEN CLOSE:RETURN ELSE NF=NF+1 +1130 INPUT #1,N$(NF),P$(NF),D$(NF),C$,V$(NF),T$(NF):C(NF)=VAL(C$):GOTO 1120 +1140 OPEN "O",#1,NFICH$:FOR I=1 TO NF +1150 WRITE #1,N$(I),P$(I),D$(I),STR$(C(I)),V$(I),T$(I):NEXT I:CLOSE:RETURN +1160 IF M$="" THEN RETURN ELSE FOR I=1 TO LEN(M$):L$=MID$(M$,I,1):L=ASC(L$) +1170 IF L<65 OR (L>90 AND L<97) OR L>122 THEN 1200 ELSE IF L>90 THEN L=L-32 +1180 N$=N$+CHR$(L) +1190 NEXT:M$=N$:N$="":RETURN +1200 L$=MID$("' UUUUUEEEEEAAAAOOOY-/C",INSTR("' -/",L$)+1,1) +1210 IF L$="" THEN 1190 ELSE L=ASC(L$):GOTO 1180 +1220 NP=INT(NF/20)+1*SGN(NF MOD 20)-1:J=0:IF P>NP THEN P=0 +1230 FOR I=1+20*P TO 20+20*P:GOSUB 1250:IF I=>NF THEN RETURN ELSE NEXT:RETURN +1240 J=MY:I=MY+P*20:GOSUB 1250:COLOR 0,7:I=Y+P*20:J=Y:GOSUB 1250:MY=Y:RETURN +1250 IF J=0 THEN J=I-20*P +1260 LOCATE J+3,2:PRINT N$(I):LOCATE J+3,15:PRINT P$(I); +1270 LOCATE J+3,28:PRINT T$(I);:LOCATE J+3,44:PRINT V$(I):J=0:RETURN +1280 FOR I=1 TO NF:FOR J=I TO NF:IF N$(I)>N$(J) THEN 1300 +1290 NEXT J:LOCATE 2,42:PRINT I+1;"/";NF:NEXT I:RETURN +1300 SWAP N$(I),N$(J):SWAP P$(I),P$(J):SWAP D$(I),D$(J):SWAP C(I),C(J) +1310 SWAP V$(I),V$(J):SWAP T$(I),T$(J):GOTO 1290 +1320 FOR KL=4 TO 23:LOCATE KL,2:PRINT SPACE$(78);:NEXT KL:LOCATE 1,1:RETURN +1330 CLS:NCO$=CHR$(68)+CHR$(65)+CHR$(82)+CHR$(67)+CHR$(72)+CHR$(69)+CHR$(32)+CHR$(89)+CHR$(111)+CHR$(97)+CHR$(110)+CHR$(110) +1340 LOCATE 1,28:COLOR 14:PRINT NCO$;" prsente :":LOCATE 7 +1350 PRINT " " +1360 PRINT " ۱۱۱۱۱۱۱" +1370 PRINT " ۱۱۰۱۰۱۰۱۱۱۱۰۱" +1380 PRINT " ۰۰۰۱۰۰۰۰۰۰۰" +1390 PRINT " ۰۰۰۱۱۱۱۱۱" +1400 PRINT " ۰۰۰۰۰۰۰۱۱۰۰" +1410 PRINT " ۰۰۰۱۰۱۰۱۰۱۰۰۰" +1420 PRINT " ۰۰۱۰۱۱۱۱۱" +1430 PRINT " " +1440 PRINT " " +1450 PRINT:PRINT " Version 1.2 " +1460 LOCATE 20,4:PRINT " Mr ";NCO$;" 71 av. d'Orlans 91800 BRUNOY tel: 69-39-51-26 aprs 19H" +1470 A$=INPUT$(1):RETURN + \ No newline at end of file diff --git a/ALPHABIN.BAS b/ALPHABIN.BAS new file mode 100644 index 0000000..1dff6f9 --- /dev/null +++ b/ALPHABIN.BAS @@ -0,0 +1,31 @@ +0 SCREEN 2:SCREEN 0:COLOR 3 +10 KEY OFF:CLS +20 INPUT "CODE de A (en decimal) ",A +25 IF A<=0 THEN BEEP:GOTO 20 +26 A=A-1 +30 CLS:PRINT "VOTRE PHRASE (255 caractres maximum = 3 lignes) +40 COLOR 14,14:LOCATE 5:PRINT "> " +50 PRINT " " +60 PRINT " " +70 PRINT " ":COLOR 14:LOCATE 5,2:INPUT "",B$ +80 T=1:FOR I=1 TO LEN(B$) +90 K$=MID$(B$,I,1) +100 IF K$=" " THEN GOSUB 1000:GOTO 190 +110 IF K$="." THEN GOSUB 1100:GOTO 190 +120 N=ASC(K$) +130 IF N<=64 OR (N=>91 AND N<=96) OR N=>123 THEN BEEP:CLS:LOCATE 12,1:COLOR 30:PRINT "ERREUR DANS LE TEXT :";:COLOR 14:PRINT K$;:COLOR 30:PRINT "N'EST PAS UNE LETTRE DE L'APHABET":COLOR 2:PRINT "cls":END +140 IF N>=97 THEN N=N-32 +150 N=N-64+A +160 WHILE N:R$=RIGHT$(STR$(N-INT(N/2)*2),1)+R$:N=INT(N/2):WEND +170 IF LEN(MB$(T))+LEN(R$)+1>254 THEN T=T+1 +180 MB$(T)=MB$(T)+R$+"-":R$="" +190 NEXT:COLOR 13,0:CLS:PRINT :PRINT +200 FOR U=1 TO T:PRINT MB$(U);:NEXT +210 PRINT :PRINT "voulez-vous une trace ecrite o/n":A$=INPUT$(1) +220 IF A$="n" OR A$="N" THEN END +230 IF A$="o" OR A$="O" THEN 250 +240 BEEP:GOTO 210 +250 LPRINT B$:FOR I=1 TO T:LPRINT MB$(I);:NEXT +1000 MB$(T)=LEFT$(MB$(T),LEN(MB$(T))-1)+" ":RETURN +1100 MB$(T)=LEFT$(MB$(T),LEN(MB$(T))-1)+".":RETURN + \ No newline at end of file diff --git a/AN.DAT b/AN.DAT new file mode 100644 index 0000000..368dac8 --- /dev/null +++ b/AN.DAT @@ -0,0 +1,27 @@ + 11.33 + 8.33 + 9.66 + 8.05 + 11.5 + 8.83 + 8.91 + 9.16 + 11 + 12.16 + 8.33 + 10.33 + 12.75 + 10.91 + 8.3 + 8.25 + 13.6 + 11.5 + 9.33 + 11 + 11.33 + 14.33 + 11.66 + 13.5 + 11.84 + 9.58 + \ No newline at end of file diff --git a/AN2.DAT b/AN2.DAT new file mode 100644 index 0000000..fc13f3a --- /dev/null +++ b/AN2.DAT @@ -0,0 +1,29 @@ + 11.93 + 12.83 + 10.09 + 10.44 + 13.02 + 8.2 + 11.14 + 9.25 + 10.62 + 11.15 + 11.22 + 8.57 + 11.19 + 12.48 + 10.85 + 12.33 + 9.75 + 10.81 + 13.34 + 10.41 + 10.25 + 9.42 + 12.25 + 13.49 + 11.62 + 12.79 + 11.82 + 11.53 + \ No newline at end of file diff --git a/ARBRE2.BAS b/ARBRE2.BAS new file mode 100644 index 0000000..b8719ae --- /dev/null +++ b/ARBRE2.BAS @@ -0,0 +1,118 @@ +' calcul +DEF FNGAUSS(MINI%,MAXI%) + EVENTAIL%=MAXI%-MINI% + VALEUR%=((EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND))/4 + FNGAUSS=MINI%+VALEUR% +END DEF + +DEF FNRNDSGN% + OUINON%=RND + FNRNDSGN%=1-(2*OUINON%) +END DEF + +'*********************** ARBRE ALEATOIRE ************************************ + +SCREEN 1 : FOND%=1 : RANDOMIZE TIMER +OUT &H3D8,14:OUT &H3D9,FOND%+48 +PI=ATN(1)*4 : DEGRES=PI/180 : YAJUST=1.15 + +DIM COULEUR$(11) +COULEUR$(1)=CHR$(&H55) +COULEUR$(2)=CHR$(&HAA) +COULEUR$(3)=CHR$(&HFF) +COULEUR$(4)=CHR$(&H66)+CHR$(&H99) +COULEUR$(5)=CHR$(&H77)+CHR$(&HDD) +COULEUR$(6)=CHR$(&H44)+CHR$(&H11) +COULEUR$(7)=CHR$(&HBB)+CHR$(&HEE) +COULEUR$(8)=CHR$(&H88)+CHR$(&H22) +COULEUR$(9)=CHR$(&HCC)+CHR$(&H33) + +LINE(0,100)-(319,100),1:PAINT(150,150),COULEUR$(4),1 +CALL HERBE(0,110,319,199) : CALL EAU(150,180) + +FOR i%=1 TO 4 + AVANCE%=AVANCE%+20 + X1%=320*RND : Y1%=80+AVANCE% : X2%=X1% : Y2%=Y1%-AVANCE% + CALL ARBRE(X1%,Y1%,X2%,Y2%) +NEXT + +WHILE INKEY$="" : WEND + +END + +'____________________________________________________________________________ +' TRACES DES ARBRES +'____________________________________________________________________________ +SUB ARBRE(AX1%,AY1%,AX2%,AY2%) STATIC +SHARED HAUTEUR% +HAUTEUR%=AY1%-AY2% + FOR I%=1 TO 2 + X1%=AX1% : Y1%=AY1% : X2%=AX2% : Y2%=AY2% + CALL TRONC(X1%,Y1%,X2%,Y2%) + NEXT +END SUB + +SUB TRONC(X1%,Y1%,X2%,Y2%) STATIC +STATIC NOMBRE% + NOMBRE%=NOMBRE%+1 + FOR X%=X1% TO X1%+(5-NOMBRE%) + LINE(X%,Y1%)-(X2%,Y2%),3 + CALL FEUILLAGE(X2%,Y2%) + NEXT + IF NOMBRE% < 4 THEN + CALL BRANCHE(X1%,Y1%, X2%,Y2%) + CALL TRONC (X1%,Y1%, X2%,Y2%) + END IF + NOMBRE%=0 +END SUB + +SUB BRANCHE(X1%,Y1%,X2%,Y2%) STATIC +SHARED DEGRES, YAJUST + ANGLE=FNGAUSS(40,85)*DEGRES + X1%=(X1%+X2%)/2: Y1%=(Y1%+Y2%)/2 + X%=ABS(X2%-X1%) : Y%=ABS(Y1%-Y2%)*YAJUST + LONGUEUR%=SQR((X%^2)+(Y%^2)) + X2%=X1%+(FNRNDSGN%*(LONGUEUR%*(COS(ANGLE)))) + Y2%=Y1%-((LONGUEUR%*(SIN(ANGLE)))/YAJUST) +END SUB + +SUB FEUILLAGE(X2%,Y2%) STATIC +SHARED PI,HAUTEUR% + D%=HAUTEUR% / 5 + DIAMETRE%=D%+(D%*RND) + X%=X2%+(FNRNDSGN%*DIAMETRE%*RND) + Y%=Y2%+(FNRNDSGN%*DIAMETRE%*RND) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,3,,,ASPECT + PAINT(X%,Y%),3,3 + CIRCLE(X%,Y%),DIAMETRE%,1,,,ASPECT + PAINT(X%,Y%),1,1 + CIRCLE(X%,Y%),DIAMETRE%,0,PI,0,ASPECT +END SUB + +' HERBE ET EAU + +SUB HERBE(X1%,Y1%,X2%,Y2%) STATIC +FOR I%=0 TO 100 + X%=X1%+(X2%-X1%)*RND:Y%=Y1%+(Y2%-Y1%)*RND + LINE(X%,Y%)-(X%+FNRNDSGN%,Y%-6),1 +NEXT +END SUB + +SUB EAU(X%,Y%) STATIC + FOR I%=1 TO 5 + DIAMETRE%=20+20*RND + X%=X%+(FNRNDSGN%*(FNGAUSS(0,60))) + Y%=Y%+(FNRNDSGN%*(FNGAUSS(0,5))) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,0,,,ASPECT + PAINT(X%,Y%),0,0 + NEXT +END SUB + + + diff --git a/ARBRE2.QB b/ARBRE2.QB new file mode 100644 index 0000000..eeef352 --- /dev/null +++ b/ARBRE2.QB @@ -0,0 +1,138 @@ +' calcul +DEF FNGAUSS(MINI%,MAXI%) + EVENTAIL%=MAXI%-MINI% + VALEUR%=((EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND))/4 + FNGAUSS=MINI%+VALEUR% +END DEF + +DEF FNRNDSGN% + OUINON%=RND + FNRNDSGN%=1-(2*OUINON%) +END DEF + +'*********************** ARBRE ALEATOIRE ************************************ + +SCREEN 1 : FOND%=1 : RANDOMIZE TIMER +PI=ATN(1)*4 : DEGRES=PI/180 : YAJUST=1.15 + +DIM COULEUR$(11) +COULEUR$(1)=CHR$(&H55) +COULEUR$(2)=CHR$(&HAA) +COULEUR$(3)=CHR$(&HFF) +COULEUR$(4)=CHR$(&H66)+CHR$(&H99) +COULEUR$(5)=CHR$(&H77)+CHR$(&HDD) +COULEUR$(6)=CHR$(&H44)+CHR$(&H11) +COULEUR$(7)=CHR$(&HBB)+CHR$(&HEE) +COULEUR$(8)=CHR$(&H88)+CHR$(&H22) +COULEUR$(9)=CHR$(&HCC)+CHR$(&H33) + +INPUT "QUELLE PALLETTE (1-6)",p% +if p%>=7 OR P%<=0 THEN P%=1 +INPUT "nombre d'ARBRES dsirs : ",NA% +INPUT "COULEUR DE TERRE (1-11) : ",CT% +IF CT%<=0 OR CT%>=12 THEN CT%=4 +CALL PAL(P%) +CLS +LINE(0,100)-(319,100),1:PAINT(150,150),COULEUR$(CT%),1 +CALL HERBE(0,110,319,199) : CALL EAU(150,180) + +FOR i%=1 TO NA% + AVANCE%=AVANCE%+20 + X1%=320*RND : Y1%=80+AVANCE% : X2%=X1% : Y2%=Y1%-AVANCE% + CALL ARBRE(X1%,Y1%,X2%,Y2%) +NEXT + +WHILE INKEY$="" : WEND + +END + +'____________________________________________________________________________ +' TRACES DES ARBRES +'____________________________________________________________________________ +SUB ARBRE(AX1%,AY1%,AX2%,AY2%) STATIC +SHARED HAUTEUR% +HAUTEUR%=AY1%-AY2% + FOR I%=1 TO 2 + X1%=AX1% : Y1%=AY1% : X2%=AX2% : Y2%=AY2% + CALL TRONC(X1%,Y1%,X2%,Y2%) + NEXT +END SUB + +SUB TRONC(X1%,Y1%,X2%,Y2%) STATIC +STATIC NOMBRE% + NOMBRE%=NOMBRE%+1 + FOR X%=X1% TO X1%+(5-NOMBRE%) + LINE(X%,Y1%)-(X2%,Y2%),3 + CALL FEUILLAGE(X2%,Y2%) + NEXT + IF NOMBRE% < 4 THEN + CALL BRANCHE(X1%,Y1%, X2%,Y2%) + CALL TRONC (X1%,Y1%, X2%,Y2%) + END IF + NOMBRE%=0 +END SUB + +SUB BRANCHE(X1%,Y1%,X2%,Y2%) STATIC +SHARED DEGRES, YAJUST + ANGLE=FNGAUSS(40,85)*DEGRES + X1%=(X1%+X2%)/2: Y1%=(Y1%+Y2%)/2 + X%=ABS(X2%-X1%) : Y%=ABS(Y1%-Y2%)*YAJUST + LONGUEUR%=SQR((X%^2)+(Y%^2)) + X2%=X1%+(FNRNDSGN%*(LONGUEUR%*(COS(ANGLE)))) + Y2%=Y1%-((LONGUEUR%*(SIN(ANGLE)))/YAJUST) +END SUB + +SUB FEUILLAGE(X2%,Y2%) STATIC +SHARED PI,HAUTEUR% + D%=HAUTEUR% / 5 + DIAMETRE%=D%+(D%*RND) + X%=X2%+(FNRNDSGN%*DIAMETRE%*RND) + Y%=Y2%+(FNRNDSGN%*DIAMETRE%*RND) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,3,,,ASPECT + PAINT(X%,Y%),3,3 + CIRCLE(X%,Y%),DIAMETRE%,1,,,ASPECT + PAINT(X%,Y%),1,1 + CIRCLE(X%,Y%),DIAMETRE%,0,PI,0,ASPECT +END SUB + +' HERBE ET EAU + +SUB HERBE(X1%,Y1%,X2%,Y2%) STATIC +FOR I%=0 TO 100 + X%=X1%+(X2%-X1%)*RND:Y%=Y1%+(Y2%-Y1%)*RND + LINE(X%,Y%)-(X%+FNRNDSGN%,Y%-6),1 +NEXT +END SUB + +SUB EAU(X%,Y%) STATIC + FOR I%=1 TO 5 + DIAMETRE%=20+20*RND + X%=X%+(FNRNDSGN%*(FNGAUSS(0,60))) + Y%=Y%+(FNRNDSGN%*(FNGAUSS(0,5))) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,0,,,ASPECT + PAINT(X%,Y%),0,0 + NEXT +END SUB + + +' CHOIX DE PALETTE + +SUB PAL(NUMERO%) STATIC +SHARED FOND% + +IF NUMERO%=1 THEN OUT &H3D8, 10 : OUT &H3D9,FOND% +IF NUMERO%=2 THEN OUT &H3D8, 10 : OUT &H3D9,FOND%+16 +IF NUMERO%=3 THEN OUT &H3D8, 10 : OUT &H3D9,FOND%+32 +IF NUMERO%=4 THEN OUT &H3D8, 10 : OUT &H3D9,FOND%+48 +IF NUMERO%=5 THEN OUT &H3D8, 14 : OUT &H3D9,FOND% +IF NUMERO%=6 THEN OUT &H3D8, 14 : OUT &H3D9,FOND%+16 + +END SUB + + diff --git a/ARBRES.QB b/ARBRES.QB new file mode 100644 index 0000000..c9f29d3 --- /dev/null +++ b/ARBRES.QB @@ -0,0 +1,132 @@ +' calcul +DEF FNGAUSS(MINI%,MAXI%) + EVENTAIL%=MAXI%-MINI% + VALEUR%=((EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND)+(EVENTAIL%*RND))/4 + FNGAUSS=MINI%+VALEUR% +END DEF + +DEF FNRNDSGN% + OUINON%=RND + FNRNDSGN%=1-(2*OUINON%) +END DEF + +'*********************** ARBRE ALEATOIRE ************************************ + +SCREEN 1 : FOND%=1 : CALL PAL(1) : RANDOMIZE TIMER +PI=ATN(1)*4 : DEGRES=PI/180 : YAJUST=1.15 + +DIM COULEUR$(11) +COULEUR$(1)=CHR$(&H55) +COULEUR$(2)=CHR$(&HAA) +COULEUR$(3)=CHR$(&HFF) +COULEUR$(4)=CHR$(&H66)+CHR$(&H99) +COULEUR$(5)=CHR$(&H77)+CHR$(&HDD) +COULEUR$(6)=CHR$(&H44)+CHR$(&H11) +COULEUR$(7)=CHR$(&HBB)+CHR$(&HEE) +COULEUR$(8)=CHR$(&H88)+CHR$(&H22) +COULEUR$(9)=CHR$(&HCC)+CHR$(&H33) + +LINE(0,100)-(319,100),1:PAINT(150,150),COULEUR$(4),1 +CALL HERBE(0,110,319,199) : CALL EAU(150,180) + +FOR i%=1 TO 4 + AVANCE%=AVANCE%+20 + X1%=320*RND : Y1%=80+AVANCE% : X2%=X1% : Y2%=Y1%-AVANCE% + CALL ARBRE(X1%,Y1%,X2%,Y2%) +NEXT + +WHILE INKEY$="" : WEND + +END + +'____________________________________________________________________________ +' TRACES DES ARBRES +'____________________________________________________________________________ +SUB ARBRE(AX1%,AY1%,AX2%,AY2%) STATIC +SHARED HAUTEUR% +HAUTEUR%=AY1%-AY2% + FOR I%=1 TO 2 + X1%=AX1% : Y1%=AY1% : X2%=AX2% : Y2%=AY2% + CALL TRONC(X1%,Y1%,X2%,Y2%) + NEXT +END SUB + +SUB TRONC(X1%,Y1%,X2%,Y2%) STATIC +STATIC NOMBRE% + NOMBRE%=NOMBRE%+1 + FOR X%=X1% TO X1%+(5-NOMBRE%) + LINE(X%,Y1%)-(X2%,Y2%),3 + CALL FEUILLAGE(X2%,Y2%) + NEXT + IF NOMBRE% < 4 THEN + CALL BRANCHE(X1%,Y1%, X2%,Y2%) + CALL TRONC (X1%,Y1%, X2%,Y2%) + END IF + NOMBRE%=0 +END SUB + +SUB BRANCHE(X1%,Y1%,X2%,Y2%) STATIC +SHARED DEGRES, YAJUST + ANGLE=FNGAUSS(40,85)*DEGRES + X1%=(X1%+X2%)/2: Y1%=(Y1%+Y2%)/2 + X%=ABS(X2%-X1%) : Y%=ABS(Y1%-Y2%)*YAJUST + LONGUEUR%=SQR((X%^2)+(Y%^2)) + X2%=X1%+(FNRNDSGN%*(LONGUEUR%*(COS(ANGLE)))) + Y2%=Y1%-((LONGUEUR%*(SIN(ANGLE)))/YAJUST) +END SUB + +SUB FEUILLAGE(X2%,Y2%) STATIC +SHARED PI,HAUTEUR% + D%=HAUTEUR% / 5 + DIAMETRE%=D%+(D%*RND) + X%=X2%+(FNRNDSGN%*DIAMETRE%*RND) + Y%=Y2%+(FNRNDSGN%*DIAMETRE%*RND) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,3,,,ASPECT + PAINT(X%,Y%),3,3 + CIRCLE(X%,Y%),DIAMETRE%,1,,,ASPECT + PAINT(X%,Y%),1,1 + CIRCLE(X%,Y%),DIAMETRE%,0,PI,0,ASPECT +END SUB + +' HERBE ET EAU + +SUB HERBE(X1%,Y1%,X2%,Y2%) STATIC +FOR I%=0 TO 100 + X%=X1%+(X2%-X1%)*RND:Y%=Y1%+(Y2%-Y1%)*RND + LINE(X%,Y%)-(X%+FNRNDSGN%,Y%-6),1 +NEXT +END SUB + +SUB EAU(X%,Y%) STATIC + FOR I%=1 TO 5 + DIAMETRE%=20+20*RND + X%=X%+(FNRNDSGN%*(FNGAUSS(0,60))) + Y%=Y%+(FNRNDSGN%*(FNGAUSS(0,5))) + ASPECT=(RND+RND+RND)/10 + CIRCLE(X%,Y%),DIAMETRE%,2,,,ASPECT + PAINT(X%,Y%),2,2 + CIRCLE(X%,Y%),DIAMETRE%,0,,,ASPECT + PAINT(X%,Y%),0,0 + NEXT +END SUB + + +' CHOIX DE PALETTE + +SUB PAL(NUMERO%) STATIC +SHARED FOND% +' IF NUMERO%=0 THEN NUMERO%=4 +' SELECT CASE NUMERO% + OUT &H3D8, 10 : OUT &H3D9,FOND% +' CASE 2 : OUT &H3D8, 10 : OUT &H3D9,FOND%+16 +' CASE 3 : OUT &H3D8, 10 : OUT &H3D9,FOND%+32 +' CASE 4 : OUT &H3D8, 10 : OUT &H3D9,FOND%+48 +' CASE 5 : OUT &H3D8, 14 : OUT &H3D9,FOND% +' CASE 6 : OUT &H3D8, 14 : OUT &H3D9,FOND%+16 +' END SELECT +END SUB + + diff --git a/B.BAS b/B.BAS new file mode 100644 index 0000000..faeebcb --- /dev/null +++ b/B.BAS @@ -0,0 +1,7 @@ +0 FI$=INPUT$(8):FI$=FI$+".iii" +10 REM +20 REM +30 DEF SEG=&HB800 +40 BSAVE FI$,0,32768! +50 END + \ No newline at end of file diff --git a/BAT1.BAS b/BAT1.BAS new file mode 100644 index 0000000..e3ec208 Binary files /dev/null and b/BAT1.BAS differ diff --git a/BINALPHA.BAS b/BINALPHA.BAS new file mode 100644 index 0000000..af26ad0 --- /dev/null +++ b/BINALPHA.BAS @@ -0,0 +1,15 @@ +0 CLS:COLOR 13 +2 DIM M$(1000),L$(26):V=1 +3 FOR I=1 TO 26:READ A$:L$(I)=A$:NEXT +9 INPUT "CODE (en decimal) du A",A +10 INPUT "phrase APHA SVP";FA$ +20 FOR T=1 TO LEN(FA$) +30 D$=MID$(FA$,T,1) +40 IF D$=" " OR D$="." THEN GOSUB 1000:V=V+1:R$="":GOTO 70 +50 IF D$="-" THEN GOSUB 1000:GOTO 70 +60 R$=R$+D$ +70 NEXT:FOR I=1 TO V:PRINT M$(I);" ";:NEXT I:END +1000 WHILE LEN(R$)>0:K=K*2+VAL(LEFT$(R$,1)):R$=RIGHT$(R$,LEN(R$)-1):WEND +1010 K=K-A+1:M$(V)=M$(V)+L$(K):K=0:RETURN +60000 DATA "A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z" + \ No newline at end of file diff --git a/BINM.BAS b/BINM.BAS new file mode 100644 index 0000000..9729c9e --- /dev/null +++ b/BINM.BAS @@ -0,0 +1,3 @@ +1 WHILE LEN(R$)>0:K=K*2+VAL(LEFT$(R$,1)):R$=RIGHT$(R$,LEN(R$)-1):WEND +3 WHILE N:R$=RIGHT$(STR$(N-INT(N/2)*2),1)+R$:N=INT(N/2):WEND + \ No newline at end of file diff --git a/BLI2.BAS b/BLI2.BAS new file mode 100644 index 0000000..2c2f4be Binary files /dev/null and b/BLI2.BAS differ diff --git a/BLITZ.BAS b/BLITZ.BAS new file mode 100644 index 0000000..eda30b6 Binary files /dev/null and b/BLITZ.BAS differ diff --git a/C--C.BAS b/C--C.BAS new file mode 100644 index 0000000..c10b78d Binary files /dev/null and b/C--C.BAS differ diff --git a/C-I-A.BAS b/C-I-A.BAS new file mode 100644 index 0000000..cf877de Binary files /dev/null and b/C-I-A.BAS differ diff --git a/CAPS&NUM.BAS b/CAPS&NUM.BAS new file mode 100644 index 0000000..479107f --- /dev/null +++ b/CAPS&NUM.BAS @@ -0,0 +1,7 @@ +96 REM teste de caps lock & num lock +97 DEF SEG=64 :IF (PEEK(23) AND 64)=64 THEN CAPS=1 +98 DEF SEG=64 :IF (PEEK(23) AND 32)=32 THEN NUM=1 +99 LOCATE 24,20:IF CAPS=1 THEN PRINT "CAPS LOCK "; ELSE PRINT " "; +100 IF NUM=1 THEN PRINT "NUM LOCK "; ELSE PRINT " "; +101 CAPS=0:NUM=0 + \ No newline at end of file diff --git a/CARTE.DAT b/CARTE.DAT new file mode 100644 index 0000000..7abff18 --- /dev/null +++ b/CARTE.DAT @@ -0,0 +1,65 @@ + 77 , 85 + 86 , 77 + 90 , 77 + 90 , 70 + 95 , 61 + 102 , 61 + 107 , 58 + 108 , 50 + 111 , 49 + 112 , 47 + 109 , 46 + 107 , 47 + 103 , 45 + 104 , 43 + 95 , 40 + 90 , 35 + 86 , 33 + 82 , 23 + 75 , 22 + 74 , 25 + 68 , 26 + 65 , 29 + 61 , 28 + 60 , 26 + 56 , 25 + 58 , 18 + 53 , 19 + 50 , 24 + 44 , 24 + 37 , 17 + 34 , 13 + 35 , 6 + 33 , 1 + 29 , 9 + 20 , 0 + 15 , 11 + 5 , 15 + 3 , 18 + 5 , 25 + 7 , 27 + 15 , 27 + 18 , 30 + 15 , 32 + 16 , 39 + 19 , 41 + 30 , 44 + 29 , 50 + 32 , 52 + 37 , 52 + 39 , 56 + 42 , 57 + 43 , 60 + 57 , 60 + 58 , 63 + 60 , 63 + 62 , 73 + 55 , 75 + 55 , 79 + 57 , 81 + 57 , 85 + 61 , 85 + 63 , 81 + 72 , 80 + 72 , 83 + \ No newline at end of file diff --git a/CCRESIST.BAS b/CCRESIST.BAS new file mode 100644 index 0000000..ad1ad0b --- /dev/null +++ b/CCRESIST.BAS @@ -0,0 +1,32 @@ +1000 SCREEN 2:SCREEN 0:CLS:COLOR 13,1 +1010 PRINT :LOCATE ,8:PRINT " C A L C U L E D E V A L E U R D E R E S I S T A N C E " +1020 COLOR 13,0:PRINT :PRINT "VOUS ENTREREZ DANS L'ORDRE ET AVEC DES VIRGULES LES COULEURS DES ANNEAUX. LORSQU'IL N'Y EN A PAS INCRIRE UN TIRET (-)" +1030 INPUT "Entrez vos couleurs ",C$(1),C$(2),C$(3),C$(4) +1040 LOCATE 14,36:FOR I=1 TO 4 +1041 H=0:T=0:V=0:V$=LEFT$(C$(I),3):IF LEN(C$)= 1 THEN V(I)=0 +1042 IF V$="NOI" THEN V=0:T=20:COLOR 0 +1043 IF V$="MAR" THEN V=1:T=1:COLOR 6 +1044 IF V$="ROU" THEN V=2:T=2:COLOR 12 +1045 IF V$="ORA" THEN V=3:COLOR 6 +1046 IF V$="JAU" THEN V=4:COLOR 14 +1047 IF V$="VER" THEN V=5:T=5:COLOR 10 +1048 IF V$="BLE" THEN V=6:COLOR 9 +1049 IF V$="VIO" THEN V=7:COLOR 13 +1050 IF V$="GRI" THEN V=8:H=.01:COLOR 8 +1051 IF V$="BLA" THEN V=9:H=.01:COLOR 15 +1052 IF V$="ARG" THEN T=10:V=0:H=0:COLOR 31 +1053 IF V$="OR" THEN T=5:V=0:H=0:COLOR 30 +1054 IF I=4 THEN PRINT " "; +1055 PRINT ""; +1056 IF I=4 THEN T1=T +1057 IF I=1 OR I=2 THEN V1$=V1$+STR$(V) +1058 IF I=3 THEN IF H=0 THEN V1=10^V ELSE V1=H +1059 NEXT +1060 VT#=VAL(V1$)*V1 +1070 COLOR 14:LOCATE 12,35:PRINT VT#;"" +1071 LOCATE 13,35:PRINT " TOLERANCE";T1;"%" +1072 LOCATE 16,25:FOR I=1 TO 4:PRINT C$(I);",";:NEXT +1073 COLOR 12:PRINT :PRINT " ESC fin ,une touche pour recommencer .... " +1074 A$=INPUT$(1):IF A$=CHR$(27) THEN CLS:COLOR 13:END +1075 RUN + \ No newline at end of file diff --git a/CERC.BAS b/CERC.BAS new file mode 100644 index 0000000..971b223 Binary files /dev/null and b/CERC.BAS differ diff --git a/CERC2.BAS b/CERC2.BAS new file mode 100644 index 0000000..1266553 Binary files /dev/null and b/CERC2.BAS differ diff --git a/CERC3.BAS b/CERC3.BAS new file mode 100644 index 0000000..d59ed49 Binary files /dev/null and b/CERC3.BAS differ diff --git a/CIA.BAS b/CIA.BAS new file mode 100644 index 0000000..5fbd05e --- /dev/null +++ b/CIA.BAS @@ -0,0 +1,56 @@ +0 KEY OFF:COLOR 3:CLS:DIM OBP$(5,50),OBC$(50) +1 OP=0:P=1:N=4:OC=0 +2 OBP$(5,1)="RIE":OBP$(2,1)="BAL" +3 EP$=STRING$(160," ") +1000 REM BOUCLE D'ENTREE DE L'ORDRE DU HEROS +1010 LOCATE 22,1:PRINT EP$:LOCATE 22,1:INPUT "Que fais-je ? ",A$ +1020 OD$ = LEFT$(A$,3) +1022 IF OD$="PRE" THEN AZ=1:GOTO 1060 +1024 IF OD$="POS" THEN AZ=2:GOTO 1060 +1026 IF OD$="REG" THEN AZ=3:GOTO 1060 +1028 IF OD$="I" OR OD$="INV" THEN 60030 +1030 IF OD$="EXA" THEN AZ=4:GOTO 1060 +1032 IF OD$="N" THEN +1034 IF OD$="S" THEN +1036 IF OD$="O" THEN +1038 IF OD$="E" THEN +1040 IF OD$="VA" THEN AZ=5:GOTO 1060 +1050 LOCATE 22:PRINT "DESOLER !!!! Je n'est pas compris (app sur une touche )"; +1051 A$=INKEY$:IF A$="" THEN 1051 ELSE 1000 +1060 FOR R=1 TO LEN(A$):IF MID$(A$,R,1)=" " THEN 1070 ELSE NEXT +1062 GOTO 1050 +1070 OD$=MID$(A$,R+1,3):R1=LEN(A$)-R:OD1$=MID$(A$,R+1,R1) +1080 ON AZ GOTO 1090,1110,1130,1150,1160 +1089 ' **** il veut predre ...... *** *** **** ****** +1090 IF OP >= N THEN LOCATE 22:PRINT "impossible vous avez dj";N;"OBJETS (App sur une touche )";:GOTO 1051 +1091 IF P<>0 THEN FOR I=1 TO 5 ELSE 1097 +1092 IF OBP$(I,P)=OD$ THEN 1093 ELSE NEXT :LOCATE 22,1:PRINT "il n'y a pas cette objet ici (App sur une touche)";:GOTO 1051 +1093 LOCATE 22:PRINT " OK !? je vais le prendre ... (APP sur une touche)"; +1094 OP=OP+1:OP$(OP)=OD1$:OBP$(I,P)="" +1095 ' ******** NE PAS OUBLIER DE LE RETIRER DE L'ECRANT ********* +1096 GOTO 1051 +1097 FOR I=1 TO OC +1098 IF LEFT$(OBC$(I),3)=OD$ THEN 1099 ELSE NEXT :LOCATE 22,1:PRINT "il n'y a pas cette objet ici (App sur une touche)";:GOTO 1051 +1099 LOCATE 22:PRINT " OK !? je vais le prendre ... (APP sur une touche)"; +1100 GOSUB 60050 :OP=OP+1:OP$(OP)=OD1$:GOTO 1051 +1109 ' **** IL VEUT POSER UN OBJET *** **** *** *** ** ** * * * * * ** * * ** +1110 OP=OP-1:GOSUB 60000 :IF P<> 0 THEN LOCATE 22,1:PRINT "si VOUS voulez CONSERVER l'objet il faut que vous soyer dans la chamdre debara or vous ni tes pas -- Continuer vous O/ou une touche ? -- "; ELSE 1112 +1111 A$=INKEY$:IF A$="" THEN 1111 ELSE IF A$<>"o" AND A$ <>"O" THEN 1000 ELSE LOCATE 22:PRINT " --- VOUS PERDEZ CETTE OBJET ?!!!!????.... --- ";:GOSUB 60040:GOTO 1051 +1112 LOCATE 22:PRINT EP$:LOCATE 22:PRINT " OK JE POSE ";OD1$;" (app sur une touche)" +1114 OC= OC +1:OBC$(OC)=OD1$:GOSUB 60040:GOTO 1051 +60000 '|||||||||||||||| controle de POSSETION DE L'OBJET ||||||||||||||||||||||| +60010 FOR I=1 TO N +60020 IF LEFT$(OP$(I),3)=OD$ THEN RETURN ELSE NEXT :LOCATE 22:PRINT " =-= dsol vous ne possedez pas cette objet =-= (App sur une touche)":GOTO 1051 +60029 '||||||||||||||||||||||||||||||||| I N V E N T A I R E ................... +60030 IF OP$(1)="" THEN LOCATE 22:PRINT " nous avons rien du tout (app sur une touche)":GOTO 1051 ELSE FOR I=1 TO N:LOCATE 22:PRINT OP$(I);" ,";:NEXT :LOCATE 23:PRINT "app sur une touche ":GOTO 1051 +60039 '|||||||||||||||| elimine un objet posseder |||||||||||||||||||||||||||||| +60040 FOR I=1 TO N +60041 IF OD1$=OP$(I) THEN 60042 ELSE NEXT +60042 OP$(I)="":FOR J=I TO N-1 +60043 OP$(J)=OP$(J+1):NEXT:RETURN +60049 '|||||||||||||||| elimine un objet CACHE |||||||||||||||||||||||||||||| +60050 FOR I=1 TO OC +60051 IF OD1$=OBC$(I) THEN 60052 ELSE NEXT +60052 OBC$(I)="":FOR J=I TO OC-1 +60053 OBC$(J)=OBC$(J+1):OC=OC-1:NEXT:RETURN + \ No newline at end of file diff --git a/CLAFOR.DAT b/CLAFOR.DAT new file mode 100644 index 0000000..51d22f9 --- /dev/null +++ b/CLAFOR.DAT @@ -0,0 +1,147 @@ +ESC 27 +1 49 +2 50 +3 51 +4 52 +5 53 +6 54 +7 55 +8 56 +9 57 +0 48 + 248 +_ 95 +DEL AV 7 +DEL AR 8 +TAB AV 9 +A 65 +Z 90 +E 69 +R 82 +T 84 +Y 89 +U 85 +I 73 +O 79 +P 80 +a 94 +$ 13 +$ 36 +* 42 +RET CH 13 +Q 81 +S 83 +D 68 +F 70 +G 71 +H 72 +J 74 +K 75 +L 76 +M 77 + 151 + 13 +< 60 +W 87 +X 88 +C 67 + 86 +V 86 +B 66 +N 78 +, 44 +; 59 +: 58 += 61 +F1 315 +F2 316 +F3 317 +F4 318 +F5 319 +F6 320 +F7 321 +F8 322 +F9 323 +F10 324 +SCR LK 19 +- 45 ++ 43 +7 55 +8 56 +9 57 + 13 +4 52 +5 13 +5 53 +6 54 +1 49 +2 50 +3 51 +0 13 +0 48 +. 46 +& 38 + 130 + 13 + 13 + 34 +' 39 +( 40 + 21 + 21 + 138 +! 33 + 135 + 133 +) 41 +- 45 +tab ar 9 +a 97 +z 122 +e 101 +r 114 +t 116 +y 121 +u 117 +i 105 +o 111 +p 112 +a 94 +* 13 +* 42 +prt sc 13 +q 113 +s 115 +d 100 +f 102 + 13 +g 103 + 13 +h 104 +j 106 +k 107 +l 108 +m 109 +% 37 + 156 +> 62 +w 119 +x 120 +c 99 +v 118 +b 98 +n 110 +? 63 +. 46 +/ 47 ++ 43 +fle h 328 +fle dr 333 +fle b 336 +fle g 331 +end 335 +pg dn 337 +pg up 329 +ins 338 +del 339 +home 327 diff --git a/CLAFORM.BAS b/CLAFORM.BAS new file mode 100644 index 0000000..d69a519 --- /dev/null +++ b/CLAFORM.BAS @@ -0,0 +1,16 @@ +OPEN #10 OUTPUT "B:CLAFOR.DAT" +blanc$=" " + LABEL essai +INPUT "Nom de la Touche";a$ +50 PRINT "Taper la Touche" +IF a$="END" THEN GOTO fin +75 a=INKEY +100 IF a=-1 GOTO 75 +a$=a$+RIGHT$(blanc$,6-LEN(a$)) +PRINT #10,a$;STR$(a) +PRINT a$;STR$(a) +200 GOTO essai +LABEL fin +CLOSE #10 +END + diff --git a/CLAVAJO.BAS b/CLAVAJO.BAS new file mode 100644 index 0000000..59b4ce1 --- /dev/null +++ b/CLAVAJO.BAS @@ -0,0 +1,14 @@ +OPEN #10 APPEND "B:CLAVIER.DAT" + LABEL essai +INPUT "Nom de la Touche";a$ +50 PRINT "Taper la Touche" +IF a$="END" THEN GOTO fin +75 a=INKEY +100 IF a=-1 GOTO 75 +PRINT #10,a$;STR$(a) +PRINT a$;STR$(a) +200 GOTO essai +LABEL fin +CLOSE #1 +END + diff --git a/CLAVIER.BAS b/CLAVIER.BAS new file mode 100644 index 0000000..498ddf8 --- /dev/null +++ b/CLAVIER.BAS @@ -0,0 +1,14 @@ +OPEN #10 OUTPUT "B:CLAVIER.DAT" + LABEL essai +INPUT "Nom de la Touche";a$ +50 PRINT "Taper la Touche" +IF a$="END" THEN GOTO fin +75 a=INKEY +100 IF a=-1 GOTO 75 +PRINT #10,a$;STR$(a) +PRINT a$;STR$(a) +200 GOTO essai +LABEL fin +CLOSE #10 +END + diff --git a/CLAVIER.DAT b/CLAVIER.DAT new file mode 100644 index 0000000..6faa744 --- /dev/null +++ b/CLAVIER.DAT @@ -0,0 +1,86 @@ +ESC 27 +1 49 +2 13 + 13 + 13 + 51 +2 130 +2 50 +3 51 +4 52 +5 53 +6 54 +7 55 +8 56 +9 57 +0 48 + 248 +_ 95 +DEV 7 +DER 8 +TAB 9 +A 65 +Z 90 +E 69 +R 82 +T 13 +T 84 +Y 89 +U 85 +I 73 +O 79 +P 34 + 327 +$ 36 +* 42 +Q 13 +Q 81 +S 83 +D 68 +F 70 +G 71 +H 13 + 72 +H 72 +J 74 +K 75 +L 76 +M 77 + 151 + 230 +< 60 +W 87 +X 88 +C 67 +V 86 +B 66 +N 78 +, 44 +; 59 +: 58 += 61 +7 55 +8 56 +9 57 +34" 52 +4 52 +5 53 +6 54 +1 49 +2 50 +3 51 +0 48 +. 46 +SCL 19 +- 45 ++ 43 +F1 315 +F2 316 +F3 317 +F4 318 +F5 319 +F6 320 +F7 321 +F8 322 +F9 323 +F10 324 diff --git a/CLI.DAT b/CLI.DAT new file mode 100644 index 0000000..e69de29 diff --git a/CLIENT.BAS b/CLIENT.BAS new file mode 100644 index 0000000..6d49577 Binary files /dev/null and b/CLIENT.BAS differ diff --git a/CLIENT.DAT b/CLIENT.DAT new file mode 100644 index 0000000..beec5b0 --- /dev/null +++ b/CLIENT.DAT @@ -0,0 +1,7 @@ +"DFGT","69.39.51.26",65002,"G.L.M.P.P","52 av. du Peuple","69.74.10.85" +"DORIT","69.25.12.01",91800,"C.L.R","Toto les lila","WHERE" +"ZOLG","45446",91800,"SUPERBE","71 avenue d'Orlans","69-39-51-26" +"DURAN","JUJI",91800,"VUYFOYUFOU",":444 UUUUU iiii RRRRR","55555" +"GHU","A COTE",91802,"HIUHUIH","41 lllll","KLOI" +"DUGLAN","WHERE",98102,"H.L.M","85 rue du bourg","WHERE" + \ No newline at end of file diff --git a/CODEBIN.BAS b/CODEBIN.BAS new file mode 100644 index 0000000..469c6ab --- /dev/null +++ b/CODEBIN.BAS @@ -0,0 +1,17 @@ +Cls +input a +gosub CODEBIN +print bin$ +end + + +CODEBIN : + b=5 + While b<>0 + b=int(a/2):r=a mod 2 + bin$=str$(r)+bin$ + print a,b,r + a=b + Wend + Return + diff --git a/COMBAT.BAS b/COMBAT.BAS new file mode 100644 index 0000000..0b091c1 Binary files /dev/null and b/COMBAT.BAS differ diff --git a/CONBAT.BAS b/CONBAT.BAS new file mode 100644 index 0000000..620dbab --- /dev/null +++ b/CONBAT.BAS @@ -0,0 +1,30 @@ +0 DIM N$(10),NT(10),TT(10),M(10):KEY OFF:COLOR 13:CLS:XX=3840:DEF SEG=&HB800:EE=ASC(" "):VV=127:IN=233:N1=196 +1 INPUT "nobre de tirs S.V.P ";TI +2 IF TI<50 THEN PRINT "insufisant ":GOTO 1 +3 IF TI>150 THEN PRINT "trop ????!!!":GOTO 1 +4 RR=TI:CLS +10 A$=INKEY$ +11 IF A$=CHR$(27) THEN CLS :PRINT "votre score est :";POI;"pour ";TI;"tires":GOTO 6000 +12 IF A$="6" THEN XX=XX+2:IF XX>=4000 THEN XX=XX-2:BEEP +13 IF A$="4" THEN XX=XX-2:IF XX<=3838 THEN XX=XX+2:BEEP +14 IF A$=" " THEN GOSUB 999 +25 POKE DD,EE:POKE XX,VV:DD=XX +26 RANDOMIZE TIMER: T=INT(RND*2):IF T=1 THEN A=A+2 ELSE IF T=2 THEN A=A-2 +27 POKE O,EE:POKE O-2,EE:POKE O+2,EE:POKE A+K,IN:POKE A+K+2,N1:POKE A+K-2,N1:O=A+K:K=K+160:IF K=>3998 THEN K=0:A=2*INT(RND*80):GOTO 10 ELSE 10 +999 TI=TI-1 :IF TI=<0 THEN PRINT "VOTRE SCORE EST :";POI;"pour ";RR;"TIRES":GOTO 6000 +1000 PALETTE 13,6:FOR I=XX TO XX-25*160 STEP -160:POKE I,24:POKE I+160,EE +1001 IF I=O OR I=A+K OR I=A+K+2 OR I=A+K-2 THEN PALETTE 13,13:POI=POI+1:POKE I,EE:A=2*INT(RND*80):K=0:RETURN ELSE NEXT +1002 PALETTE 13,13:RETURN +6000 I=0:OPEN"scoj1.dat" FOR INPUT AS #1 +6001 FOR I=1 TO 10 :INPUT #1,N$(I),NT(I),TT(I),M(I):NEXT:CLOSE +6002 PRINT "NOMS","T.TIRS","POINTS"," MOYENNE" +6003 FOR I=1 TO 10:COLOR 14:PRINT N$(I),:COLOR 13:PRINT NT(I),TT(I),:COLOR 20:PRINT M(I):NEXT :COLOR 2 +6004 MM=100/RR*POI +6005 FOR I=1 TO 10:IF MM>=M(I) THEN 6050 +6006 NEXT :PRINT " DESOLE VOUS N'ETES PAS PARMIS LES DIX MEILIEURS !!!":END +6050 PRINT "BRAVO !!! vous tes le ";I" eme ":INPUT "VOTRE NOM s.v.p ";NN$ +6060 FOR T=10 TO I STEP -1:N$(T)=N$(T-1):NT(T)=NT(T-1):TT(T)=TT(T-1):M(T)=M(T-1):NEXT +6070 M(I)=MM:N$(I)=NN$:NT(I)=RR:TT(I)=POI +6080 OPEN"scoj1.dat" FOR OUTPUT AS #1 +6081 FOR Y=1 TO 10 :PRINT #1,N$(Y);",";NT(Y);",";TT(Y);",";M(Y):NEXT :CLOSE:END + \ No newline at end of file diff --git a/CONC.DAT b/CONC.DAT new file mode 100644 index 0000000..d61b8bb --- /dev/null +++ b/CONC.DAT @@ -0,0 +1,29 @@ + 26 +Allirot Guillaume +Caron Christelle +Couade Celine +Darche Yoann +Darcot Thomas +De Foucault Guillaume +Fauchet Cristian +Genos Alexendra +Giethlen Julien +Gompel Carole +Guego de Traoulene S +Guimiot Fabien +Hassoun Jerome +Legrain Vincent +Letierce Thomas +Loudoux Henri +Muller Delphine +Paccioni Laurent +Pinget Gaetan +Robert Alin +Robert Sebastien +Robin Stephane +Tessier Annelyse +Thuilier Denis +Trouillon Karle... +Zamarra Gilbert + + \ No newline at end of file diff --git a/CONC1.DAT b/CONC1.DAT new file mode 100644 index 0000000..11a4a4e --- /dev/null +++ b/CONC1.DAT @@ -0,0 +1,31 @@ + 28 +Allirot Guillaume +Costard Christophe +Couade Celine +Darche Yoann +Darcot Thomas +De Foucault Guillaume +DelVecchio Christophe +Fauchet Cristian +Genos Alexendra +Giethlen Julien +Gompel Carole +Guerrouzi Severine +Guimiot Fabien +Hassoun Jerome +Legrain Vincent +Leonardi Damien +Letierce Thomas +Montemon Stephanie +Muller Delphine +Neuts Emmanuelle +Paccioni Laurent +Pinget Gaetan +Robert Alin +Robin Stephane +Tessier Annelyse +Thuilier Denis +Trouillon Karle... +Zamarra Gilbert + + \ No newline at end of file diff --git a/CONCEIL.BAS b/CONCEIL.BAS new file mode 100644 index 0000000..11b84d3 Binary files /dev/null and b/CONCEIL.BAS differ diff --git a/CONFIG.FIC b/CONFIG.FIC new file mode 100644 index 0000000..bd03603 Binary files /dev/null and b/CONFIG.FIC differ diff --git a/CONROMME.BAS b/CONROMME.BAS new file mode 100644 index 0000000..06aec36 Binary files /dev/null and b/CONROMME.BAS differ diff --git a/CONSEIL.BAS b/CONSEIL.BAS new file mode 100644 index 0000000..17f6e2d Binary files /dev/null and b/CONSEIL.BAS differ diff --git a/CONSEIL2.BAS b/CONSEIL2.BAS new file mode 100644 index 0000000..9b74a2b Binary files /dev/null and b/CONSEIL2.BAS differ diff --git a/COUPINTE.BAS b/COUPINTE.BAS new file mode 100644 index 0000000..a06df7e --- /dev/null +++ b/COUPINTE.BAS @@ -0,0 +1,52 @@ +1 ' ************************************************************************ +2 ' Programme de gestion d'espace imprimable pseudo intelligent +3 ' a partir d'un texte stok dans TEXT$, pouvant contenir le code de +4 ' controle suivant : 13 ( retour chario ), le programme le met en forme +5 ' de tel manire ce qu'il tienne dans une colone d'espace caractre +6 ' dfinie par LCOL%. Le programme effectura des coupure de mot lorsqu'il +7 ' y a rptition d'une lettre ou pas ( Fixe par COUPE% -1 avec 0 sans +8 ' ============ Programation et ide de DARCHE Yoann (C) 1991 ARTECHNYD == +9 '************************************************************************** +10 KEY OFF +20 CLS +30 PRINT " Introduisez le Texte ( maxi 255 car ) puis le nobre de caractre " +40 PRINT " Maxi par ligne le Programme vous le mettra en forme " +50 PRINT " Si vous voulez que le programme face des copures qu'il poura dtecter" +60 PRINT " Introdusez la question Coupure : -1 sinon introduisez 0 " +70 PRINT:PRINT " Programme et Ide de DARCHE Yoann (C) 1991 ARTECHNYD <<<<-----" +80 PRINT:PRINT +90 INPUT " TEXTE ( maxi 255 car ) : ",TEXTE$ +100 INPUT " Nb de caractre par ligne ( 20-80 ) ",LCOL% +101 IF LCOL%>80 OR LCOL%<20 THEN BEEP:PRINT " Idiot !!":GOTO 100 +110 INPUT " Coupure ? ( -1 = Oui, 0 = Non ) ",COUPE% +111 IF COUPE%<>-1 AND COUPE%<>0 THEN 110 +197 '*************************************************************************** +198 '** DEBUT DU PROGRAMME COUPE INTELLIGENTE (C) ARTECHNYD ** +199 '*************************************************************************** +200 DIM LI$(25): REM TABLEAU QUI VA PERMETTRE DE STOCKER LES LIGNES +204 MI%=0:I%=0:M$="":PI%=0:LI%=0:LI$="" +205 DIM M$(10): REM mot par ligne +210 FOR I%=1 TO LEN(TEXTE$) +220 PI%=PI%+1 +230 IF PI% > LCOL% THEN 270 +240 L$=MID$(TEXTE$,I%,1) +250 IF L$<>" " THEN M$=M$+L$:GOTO 340 +260 MI%=MI%+1:M$(MI%)=M$:M$="":GOTO 340 +265 ' +270 IF M$="" THEN REM ligne supp. +280 IF MID$(M$,LEN(M$)-1,1)=RIGHT$(M$,1) THEN MET UN TIRET +290 FOR J%=1 TO LEN(M$)-1 +300 IF MID$(M$,J%,1)=MID$(M$,J%+1,1) THEN COUPE ICI +310 NEXT J% +320 ' il n'y a plus rien a faire +330 GOTO 350 +340 NEXT I% +341 ' il n'y a plus rien faire !!!! +350 LI%=LI%+1 +360 FOR M%=1 TO MI%:LON%=LEN(M$(M%))+LON%:NEXT M% +370 NESPA%=LCOL%-LON%:NPESP%=INT(NESPA%/(MI%-1)):NDER%=NESPA%-NPESP%*(MI%-1) +380 FOR M%=2 TO MI%-1:LI$=LI$+SPACE$(NPESP%)+M$(M%):NEXT M% +390 LI$=LI$+SPACE$(NDER%+1)+M$(MI%):LI$=M$(1)+LI$ +400 PRINT LI$ +380 FOR M%=2 TO MI%-1:LI$=LI$+SPACE$(NPESP%)+M$(M%):NEXT M% +390 LI$=LI$+SPACE$(NDER%+1)+M$(MI%):LI$=M$( \ No newline at end of file diff --git a/CRE.BAS b/CRE.BAS new file mode 100644 index 0000000..2e643ab Binary files /dev/null and b/CRE.BAS differ diff --git a/CRE2.BAS b/CRE2.BAS new file mode 100644 index 0000000..8a4c40c Binary files /dev/null and b/CRE2.BAS differ diff --git a/CREA.SUP b/CREA.SUP new file mode 100644 index 0000000..1746542 --- /dev/null +++ b/CREA.SUP @@ -0,0 +1,5 @@ +2220 IF O=9 THEN 2230 ELSE LOCATE 23,1:INPUT "+X,+Y",PX,PY:LOCATE 23,1:PRINT " ";:O=9:GOTO 20 +2230 PSET(X,Y),K:PSET(X+PX,Y+PY),K +2240 IF X$=CHR$(221) THEN O=0:DELETE 2220-2240 +2250 RETURN + \ No newline at end of file diff --git a/CREA2.BAS b/CREA2.BAS new file mode 100644 index 0000000..889fc08 Binary files /dev/null and b/CREA2.BAS differ diff --git a/CREA3.BAS b/CREA3.BAS new file mode 100644 index 0000000..889fc08 Binary files /dev/null and b/CREA3.BAS differ diff --git a/CREA5.BAS b/CREA5.BAS new file mode 100644 index 0000000..0ffc022 Binary files /dev/null and b/CREA5.BAS differ diff --git a/CREAB2.BAS b/CREAB2.BAS new file mode 100644 index 0000000..8befccf Binary files /dev/null and b/CREAB2.BAS differ diff --git a/CREACARA.BAS b/CREACARA.BAS new file mode 100644 index 0000000..f913667 Binary files /dev/null and b/CREACARA.BAS differ diff --git a/CREADESS.BAS b/CREADESS.BAS new file mode 100644 index 0000000..f33a537 --- /dev/null +++ b/CREADESS.BAS @@ -0,0 +1,120 @@ +0 KEY OFF:SCREEN 2:SCREEN 0:CLS:COLOR 13:PRINT :PRINT :PRINT "-1- POUR REGLER L'IMPRIMANTE ":PRINT "-2- POUR COMMANCER LE PROGRAME ":PRINT " POUR FIN " +1 PRINT:PRINT "votre choix :" +2 A$=INKEY$:IF A$=CHR$(27) THEN END ELSE IF A$="" THEN 2 +3 IF A$="1" OR A$="&" THEN PRINT "app sur une touche lorsque vous serez pret" ELSE 5 +4 A$=INKEY$:IF A$="" THEN 4 ELSE LPRINT CHR$(27);"!":LPRINT CHR$(18):GOTO 0 +5 IF A$="2" OR A$="`" OR A$="" THEN 10 +10 CLEAR,,,32768!:SCREEN 5:CLS:KEY 11,CHR$(253):KEY 12,CHR$(221) +11 AV=1:X=160:Y=100:Q=12:K=2:DIM M(14000) +20 X$=INKEY$ +30 IF X$="'" OR X$="4" OR X$="|" THEN X=X-AV +40 IF X$="6" THEN X=X+AV +41 IF X$="8" OR X$="~" OR X$="!" THEN Y=Y-AV +42 IF X$="2" OR X$="`" OR X$="" THEN Y=Y+AV +43 IF X$=" " AND O=0 THEN X1=X:Y1=Y:GOTO 20 +44 IF X$="a" OR X$="A" THEN RUN 10 +45 IF X$="0" OR X$="" THEN O=0 +46 IF X$=CHR$(27) THEN END +47 IF X$="1" OR X$="&" THEN X=X-AV:Y=Y+AV +48 IF X$="3" THEN X=X+AV:Y=Y+AV +49 IF X$="7" OR X$="" OR X$="\" THEN Y=Y-AV :X=X-AV +50 IF X$="9" OR X$="" THEN Y=Y-AV :X=X+AV +86 IF Y<2 THEN BEEP:Y=Y+AV +87 IF Y>170 THEN BEEP:Y=Y-AV +88 IF X>316 THEN BEEP:X=X-AV +89 IF X<2 THEN BEEP:X=X+AV +90 S(0)=POINT (X,Y):S(1)=POINT (X-1,Y):S(2)=POINT (X+1,Y):S(3)=POINT (X,Y+1):S(4)=POINT (X,Y-1) +91 PSET (X,Y),K:PSET (X-1,Y),K:PSET (X+1,Y),K:PSET (X,Y+1),K:PSET (X,Y-1),K +92 PSET (X,Y),S(0):PSET (X-1,Y),S(1):PSET (X+1,Y),S(2):PSET (X,Y+1),S(3):PSET (X,Y-1),S(4) +93 LOCATE 24,1 +94 IF Q<> 0 AND Q<> 16 THEN COLOR Q:PRINT CHR$(8);" "; ELSE COLOR 13:PRINT "N";" "; +95 IF K<> 0 AND K<> 16 THEN COLOR K:PRINT CHR$(8); ELSE COLOR 13:PRINT "N"; +102 GOSUB 1000 +103 GOTO 20 +1000 IF X$="b" OR X$="B" THEN 2000 +1001 IF X$="c" OR X$="C" THEN 2010 +1002 IF X$="l" OR X$="L" THEN 2050 +1003 IF X$="p" OR X$="P" THEN 2060 +1004 IF X$="k" OR X$="K" THEN 2070 +1005 IF X$="d" OR X$="D" THEN 2080 +1006 IF X$="m" OR X$="M" THEN 2090 +1007 IF X$="n" OR X$="N" THEN 2100 +1008 IF X$="f" OR X$="F" THEN 2120 +1009 IF X$="q" OR X$="Q" THEN 2110 +1010 IF X$="z" OR X$="Z" THEN CLS +1011 IF X$="w" OR X$="W" THEN 2130 +1012 IF X$="v" OR X$="V" THEN 2140 +1013 IF X$="g" OR X$="G" THEN 2160 +1014 IF X$="t" OR X$="T" THEN 2170 +1015 IF X$="s" OR X$="S" THEN 2180 +1016 IF X$="e" OR X$="E" THEN 2200 +1017 IF X$="r" OR X$="R" THEN 2190 +1110 IF O=1 THEN 2000 +1111 IF O=2 THEN 2010 +1112 IF O=3 THEN 2050 +1113 IF O=4 THEN 2060 +1114 IF O=5 THEN 2090 +1115 IF O=6 THEN 2140 +1116 IF O=7 THEN 2170 +1117 IF O=8 THEN 2200 +1997 RETURN +2000 LINE (X1,Y1)-(X,Y),K,B:LINE (X1,Y1)-(X,Y),0,B +2005 IF X$=" " THEN LINE (X1,Y1)-(X,Y),K,B:O=0 ELSE O=1 +2006 RETURN +2010 R=X-X1:IF R<0 THEN R=X1-X +2030 CIRCLE (X1,Y1),R,K:CIRCLE (X1,Y1),R,0 +2035 IF X$=" " THEN CIRCLE (X1,Y1),R,K:O=0 ELSE O=2 +2040 RETURN +2050 LINE (X1,Y1)-(X,Y),K:LINE (X1,Y1)-(X,Y),0 +2051 IF X$=" " THEN LINE (X1,Y1)-(X,Y),K:O=0 ELSE O=3 +2052 RETURN +2060 IF X$=" " THEN PAINT (X,Y),Q,K:O=0 ELSE O=4 +2061 RETURN +2070 K=K+1:IF K=17 THEN K=1:RETURN +2071 RETURN +2080 PSET (X,Y),K +2081 RETURN +2090 PSET(X1,Y1),K +2091 IF X$=" " THEN LINE (X1-1,Y1-1)-(X+1,Y+1),K,B ELSE O=5:RETURN +2092 W=X1-X:IF W<0 THEN W=X-X1 +2093 W1=Y1-Y:IF X<0 THEN W1=Y-Y1 +2094 IF (W*W1) > 10000 THEN LOCATE 24,1:PRINT " ERREUR : PAS ASSEZ DE CAPACITEZ !!! ";:FOR I=1 TO 1500 :NEXT :LOCATE 24,1:PRINT " ";:LINE (X1-1,Y1-1)-(X+1,Y+1),O,B:RETURN +2095 GET(X1,Y1)-(X,Y),M:LINE (X1-1,Y1-1)-(X+1,Y+1),0,B:O=0:M(1)=1:RETURN +2100 IF M(1)=1 THEN PUT (X,Y),M :RETURN +2101 LOCATE 23,1:PRINT " ERREUR : VOUS N'AVIER PAS ENREGISTRE DE DESSIN ";:FOR I=1 TO 1500:NEXT :LOCATE 23,1:PRINT " "; +2102 RETURN +2110 Q=Q+1:IF Q=>16 THEN Q=0 +2111 RETURN +2120 CX=K+1:IF CX>=16 THEN CX=1 +2121 IF K>=16 THEN K=0 +2122 COLOR CX,K +2123 RETURN +2130 LOCATE 23,1:INPUT " N DE POINTS ",AV:LOCATE 24,1:PRINT " ";:LOCATE 23,1:PRINT " ":RETURN +2140 IF X$=" " AND DD=0 THEN BEEP :X2=X:Y2=Y:PSET(X1,Y1),K:PSET (X2,Y2),K:O=6:DD=1:RETURN +2141 IF X$=" " AND DD=1 THEN 2142 ELSE O=6:RETURN +2142 Y3=Y:X3=X:Y4=Y3:X4=X3+(Y3-Y2):X5=X4:Y5=Y2:X6=X1+(Y3-Y2):Y6=Y1:X7=X6:Y7=Y1+(Y3-Y2):X8=X1:Y8=Y7 +2143 LINE (X2,Y2)-(X4,Y4),K,B:LINE (X1,Y1)-(X7,Y7),K,B:LINE -(X4,Y4),K:LINE (X3,Y3)-(X8,Y8),K:LINE (X2,Y2)-(X1,Y1),K:LINE (X5,Y5)-(X6,Y6),K +2154 DD=0:Y2=0:X2=0:X3=0:X4=0:X5=0:X6=0:X7=0:X8=0:Y3=0:Y4=0:Y5=0:Y6=0:Y7=0:Y8=0:O=0:RETURN +2160 LOCATE 23,1:COLOR 14:PRINT " app sur une touche pour effacer et une seconde pour reprendre "; +2161 A$=INKEY$:IF A$="" THEN 2161 +2162 LOCATE 23,1:PRINT SPC(39);:LOCATE 24,1:PRINT SPC(39); +2163 A$=INKEY$:IF A$="" THEN 2163 ELSE RETURN +2170 O=7:IF X$<>" " THEN RETURN +2171 LX=INT(X/8)+1:LY=INT(Y/8)+1 +2172 LOCATE 23,1:PRINT " VOTRE PHRASE ? (f12 fin,f11 correction)"; +2173 COLOR K:LOCATE LY,LX +2174 A$=INKEY$:IF A$="" THEN 2174 ELSE IF ASC(A$)=221 THEN 2177 ELSE IF ASC(A$)=253 THEN LX=LX-1:IF LX=0 THEN LX=40:LY=LY-1:IF LY=0 THEN O=0:RETURN ELSE GOTO 2173 ELSE 2173 +2175 PRINT A$;:LX=LX+1:IF LX=41 THEN LY=LY+1:LX=1:IF LY=22 THEN O=0:RETURN +2176 GOTO 2173 +2177 LOCATE 23,1:PRINT SPC(39);" ";:O=0:RETURN +2180 DEF SEG=&HB800:LOCATE 23,1:COLOR 14:INPUT " Donnez un nom puis enter ";FI$ +2181 IF LEN(FI$)>=9 THEN BEEP 2180 +2182 LOCATE 23,1:PRINT SPC(39);:LOCATE 24,1:PRINT SPC(39); +2183 FI$=FI$+".im":BSAVE FI$,0,32768!:RETURN +2190 LOCATE 24,1:PRINT "ETES VOUS SUR ? O/N"; +2191 A$=INKEY$:IF A$="" THEN 2191 ELSE IF A$="O" OR A$="o" THEN 2192 ELSE LOCATE 24,1:PRINT SPACE$(40);:RETURN +2192 DEF SEG=&HB800:CLS:FILES "*.im" +2193 INPUT "NOM DU FICHIER IMAGE ";FI$:IF LEN(FI$)>=9 THEN 2193 ELSE FI$=FI$+".im" +2194 BLOAD FI$:RETURN +2200 LOCATE 23,1:PRINT "F12 pour fin";:O=8:PSET(X,Y),K:IF X$=CHR$(221) THEN O=0:RETURN ELSE RETURN + \ No newline at end of file diff --git a/CREALECT.BAS b/CREALECT.BAS new file mode 100644 index 0000000..8860a0d --- /dev/null +++ b/CREALECT.BAS @@ -0,0 +1,129 @@ +0 KEY OFF:COLOR 2,0,0:CLS +10 COLOR 13 +20 LOCATE 19 +30 A$=" " +40 B$=" " +50 C$=" " +60 D$=" " +70 E$=" " +80 PRINT " ";A$ +90 PRINT " ";B$ +100 PRINT " ";C$ +110 PRINT " ";D$ +120 PRINT " ";E$:LOCATE 25,1:COLOR 1:PRINT " Ecrit et realis par DARCHE Yoann tel: 69.39.51.26 " +130 FOR I=1 TO 18:PRINT :PLAY "p5":NEXT +140 CLEAR:COLOR 13:CLS +150 LOCATE 10:PRINT " F1= AIDE CTRL-A = SAUVE CTRL-R = RAPELLE +160 KEY 1,"":Y2=14:X2=14:XX=1:X=13:Y=13 +170 COLOR 30:LOCATE 25:PRINT " Appuyez sur la bar espace ":A$=INPUT$(1) +180 CLS:COLOR 2:C1$=CHR$(24):C2$=CHR$(25):C3$=CHR$(26):C4$=CHR$(27):E$=CHR$(18) +190 I3$=CHR$(202):I4$=CHR$(204):IX$=CHR$(206):OPTION BASE 1:DIM P$(23,23,3) +200 PRINT " ¿ ¿ ¿" +210 FOR I=1 TO 22:PRINT " ":NEXT +220 LOCATE 24,1:PRINT " "; +230 LOCATE 25,1:PRINT " "; +240 LOCATE 1,1:IF PP=1 THEN PP=0:RETURN ELSE COLOR 4 +250 A$=INKEY$:IF A$="" THEN 250 +260 IF A$=CHR$(219) THEN 970 +270 IF A$=CHR$(1) THEN 640 ELSE IF A$=CHR$(26) THEN 800 +280 IF A$=CHR$(18) THEN 710 +290 IF A$=CHR$(0)+"H" THEN Y=Y-1:GOTO 510 +300 IF A$=CHR$(0)+"P" THEN Y=Y+1:GOTO 510 +310 IF A$=CHR$(0)+"M" THEN X=X+1:GOTO 510 +320 IF A$=CHR$(0)+"K" THEN X=X-1:GOTO 510 +330 IF A$="_" THEN K$="":GOTO 630 +340 IF ASC(A$)=31 THEN K$="":GOTO 630 +350 IF A$="D" THEN K$="":GOTO 630 +360 IF ASC(A$)=4 THEN K$="":GOTO 630 +370 IF A$="G" THEN K$="":GOTO 630 +380 IF ASC(A$)=7 THEN K$="":GOTO 630 +390 IF A$="U" THEN K$=C1$:GOTO 630 +400 IF A$=CHR$(0)+CHR$(22) THEN K$=C2$:GOTO 630 +410 IF A$=CHR$(21) THEN K$=C3$:GOTO 630 +420 IF A$="u" THEN K$=C4$:GOTO 630 +430 IF A$="T" THEN K$="":GOTO 630 +440 IF A$=CHR$(0)+CHR$(20) THEN K$="":GOTO 630 +450 IF ASC(A$)=20 THEN K$="":GOTO 630 +460 IF A$="t" THEN K$="":GOTO 630 +470 IF A$="+" THEN K$="":GOTO 630 +480 IF A$="E" THEN K$=E$ :GOTO 1230 +490 IF A$=" " THEN K$=" ":GOTO 1250 +500 GOTO 250 +510 IF Y<=0 THEN Y=Y+1 +520 IF Y>=24 THEN Y=Y-1 +530 IF X<=0 AND XX=1 THEN XX=3:X=23 +540 IF X>=24 AND XX=3 THEN XX=1:X=1 +550 IF X>=24 AND XX<3 THEN XX=XX+1:X=1 +560 IF X<=0 AND XX>1 THEN XX=XX-1:X=23 +570 Y1=Y+1 +580 IF XX=1 THEN X1=X+2 +590 IF XX=2 THEN X1=X+28 +600 IF XX=3 THEN X1=X+54 +610 LOCATE Y2,X2:PRINT CHR$(V);:V=SCREEN (Y1,X1):LOCATE Y1,X1:PRINT "";:Y2=Y1:X2=X1 +620 GOTO 250 +630 V=ASC(K$):P$(X,Y,XX)=K$:GOTO 510 +640 CLS:INPUT "Nom du fichier 8 caractres ";FI$:IF LEN(FI$)>=9 THEN 640 ELSE FI$=FI$+".lab" +650 OPEN "O",#1,FI$ +660 FOR A=1 TO 3:FOR B=1 TO 23:FOR C=1 TO 22 +670 PRINT #1,P$(C,B,A);",";:PRINT P$(C,B,A);","; +680 NEXT C:PRINT #1,P$(23,B,A):PRINT P$(23,B,A):NEXT B:PRINT:NEXT A +690 CLOSE:PRINT "Voulez - Vous RETOURNEZ l'dition O/N ":A$=INPUT$(1) +700 IF A$="O" OR A$="o" THEN 850 +710 CLS:COLOR 14:LOCATE 12:PRINT " ETES-VOUS SUR DE RAPPELER UN FICHIER O/N":A$=INPUT$(1) +720 IF A$="N" OR A$="n" THEN 850 +730 IF A$="O" OR A$="o" THEN 740 ELSE BEEP:GOTO 710 +740 CLS:COLOR 13:FILES "*.LAB" +750 INPUT "Nom de votre fichier : ",FI$:IF LEN(FI$)>=9 THEN 710 ELSE FI$=FI$+".lab" +760 OPEN "i",#1,FI$ +770 FOR A=1 TO 3:FOR B=1 TO 23 +780 INPUT#1,P$(1,B,A),P$(2,B,A),P$(3,B,A),P$(4,B,A),P$(5,B,A),P$(6,B,A),P$(7,B,A),P$(8,B,A),P$(9,B,A),P$(10,B,A),P$(11,B,A),P$(12,B,A),P$(13,B,A),P$(14,B,A),P$(15,B,A),P$(16,B,A),P$(17,B,A),P$(18,B,A),P$(19,B,A),P$(20,B,A),P$(21,B,A),P$(22,B,A),P$(23,B,A) +790 NEXT B:NEXT A:CLOSE:GOTO 850 +800 CLS:LOCATE 12,1:COLOR 14:PRINT " ETES-SURE DE VOULOIRE EFFACER LES TABLEAUX O/N":A$=INPUT$(1) +810 IF A$="N" OR A$="n" THEN 850 +820 IF A$="O" OR A$="o" THEN 830 ELSE BEEP:GOTO 800 +830 ERASE P$:DIM P$(23,23,3) +840 COLOR 2,0:CLS:PP=1:GOSUB 200:COLOR 4:GOTO 250 +850 COLOR 2,0:CLS:PP=1:GOSUB 200:COLOR 4 +860 FOR I=1 TO 23:FOR N=1 TO 23 +870 LOCATE I+1,N+2:PRINT P$(N,I,1); +880 NEXT N:NEXT I +890 FOR I=1 TO 23:FOR N=1 TO 23 +900 LOCATE I+1,N+28:PRINT P$(N,I,2); +910 NEXT N:NEXT I +920 FOR I=1 TO 23:FOR N=1 TO 23 +930 LOCATE I+1,N+54:PRINT P$(N,I,3); +940 NEXT N:NEXT I +950 GOTO 250 +960 REM PAGE D'AIDE (F1) +970 CLS +980 COLOR 13,1:CLS:PRINT " PAGE-AIDE " +990 PRINT :PRINT " INDEX DES DIFERANTES TOUCHES ,LEUR CARACTERE,ET LA SIGNIFICATION " +1000 PRINT " =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=" +1010 PRINT "Ŀ" +1020 PRINT " touche car. SINIFICATION: " +1030 PRINT "Ĵ" +1040 PRINT " _ COULOIR " +1050 PRINT " CTRL-_ IDEM CTRL-R = RAPELLE +1060 PRINT " D Virage DROIT CTRL-A = SAUVE +1070 PRINT " CTRL-D IDEM CTRL-Z = EFFACE TOUT LES +1080 PRINT " G Virage GAUCHE 3 PLANTS EN MEMOIR +1090 PRINT " CTRL-G IDEM " +1100 PRINT " U ";C1$;" Cul de Sac ETAGE : +1110 PRINT " ALT-U ";C2$;" IDEM Ŀ Ŀ Ŀ +1120 PRINT " CTRL-U ";C3$;" IDEM 1 2 3 +1130 PRINT " SHIFT-U ";C4$;" IDEM +1140 PRINT " T Intersection en T CHAQUE ETAGE COMPREND +1150 PRINT " ALT-T IDEM 23 SUR 23 CARACTERES +1160 PRINT " CTRL-T IDEM +1170 PRINT " SHIFT-T IDEM N.B. METTEZ VOUS SUR +1180 PRINT " + Intersection en X CAPS LOOK +1190 PRINT " E ";E$;" Escalier " +1200 PRINT " APPUYER SUR UNE TOUCHE POUR EDITION "; +1210 LOCATE 1,1 +1220 A$=INKEY$:IF A$="" THEN 1220 ELSE GOTO 850 +1230 LOCATE Y+1,X+2:PRINT K$;:LOCATE Y+1,X+28:PRINT K$;:LOCATE Y+1,X+54:PRINT K$; +1240 V=ASC(K$):P$(X,Y,1)=K$:P$(X,Y,2)=K$:P$(X,Y,3)=K$:GOTO 250 +1250 IF V<>18 THEN K$=" ":GOTO 630 +1260 LOCATE Y+1,X+2:PRINT K$;:LOCATE Y+1,X+28:PRINT K$;:LOCATE Y+1,X+54:PRINT K$; +1270 V=ASC(K$):P$(X,Y,1)=K$:P$(X,Y,2)=K$:P$(X,Y,3)=K$:GOTO 250 + \ No newline at end of file diff --git a/CREAPAG.BAS b/CREAPAG.BAS new file mode 100644 index 0000000..eb5b8ed --- /dev/null +++ b/CREAPAG.BAS @@ -0,0 +1,879 @@ +CLS +DEFINT A-Z +DIM BB(40),CC(63),T%(4,4),CT(26,6),TA%(16) +YOANN$=chr$(68)+chr$(65)+chr$(82)+chr$(67)+chr$(72)+chr$(69)+" "+CHR$(89)+chr$(111)+chr$(97)+chr$(110)+chr$(110) +LOCATE 1,1,1,8,8 +gosub publicite +ON ERROR GOTO TRAITERREUR +CHX%=1 +' ------------------------ Chargement des Sub Routines Suplmantaires ------- + +' $INCLUDE: 'A:CREAPSUP.BAS' + +' ----------------------- Chargement des Sub Routine MENUS ------------------ + +' $INCLUDE: 'A:MENUTXT.BAS' + +' ---------------------- Slection du mode de l'ecran ------------------------ + DEF SEG = &h40 + TE%=(PEEK(&h10) AND &h30):DEF SEG + IF TE%=0 THEN PRINT " Programme non utilisable sur cette appareil ! [ECRAN] ":END + IF TE%=&h30 Then SegEcr%=&hB000 Else SegEcr%=&hB800 + DEF SEG = SEGECR% + +' --------------- Constante Provisoire -------------------------------------- + +CN%=11:FN%=1:CI=14:FI=4 ' Couleurs Normales Inverss +CND%=14:CID%=110 ' Couleur du Trac Normale/Inverse +CNT%=10:CIT%=110 ' Couleur de Texte Normale/Inverse +IND%=-1:INE%=-1:A$=CHR$(27):PCOPY 0,3 + +IF SEGECR%=&hb000 THEN CN%=7:FN%=0:CI%=0:FI%=7:CND%=15:CID%=7 + +Ta%(1)=17:Ta%(2)=30:Ta%(3)=254:Ta%(4)=16:Ta%(8)=31:Ta%(12)=254 + +GOSUB LectData ' ****** Lit les DATAs ****** +GOSUB Rapp.Config ' ****** Rappelle la Configuration ***** +GOTO Debut + +' --------- converstion asc(x)-178 ===> code binaire ------------------------ + + DATA 05,13,45,61,60,44,29,21,28,25,57,41,12,03,11,14,07,10,15,39 + DATA 55,19,22,27,30,23,26,31,43,59,46,62,51,35,38,54,63,47,09,06 + +' ------------- convertion binaire ====> code caractre CHR$() -------------- + + DATA 032,032,032,192,032,179,218,195,032,217,196,193,191,180,194,197 + DATA 032,032,032,200,032,186,201,204,032,188,205,202,187,185,203,206 + DATA 032,032,032,212,032,179,213,198,032,190,205,207,184,181,209,216 + DATA 032,032,032,211,032,186,214,199,032,189,196,208,183,182,210,215 + +' ------------ Donnes pour le choix directe des caractres ----------------- + +DATA 253,251,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,252 +DATA 130,136,137,138,160,131,132,133,161,140,139,141,162,147,148,149,163,150,129,151,135,128,142,143,134,144,153 +DATA 154,152,155,145,146,156,157,158,159,171,172,064,164,165,166,167,168,173,174,175,169,170,019,021,020,015,028 +DATA 219,176,177,178,220,223,221,222,022,254,248,249,250,007,008,009,010,001,002,003,004,005,006,011,012,013,014 +DATA 218,194,191,201,203,187,214,210,183,213,209,184,205,186,091,024,029,018,030,093,035,036,037,038,045,022,127 +DATA 195,197,180,204,206,185,199,215,182,198,216,181,196,179,027,042,026,017,043,016,047,092,060,061,062,063,033 +DATA 192,193,217,200,202,188,211,208,189,212,207,190,023,124,040,025,123,125,031,041,094,095,096,039,044,046,059 + +' ============================== Lecture des datas ========================= +LectData : +COLOR 30,1 +RESTORE +LOCATE 25,1:PRINT "PATIENTEZ "; + FOR I=1 TO 40 :READ BB(I):NEXT I + FOR I=0 TO 63 :READ CC(I):NEXT I + FOR J=0 TO 6 + FOR I=0 TO 26 + READ CT(I,J) + NEXT I + NEXT J +X=1:Y=1:LOCATE 25,1:PRINT "OK "; +RETURN + +' ============================== Sous prog calcule ========================== + +SUB CALCUL(AN,CO,V,D,NO,PR%) STATIC + +STATIC S,C + + IF PR% THEN AN= 0+( D AND 16) + S =-(AN AND 32)/32 + C =-(AN AND 16)/16 + VL=-(NOT(V) AND D)*(C*16+32)-(NOT(V) AND NOT(D) AND C)*48 + VL=VL+(V AND ((D AND 48)+(S XOR C)*32*((NOT(D))-D))) + CO=CO OR VL + NO=(AN AND 15) OR (CO) + +End Sub + +'============================= sOUS PROG VERIFICATION DU POKAGE ============= + +Sub Verif(AN) STATIC +shared d,BB() +IF AN<179 OR AN>218 THEN AN= 0+( D AND 16) ELSE AN=BB(AN-178) +End Sub + + +' ==================================== Sous Prog Color ====================== +SUB COLORC(CA%,CB%,SS%) STATIC + +STATIC COU,B$,K%,V%,KA%,C% +SHARED CN%,FN%,T%() + +COU=FNCO%(CN%,FN%) + +IF SS%<>0 THEN + IF CA%>=128 THEN CA%=CA%-128:KA%=128 ELSE KA%=0 + CB%=INT(cA%/16):CA%=(CA%-CB%*16) + ELSE + IF CA%>=32 THEN CA%=CA-16:ka%=128 ELSE KA%=0 + END IF + +B$=chr$(0):T%(0,0)=CA%:T%(1,0)=CB%:for i=0 to 2:T%(i,1)=T%(i,0):next i +CALL FAITUNCADRE(6,6,74,18,CN%,FN%) +LOCATE 7,34:PRINT "LES COULEURS"; +locate 9,11:print " Utilisez les flches pour le choix C clignotant / ou pas " +DE%=1634 + +'************** Affichages des couleurs actuelles et choisies . *********** + +COLOR CA%,CB% +LOCATE 17,19:PRINT "Ancienne Couleur" +LOCATE 17,45:PRINT "Nouvelle Couleur" +CY%=0:CX%=CA% + +NEWCOLOR : +T%(2,0)=KA%:A$="" + +FOR I=0 TO 15 +POKE DE% +2*(3*i-2),219 :POKE DE%+2+2*(3*I-2),219 +POKE DE%+1+2*(3*i-2),I+KA%:POKE de%+3+2*(3*I-2),I+KA% +NEXT I +FOR I=0 TO 7 +POKE DE%+502+2*(3*i-2),219:POKE DE%+504+2*(3*I-2),219 +POKE DE%+503+2*(3*i-2),I :POKE DE%+505+2*(3*I-2),I +NEXT I +poke DE%+498,222:POKE DE%+499,143:POKE DE%+500,221:POKE DE%+501,143 +poke DE%-4,222:POKE DE%-3,143:POKE DE%-2,221:POKE DE%-1,143:K=-4 + + +WHILE NOT(A$=" " or A$=CHR$(13) or A$=chr$(27)) +mp=0 + IF A$=B$+"P" or A$="2" Then CY=CY+1:mp=-1 + IF A$=B$+"H" or A$="8" Then CY=CY-1:mp=-1 + IF A$=b$+"M" or A$="6" Then CX=CX+1 + If A$=B$+"K" or A$="4" Then CX=CX-1 + IF A$="C" or A$="c" Then + IF KA%=128 THEN KA%=0 ELSE KA%=128 + GOTO NEWCOLOR + End if + IF cy=1 THEN MCX=7 ELSE MCX=15 + IF Cy<0 THEN CY=1 + IF CY>1 THEN CY=0 + IF MP THEN CX=T%(CY,0) + IF CX<0 THEN CX=MCX + IF CX>MCX THEN CX=0 + + c=2*(3*CX-2)+502*cy:T%(CY,0)=CX + +POKE K+DE%-162,000:POKE K+DE%-160,000:POKE K+DE%-158,000:POKE K+DE%-156,000 +POKE K+DE%-002,000 :POKE K+DE%+004,000 +POKE K+de%+158,000:POKE K+DE%+160,000:POKE K+DE%+162,000:POKE K+DE%+164,000 +POKE C+DE%-162,218:POKE C+DE%-160,196:POKE C+DE%-158,196:POKE C+DE%-156,191 +POKE C+DE%-002,179 :POKE C+DE%+004,179 +POKE C+de%+158,192:POKE C+DE%+160,196:POKE C+DE%+162,196:POKE C+DE%+164,217 +COP%=FNCO%(T%(0,0),T%(1,0)):FOR I=2649 TO 2681 STEP 2:POKE I,COP%+KA%:NEXT I +K=C:A$="": WHILE A$="":A$=INKEY$:WEND +wend + +IF A$=chr$(27) then + CA%=T%(0,1):CB%=T%(1,1):KA%=T%(2,1) + ELSE + CA%=T%(0,0):CB%=T%(1,0):KA%=T%(2,0) + END IF + + +IF SS%<>0 THEN + CA%=CB%*16+CA%+KA% + ELSE + IF KA%<>0 then CA%=CA%+16 +END IF + +if a$=chr$(27) then ss%=-1 else ss%=0 + +END SUB + +'=============================== CHOIX CARACTERE ========================== +SUB CHXCAR(C%) static + +SHARED CN%,FN%,CI%,FI%,CT() +STATIC DE%,B$,CX,CY + +CALL FaitUnCAdre(10,2,68,19,CN%,FN%) +LOCATE 18,12:PRINT " Utilisez les flches, pour valider, FIN " +DE%=502:B$=chr$(0):a$="" +FOR I=0 TO 26:FOR j=0 TO 6:PO%=DE%+I*4+J*320:POKE PO%,CT(I,J):NEXT j:NEXT I + +WHILE NOT(A$=" " or A$=CHR$(13) or A$=chr$(27)) + + IF A$=B$+"P" or A$="2" Then Cy=CY+1 + IF A$=B$+"H" or A$="8" Then CY=CY-1 + IF A$=b$+"M" or A$="6" Then Cx=Cx+1 + If A$=B$+"K" or A$="4" Then Cx=Cx-1 + IF Cy<0 THEN CY=6 + IF CY>6 THEN CY=0 + IF CX<0 THEN CX=26 + IF CX>26 THEN CX=0 + + V=DE%+CX*4+CY*320 + + POKE K-162,000:POKE K-160,000:POKE K-158,000 + POKE K-002,000: POKE K+002,000 + POKE K+158,000:POKE K+160,000:POKE K+162,000 + POKE V-162,218:POKE V-160,196:POKE V-158,191 + +POKE V-002,179: POKE V+002,179 + POKE V+158,192:POKE V+160,196:POKE V+162,217 + + K=V:a$="":While a$="":A$=INKEY$:Wend + WEND + + C%=CT(CX,CY) + if a$=chr$(27) then C%=-1 + +end sub + +'=================== Menu de saisi d'un caractre spcifique ================ + +SUB CHOIXCAR(C%) STATIC + +SHARED CN%,FN%,CI%,FI% +STATIC MENU$,CHY%,A$,b$,kl,re$ +A$="":kl=0:re$="":C%=0 + +debutc : + CHY% = 3 +MENU$="entre au Clavier code Ascii choix Pratique Fin " + CALL MENU(MENU$,17,15,10,CN%,FN%,CI%,FI%,0,CHY%,-1) + if CHY% = -1 then c%=-1:goto finch + ON CHY% gosub CH1,CH2,CH3,FINCH1 + if c%=-1 then goto debutc + goto finch + +CH1 : +CALL FAITUNCADRE(13,11,55,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez au Clavier votre caractre : "; +a$="" +WHile A$<>CHR$(13) and a$<>chr$(27) + Locate 12,50:pRINT A$:C$=A$:a$="" + While A$="":a$=inkey$:wend +wend +c%=asc(c$) +if a$=chr$(27) then c%=-1:return +gosub testbid +if a$="N" or a$="n" then goto CH1 +return + +ch2 : + +CALL FAITUNCADRE(13,11,55,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez le code ASCII du caractre : "; +a$="":B$=CHR$(0):re$="":kl=0 +While (a$<>chr$(27) AND a$<>chr$(13)) + A$="" + while a$="" : a$=inkey$ : wend: a= asc(a$) + if a>47 and a<57 and kl<3 then + kl=kl+1:locate 12,49+kl:print a$ + re$=re$+a$ + end if + + if (a$=b$+"K" or a$=b$+"S" or A$=CHR$(8)) and kL>0 then + locate 12,49+kl:print " " + kl=kl-1:re$=left$(re$,kl) + end if +wend +IF A$=CHR$(27) then c%=-1:return +c%=val(re$) +gosub testbid +if a$="n" or a$="N" then goto CH2 +return + +ch3: +CALL CHXCAR(C%) +IF c%=-1 then return +gosub testbid +if a$="N" or a$="n" then goto ch3 +return + +Testbid : '++++++++ test ok oui/non !!!! ++++++++++++++ + + CALL FAITUNCADRE(12,9,49,10,CN%,FN%) + LOCATE 10,12:PRINT "Caractre choisi : OK? Oui/Non" + if c%<>0 then POKE 1506,C%:poke 1507,ci%+fi%*16 + color ci%,fi% + if c%=32 then locate 10,32:print "" + if c%=0 then locate 10,32:print "" + A$=input$(1):return + +finch1 : + c%=-1 +Finch: +END SUB + +'============================================================================== +'|| Saisi d'un nom de Fichier avec Mga Controle || +'============================================================================== +sub DonneNom(N$,PH$) STATIC + +SHARED CN%,FN%,CI%,FI% +STATIC C$,U$,FIC$,OK% + +IF U$="" OR len(U$)<>2 THEN U$="A:":C$="\":FIC$="PASDENOM.PIC":CHY%=3 ELSE CHY%=4 +CALL FAITunCADRE(5,2,76,6,CN%,FN%) +COLOR CN%,FN% +LOCATE 3,INT((80-LEN(PH$))/2):PRINT PH$ +LOCATE 4,5 :PRINT " Unit disque(tte). : " +LOCATE 5,5 :PRINT " Chemin d'accs ... : " +LOCATE 6,5 :PRINT " Nom du fichier ... : " + + +AFFICHERESULTAT : +FOR I=4 TO 6 :LOCATE I,27:PRINT SPACE$(50);:NEXT I +COLOR CI%,FI% +LOCATE 4,27:PRINT U$ +LOCATE 5,27:PRINT C$ +LOCATE 6,27:PRINT FIC$ + +CHY%=3 +MM$="Unit de disquette Rpertoire Nom du Fichier Validation Quitter " +CALL MENU(MM$,18,31,10,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 or CHY%=5 THEN PH$="E" : GOTO FICFIN +PH$="" +ON CHY% GOTO UNITE,REPTOIRE,NONFIC,FICFIN + +REPTOIRE : + + INV$="CHEMIN ( REPETOIRE ) :" + OK%=0:M$=C$ + CALL SAISI(10,10,CN%,FN%,INV$,M$,15,50) + IF M$="" then goto afficheresultat + CALL ANTIBUG(M$,"/*|#[],;:=+<>&?^",OK%):IF OK% THEN GOTO reptoire + C$=M$ + GOTO AFFICHERESULTAT + +UNITE : + +CHY% = INSTR("ABCDEF",LEFT$(U$,1)):IF CHY%=0 THEN CHY%=7 +CALL MENU(" A: B: C: D: E: F: ?? ",4,33,10,CN%,FN%,CI%,FI%,0,CHY%,-1) +IF CHY%=-1 THEN GOTO AFFICHERESULTAT +IF CHY%<>7 THEN + U$=MID$("A:B:C:D:E:F:",(CHY%-1)*2+1,2):GOTO AFFICHERESULTAT + ELSE + +CALL FAITUNCADRE(13,11,50,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez l'Unit au Clavier : "; +a$="" +WHile A$<>CHR$(13) and a$<>chr$(27) + IF A$=>"a" and A$<="z" then A$=chr$(ASC(A$) and 95) + IF A$=>"A" and A$<="Z" then K$=A$:Locate 12,46:PRINT A$+":" + A$="" + While A$="":a$=inkey$:wend +wend +IF A$<>CHR$(27) THEN U$=K$+":" +GOTO AFFICHERESULTAT + END IF + +NONFIC : + INV$="Nom du fichier :" + OK%=0:M$=FIC$ + CALL SAISI(20,15,CN%,FN%,INV$,M$,12,12) + IF M$="" then goto afficheresultat + CALL ANTIBUG(M$,"\/*|#[],;:=+<>&?^",OK%):IF OK% THEN GOTO NONFIC + FIC$=M$ + GOTO AFFICHERESULTAT + +FICFIN : + +IF RIGHT$(C$,1)<>"\" then sup$="\" else sup$="" +N$=U$+C$+SUP$+FIC$ + +end sub + +' --------------------------------------------------------------------------- +' Procdure qui contrle si une chaine de caractre est valide pour des +' accs disque NOM = 8 car, EXT = 3 car, pas de car. interdit etc .... +' *********** DE DARCHE Yoann 26/01/91 ************************************** +' --------------------------------------------------------------------------- +SUB ANTIBUG(C$,B$,OK%) static + +SHARED CN%,FN% + +IF INSTR(B$,"\") = 0 THEN + IF MID$(C$,1,1)<>"\" then C$="\"+C$ + CPT%=1 + ELSE + CPT%=0 + END IF + +PT%=0:MAX%=8:CPT$="Chaine trop longue pour un Nom !" + +For I = 1 To Len(C$) + A$=MID$(C$,I,1) + IF INSTR(B$,A$)<>0 THEN M$="Caractre invalide : "+a$+" !":goto erreur + IF A$="\" Then + IF PT%<>0 AND CPT%=0 THEN BEEP:M$="Recontre d'un . sans dfinition d'une extension":GOTO ERREUR + IF CPT%=0 THEN M$="Rencontre de deux antislash !! \ sans dfinition entre !":GOTO ERREUR + CPT%=0:PT%=0:MAX%=8:CPT$="Chaine trop longue pour un Nom !":GOTO SCH + END IF + IF A$="." Then + IF PT%<>0 THEN BEEP:M$="Erreur deux points recontrs !":Goto Erreur + IF CPT%=0 THEN BEEP:M$="Dfinition d'une extention sans Nom !":goto Erreur + PT%=1:CPT%=0:MAX%=3:CPT$="Chaine trop longue pour une extention !" + Goto SCH + END IF + + CPT%=CPT%+1 + IF CPT% > MAX% THEN M$=CPT$:GOTO ERREUR + SCH : +next I:M$="" + +ERREUR : + IF M$<>"" THEN + L=LEN(M$):L=L+4:X1%=INT((80-L)/2) + CALL FAITUNCADRE(X1%,8,X1%+L,9,31,4) + LOCATE 9,X1%+2:PRINT M$ + OK%=-1:A$=INPUT$(1) + END IF +COLOR CN%,FN% + +END SUB + +'================================ Sous Programme Qui affiche le rpetoire === + +CATALOGUE : + +IF CATAC$="" THEN CATAC$="A:\*.PIC" +M$=CATAC$ +COLOR CN,FN +IDEM : + INV$="CHEMIN ( REPETOIRE ) :" + OK%=0: + CALL SAISI(10,10,CN%,FN%,INV$,M$,15,50) + IF M$="" then goto FinCata + CALL ANTIBUG(M$,"|#[]/,;=+<>&^",OK%):IF OK% THEN GOTO IDEM + m$=right$(m$,len(m$)-1) + CATAC$=M$ +CLS:FILES M$:A$=INPUT$(1) + +CALL MENU(" ENCORE FIN ",8,33,10,CN%,FN%,CI%,FI%,0,CHY%,0) +IF CHY%=1 THEN GOTO IDEM + +FINCata : +PCOPY 1,0:RETURN + +' ==================== CLS PARTICULIER ====================================== + +CLS.SPEC : + +IF COL%=0 THEN COL%=7 +CALL PFENETRE(FX1%,FY1%,FX2%,FY2%) +CALL CHOIXCAR(CAR%):DF%=1 +IF CAR%=-1 THEN RETURN +CALL COLORC(COL%,0,df%) +IF DF%=-1 THEN RETURN +CALL SCLS(FX1%,FY1%,FX2%,FY2%,CAR%,COL%):RETURN + +' ========================= Routine Cls ===================================== +SUB SCLS(A%,B%,C%,D%,E%,F%) STATIC + +SHARED CI%,FI% + + PCOPY 3,0 + For i=A% TO C%:FOR J=B% TO D% + CUR=J*160+I*2:POKE CUR,E%:POKE CUR+1,F% + Next j:Next I + LOCATE 25,10:COLOR CI,FI:PRINT " ETES - VOUS SURE DE VOILOIRE EFFACER CETTE PORTION [O/N] "; + XDF=0:While XDF=0 + A$=INPUT$(1) + IF A$="O" OR A$="o" THEN PCOPY 0,3:PCOPY 0,1:XDF=10 + IF A$="N" OR A$="n" THEN XDF=10 + WEND + PCOPY 0,3 + PCOPY 0,1 +END SUB + +' ====================== dfinie une fentre ================================ + +SUB PFENETRE(X1%,Y1%,X2%,Y2%) STATIC + +Shared Ta%(),CN%,FN%,CI%,FI% + +MM$="Tout l'Ecran Fentre ":CHY%=2 +CALL MENU(MM$,12,20,12,CN%,FN%,CI%,FI%,0,CHY%,-1) +IF CHY%=-1 THEN a$=chr$(27) else A$="" +IF CHY%=1 THEN A$=Chr$(13):XA=0:YA=0:YB=23:XB=79 else ya=12:XA=39:XB=39:YB=12 + +pcopy 3,0 + + CU2=4006:AU2=CU2:CU1=4006:AU1=CU1:Y2=YB:X2=XB:X1=XA:Y1=YA + CO%=CN%+16*FN% + IF CN%>15 THEN CO%=CO%+112 + +While A$<>chr$(13) AND A$<>chr$(27) + + V=(XA=XB)*-2+(YA=YB)*-1 + W=(XA=XB)*-8+(YA=YB)*-4 + V= ((V=0) AND 217) + ((V<>0) AND Ta%(V)) + W= ((W=0) AND 218) + ((W<>0) AND Ta%(W)) + + CU1=XA*2+160*YA:CU2=XB*2+YB*160 + POKE AU1,VA1:POKE AU1+1,VB1 + POKE AU2,VA2:POKE AU2+1,VB2 + VA1=PEEK(CU1):VA2=PEEK(CU2):VB1=PEEK(CU1+1):VB2=PEEK(CU2+1) + POKE CU1,W:POKE CU2,V:POKE CU1+1,CO:POKE CU2+1,CO + AU1=CU1:AU2=CU2 + + + A$="" + While a$="" :A$=INKEY$:WEND + + IF A$="8" AND Y1>0 THEN Y1=Y1-1:GOTO 150 + IF A$="2" AND Y1<23 THEN Y1=Y1+1:GOTO 150 + IF A$="4" AND X1>0 THEN X1=X1-1:GOTO 150 + IF A$="6" AND X1<79 THEN X1=X1+1:GOTO 150 + IF A$=CHR$(0)+"K" AND X2>0 THEN X2=X2-1:GOTO 150 + IF A$=CHR$(0)+"M" AND X2<79 THEN X2=X2+1:GOTO 150 + IF A$=CHR$(0)+"H" AND Y2>0 THEN Y2=Y2-1 + IF A$=CHR$(0)+"P" AND Y2<24 THEN Y2=Y2+1 + 150: IF X1>X2 THEN XA=X2:XB=X1 ELSE XA=X1:XB=X2 + IF Y1>Y2 THEN YA=Y2:YB=Y1 ELSE YA=Y1:YB=Y2 + + +Wend + +X1=XA:Y1=YA:X2=XB:Y2=YB + +IF A$=CHR$(27) Then X1%=-1 + +PCOPY 3,0 +End sub + +' ========================== Sous prog de Copie ============================= + +sub COPYPA(XA%,YA%,XB%,YB%,deca%) Static + +SHARED CN%,FN% +COU%=FNCO%(CN%,FN%):DEB%=-1 +'---------------------------- Calcule interne ---------- +CY%=YA%:CX%=XA%:A$="":b$=chr$(0) +DIX%=XB%-XA%:DIY%=YB%-YA% +APOS1%=1:APOS2%=1:CA1%=PEEK(APOS1%):ACO1%=PEEK(APOS1%+1):CA2%=CA1%:ACO2%=ACO1% +car1%=218:car2%=217 +IF DIX%=0 THEN CAR1%=31:CAR2%=30 +IF DIY%=0 THEN + IF DIX%=0 THEN CAR1%=254:CAR2%=254 ELSE CAR1%=16:CAR2%=17 + END IF +'------------------------------------------------------- + +While A$<>chr$(13) and a$<>chr$(27) +'------ Calcule des positions curseurs (le 2me) ------- +AX%=CX%:AY%=CY%:BX%=CX%+DIX%:BY%=CY%+DIY% +IF DEB% THEN + IF AX%<0 THEN AX%=80+AX%:CX%=AX% + IF AY%<0 THEN AY%=24+AY%:CY%=AY% + IF BX%>79 THEN BX%=BX%-80 + IF BY%>23 THEN BY%=BY%-24 + ELSE + IF AX%<0 THEN AX%=0 + IF AY%<0 THEN AY%=0 + IF BX%>79 THEN BX%=79 + IF BY%>23 THEN BY%=23 + END IF + IF BX%=0 THEN BX%=79:AX%=79-ABS(DIX%):CX%=AX% + IF BY%=0 THEN BY%=23:AY%=23-ABS(DIY%):CY%=AY% + IF AX%>79 THEN AX%=0 :BX%=DIX% :CX%=AX% + IF AY%>23 THEN AY%=0 :BY%=DIY% :CY%=AY% +'-------- Affichage des curseurs sur l'cran ----------- + POKE APOS1%,CA1%:POKE APOS2%,CA2%:POKE APOS1%+1,ACO1%:POKE APOS2%+1,ACO2% + POSI1%=AX%*2+AY%*160:APOS1%=POSI1%:POSI2%=BX%*2+BY%*160:APOS2%=POSI2% + ACO1%=PEEK(POSI1%+1):ACO2%=PEEK(POSI2%+1):CA1%=PEEk(POSI1%):CA2%=PEEK(POSI2%) + POKE POSI1%,CAR1%:POKE POSI2%,CAR2%:POKE POSI1%+1,COU%:POKE POSI2%+1,COU% + + A$=FNTOUCHE$ + + IF A$=B$+"P" or A$="2" Then CY%=CY%+1 + IF A$=B$+"H" or A$="8" Then CY%=CY%-1 + IF A$=b$+"M" or A$="6" Then CX%=CX%+1 + If A$=B$+"K" or A$="4" Then CX%=CX%-1 + If A$="D" or A$="d" Then DEB%=NOT(DEB%) + If CX%< -DIX% THEN CX%=79 + If CX%>79 Then CX%=0 + If CY%< -DIY% Then CY%=23 + If CY%>23 Then CY%=0 + +WEND + +END SUB +' ========================== Sous prog de SAISI ============================= + +DESSIN : + +A$="" + +While (A$<>chr$(27)) + + A$="":WHILE A$="":A$=INKEY$:WEND + B$=CHR$(0):P2=P1:CM1=0:CM2=0 + + GOSUB GESTION.TOUCHE + + P1=(X-1)*2+(Y-1)*160 + AN=PEEK(P2):CALL VERIF(AN):CO=(CM2 OR CR1) :CALL CALCUL(AN,CO,V,D,NO,PRD%) + POKE P2+1,CND%:POKE P2,CC(NO) + AN=PEEK(P1):CALL VERIF(AN):CO=CM1 :CALL CALCUL(An,CO,V,D,NO,PRD%) + POKE P1+1,CID%:POKE P1,CC(NO):CR1=CM1 + +Wend:POKE P1+1,CND%:pcopy 0,3:RETURN + +'--------------------------------------------------------------------------- + +GESTION.TOUCHE : + + IF A$=B$+"M" OR A$="6" THEN X=X+1:V=0 :CM2=2:CM1=8 + IF A$=B$+"K" OR A$="4" THEN X=X-1:V=0 :CM2=8:CM1=2 + IF A$=B$+"H" OR A$="8" THEN Y=Y-1:V=-1:CM2=1:CM1=4 + IF A$=B$+"P" OR A$="2" THEN Y=Y+1:V=-1:CM2=4:CM1=1 + IF A$=CHR$(27) THEN IND%=-1 + IF A$=B$+";" THEN MEN%=-1:A$=CHR$(27) + IF A$="D" OR A$="d" THEN D=-1 + IF A$="S" OR A$="s" THEN D=0 + + IF Y<1 THEN Y=24 + IF X<1 THEN X=80 + IF X>80 THEN X=1 + IF Y>24 THEN Y=1 + +RETURN + + +'======================== OPTION du MODE TRACE ============================== +SAUV : +N$="":PH$="NON DU FICHIER A ENREGISTRER" +CALL DonneNom(N$,PH$) +PCOPY 3,0 +IF PH$="E" THEN Return +BSAVE N$,0,4000 +return + +RAPP : +N$="":PH$="NON DU FICHIER A CHARGER" +CALL DonneNom(N$,PH$) +IF PH$="E" THEN Return +BLOAD N$ +PCOPY 0,1:PCOPY 0,3:RETURN + +'========================== Dbut du programme Enfin !!! ===================== +debut : + +B$=chr$(0) + + A$=FNTOUCHE$ + GOSUB GESTION.TOUCHE + + P1=(X-1)*2+(Y-1)*160 + POKE P2+1,CMC%:CMC%=PEEK(P1+1):POKE P1+1,CID%:P2=P1 + IF A$=CHR$(27) THEN MEN%=-1 ELSE MEN%=0 + + ' Aiguillage des activite des sous gros programmes !! + + IF NOT(IND%) THEN GOSUB DESSIN :POKE P1+1,CND% :GOSUB Affiche.Ligne + IF MEN% THEN GOSUB DEBUTAZ:PCOPY 3,0:MEN%=0:GOSUB Affiche.Ligne + +GOTO Debut + +DEBUTAZ : + + GOSUB Affiche.Ligne + MM$="UtilitsFichiers Texte Dessin Config Quitter " + CALL MENUB(MM$,8,1,CN%,FN%,CI%,FI%,CHX%,-1) + IF CHX%=-1 THEN RETURN + PCOPY 0,1 + IF CHX%=6 THEN GOTO FINPROG + ON CHX% GOSUB MENU1,MENU2,MENU3,MENU4,MENU5 + IF CHY%=-3 OR CHY%=3 THEN CHx%=CHx%+1 + IF CHY%=-2 OR CHY%=2 THEN CHX%=CHX%-1 + PCOPY 1,0 +a$="":Goto DEBUTAZ + +'Gosub ModeTrace + + +TRAITERREUR : +PCOPY 3,0 +CALL FAITUNCADRE(29,10,51,14,15,4) +LOCATE 11,32:PRINT "Une ERREUR s'est" +LOCATE 12,36:PRINT "produite" +LOCATE 13,31:PRINT "N d'Erreur : ";:PRINT USING "###";ERR +LOCATE 14,29:PRINT "Appuyez sur une touche" +A$=input$(1) +PCOPY 3,0 +RESUME debut + +MENU1 : + +cm$=cHR$(26) +MM$=" cls Total cls fEnetrecls Spcial Copie 1"+CM$+"1 cOpie 2"+CM$+"1 Filtres " +CHY%=6 +CALL MENU(MM$,11,3,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Cls.T,CFLS,CLS.SPEC,COPIE11,IN,FIS +RETURN + +MENU2 : +CHY%=5 +MM$=" Sauve 1 sAuve 2 Rappelle 1raPpelle 2Catalogue " +CALL MENU(MM$,10,18,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +ON CHY% GOSUB SAUV,IN,RAPP,IN,CATALOGUE +RETURN + +MENU3 : +CHY%=3 +mm$="marge Droite marge Gauche couleurs Texte couleurs cUrseur Centre Priorit

criture Activecriture Inactive" +CALL MENU(MM$,17,31,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +RETURN + +MENU4 : +CHY%=1 +mm$="couleurs Traccouleurs Cur. Simple Double Priorit iMage1/image2 trac Actif trac Inactif " +CALL MENU(MM$,14,41,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Couleur.Trace,Couleur.Cur,Simple,Double,Priorite.Trace,ImageI,Trace.A,Trace.I +IF CHY%=-1 THEN RETURN +GOSUB Affiche.Ligne +goto Menu4 + +MENU5 : +CHY%=3 +MM$="Couleur Monochrome couleur Normale couleur InverseSauve config ligne d'tat Ac.ligne d'tat in." +CALL MENU(MM$,16,51,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Couleur.E,Monochrome,Couleur.text,Couleur.Curs,Sauve.Config,Ligne.A,Ligne.I +IF CHY%=-1 THEN RETURN +GOSUB Affiche.Ligne +Goto Menu5 + +'======= +IN : +CALL FAITUNCADRE(20,11,60,12,CI%,FI%):LOCATE 12,25:PRINT " PAS ENCORE DISPONIBLE !!!!!! " +a$=input$(1) +RETURN + +'================== Option Menu1 =========================================== +MM$=" cls Total cls fEnetrecls Spcial Copie 1"+CM$+"1 cOpie 2"+CM$+"1 Filtres " +Cls.T : COLOR 7,0:CLS:PCOPY 0,3:PCOPY 0,1:CHY%=-1:RETURN +CFLS : Call Pfenetre(X1%,Y1%,X2%,Y2%) + Call SCLS(X1%,Y1%,X2%,Y2%,32,7) + RETURN +FIS : CALL Pfenetre(X1,Y1,X2,Y2) + IF X1=-1 THEN RETURN + B$=CHR$(26) + MM$="CAR "+B$+" COUCOU "+B$+" CARCOU "+B$+" COUCAR "+B$+" CAR QUITTER " + CHY%=5 + CALL MENU(MM$,9,28,8,CN%,FN%,CI,FI,0,CHY%,0) + IF CHY%=5 or CHY%=-1 THEN RETURN + F1%=0:F2%=0:s%=1:nc%=0:rc%=0 + IF CHY%=1 THEN F1%=-1 + IF CHY%=2 THEN F2%=-1 + IF CHY%=4 THEN F1%=-1:F2%=-1 + IF F1% THEN Call ChoixCar(RC%) ELSE Call Colorc(RC%,N,S%) + IF RC%=-1 or s%=-1 Then return + s%=1 + IF F2% THEN Call ChoixCar(NC%) ELSE Call Colorc(NC%,N,S%) + IF NC%=-1 or s%=-1 Then return + PCOPY 3,0 + CALL FILTRES(RC%,NC%,F1%,F2%,X1%,Y1%,X2%,Y2%) + PCOPY 0,1 +RETURN + + +'================== Option Menu4 =========================================== +Couleur.Trace : CALL COLORC(CND%,0,1):RETURN +Couleur.Cur : CALL COLORC(CID%,0,1):RETURN +Simple : D= 0:RETURN +Double : D=-1:RETURN +Priorite.Trace: PRD%=NOT(PRD%):RETURN +ImageI : Pcopy 2,0:PCOPY 3,2:pcopy 0,3:PCOPY 0,1:CHY%=-1:RETURN +Trace.A : IND=0:RETURN +Trace.I : Ind=-1:RETURN + +'==================== Option Menu5 ========================================= +Monochrome : CN%=7 :FN%=0:CI%=0 :FI%=7:CHY%=-1:RETURN +Couleur.E : CN%=11:FN%=1:CI%=14:FI%=4:CHY%=-1:RETURN +Couleur.TEXT : CALL COLORC(CN%,FN%,0):RETURN +Couleur.Curs : CALL COLORC(CI%,FI%,0):RETURN +Ligne.A : LIN%=0 :RETURN +Ligne.I : LIN%=-1:RETURN + +'================== Affiche la Ligne d'tat ================================ +Affiche.Ligne : + +Color CN%,FN%:LOCATE 25,1:PRINT SPACE$(78); +IF LIN THEN RETURN +Locate 25,1:PRINT "Ecriture "; +Locate 25,31:PRINT "Dessin "; +Locate 25,10 +IF INE% THEN PRINT "INACTIVE"; ELSE PRINT " ACTIVE "; +IF PRE% THEN Locate 25,19:PRINT "PRIORITAIRE"; +Locate 25,38 +IF IND% THEN PRINT "INACTIF"; ELSE PRINT " ACTIF "; +IF PRD% THEN LOCATE 25,46:PRINT "PRIORITAIRE"; +Locate 25,58 +IF D THEN PRINT "DOUBLE"; ELSE PRINT "SIMPLE"; +POKE 3994,42:POKE 3995,CNT%:POKE 3998,42:POKE 3999,CND% +RETURN + +'================================ FIN ======================================= +FINPROG : + +CLS +PCOPY 1,0 +A$=input$(1) +PCOPY 2,0 +A$=input$(1) +PCOPY 3,0 +A$=input$(1) +END + +PUBLICITE : '*************** IL en faut pour vivre !!! *********************** +screen 2:screen 0 +LOCATE 1,1:color 0,15 +PRINT "" +PRINT "۰۰۰۰" +PRINT "۱۰۰۱۰" +PRINT "۰۰۰۰۰۰۰" +PRINT "۰۱۱۰۰۰۰۰۰۰۰۰۰۰" +PRINT "۱۰۰۱۱۱۱۱۰۱۰۰۰۰۰" +PRINT "۰۰۰۱۱۰۰۰۱۰۰۰۰۰" +PRINT "۰۰۱۰۰۱۱۱۰۰۰۰" +PRINT "۱۰۱۰۱۱۰۱۱۱۰۰۰۰" +PRINT "۰۱۱۰۱۰۰۱۰۱۰۰۰۰۱" +PRINT "۰۱۰۱۱۱۰۰۱۰۰۰۱" +PRINT "" +PRINT "" +PRINT:color 14,0 +PRINT " Vous Prsente un logiciel UTILITAIRE " +PRINT +PRINT " ͻ ͻ ͻ ͻ ͻ ͻ ͵ ͻ " +PRINT " ɼ Ȼ ɼ Ȼ " +PRINT " ͼ ͵ ͹ ͼ ͹ ͵ " +PRINT " Ȼ ͻ " +PRINT " ͼ ͼ ͼ ͼ " +PRINT " de "+Yoann$+" " +PRINT " 71, avenue d'Orlans 91800 BRUNOY (FRANCE) " +PRINT " Tel : 16.1.69-39-51-26 "; +LOCATE 1:A$=input$(1):return + +'================================= SAUVE Les configurations ================= +SAUVE.CONFIG : +OPEN "O",#1,"CREAPAGE.CFG" +WRITE #1,CN%,FN%,CI%,FI%,LIN% +Close:RETURN +'================================= RAPPELLE Configurations ================== +RAPP.CONFIG : +OPEN "I",#1,"CREAPAGE.CFG":INPUT #1,A$,B$,c$,d$,e$:CLOSE +CN%=VAL(A$):FN%=VAL(B$):CI%=val(C$):FI%=VAL(D$):LIN%=VAL(E$):RETURN + + +'======================== COPIE de 1 vers 1 ================================= +COPIE11 : + +PCOPY 3,0:COLOR CN%,FN% +LOCATE 25,24:PRINT "Slectionnez la partie copier"; +CALL PFENETRE(FX1%,FY1%,FX2%,FY2%) +LOCATE 25,24:PRINT " Positionnez la partie copier "; +CALL COPYPA(FX1%,FY1%,FX2%,FY2%,0) +RETURN + diff --git a/CREAPAGE.BAS b/CREAPAGE.BAS new file mode 100644 index 0000000..b55d09d --- /dev/null +++ b/CREAPAGE.BAS @@ -0,0 +1,930 @@ +CLS +DEFINT A-Z +YOANN$=chr$(68)+chr$(65)+chr$(82)+chr$(67)+chr$(72)+chr$(69)+" "+CHR$(89)+chr$(111)+chr$(97)+chr$(110)+chr$(110) +DIM BB(40),CC(63),T%(4,4),CT(26,6),TA%(16) +LOCATE 1,1,1,8,8 +ON ERROR GOTO TRAITERREUR +CHX%=1 +' ------------------------ Chargement des Sub Routines Suplmantaires ------- + +' $INCLUDE: 'A:CREAPSUP.BAS' + +' ----------------------- Chargement des Sub Routine MENUS ------------------ + +' $INCLUDE: 'A:MENUTXT.BAS' + +' ----------------------- Chargement de la PUBLICIT ----------------------- + +' $INCLUDE : 'A:PUB.BAS' + +' ---------------------- Slection du mode de l'ecran ------------------------ +Call Publicite ' a l'affiche + + DEF SEG = &h40 + TE%=(PEEK(&h10) AND &h30):DEF SEG + IF TE%=0 THEN PRINT " Programme non utilisable sur cette appareil ! [ECRAN] ":END + IF TE%=&h30 Then SegEcr%=&hB000 Else SegEcr%=&hB800 + DEF SEG = SEGECR% + +' --------------- Constante Provisoire -------------------------------------- + +CN%=11:FN%=1:CI=14:FI=4 ' Couleurs Normales Inverss +CND%=14:CID%=110 ' Couleur du Trac Normale/Inverse +CNT%=10:CIT%=110 ' Couleur de Texte Normale/Inverse +IND%=-1:INE%=-1:A$=CHR$(27):PCOPY 0,3 +NOM$="":NOM1$="PASDENOM.PIC":NOM2$=NOM1$ ' Nom par dfaut des images + +CPA1 = 0:CPA2 = 0 'Protection contre le fait de quitter sans sauvegarde + ' Si -1 Changement effectu, Si 0 aucune modif ! + +IF SEGECR%=&hb000 THEN CN%=7:FN%=0:CI%=0:FI%=7:CND%=15:CID%=7 + +Ta%(1)=17:Ta%(2)=30:Ta%(3)=254:Ta%(4)=16:Ta%(8)=31:Ta%(12)=254 + +GOSUB LectData ' ****** Lit les DATAs ****** +GOSUB Rapp.Config ' ****** Rappelle la Configuration ***** +GOTO Debut + +' --------- converstion asc(x)-178 ===> code binaire ------------------------ + + DATA 05,13,45,61,60,44,29,21,28,25,57,41,12,03,11,14,07,10,15,39 + DATA 55,19,22,27,30,23,26,31,43,59,46,62,51,35,38,54,63,47,09,06 + +' ------------- convertion binaire ====> code caractre CHR$() -------------- + + DATA 032,032,032,192,032,179,218,195,032,217,196,193,191,180,194,197 + DATA 032,032,032,200,032,186,201,204,032,188,205,202,187,185,203,206 + DATA 032,032,032,212,032,179,213,198,032,190,205,207,184,181,209,216 + DATA 032,032,032,211,032,186,214,199,032,189,196,208,183,182,210,215 + +' ------------ Donnes pour le choix directe des caractres ----------------- + +DATA 253,251,224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,252 +DATA 130,136,137,138,160,131,132,133,161,140,139,141,162,147,148,149,163,150,129,151,135,128,142,143,134,144,153 +DATA 154,152,155,145,146,156,157,158,159,171,172,064,164,165,166,167,168,173,174,175,169,170,019,021,020,015,028 +DATA 219,176,177,178,220,223,221,222,022,254,248,249,250,007,008,009,010,001,002,003,004,005,006,011,012,013,014 +DATA 218,194,191,201,203,187,214,210,183,213,209,184,205,186,091,024,029,018,030,093,035,036,037,038,045,022,127 +DATA 195,197,180,204,206,185,199,215,182,198,216,181,196,179,027,042,026,017,043,016,047,092,060,061,062,063,033 +DATA 192,193,217,200,202,188,211,208,189,212,207,190,023,124,040,025,123,125,031,041,094,095,096,039,044,046,059 + +' ============================== Lecture des datas ========================= +LectData : +COLOR 30,1 +RESTORE +LOCATE 25,1:PRINT "PATIENTEZ "; + FOR I=1 TO 40 :READ BB(I):NEXT I + FOR I=0 TO 63 :READ CC(I):NEXT I + FOR J=0 TO 6 + FOR I=0 TO 26 + READ CT(I,J) + NEXT I + NEXT J +X=1:Y=1:LOCATE 25,1:PRINT "OK "; +RETURN + +' ============================== Sous prog calcule ========================== + +SUB CALCUL(AN,CO,V,D,NO,PR%) STATIC + +STATIC S,C + + IF PR% THEN AN= 0+( D AND 16) + S =-(AN AND 32)/32 + C =-(AN AND 16)/16 + VL=-(NOT(V) AND D)*(C*16+32)-(NOT(V) AND NOT(D) AND C)*48 + VL=VL+(V AND ((D AND 48)+(S XOR C)*32*((NOT(D))-D))) + CO=CO OR VL + NO=(AN AND 15) OR (CO) + +End Sub + +'============================= sOUS PROG VERIFICATION DU POKAGE ============= + +Sub Verif(AN) STATIC +shared d,BB() +IF AN<179 OR AN>218 THEN AN= 0+( D AND 16) ELSE AN=BB(AN-178) +End Sub + + +' ==================================== Sous Prog Color ====================== +SUB COLORC(CA%,CB%,SS%) STATIC + +STATIC COU,B$,K%,V%,KA%,C% +SHARED CN%,FN%,T%() + +COU=FNCO%(CN%,FN%) + +IF SS%<>0 THEN + IF CA%>=128 THEN CA%=CA%-128:KA%=128 ELSE KA%=0 + CB%=INT(cA%/16):CA%=(CA%-CB%*16) + ELSE + IF CA%>=32 THEN CA%=CA-16:ka%=128 ELSE KA%=0 + END IF + +B$=chr$(0):T%(0,0)=CA%:T%(1,0)=CB%:for i=0 to 2:T%(i,1)=T%(i,0):next i +CALL FAITUNCADRE(6,6,74,18,CN%,FN%) +LOCATE 7,34:PRINT "LES COULEURS"; +locate 9,11:print " Utilisez les flches pour le choix C clignotant / ou pas " +DE%=1634 + +'************** Affichages des couleurs actuelles et choisies . *********** + +COLOR CA%,CB% +LOCATE 17,19:PRINT "Ancienne Couleur" +LOCATE 17,45:PRINT "Nouvelle Couleur" +CY%=0:CX%=CA% + +NEWCOLOR : +T%(2,0)=KA%:A$="" + +FOR I=0 TO 15 +POKE DE% +2*(3*i-2),219 :POKE DE%+2+2*(3*I-2),219 +POKE DE%+1+2*(3*i-2),I+KA%:POKE de%+3+2*(3*I-2),I+KA% +NEXT I +FOR I=0 TO 7 +POKE DE%+502+2*(3*i-2),219:POKE DE%+504+2*(3*I-2),219 +POKE DE%+503+2*(3*i-2),I :POKE DE%+505+2*(3*I-2),I +NEXT I +poke DE%+498,222:POKE DE%+499,143:POKE DE%+500,221:POKE DE%+501,143 +poke DE%-4,222:POKE DE%-3,143:POKE DE%-2,221:POKE DE%-1,143:K=-4 + + +WHILE NOT(A$=" " or A$=CHR$(13) or A$=chr$(27)) +mp=0 + IF A$=B$+"P" or A$="2" Then CY=CY+1:mp=-1 + IF A$=B$+"H" or A$="8" Then CY=CY-1:mp=-1 + IF A$=b$+"M" or A$="6" Then CX=CX+1 + If A$=B$+"K" or A$="4" Then CX=CX-1 + IF A$="C" or A$="c" Then + IF KA%=128 THEN KA%=0 ELSE KA%=128 + GOTO NEWCOLOR + End if + IF cy=1 THEN MCX=7 ELSE MCX=15 + IF Cy<0 THEN CY=1 + IF CY>1 THEN CY=0 + IF MP THEN CX=T%(CY,0) + IF CX<0 THEN CX=MCX + IF CX>MCX THEN CX=0 + + c=2*(3*CX-2)+502*cy:T%(CY,0)=CX + +POKE K+DE%-162,000:POKE K+DE%-160,000:POKE K+DE%-158,000:POKE K+DE%-156,000 +POKE K+DE%-002,000 :POKE K+DE%+004,000 +POKE K+de%+158,000:POKE K+DE%+160,000:POKE K+DE%+162,000:POKE K+DE%+164,000 +POKE C+DE%-162,218:POKE C+DE%-160,196:POKE C+DE%-158,196:POKE C+DE%-156,191 +POKE C+DE%-002,179 :POKE C+DE%+004,179 +POKE C+de%+158,192:POKE C+DE%+160,196:POKE C+DE%+162,196:POKE C+DE%+164,217 +COP%=FNCO%(T%(0,0),T%(1,0)):FOR I=2649 TO 2681 STEP 2:POKE I,COP%+KA%:NEXT I +K=C:A$="": WHILE A$="":A$=INKEY$:WEND +wend + +IF A$=chr$(27) then + CA%=T%(0,1):CB%=T%(1,1):KA%=T%(2,1) + ELSE + CA%=T%(0,0):CB%=T%(1,0):KA%=T%(2,0) + END IF + + +IF SS%<>0 THEN + CA%=CB%*16+CA%+KA% + ELSE + IF KA%<>0 then CA%=CA%+16 +END IF + +if a$=chr$(27) then ss%=-1 else ss%=0 + +END SUB + +'=============================== CHOIX CARACTERE ========================== +SUB CHXCAR(C%) static + +SHARED CN%,FN%,CI%,FI%,CT() +STATIC DE%,B$,CX,CY + +CALL FaitUnCAdre(10,2,68,19,CN%,FN%) +LOCATE 18,12:PRINT " Utilisez les flches, pour valider, FIN " +DE%=502:B$=chr$(0):a$="" +FOR I=0 TO 26:FOR j=0 TO 6:PO%=DE%+I*4+J*320:POKE PO%,CT(I,J):NEXT j:NEXT I + +WHILE NOT(A$=" " or A$=CHR$(13) or A$=chr$(27)) + + IF A$=B$+"P" or A$="2" Then Cy=CY+1 + IF A$=B$+"H" or A$="8" Then CY=CY-1 + IF A$=b$+"M" or A$="6" Then Cx=Cx+1 + If A$=B$+"K" or A$="4" Then Cx=Cx-1 + IF Cy<0 THEN CY=6 + IF CY>6 THEN CY=0 + IF CX<0 THEN CX=26 + IF CX>26 THEN CX=0 + + V=DE%+CX*4+CY*320 + + POKE K-162,000:POKE K-160,000:POKE K-158,000 + POKE K-002,000: POKE K+002,000 + POKE K+158,000:POKE K+160,000:POKE K+162,000 + POKE V-162,218:POKE V-160,196:POKE V-158,191 + +POKE V-002,179: POKE V+002,179 + POKE V+158,192:POKE V+160,196:POKE V+162,217 + + K=V:a$="":While a$="":A$=INKEY$:Wend + WEND + + C%=CT(CX,CY) + if a$=chr$(27) then C%=-1 + +end sub + +'=================== Menu de saisi d'un caractre spcifique ================ + +SUB CHOIXCAR(C%) STATIC + +SHARED CN%,FN%,CI%,FI% +STATIC MENU$,CHY%,A$,b$,kl,re$ +A$="":kl=0:re$="":C%=0 + +debutc : + CHY% = 3 +MENU$="entre au Clavier code Ascii choix Pratique Fin " + CALL MENU(MENU$,17,15,10,CN%,FN%,CI%,FI%,0,CHY%,-1) + if CHY% = -1 then c%=-1:goto finch + ON CHY% gosub CH1,CH2,CH3,FINCH1 + if c%=-1 then goto debutc + goto finch + +CH1 : +CALL FAITUNCADRE(13,11,55,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez au Clavier votre caractre : "; +a$="" +WHile A$<>CHR$(13) and a$<>chr$(27) + Locate 12,50:pRINT A$:C$=A$:a$="" + While A$="":a$=inkey$:wend +wend +c%=asc(c$) +if a$=chr$(27) then c%=-1:return +gosub testbid +if a$="N" or a$="n" then goto CH1 +return + +ch2 : + +CALL FAITUNCADRE(13,11,55,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez le code ASCII du caractre : "; +a$="":B$=CHR$(0):re$="":kl=0 +While (a$<>chr$(27) AND a$<>chr$(13)) + A$="" + while a$="" : a$=inkey$ : wend: a= asc(a$) + if a>47 and a<57 and kl<3 then + kl=kl+1:locate 12,49+kl:print a$ + re$=re$+a$ + end if + + if (a$=b$+"K" or a$=b$+"S" or A$=CHR$(8)) and kL>0 then + locate 12,49+kl:print " " + kl=kl-1:re$=left$(re$,kl) + end if +wend +IF A$=CHR$(27) then c%=-1:return +c%=val(re$) +gosub testbid +if a$="n" or a$="N" then goto CH2 +return + +ch3: +CALL CHXCAR(C%) +IF c%=-1 then return +gosub testbid +if a$="N" or a$="n" then goto ch3 +return + +Testbid : '++++++++ test ok oui/non !!!! ++++++++++++++ + + CALL FAITUNCADRE(12,9,49,10,CN%,FN%) + LOCATE 10,12:PRINT "Caractre choisi : OK? Oui/Non" + if c%<>0 then POKE 1506,C%:poke 1507,ci%+fi%*16 + color ci%,fi% + if c%=32 then locate 10,32:print "" + if c%=0 then locate 10,32:print "" + A$=input$(1):return + +finch1 : + c%=-1 +Finch: +END SUB + +'============================================================================== +'|| Saisi d'un nom de Fichier avec Mga Controle || +'============================================================================== +sub DonneNom(N$,PH$) STATIC + +SHARED CN%,FN%,CI%,FI%,NOM$ +STATIC C$,U$,FIC$,OK% + +IF NOM$="" THEN FIC$="PASDENOM.PIC":CHY%=3 ELSE FIC$=NOM$:CHY%=4 +IF len(U$)<>2 THEN U$="A:":C$="\":FIC$="PASDENOM.PIC":CHY%=3 ELSE CHY%=4 + +CALL FAITunCADRE(5,2,76,6,CN%,FN%) +COLOR CN%,FN% +LOCATE 3,INT((80-LEN(PH$))/2):PRINT PH$ +LOCATE 4,5 :PRINT " Unit disque(tte). : " +LOCATE 5,5 :PRINT " Chemin d'accs ... : " +LOCATE 6,5 :PRINT " Nom du fichier ... : " + + +AFFICHERESULTAT : +FOR I=4 TO 6 :LOCATE I,27:PRINT SPACE$(50);:NEXT I +COLOR CI%,FI% +LOCATE 4,27:PRINT U$ +LOCATE 5,27:PRINT C$ +LOCATE 6,27:PRINT FIC$ + +CHY%=3 +MM$="Unit de disquette Rpertoire Nom du Fichier Validation Quitter " +CALL MENU(MM$,18,31,10,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 or CHY%=5 THEN PH$="E" : GOTO FICFIN +PH$="" +ON CHY% GOTO UNITE,REPTOIRE,NONFIC,FICFIN + +REPTOIRE : + + INV$="CHEMIN ( REPETOIRE ) :" + OK%=0:M$=C$ + CALL SAISI(10,10,CN%,FN%,INV$,M$,15,50) + IF M$="" then goto afficheresultat + CALL ANTIBUG(M$,"/*|#[],;:=+<>&?^",OK%):IF OK% THEN GOTO reptoire + C$=M$ + GOTO AFFICHERESULTAT + +UNITE : + +CHY% = INSTR("ABCDEF",LEFT$(U$,1)):IF CHY%=0 THEN CHY%=7 +CALL MENU(" A: B: C: D: E: F: ?? ",4,33,10,CN%,FN%,CI%,FI%,0,CHY%,-1) +IF CHY%=-1 THEN GOTO AFFICHERESULTAT +IF CHY%<>7 THEN + U$=MID$("A:B:C:D:E:F:",(CHY%-1)*2+1,2):GOTO AFFICHERESULTAT + ELSE + +CALL FAITUNCADRE(13,11,50,12,CN%,FN%) +COLOR CN%,FN%:LOCATE 12,14:PRINT "Entrez l'Unit au Clavier : "; +a$="" +WHile A$<>CHR$(13) and a$<>chr$(27) + IF A$=>"a" and A$<="z" then A$=chr$(ASC(A$) and 95) + IF A$=>"A" and A$<="Z" then K$=A$:Locate 12,46:PRINT A$+":" + A$="" + While A$="":a$=inkey$:wend +wend +IF A$<>CHR$(27) THEN U$=K$+":" +GOTO AFFICHERESULTAT + END IF + +NONFIC : + INV$="Nom du fichier :" + OK%=0:M$=FIC$ + CALL SAISI(20,15,CN%,FN%,INV$,M$,12,12) + IF M$="" then goto afficheresultat + CALL ANTIBUG(M$,"\/*|#[],;:=+<>&?^",OK%):IF OK% THEN GOTO NONFIC + FIC$=M$:NOM$=FIC$ + GOTO AFFICHERESULTAT + +FICFIN : + +IF RIGHT$(C$,1)<>"\" then sup$="\" else sup$="" +N$=U$+C$+SUP$+FIC$ + +end sub + +' --------------------------------------------------------------------------- +' Procdure qui contrle si une chaine de caractre est valide pour des +' accs disque NOM = 8 car, EXT = 3 car, pas de car. interdit etc .... +' *********** DE DARCHE Yoann 26/01/91 ************************************** +' --------------------------------------------------------------------------- +SUB ANTIBUG(C$,B$,OK%) static + +SHARED CN%,FN% + +IF INSTR(B$,"\") = 0 THEN + IF MID$(C$,1,1)<>"\" then C$="\"+C$ + CPT%=1 + ELSE + CPT%=0 + END IF + +PT%=0:MAX%=8:CPT$="Chaine trop longue pour un Nom !" + +For I = 1 To Len(C$) + A$=MID$(C$,I,1) + IF INSTR(B$,A$)<>0 THEN M$="Caractre invalide : "+a$+" !":goto erreur + IF A$="\" Then + IF PT%<>0 AND CPT%=0 THEN BEEP:M$="Recontre d'un . sans dfinition d'une extension":GOTO ERREUR + IF CPT%=0 THEN M$="Rencontre de deux antislash !! \ sans dfinition entre !":GOTO ERREUR + CPT%=0:PT%=0:MAX%=8:CPT$="Chaine trop longue pour un Nom !":GOTO SCH + END IF + IF A$="." Then + IF PT%<>0 THEN BEEP:M$="Erreur deux points recontrs !":Goto Erreur + IF CPT%=0 THEN BEEP:M$="Dfinition d'une extention sans Nom !":goto Erreur + PT%=1:CPT%=0:MAX%=3:CPT$="Chaine trop longue pour une extention !" + Goto SCH + END IF + + CPT%=CPT%+1 + IF CPT% > MAX% THEN M$=CPT$:GOTO ERREUR + SCH : +next I:M$="" + +ERREUR : + IF M$<>"" THEN + L=LEN(M$):L=L+4:X1%=INT((80-L)/2) + CALL FAITUNCADRE(X1%,8,X1%+L,9,31,4) + LOCATE 9,X1%+2:PRINT M$ + OK%=-1:A$=INPUT$(1) + END IF +COLOR CN%,FN% + +END SUB + +'================================ Sous Programme Qui affiche le rpetoire === + +CATALOGUE : + +IF CATAC$="" THEN CATAC$="A:\*.PIC" +M$=CATAC$ +COLOR CN,FN +IDEM : + INV$="CHEMIN ( REPETOIRE ) :" + OK%=0: + CALL SAISI(10,10,CN%,FN%,INV$,M$,15,50) + IF M$="" then goto FinCata + CALL ANTIBUG(M$,"|#[]/,;=+<>&^",OK%):IF OK% THEN GOTO IDEM + m$=right$(m$,len(m$)-1) + CATAC$=M$ +CLS:FILES M$:A$=INPUT$(1) + +CALL MENU(" ENCORE FIN ",8,33,10,CN%,FN%,CI%,FI%,0,CHY%,0) +IF CHY%=1 THEN GOTO IDEM + +FINCata : +PCOPY 1,0:RETURN + +' ==================== CLS PARTICULIER ====================================== + +CLS.SPEC : + +IF COL%=0 THEN COL%=7 +CALL PFENETRE(FX1%,FY1%,FX2%,FY2%,3) +CALL CHOIXCAR(CAR%):DF%=1 +IF CAR%=-1 THEN RETURN +CALL COLORC(COL%,0,df%) +IF DF%=-1 THEN RETURN +CALL SCLS(FX1%,FY1%,FX2%,FY2%,CAR%,COL%):RETURN + +' ========================= Routine Cls ===================================== +SUB SCLS(A%,B%,C%,D%,E%,F%) STATIC + +SHARED CI%,FI% + + PCOPY 3,0 + For i=A% TO C%:FOR J=B% TO D% + CUR=J*160+I*2:POKE CUR,E%:POKE CUR+1,F% + Next j:Next I + LOCATE 25,10:COLOR CI,FI:PRINT " ETES - VOUS SURE DE VOILOIRE EFFACER CETTE PORTION [O/N] "; + XDF=0:While XDF=0 + A$=INPUT$(1) + IF A$="O" OR A$="o" THEN PCOPY 0,3:PCOPY 0,1:XDF=10 + IF A$="N" OR A$="n" THEN XDF=10 + WEND + PCOPY 0,3 + PCOPY 0,1 +END SUB + +' ====================== dfinie une fentre ================================ + +SUB PFENETRE(X1%,Y1%,X2%,Y2%,PAG%) STATIC + +Shared Ta%(),CN%,FN%,CI%,FI% + +MM$="Tout l'Ecran Fentre ":CHY%=2 +CALL MENU(MM$,12,20,12,CN%,FN%,CI%,FI%,0,CHY%,-1) +IF CHY%=-1 THEN a$=chr$(27) else A$="" +IF CHY%=1 THEN A$=Chr$(13):XA=0:YA=0:YB=23:XB=79 else ya=12:XA=39:XB=39:YB=12 + +pcopy PAG%,0 + + CU2=4006:AU2=CU2:CU1=4006:AU1=CU1:Y2=YB:X2=XB:X1=XA:Y1=YA + CO%=CN%+16*FN% + IF CN%>15 THEN CO%=CO%+112 + +While A$<>chr$(13) AND A$<>chr$(27) + + V=(XA=XB)*-2+(YA=YB)*-1 + W=(XA=XB)*-8+(YA=YB)*-4 + V= ((V=0) AND 217) + ((V<>0) AND Ta%(V)) + W= ((W=0) AND 218) + ((W<>0) AND Ta%(W)) + + CU1=XA*2+160*YA:CU2=XB*2+YB*160 + POKE AU1,VA1:POKE AU1+1,VB1 + POKE AU2,VA2:POKE AU2+1,VB2 + VA1=PEEK(CU1):VA2=PEEK(CU2):VB1=PEEK(CU1+1):VB2=PEEK(CU2+1) + POKE CU1,W:POKE CU2,V:POKE CU1+1,CO:POKE CU2+1,CO + AU1=CU1:AU2=CU2 + + + A$="" + While a$="" :A$=INKEY$:WEND + + IF A$="8" AND Y1>0 THEN Y1=Y1-1:GOTO 150 + IF A$="2" AND Y1<23 THEN Y1=Y1+1:GOTO 150 + IF A$="4" AND X1>0 THEN X1=X1-1:GOTO 150 + IF A$="6" AND X1<79 THEN X1=X1+1:GOTO 150 + IF A$=CHR$(0)+"K" AND X2>0 THEN X2=X2-1:GOTO 150 + IF A$=CHR$(0)+"M" AND X2<79 THEN X2=X2+1:GOTO 150 + IF A$=CHR$(0)+"H" AND Y2>0 THEN Y2=Y2-1 + IF A$=CHR$(0)+"P" AND Y2<24 THEN Y2=Y2+1 + 150: IF X1>X2 THEN XA=X2:XB=X1 ELSE XA=X1:XB=X2 + IF Y1>Y2 THEN YA=Y2:YB=Y1 ELSE YA=Y1:YB=Y2 + + +Wend + +X1=XA:Y1=YA:X2=XB:Y2=YB + +IF A$=CHR$(27) Then X1%=-1 + +PCOPY PAG%,0 +End sub + +' ========================== Sous prog de Copie ============================= + +sub COPYPA(XA%,YA%,XB%,YB%,DECA%) Static + +SHARED CN%,FN% +COU%=FNCO%(CN%,FN%):DEB%=-1 +'IF PAGE%=2 THEN DECA%=8192 ELSE DECA%=12288 +'---------------------------- Calcule interne ---------- +CY%=YA%:CX%=XA%:A$="":b$=chr$(0) +DIX%=XB%-XA%:DIY%=YB%-YA% +APOS1%=1:APOS2%=1:CA1%=PEEK(APOS1%):ACO1%=PEEK(APOS1%+1):CA2%=CA1%:ACO2%=ACO1% +car1%=218:car2%=217 +IF DIX%=0 THEN CAR1%=31:CAR2%=30 +IF DIY%=0 THEN + IF DIX%=0 THEN CAR1%=254:CAR2%=254 ELSE CAR1%=16:CAR2%=17 + END IF +'------------------------------------------------------- + +While A$<>chr$(13) and a$<>chr$(27) + +'------ Calcule des positions curseurs (le 2me) ------- +AX%=CX%:AY%=CY%:BX%=CX%+DIX%:BY%=CY%+DIY% +IF DEB% THEN + IF AX%<0 THEN AX%=80+AX%:CX%=AX% + IF AY%<0 THEN AY%=24+AY%:CY%=AY% + IF BX%>79 THEN BX%=BX%-80 + IF BY%>23 THEN BY%=BY%-24 + ELSE + IF AX%<0 THEN AX%=0 + IF AY%<0 THEN AY%=0 + IF BX%>79 THEN BX%=79 + IF BY%>23 THEN BY%=23 + IF BX%<0 THEN BX%=79:AX%=79-DIX%:CX%=AX% + IF BY%<0 THEN BY%=23:AY%=23-DIY%:CY%=AY% + IF AX%>79 THEN AX%=0 :BX%=DIX% :CX%=AX% + IF AY%>23 THEN AY%=0 :BY%=DIY% :CY%=AY% + END IF + +'-------- Affichage des curseurs sur l'cran ----------- + POKE APOS1%,CA1%:POKE APOS2%,CA2%:POKE APOS1%+1,ACO1%:POKE APOS2%+1,ACO2% + POSI1%=AX%*2+AY%*160:APOS1%=POSI1%:POSI2%=BX%*2+BY%*160:APOS2%=POSI2% + ACO1%=PEEK(POSI1%+1):ACO2%=PEEK(POSI2%+1):CA1%=PEEk(POSI1%):CA2%=PEEK(POSI2%) + POKE POSI1%,CAR1%:POKE POSI2%,CAR2%:POKE POSI1%+1,COU%:POKE POSI2%+1,COU% + + A$=FNTOUCHE$ + + IF A$=B$+"P" or A$="2" Then CY%=CY%+1 + IF A$=B$+"H" or A$="8" Then CY%=CY%-1 + IF A$=b$+"M" or A$="6" Then CX%=CX%+1 + If A$=B$+"K" or A$="4" Then CX%=CX%-1 + If A$="D" or A$="d" Then DEB%=NOT(DEB%) + If CX%< -DIX% THEN CX%=79 + If CX%>79 Then CX%=0 + If CY%< -DIY% Then CY%=23 + If CY%>23 Then CY%=0 + +WEND +PCOPY 3,0 + +FOR I=0 TO DIX% + FOR J=0 TO DIY% + VX%=AX%+I:VY%=AY%+J + IF ( VX%>BX% OR VY%>BY% ) AND NOT(DEB%) THEN VX%=0:VY%=24 + IF DEB% THEN + VX%= (VX% + (VX%>79)*80) + VY%= (VY% + (VY%>23)*24) + END IF + + POSR%=VX%*2+VY%*160 + POSS%=DECA%+(XA%+I)*2+(YA%+J)*160 + POKE POSR%,PEEK(POSS%):POKE POSR%+1,PEEK(POSS%+1) + NEXT J +NEXT I +OK%=-1 +COLOR CN%,FN%:LOCATE 25,1:PRINT " VOULEZ-VOUS CONSERVER CETTE TRANSFORMATION "; +While OK% + A$=FNTOUCHE$ + IF A$="O" or A$="o" then PCOPY 0,3:pcopy 0,1:OK%=0 + IF A$="N" or A$="n" then PCOPY 3,0:pcopy 0,1:OK%=0 +Wend +END SUB +' ========================== Sous prog de SAISI ============================= + +DESSIN : + +A$="" + +While (A$<>chr$(27)) + + A$="":WHILE A$="":A$=INKEY$:WEND + B$=CHR$(0):P2=P1:CM1=0:CM2=0 + + GOSUB GESTION.TOUCHE + + P1=(X-1)*2+(Y-1)*160 + AN=PEEK(P2):CALL VERIF(AN):CO=(CM2 OR CR1) :CALL CALCUL(AN,CO,V,D,NO,PRD%) + POKE P2+1,CND%:POKE P2,CC(NO) + AN=PEEK(P1):CALL VERIF(AN):CO=CM1 :CALL CALCUL(An,CO,V,D,NO,PRD%) + POKE P1+1,CID%:POKE P1,CC(NO):CR1=CM1 + +Wend:POKE P1+1,CND%:pcopy 0,3:RETURN + +'--------------------------------------------------------------------------- + +GESTION.TOUCHE : + + IF A$=B$+"M" OR A$="6" THEN X=X+1:V=0 :CM2=2:CM1=8 + IF A$=B$+"K" OR A$="4" THEN X=X-1:V=0 :CM2=8:CM1=2 + IF A$=B$+"H" OR A$="8" THEN Y=Y-1:V=-1:CM2=1:CM1=4 + IF A$=B$+"P" OR A$="2" THEN Y=Y+1:V=-1:CM2=4:CM1=1 + IF A$=CHR$(27) THEN IND%=-1 + IF A$=B$+";" THEN MEN%=-1:A$=CHR$(27) + IF A$="D" OR A$="d" THEN D=-1 + IF A$="S" OR A$="s" THEN D=0 + IF A$="X" OR A$="x" THEN CPA1%=NOT(CPA1%) + + IF Y<1 THEN Y=24 + IF X<1 THEN X=80 + IF X>80 THEN X=1 + IF Y>24 THEN Y=1 + +RETURN + + +'======================== OPTION du MODE TRACE ============================== + +SUB SAUV(NOI$,PAG%) STATIC + +SHARED NOM$,CPA1%,CPA2% + + NOM$=NOI$:N$="":PH$="NON DU FICHIER A ENREGISTRER" + CALL DonneNom(N$,PH$) + PCOPY PAG%,0 + IF PH$="E" THEN PCOPY 3,0:EXIT Sub + BSAVE N$,0,4000 + PCOPY 3,0 + IF PAG%=2 THEN CPA2%=0 ELSE CPA1%=0 + NOI$=NOM$ + +END SUB + +'================= Sub de Chargement ======================================== + +SUB RAPP(NOI$,PAG%) STATIC + +SHARED NOM$,CPA1%,CPA2%,CN%,FN%,CI%,FI% + +IF PAG%=2 THEN DECA%=8192:NP%=2 ELSE DECA%=12288:NP%=1 +CALL VERIPAGE(PAG%):IF PAG%=-1 THEN EXIT SUB +NOM$=NOI$:N$="":PH$="NON DU FICHIER A CHARGER" +CALL DonneNom(N$,PH$) +IF PH$="E" THEN EXIT Sub +BLOAD N$,DECA% +PCOPY 3,0:PCOPY 0,1 +End Sub + +'================== Sub de Vrification de sauvegarde d'une page avant Cls === +SUB VeriPage(N%) Static + SHARED CPA1%,CPA2%,NOM1$,NOM2$ + S%=0 + IF CPA1% AND N%=3 THEN CALL INTEROGE(NOM1$,N%,S%) + IF CPA2% AND N%=2 THEN CALL INTEROGE(NOM2$,N%,S%) + IF S%=-1 THEN N%=-1 +END SUB + +SUB INTEROGE(No$,NN%,S%) Static + +SHARED CN%,FN%,CI%,FI% + + IF NN%=0 OR NN%=1 OR NN%=3 THEN NP%=1 ELSE NP%=2 + CALL FaitUnCADRE(30,5,50,17,15,4) + COLOR 15,4 + LOCATE 7,32:PRINT "La Page N";NP%;" est" + LOCATE 9,33:PRINT "NON SAUVEGARDE":CPY%=1 + Reprend : + + CALL MENU("Sauver pageAnnuler CMD Ignorer ",11,34,11,CN%,FN%,CI%,FI%,0,CPY%,-1) + IF CPY%=-1 THEN Beep:Goto Reprend + IF CPY%=1 THEN Call SAUV(No$,NN%):S%=0 + IF CPY%=2 THEN S%=-1 + IF CPY%=3 THEN S%=0 + +END SUB +'========================== Dbut du programme Enfin !!! ===================== +debut : + +B$=chr$(0) + + A$=FNTOUCHE$ + GOSUB GESTION.TOUCHE + + P1=(X-1)*2+(Y-1)*160 + POKE P2+1,CMC%:CMC%=PEEK(P1+1):POKE P1+1,CID%:P2=P1 + IF A$=CHR$(27) THEN MEN%=-1 ELSE MEN%=0 + + ' Aiguillage des activite des sous gros programmes !! + + IF NOT(IND%) THEN GOSUB DESSIN :POKE P1+1,CND% :GOSUB Affiche.Ligne + IF MEN% THEN GOSUB DEBUTAZ:PCOPY 3,0:MEN%=0:GOSUB Affiche.Ligne + +GOTO Debut + +DEBUTAZ : + + GOSUB Affiche.Ligne + MM$="UtilitsFichiers Texte Dessin Config Quitter " + CALL MENUB(MM$,8,1,CN%,FN%,CI%,FI%,CHX%,-1) + IF CHX%=-1 THEN RETURN + PCOPY 0,1 + IF CHX%=6 THEN GOTO FINPROG + ON CHX% GOSUB MENU1,MENU2,MENU3,MENU4,MENU5 + IF CHY%=-3 OR CHY%=3 THEN CHx%=CHx%+1 + IF CHY%=-2 OR CHY%=2 THEN CHX%=CHX%-1 + PCOPY 1,0 +a$="":Goto DEBUTAZ + +TRAITERREUR : +PCOPY 3,0 +CALL FAITUNCADRE(29,10,51,14,15,4) +LOCATE 11,32:PRINT "Une ERREUR s'est" +LOCATE 12,36:PRINT "produite" +LOCATE 13,31:PRINT "N d'Erreur : ";:PRINT USING "###";ERR +LOCATE 14,29:PRINT "Appuyez sur une touche" +A$=input$(1) +PCOPY 3,0 +RESUME debut + +MENU1 : + +cm$=cHR$(26) +MM$=" cls Total cls fEnetrecls Spcial Copie 1"+CM$+"1 cOpie 2"+CM$+"1 Filtres " +CHY%=6 +CALL MENU(MM$,11,3,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Cls.T,CFLS,CLS.SPEC,COPIE11,COPIE21,FIS +RETURN + +MENU2 : +CHY%=5 +MM$=" Sauve 1 sAuve 2 Rappelle 1raPpelle 2Catalogue " +CALL MENU(MM$,10,18,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +ON CHY% GOSUB SAUV1,SAUV2,RAPP1,RAPP2,CATALOGUE +RETURN + +MENU3 : +CHY%=3 +mm$="marge Droite marge Gauche couleurs Texte couleurs cUrseur Centre Priorit

criture Activecriture Inactive" +CALL MENU(MM$,17,31,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +RETURN + +MENU4 : +CHY%=1 +mm$="couleurs Traccouleurs Cur. Simple Double Priorit iMage1/image2 trac Actif trac Inactif " +CALL MENU(MM$,14,41,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Couleur.Trace,Couleur.Cur,Simple,Double,Priorite.Trace,ImageI,Trace.A,Trace.I +IF CHY%=-1 THEN RETURN +GOSUB Affiche.Ligne +goto Menu4 + +MENU5 : +CHY%=3 +MM$="Couleur Monochrome couleur Normale couleur InverseSauve config ligne d'tat Ac.ligne d'tat in." +CALL MENU(MM$,16,51,3,CN%,FN%,CI%,FI%,chx%,CHY%,-1) +IF CHY%=-1 OR CHY%=0 THEN Return +ON CHY% GOSUB Couleur.E,Monochrome,Couleur.text,Couleur.Curs,Sauve.Config,Ligne.A,Ligne.I +IF CHY%=-1 THEN RETURN +GOSUB Affiche.Ligne +Goto Menu5 + +'======= +IN : +CALL FAITUNCADRE(20,11,60,12,CI%,FI%):LOCATE 12,25:PRINT " PAS ENCORE DISPONIBLE !!!!!! " +a$=input$(1) +RETURN + +'================== Option Menu1 =========================================== +MM$=" cls Total cls fEnetrecls Spcial Copie 1"+CM$+"1 cOpie 2"+CM$+"1 Filtres " +Cls.T : COLOR 7,0:CLS:PCOPY 0,3:PCOPY 0,1:CHY%=-1:RETURN +CFLS : Call Pfenetre(X1%,Y1%,X2%,Y2%,3) + Call SCLS(X1%,Y1%,X2%,Y2%,32,7) + RETURN +FIS : CALL Pfenetre(X1,Y1,X2,Y2,3) + IF X1=-1 THEN RETURN + B$=CHR$(26) + MM$="CAR "+B$+" COUCOU "+B$+" CARCOU "+B$+" COUCAR "+B$+" CAR QUITTER " + CHY%=5 + CALL MENU(MM$,9,28,8,CN%,FN%,CI,FI,0,CHY%,0) + IF CHY%=5 or CHY%=-1 THEN RETURN + F1%=0:F2%=0:s%=1:nc%=0:rc%=0 + IF CHY%=1 THEN F1%=-1 + IF CHY%=2 THEN F2%=-1 + IF CHY%=4 THEN F1%=-1:F2%=-1 + IF F1% THEN Call ChoixCar(RC%) ELSE Call Colorc(RC%,N,S%) + IF RC%=-1 or s%=-1 Then return + s%=1 + IF F2% THEN Call ChoixCar(NC%) ELSE Call Colorc(NC%,N,S%) + IF NC%=-1 or s%=-1 Then return + PCOPY 3,0:CALL FILTRES(RC%,NC%,F1%,F2%,X1%,Y1%,X2%,Y2%) + PCOPY 0,1:RETURN +COPIE11 : PCOPY 3,0:COLOR CN%,FN% + LOCATE 25,23:PRINT " Slectionnez la partie copier "; + CALL PFENETRE(FX1%,FY1%,FX2%,FY2%,3) + LOCATE 25,23:PRINT " Positionnez la partie copier "; + CALL COPYPA(FX1%,FY1%,FX2%,FY2%,12288):RETURN +COPIE21 : PCOPY 2,0:COLOR CN%,FN% + LOCATE 25,23:PRINT " Slectionnez la partie copier "; + CALL PFENETRE(FX1%,FY1%,FX2%,FY2%,2) + PCOPY 3,0:LOCATE 25,23:PRINT " Positionnez la partie copier "; + CALL COPYPA(FX1%,FY1%,FX2%,FY2%,8192):RETURN +'================== Option Menu2 =========================================== +SAUV1 : CALL SAUV(NOM1$,3) :RETURN +SAUV2 : PCOPY 2,0:CALL SAUV(NOM2$,2):RETURN +RAPP1 : CALL RAPP(NOM1$,3) :RETURN +RAPP2 : CALL RAPP(NOM2$,2) :RETURN +'================== Option Menu3 =========================================== +' Quedal !!! +'================== Option Menu4 =========================================== +Couleur.Trace : CALL COLORC(CND%,0,1):RETURN +Couleur.Cur : CALL COLORC(CID%,0,1):RETURN +Simple : D= 0:RETURN +Double : D=-1:RETURN +Priorite.Trace: PRD%=NOT(PRD%):RETURN +ImageI : SWAP NOM1$,NOM2$:SWAP CPA1%,CPA2%:Pcopy 2,0:PCOPY 3,2:pcopy 0,3:PCOPY 0,1:CHY%=-1:RETURN +Trace.A : IND=0:RETURN +Trace.I : Ind=-1:RETURN +'==================== Option Menu5 ========================================= +Monochrome : CN%=7 :FN%=0:CI%=0 :FI%=7:CHY%=-1:RETURN +Couleur.E : CN%=11:FN%=1:CI%=14:FI%=4:CHY%=-1:RETURN +Couleur.TEXT : CALL COLORC(CN%,FN%,0):RETURN +Couleur.Curs : CALL COLORC(CI%,FI%,0):RETURN +Ligne.A : LIN%=0 :RETURN +Ligne.I : LIN%=-1:RETURN + +'================== Affiche la Ligne d'tat ================================ +Affiche.Ligne : +Color CN%,FN%:LOCATE 25,1:PRINT SPACE$(78); +IF LIN THEN RETURN +Locate 25,1:PRINT "Ecriture "; +Locate 25,31:PRINT "Dessin "; +Locate 25,10 +IF INE% THEN PRINT "INACTIVE"; ELSE PRINT " ACTIVE "; +IF PRE% THEN Locate 25,19:PRINT "PRIORITAIRE"; +Locate 25,38 +IF IND% THEN PRINT "INACTIF"; ELSE PRINT " ACTIF "; +IF PRD% THEN LOCATE 25,46:PRINT "PRIORITAIRE"; +Locate 25,58 +IF D THEN PRINT "DOUBLE"; ELSE PRINT "SIMPLE"; +POKE 3994,42:POKE 3995,CNT%:POKE 3998,42:POKE 3999,CND% +RETURN + +'================================ FIN ======================================= +FINPROG : +COLOR 7,0 +IF NOT(CPA1%) AND NOT(CPA2%) THEN CLS:PRINT "Vous avez le bonjour de "+Yoann$:END + +PCOPY 1,0 +A$=input$(1) +PCOPY 2,0 +A$=input$(1) +PCOPY 3,0 +A$=input$(1) +END + +'================================= SAUVE Les configurations ================= +SAUVE.CONFIG : +OPEN "O",#1,"CREAPAGE.CFG" +WRITE #1,CN%,FN%,CI%,FI%,LIN% +Close:RETURN +'================================= RAPPELLE Configurations ================== +RAPP.CONFIG : +OPEN "I",#1,"CREAPAGE.CFG":INPUT #1,A$,B$,c$,d$,e$:CLOSE +CN%=VAL(A$):FN%=VAL(B$):CI%=val(C$):FI%=VAL(D$):LIN%=VAL(E$):RETURN + + + diff --git a/CREAPAGE.EXE b/CREAPAGE.EXE new file mode 100644 index 0000000..2553190 Binary files /dev/null and b/CREAPAGE.EXE differ diff --git a/CREAPSUP.BAS b/CREAPSUP.BAS new file mode 100644 index 0000000..51a3d37 --- /dev/null +++ b/CREAPSUP.BAS @@ -0,0 +1,77 @@ +' *************************************************************************** +' ** Routine suplmentaire appeller par un $INCLUDE "CREAPSUP.BAS"** +' ** Pour le programme Crapage.BAS ( Compilable par QB Ver 2.0 ) ** +' *************************************************************************** + + +'--------------------------------------------------------------------------- +' ** MODE d'EMPLOIE ** +' Table de Vrit en fonction des donnes entrante : +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +' Ŀ +' RC% F1% F2% RC% NC% +' ͵ Sytaxe : +' + 0 0 Couleur CAR Novelle +' Recherche Couleur FILTRES(RC%,NC%,F1%,F2%) +' Ĵ +' + 0 1 couleur CAR Code du +' RECHERCHE NOUVEAU CAR En respectant ce tableau +' Ĵ <------- +' + 1 0 code du CAR Nouvelle pour les diffrents +' Recherche Couleur filtres possibles +' Ĵ +' + 1 1 code du CAR Code du Par ailleur les valeurs : +' Recherche Nouveau Couleurs en systeme POKE +' ĴCaractre en ASCII +' - CDE CARNOUVEAU Couleur CAR Nouvelle +' RECH. CDE CAR Recherche Couleur +' +' RC% = signe de RC% +: Positif -: Ngatif attention 0 cod 256 !! +' CAR = CARACTERE, CDE = CODE, RECH. = RECHERCHE +' Dans X1%,Y1%,X2%,Y2% dfinition de la fentre (Faon poke !!! ) + +SUB FILTRES(RC%,NC%,F1%,F2%,X1%,Y1%,X2%,Y2%) STATIC + +PCOPY 0,3:' SAUVEGARDE d' cran + +STATIC F3%,X,Y,PO%,P1%,P2%,cr%,cpn%,cor%,con% +SHARED FI%,CI%,cn%,fn% + + IF (RC%)<0 then F3%=-1 Else F3%=0 + RC%=ABS(RC%):IF RC%=256 THEN RC%=0 + +IF F3% Then CR%=F1%:CpN%=F2%:COR%=RC%:CON%=NC%:GOTO FLS +IF F1% AND F2% THEN CR%=RC%:CpN%=NC%:COR%= 2 :CON%= -1:GOTO FLS +IF F1% THEN CR%=RC%:CpN%= -1:COR%= 1 :CON%=NC%:GOTO FLS +IF F2% THEN CR%= 4 :CpN%=NC%:COR%=RC%:CON%= -1:GOTO FLS + CR%= 2 :CpN%= -1:COR%=RC%:CON%=NC% +FLS : + + FOR X=X1% TO X2% + FOR Y=Y1% TO Y2% + A$=INKEY$ + PO% = (X*2) + (Y*160) + WHILE A$="" + P1%=PEEK(PO%):P2%=PEEK(PO%+1) + + IF (CR%=2) AND (P2% =COR%) THEN P2%=CoN%:goto SUITEFL + IF (CR%=4) AND (P2% =COR%) THEN P1%=CpN% :goto SUITEFL + IF (COR%=1) AND (CR% =P1% ) THEN P2%=CON%:goto SUITEFL + IF (COR%=2) AND (CR% =P1% ) THEN P1%=CpN% :goto SUITEFL + 'IF (CR% = P1%) AND (COR%=P1% ) THEN P1%=CpN%:P2%=CON% + + SUITEFL : + POKE PO%,P1%:POKE PO%+1,P2% + NEXT Y + NEXT X:A$=" " + WEND + +COLOR CI,FI:LOCATE 25,12:PRINT "Voulez-vous conserver la Transformation [O/N]"; +A$=INPUT$(1) +IF A$="N" OR a$="n" THEN PCOPY 3,0 +COLOR CN%,FN% +Locate 25,1:PRINT " Mode Traage pour valider, options , Votre Trac sera : ";:locate 1,1 +pcopy 0,3 +END SUB + + diff --git a/CUB.BAS b/CUB.BAS new file mode 100644 index 0000000..964dc92 Binary files /dev/null and b/CUB.BAS differ diff --git a/CUBE.BAS b/CUBE.BAS new file mode 100644 index 0000000..d2730d6 --- /dev/null +++ b/CUBE.BAS @@ -0,0 +1,126 @@ +0 REM |||||||||||||||| CUB DE MONGE : EDITEUR .. ||||||||||||||||||||||||||||||| +1 CLEAR:KEY OFF:CLS +10 SCREEN 2:PALETTE 1,13:WINDOW SCREEN (640,400)-(0,0) +20 OPTION BASE 1:DIM LX%(100,2),LY%(100,2),LZ%(100,2) +21 DEFINT X,Y,Z,C,A,N,Q +1000 L=1:LINE (0,0)-(420,200),1,B:LINE(440,0)-(640,200),1,B:LINE (0,200)-(420,400),1,B:P=1:X=155:Y=100:Z=50:LOCATE 15,58:PRINT "VUE DE FACE" +1001 LOCATE 19,56:PRINT "N= 1":N%=1 +1010 A$=INKEY$:IF A$<>"" THEN 1020 ELSE C=POINT(X,Y):C1=POINT(Z+440,Y):C2=POINT(X,Z+200):PSET(X,Y):PSET(X,Z+200):PSET(Z+440,Y):PSET(X,Y),C:PSET(X,Z+200),C1:PSET(Z+440,Y),C2:GOTO 1010 +1020 IF A$="a" OR A$="A" THEN P=1:LOCATE 15,58:PRINT "VUE DE FACE ":GOTO 1010 +1021 IF A$="z" OR A$="Z" THEN P=2:LOCATE 15,58:PRINT "VUE DE GAUCHE":GOTO 1010 +1022 IF A$="e" OR A$="E" THEN P=3:LOCATE 15,58:PRINT "VUE DE DESSUS":GOTO 1010 +1023 IF A$="l" OR A$="L" THEN 2000 +1024 IF A$="i" OR A$="I" THEN DX=SX:DY=SY:DZ=SZ:SZ=PZ:Z=PZ:X=PX:Y=PY:SX=PX:SY=PY:PX=DX:PY=DY:PZ=DZ:DZ=0:DY=0:DX=0:GOTO 1010 +1025 IF A$="P" OR A$="p" THEN 2050 +1026 IF A$="D" OR A$="d" THEN 2060 +1027 IF A$="H" OR A$="h" THEN 3000 +1028 IF A$="c" OR A$="C" THEN 2100 +1029 IF A$="T" OR A$="t" THEN 2150 +1090 IF V=1 THEN 2000 +1100 ON P GOTO 1101,1160,1210 +1101 IF A$="6" THEN X=X+N +1102 IF A$="4" OR A$="|" THEN X=X-N +1103 IF A$="2" OR A$="`" THEN Y=Y+N +1104 IF A$="8" OR A$="~" THEN Y=Y-N +1119 IF X<=0 THEN X=419 +1120 IF X>=420 THEN X=1 +1130 IF Y<=0 THEN Y=199 +1140 IF Y>=200 THEN Y=1 +1150 GOTO 1010 +1160 IF A$="6" THEN Z=Z+N +1162 IF A$="4" OR A$="|" THEN Z=Z-N +1163 IF A$="2" OR A$="`" THEN Y=Y+N +1164 IF A$="8" OR A$="~" THEN Y=Y-N +1169 IF Z<=0 THEN Z=199 +1170 IF Z>=200 THEN Z=1 +1180 IF Y<=0 THEN Y=199 +1190 IF Y>=200 THEN Y=1 +1200 GOTO 1010 +1210 IF A$="6" THEN X=X+N +1211 IF A$="4" OR A$="|" THEN X=X-N +1212 IF A$="2" OR A$="`" THEN Z=Z+N +1213 IF A$="8" OR A$="~" THEN Z=Z-N +1219 IF X<=0 THEN X=419 +1220 IF X>=420 THEN X=1 +1230 IF Z<=0 THEN Z=199 +1240 IF Z>=200 THEN Z=1 +1260 GOTO 1010 +2000 IF V<>0 THEN IF A<>1 THEN 2002 ELSE 2004 +2001 LOCATE 16,56:PRINT " pour le 1er Point":V=1:GOTO 1010 +2002 IF A$=" " THEN A$="":A=1 :GOTO 2003 ELSE 1100 +2003 PX=X:PY=Y:PZ=Z:SX=X:SY=Y:SZ=Z:LOCATE 16,56:PRINT " pour valider " +2004 IF A$=" " THEN A=0:LY%(L,1)=PY:LY%(L,2)=SY:LX%(L,1)=PX:LX%(L,2)=SX:LZ%(L,1)=PZ:LZ%(L,2)=SZ:V=0:L=L+1:LOCATE 16,56:PRINT " ":GOTO 1010 +2005 IF SZ=Z AND SY=Y AND SX= X THEN 1100 +2010 LINE (PX,PY)-(SX,SY),0:LINE (PX,PZ+200)-(SX,SZ+200),0:LINE(PZ+440,PY)-(SZ+440,SY),0:SX=X:SY=Y:SZ=Z:LINE(PX,PY)-(X,Y):LINE(PX,PZ+200)-(X,Z+200):LINE(PZ+440,PY)-(Z+440,Y):GOTO 1010 +2050 LOCATE 18,56:PRINT "X=";X;"Y=";Y;"Z=";Z +2051 LOCATE 17,56:INPUT "X= ",Q:IF Q<=0 OR Q>=420 THEN BEEP:GOTO 2050 ELSE X=Q +2052 LOCATE 17,56:INPUT "Y= ",Q:IF Q<=0 OR Q>=200 THEN BEEP:GOTO 2050 ELSE Y=Q +2053 LOCATE 17,56:INPUT "Z= ",Q:IF Q<=0 OR Q>=200 THEN BEEP:GOTO 2050 ELSE Z=Q +2054 LOCATE 18,56:PRINT " ":LOCATE 17,56:PRINT SPACE$(14);:GOTO 1010 +2060 LOCATE 17,56:INPUT "N. DE POINT ",N:IF N=0 THEN N=1 +2061 LOCATE 19,56:PRINT "N=";N:LOCATE 17,56:PRINT SPACE$(14); +2062 GOTO 1010 +2100 LOCATE 17,56:INPUT "Arrte : ",AR +2101 LOCATE 17,56:PRINT SPACE$(24); +2102 LOCATE 17,56:INPUT "pos x,y,z ",GX,GY,GZ +2103 LOCATE 17,56:PRINT SPACE$(24); +2104 IF AR+GX>420 THEN BEEP :GOTO 2100 +2105 IF AR+GY>200 THEN BEEP :GOTO 2100 +2106 IF AR+GZ>200 THEN BEEP :GOTO 2100 +2107 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX:LY%(L,2)=GY:LZ%(L,2)=GZ+AR:L=L+1 +2108 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX:LY%(L,2)=GY+AR:LZ%(L,2)=GZ:L=L+1 +2109 LX%(L,1)=GX:LY%(L,1)=GY+AR:LZ%(L,1)=GZ:LX%(L,2)=GX+AR:LY%(L,2)=GY+AR:LZ%(L,2)=GZ:L=L+1 +2110 LX%(L,1)=GX:LY%(L,1)=GY+AR:LZ%(L,1)=GZ:LX%(L,2)=GX:LY%(L,2)=GY+AR:LZ%(L,2)=GZ+AR:L=L+1 +2111 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX+AR:LY%(L,2)=GY:LZ%(L,2)=GZ:L=L+1 +2112 LX%(L,1)=GX+AR:LY%(L,1)=GY+AR:LZ%(L,1)=GZ+AR:LX%(L,2)=GX+AR:LY%(L,2)=GY+AR:LZ%(L,2)=GZ:L=L+1 +2113 LX%(L,1)=GX+AR:LY%(L,1)=GY+AR:LZ%(L,1)=GZ+AR:LX%(L,2)=GX+AR:LY%(L,2)=GY:LZ%(L,2)=GZ+AR:L=L+1 +2114 LX%(L,1)=GX+AR:LY%(L,1)=GY+AR:LZ%(L,1)=GZ+AR:LX%(L,2)=GX:LY%(L,2)=GY+AR:LZ%(L,2)=GZ+AR:L=L+1 +2115 LX%(L,1)=GX+AR:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX+AR:LY%(L,2)=GY:LZ%(L,2)=GZ+AR:L=L+1 +2116 LX%(L,1)=GX+AR:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX+AR:LY%(L,2)=GY+AR:LZ%(L,2)=GZ:L=L+1 +2117 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ+AR:LX%(L,2)=GX:LY%(L,2)=GY+AR:LZ%(L,2)=GZ+AR:L=L+1 +2118 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ+AR:LX%(L,2)=GX+AR:LY%(L,2)=GY:LZ%(L,2)=GZ+AR:L=L+1 +2119 LINE (GX,GY)-(GX+AR,GY+AR),1,B:LINE (GX,GZ+200)-(GX+AR,GZ+AR+200),1,B:LINE (GZ+440,GY)-(GZ+AR+440,GY+AR),1,B +2130 GOTO 1010 +2150 LOCATE 17,56:INPUT "l. PETIT COTE ",M:M=INT(M) +2151 LOCATE 17,56:PRINT SPACE$(24); +2152 LOCATE 17,56:INPUT "pos x,y,z",GX,GY,GZ +2153 LOCATE 17,56:PRINT SPACE$(24); +2154 LOCATE 17,56:INPUT "PROFONDEUR pt cot",D +2155 LOCATE 17,56:PRINT SPACE$(24); +2156 IF GX<0 OR GY<0 OR GZ<0 THEN 2150 +2157 IF GZ+D>=200 OR GX+D>=440 OR GY+D>=200 THEN GOTO 2150 +2158 LOCATE 17,56:INPUT "l. GRAND COTE ",P:P=INT(P) +2159 LOCATE 17,56:PRINT SPACE$(24); +2160 LOCATE 17,56:INPUT "pos x,y,z",G1X,G1Y,G1Z +2161 LOCATE 17,56:PRINT SPACE$(24); +2162 LOCATE 17,56:INPUT "PROFONDEUR pt cot",D1 +2163 LOCATE 17,56:PRINT SPACE$(24); +2164 IF G1X<0 OR G1Y<0 OR G1Z<0 THEN 2158 +2165 IF G1Z+D1>=200 OR G1X+D1>=440 OR G1Y+D1>=200 THEN 2158 +2166 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX:LY%(L,2)=GY:LZ%(L,2)=GZ+D:L=L+1 +2167 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=GX+M:LY%(L,2)=GY:LZ%(L,2)=GZ:L=L+1 +2168 LX%(L,1)=GX+M:LY%(L,1)=GY:LZ%(L,1)=GZ+D:LX%(L,2)=GX+M:LY%(L,2)=GY:LZ%(L,2)=GZ:L=L+1 +2169 LX%(L,1)=GX+M:LY%(L,1)=GY:LZ%(L,1)=GZ+D:LX%(L,2)=GX:LY%(L,2)=GY:LZ%(L,2)=GZ+D:L=L+1 +2170 LX%(L,1)=G1X:LY%(L,1)=G1Y:LZ%(L,1)=G1Z:LX%(L,2)=G1X:LY%(L,2)=G1Y:LZ%(L,2)=G1Z+D1:L=L+1 +2171 LX%(L,1)=G1X:LY%(L,1)=G1Y:LZ%(L,1)=G1Z:LX%(L,2)=G1X+P:LY%(L,2)=G1Y:LZ%(L,2)=G1Z:L=L+1 +2172 LX%(L,1)=G1X+P:LY%(L,1)=G1Y:LZ%(L,1)=G1Z+D1:LX%(L,2)=G1X+P:LY%(L,2)=G1Y:LZ%(L,2)=G1Z:L=L+1 +2173 LX%(L,1)=G1X+P:LY%(L,1)=G1Y:LZ%(L,1)=G1Z+D1:LX%(L,2)=G1X:LY%(L,2)=G1Y:LZ%(L,2)=G1Z+D1:L=L+1 +2174 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=G1X:LY%(L,2)=G1Y:LZ%(L,2)=G1Z:L=L+1 +2175 LX%(L,1)=GX+M:LY%(L,1)=GY:LZ%(L,1)=GZ:LX%(L,2)=G1X+P:LY%(L,2)=G1Y:LZ%(L,2)=G1Z:L=L+1 +2176 LX%(L,1)=GX+M:LY%(L,1)=GY:LZ%(L,1)=GZ+D:LX%(L,2)=G1X+P:LY%(L,2)=G1Y:LZ%(L,2)=G1Z+D1:L=L+1 +2177 LX%(L,1)=GX:LY%(L,1)=GY:LZ%(L,1)=GZ+D:LX%(L,2)=G1X:LY%(L,2)=G1Y:LZ%(L,2)=G1Z+D1:L=L+1 +2178 LINE (GX,GY)-(GX+M,GY),1:LINE(G1X,G1Y)-(G1X+P,G1Y),1:LINE(GX,GY)-(G1X,G1Y),1:LINE (GX+M,GY)-(G1X+P,G1Y),1 +2179 LINE (GZ+440,GY)-(GZ+440+D,GY),1:LINE(G1Z+440,G1Y)-(G1Z+D1+440,G1Y),1:LINE (GZ+440,GY)-(G1Z+440,G1Y),1:LINE (GZ+440+D,GY)-(G1Z+440+D1,G1Y),1 +2180 LINE (GX,GZ+200)-(GX+M,GZ+200),1,,21845:LINE -(GX+M,GZ+200+D),1,,21845:LINE -(GX,GZ+D+200),1,,21845:LINE -(GX,GZ+200),1,,21845 +2181 LINE (G1X,G1Z+200)-(G1X+P,G1Z+200),1:LINE -(G1X+P,G1Z+200+D1),1:LINE -(G1X,G1Z+D1+200),1:LINE -(G1X,G1Z+200),1 +2199 GOTO 1010 +3000 CLS:FOR I=1 TO L-1 +3010 P1X=LX%(I,1)+(.5*LZ%(I,1)/1.414):P1Y=LY%(I,1)+(.5*LZ%(I,1)/1.414) +3020 P2X=LX%(I,2)+(.5*LZ%(I,2)/1.414):P2Y=LY%(I,2)+(.5*LZ%(I,2)/1.414) +3030 LINE (P1X+80,P1Y+50)-(P2X+80,P2Y+50),1:NEXT +3040 A$=INPUT$(1):IF A$=CHR$(27) THEN END +3041 CLS:LINE (0,0)-(420,200),1,B:LINE(440,0)-(640,200),1,B:LINE (0,200)-(420,400),1,B:P=1:X=155:Y=100:Z=50:LOCATE 15,58:PRINT "VUE DE FACE" +3050 FOR I=1 TO L-1 +3060 LINE(LX%(I,1),LY%(I,1))-(LX%(I,2),LY%(I,2)),1:LINE (LZ%(I,1)+440,LY%(I,1))-(LZ%(I,2)+440,LY%(I,2)),1:LINE (LX%(I,1),LZ%(I,1)+200)-(LX%(I,2),LZ%(I,2)+200),1 +3065 NEXT :GOTO 1010 + \ No newline at end of file diff --git a/CV-AR-RO.BAS b/CV-AR-RO.BAS new file mode 100644 index 0000000..35d5343 --- /dev/null +++ b/CV-AR-RO.BAS @@ -0,0 +1,35 @@ +0 CLS:COLOR 13 +1000 INPUT " Votre nombre en Decimal (SANS VIRGULE) :",DE +1002 IF DE<>INT(DE) THEN COLOR 30:PRINT "S A N S V I R G U L E .. ":COLOR 13:GOTO 1000 +1003 IF DE<=0 OR DE >=4999 THEN COLOR 30:PRINT DE;"??";:IF DE<=0 THEN PRINT " est < ou = 0 !!!" ELSE IF DE >=4999 THEN PRINT " est > ou = 4999" ELSE ELSE 1010 +1004 COLOR 13:GOTO 1000 +1010 REM +1020 IF DE >=1000 AND M<=2 THEN M=M+1:R$=R$+"M":DE=DE-1000:GOTO 1020 +1021 IF DE >=999 AND M<=2 THEN R$=R$+"IM":DE=DE-999:M=M+1 +1022 IF DE >=995 AND M<=2 THEN R$=R$+"VM":DE=DE-995:M=M+1 +1023 IF DE >=990 AND M<=2 THEN R$=R$+"XM":DE=DE-990:M=M+1 +1024 IF DE >=950 AND M<=2 THEN R$=R$+"LM":DE=DE-950:M=M+1 +1025 IF DE >=900 AND M<=2 THEN R$=R$+"CM":DE=DE-900:M=M+1 +1026 IF DE >=500 AND D<=2 THEN R$=R$+"D":DE=DE-500:D=D+1:GOTO 1025 +1027 IF DE >=499 AND D<=2 THEN R$=R$+"ID":DE=DE-499:D=D+1 +1028 IF DE >=495 AND D<=2 THEN R$=R$+"VD":DE=DE-495:D=D+1 +1029 IF DE >=490 AND D<=2 THEN R$=R$+"XD":DE=DE-490:D=D+1 +1030 IF DE >=100 AND C<=2 THEN R$=R$+"C":DE=DE-100:C=C+1:GOTO 1030 +1031 IF DE >=99 AND C<=2 THEN R$=R$+"IC":DE=DE-99:C=C+1 +1032 IF DE >=95 AND C<=2 THEN R$=R$+"VC":DE=DE-95:C=C+1 +1033 IF DE >=90 AND C<=2 THEN R$=R$+"XC":DE=DE-90:C=C+1 +1035 IF DE >=50 AND L<=2 THEN R$=R$+"L":DE=DE-50: L=L+1:GOTO 1035 +1036 IF DE >=49 AND L<=2 THEN R$=R$+"IL":DE=DE-49:L=L+1 +1037 IF DE >=45 AND L<=2 THEN R$=R$+"VL":DE=DE-45:L=L+1 +1038 IF DE >=40 AND L<=2 THEN R$=R$+"XL":DE=DE-40:L=L+1 +1040 IF DE >=10 AND X<=2 THEN R$=R$+"X":DE=DE-10: X=X+1:GOTO 1040 +1041 IF DE >=9 AND X<=2 THEN R$=R$+"IX":DE=DE-9:X=X+1 +1045 IF DE >=5 AND V<=2 THEN R$=R$+"V":DE=DE-5: V=V+1:GOTO 1045 +1046 IF DE >=4 AND V<=2 THEN R$=R$+"IV":DE=DE-4:V=V+1 +1050 IF DE >=1 THEN R$=R$+"I":DE=DE-1:GOTO 1050 +1060 COLOR 14:L=LEN(R$):LO=(80-(L*2))/2:A$="":B$="":C$="":D$="":E$="" +1061 LOCATE 12,LO:PRINT A$;:FOR I=1 TO L*2+1:PRINT E$;:NEXT :PRINT B$ +1062 LOCATE 13,LO:PRINT " ";:COLOR 28:FOR I=1 TO L:PRINT MID$(R$,I,1)+" ";:NEXT :COLOR 14:PRINT " +1063 LOCATE 14,LO:PRINT C$;:FOR I=1 TO L*2+1:PRINT E$;:NEXT :PRINT D$ +1064 COLOR 2 + \ No newline at end of file diff --git a/DATABASE.BAS b/DATABASE.BAS new file mode 100644 index 0000000..c1e2953 --- /dev/null +++ b/DATABASE.BAS @@ -0,0 +1,468 @@ +10 REM ************************************************************************* +20 REM ** Programme de stockage de produits + tri + recherche ** +30 REM ** Achev le 21/08/1989 N4 Ver 1.1 ** +40 REM ** De DARCHE Yoann Tel 69-39-51-26 ** +50 REM ************************************************************************* +60 GOSUB 4460 +70 SCREEN 2:SCREEN 0:CLS:CLEAR:KEY OFF +80 KEY 10,CHR$(219)+CHR$(13) +90 ON ERROR GOTO 4180 +100 COLOR 13 +110 R$="":F$="":U$="":PRINT "UNITE UTILISEE : (A-B-C) " +120 A$=INKEY$:IF A$="" THEN 120 +130 IF A$="a" OR A$="A" THEN U$="A:" +140 IF A$=CHR$(27) THEN 560 +150 IF A$="b" OR A$="B" THEN U$="B:" +160 IF A$="c" OR A$="C" THEN U$="C:":GOTO 190 +170 IF U$="" THEN COLOR 30:BEEP:PRINT A$;" n'est pas une unite ... ":COLOR 13:GOTO 110 +180 GOTO 240 +190 PRINT:PRINT +200 COLOR 2:INPUT "Quelle repertoire (sans les /) ";R$ +210 IF LEN(R$)>8 THEN BEEP:COLOR 30:PRINT "trop long ....":GOTO 200 +220 IF R$="" THEN 240 +230 U$=U$+"/"+R$+"/" +240 COLOR 4:INPUT "Nom du fichier ",F$ +250 U$=U$+F$ +260 PRINT:PRINT +270 COLOR 10:PRINT "Nom d'acces = ";U$ +280 COLOR 14:PRINT " Oui ou Non" +290 A$=INKEY$:IF A$="" THEN 290 +300 IF A$="n" OR A$="N" THEN 70 +310 IF A$="o" OR A$="O" THEN 330 +320 BEEP:GOTO 290 +330 OPEN "I",#1,U$ +340 COLOR 15:IF EOF(1) THEN PRINT "NOUVEAU FICHIER ...." ELSE 370 +350 CLOSE:COLOR 11 +360 FOR U=1 TO 1000:NEXT +370 CLOSE:DIM N!(500),N$(500),C$(500),C!(500),T$(500),D!(500),P!(500),E$(500),L$(500),D$(500),R(50) +380 H=0:CLS:REM ====================================== debut PROGRAMME ============ +390 OPEN "I",#1,U$ +400 IF EOF(1) THEN 450 +410 H=H+1 +420 INPUT #1,N$,N$(H),C$(H),C$,T$(H),D$,P$,E$(H),L$(H),D$(H) +430 N!(H)=VAL(N$):C!(H)=VAL(C$):D!(H)=VAL(D$):P!(H)=VAL(P$) +440 GOTO 400 +450 CLOSE +460 PRINT "Il y a";H;"produits enregistrs ":A$=INPUT$(1) +470 COLOR 11,0:CLS +480 LOCATE 11,9:PRINT "Ŀ" +490 LOCATE 12,9:PRINT " ";:COLOR 14,6:PRINT "-1- Listing -2- Modifications -3- recherches -ESC- Fin";:COLOR 11,0:PRINT " Ŀ" +500 LOCATE 13,9:PRINT " " +510 LOCATE 14,12:PRINT "" +520 A$=INKEY$:IF A$="" THEN 520 +530 IF A$="1" OR A$="&" THEN 590 +540 IF A$="2" OR A$="`" OR A$="" THEN 1990 +550 IF A$=CHR$(39) OR A$="3" THEN 3350 +560 IF A$=CHR$(27) THEN CLS:CLEAR:PRINT :PRINT "SALUT ....... Programme de DARCHE Yoann 1989 ...... ":END +570 GOTO 520 +580 END:REM ******************************************** Listing ************** +590 CLS +600 COLOR 4:LOCATE 1,35:PRINT ""+STRING$(14,196)+"" +610 LOCATE 2,33:PRINT ""+STRING$(12,196)+" " +620 LOCATE 3,33:PRINT " ";:COLOR 11,1:PRINT "LES LISTINGS";:COLOR 4,0:PRINT " " +630 LOCATE 4,33:PRINT "";STRING$(14,196);"" +640 COLOR 9:LOCATE 9,31:PRINT "";STRING$(16,196);"":FOR I=1 TO 5:LOCATE ,31:PRINT "";:LOCATE ,48:PRINT "":NEXT :LOCATE ,31:PRINT "";STRING$(16,196);"" +650 COLOR 13:LOCATE 10,33:PRINT "-1- TOUT " +660 LOCATE 12,33:PRINT "-2- INTERVAL" +670 LOCATE 14,33:PRINT "-3- CONDITION" +680 LOCATE 25,1:COLOR 14,6:PRINT " pour retour au menu principal MENU DES LISTINGS ";:COLOR 10,0:LOCATE 10 +690 A$=INKEY$:IF A$="" THEN 690 +700 IF A$="1" OR A$="&" THEN 760 +710 IF A$="2" OR A$="" THEN 970 +720 IF A$="3" THEN 1320 +730 IF A$=CHR$(27) GOTO 470 +740 BEEP:GOTO 690 +750 REM ....................................................................... +760 COLOR 10:GOSUB 1920 +770 IF H<=20 THEN 780 ELSE 840 +780 FOR I=1 TO H:LOCATE 3+I,1:PRINT " "; +790 LOCATE I+3,2:PRINT N!(I):LOCATE I+3,11:PRINT N$(I):LOCATE I+3,15:PRINT C$(I) +800 LOCATE I+3,19:PRINT C!(I):LOCATE I+3,27:PRINT T$(I):LOCATE I+3,37:PRINT D!(I):LOCATE I+3,51:FE=I:GOSUB 1950:PRINT P$ +810 FE=I:GOSUB 4190:LOCATE I+3,44:PRINT VA:LOCATE I+3,54:PRINT E$(I):LOCATE I+3,57:PRINT L$(I):LOCATE I+3,65:PRINT D$(I):NEXT +820 LOCATE I+3,1:PRINT "" +830 A$=INPUT$(1):GOTO 590 +840 LM=INT(H/21)+1:Z=0:LOCATE 25,1:COLOR 14,6:PRINT " MENU des LISTINGS : TOUT FIN ";+CHR$(24)+" "+CHR$(25)+" ";:COLOR 10,0 +850 FOR I=1+(20*Z) TO 20+(20*Z):W=I-(Z*20) +860 LOCATE W+3,1:PRINT " "; +870 LOCATE W+3,2:PRINT N!(I):LOCATE W+3,11:PRINT N$(I):LOCATE W+3,15:PRINT C$(I) +880 LOCATE W+3,19:PRINT C!(I):LOCATE W+3,27:PRINT T$(I):LOCATE W+3,37:PRINT D!(I):LOCATE W+3,51:FE=I:GOSUB 1950:PRINT P$ +890 FE=I:GOSUB 4190:LOCATE W+3,44:PRINT VA:LOCATE W+3,54:PRINT E$(I):LOCATE W+3,57:PRINT L$(I):LOCATE W+3,65:PRINT D$(I):NEXT +900 LOCATE W+4,1:PRINT "";:LOCATE 1,1 +910 A$=INKEY$:IF A$="" THEN 910 +920 IF A$=CHR$(27) GOTO 590 +930 IF A$="2" OR A$="`" OR A$=CHR$(0)+"P" THEN Z=Z-1:IF Z<0 THEN Z=LM-1:GOTO 850 ELSE 850 +940 IF A$="8" OR A$="~" OR A$=CHR$(0)+"H" THEN Z=Z+1:IF Z>LM-1 THEN Z=0:GOTO 850 ELSE 850 +950 BEEP:GOTO 910 +960 REM ............................................... interval .............. +970 COLOR 3:CLS:INPUT " Depart (1 pour debut 0 pour retour ) ",DE +980 IF DE=0 THEN 590 +990 INPUT " FIN ( 1 pour fin 0 pour retour ) ",AR +1000 IF AR=0 THEN 590 +1010 IF DE=1 AND AR=1 THEN BEEP:PRINT "vous tes illogique il y a l'option 1 du menu LISTING pour obtenir tout la liste":A$=INPUT$(1):GOTO 760 +1020 IF DE=AR THEN 1810 +1030 IF DE<0 OR AR<0 THEN BEEP :PRINT"chiffre ngatif ... ":A$=INPUT$(1):GOTO 970 +1040 IF DE>=N!(H) THEN I=H:GOTO 1850 +1050 IF AR>=N!(H) THEN AR=1 +1060 IF DE<=N!(1) THEN DE=1 +1070 IF DE=1 THEN 1120 +1080 IF DE=AR AND DE=1 THEN 1010 +1090 FOR I=1 TO H +1100 IF DE<=N!(I) THEN DE=I:GOTO 1120 +1110 NEXT I +1120 IF AR=1 THEN AR=H:GOTO 1160 +1130 FOR I=1 TO H +1140 IF AR<=N!(I) THEN AR=I:GOTO 1160 +1150 NEXT I +1160 GOSUB 1920 +1170 T=AR-DE+1:DE=DE-1 +1180 LM=INT(T/21)+1:Z=0:LOCATE 25,1:COLOR 14,6:PRINT " MENU des LISTINGS : INTERVAL ... FIN ";+CHR$(24)+" "+CHR$(25)+" ";:COLOR 12,0 +1190 FOR I=1+(20*Z) TO 20+(20*Z):W=I-(Z*20) +1200 LOCATE W+3,1:PRINT " "; +1210 LOCATE W+3,2:PRINT N!(I+DE):LOCATE W+3,11:PRINT N$(I+DE):LOCATE W+3,15:PRINT C$(I+DE) +1220 LOCATE W+3,19:PRINT C!(I+DE):LOCATE W+3,27:PRINT T$(I+DE):LOCATE W+3,37:PRINT D!(I+DE):LOCATE W+3,51:FE=I+DE:GOSUB 1950:PRINT P$ +1230 FE=I+DE:GOSUB 4190:LOCATE W+3,44:PRINT VA:LOCATE W+3,54:PRINT E$(I+DE):LOCATE W+3,57:PRINT L$(I+DE):LOCATE W+3,65:PRINT D$(I+DE) +1240 IF I>=T THEN 1250 ELSE NEXT I +1250 LOCATE W+4,1:PRINT "";:LOCATE 1,1 +1260 A$=INKEY$:IF A$="" THEN 1260 +1270 IF A$=CHR$(27) GOTO 590 +1280 IF A$="2" OR A$="`" OR A$=CHR$(0)+"P" THEN CLS:GOSUB 1920:GOSUB 1970 :Z=Z-1:IF Z<0 THEN Z=LM-1:GOTO 1190 ELSE 1190 +1290 IF A$="8" OR A$="~" OR A$=CHR$(0)+"H" THEN CLS:GOSUB 1920:GOSUB 1970:Z=Z+1:IF Z>LM-1 THEN Z=0:GOTO 850 ELSE 850 +1300 BEEP:GOTO 1260 +1310 REM ....................................................................... +1320 CLS:LOCATE 25,1:COLOR 14,6:PRINT " <*> pour retour LISTING A CONDITIONS .... ";:COLOR 13,0:LOCATE 5,1 +1330 INPUT "INITIAL DE LOT .. ",C$ +1340 IF C$="$" OR C$="*" THEN 590 +1350 INPUT "DOSE ............ ",D$ +1360 IF D$="$" OR D$="*" THEN 590 ELSE D!=VAL(D$) +1370 INPUT "% ............... ",P$ +1380 IF P$="$" OR P$="*" THEN 590 ELSE P!=VAL(P$) +1390 INPUT " 1 protec 2 actif ",H$ +1400 IF H$="$" OR H$="*" THEN 590 +1410 IF H$="1" THEN U=-1 ELSE U=1 +1420 IF H$="" THEN U=0 +1430 INPUT "ANIMAL R/S/G .... ",E$ +1440 IF E$="*" OR E$="$" THEN 590 +1450 INPUT "DATE MINIMAL .... ",DM$ +1460 IF DM$="*" OR DM$="$" THEN 590 +1470 D1=VAL(DM$) +1480 INPUT "DATE MAXIMAL .... ",DM$ +1490 IF DM$="*" OR DM$="$" THEN 590 +1500 D2=VAL(DM$) +1510 CLS:PRINT "PATIENTEZ ............" +1520 IF P$="" THEN P!=-1 +1530 IF P!=0 THEN P!=.001 +1540 R(1)=0:O=0:FOR I=1 TO H +1550 IF C$<>"" THEN IF C$<>C$(I) THEN GOTO 1660 +1560 IF D!<>0 THEN IF D!<>D!(I) THEN 1660 +1570 IF P!<>-1 THEN IF P!<>ABS(P!(I)) THEN 1660 +1580 IF U <> 0 THEN 1590 ELSE 1610 +1590 IF U=1 THEN IF P!(I)<0 THEN 1660 +1600 IF U=-1 THEN IF P!(I)>0 THEN 1660 +1610 IF E$<>"" THEN IF E$<>E$(I) THEN 1660 +1620 IF D1<>0 THEN 1650 +1630 DA$=MID$(D$(I),3,2):D0=VAL(DA$) +1640 IF D0D2 THEN 1660 +1650 O=O+1:R(O)=I +1660 NEXT I:IF R(1)=0 THEN PRINT "desol aucun produit ne correspond ...":A$=INPUT$(1):GOTO 590 +1670 COLOR 12:GOSUB 1920 +1680 LM=INT(O/21)+1:Z=0:LOCATE 25,1:COLOR 14,6:PRINT " MENU des LISTINGS : CONDITION FIN ";+CHR$(24)+" "+CHR$(25)+" ";:COLOR 12,0 +1690 FOR I=1+(20*Z) TO 20+(20*Z):W=I-(Z*20):M=R(I) +1700 LOCATE W+3,1:PRINT " "; +1710 LOCATE W+3,2:PRINT N!(M):LOCATE W+3,11:PRINT N$(M):LOCATE W+3,15:PRINT C$(M) +1720 LOCATE W+3,19:PRINT C!(M):LOCATE W+3,27:PRINT T$(M):LOCATE W+3,37:PRINT D!(M):LOCATE W+3,51:FE=M:GOSUB 1950:PRINT P$ +1730 FE=M:GOSUB 4190:LOCATE W+3,44:PRINT VA:LOCATE W+3,54:PRINT E$(M):LOCATE W+3,57:PRINT L$(M):LOCATE W+3,65:PRINT D$(M) +1740 IF I>=O THEN 1750 ELSE NEXT I +1750 LOCATE W+4,1:PRINT "";:LOCATE 1,1 +1760 A$=INKEY$:IF A$="" THEN 1760 +1770 IF A$=CHR$(27) GOTO 590 +1780 IF A$="2" OR A$="`" OR A$=CHR$(0)+"P" THEN CLS:GOSUB 1920:GOSUB 1970 :Z=Z-1:IF Z<0 THEN Z=LM-1:GOTO 1690 ELSE 1690 +1790 IF A$="8" OR A$="~" OR A$=CHR$(0)+"H" THEN CLS:GOSUB 1920:GOSUB 1970:Z=Z+1:IF Z>LM-1 THEN Z=0:GOTO 1690 ELSE 1690 +1800 BEEP:GOTO 1760 +1810 FOR I=1 TO H +1820 IF N!(I)=AR THEN 1850 +1830 NEXT I +1840 BEEP:PRINT "AUCUN NUMERO ENREGITRE CORESPOND ....":A$=INPUT$(1):GOTO 590 +1850 CLS:GOSUB 1920 +1860 LOCATE 4,1:PRINT " "; +1870 LOCATE 4,2:PRINT N!(I):LOCATE 4,11:PRINT N$(I):LOCATE 4,15:PRINT C$(I) +1880 LOCATE 4,19:PRINT C!(I):LOCATE 4,27:PRINT T$(I):LOCATE 4,37:PRINT D!(I):LOCATE 4,51:FE=I:GOSUB 1950:PRINT P$ +1890 FE=I:GOSUB 4190:LOCATE 4,44:PRINT VA:LOCATE 4,54:PRINT E$(I):LOCATE 4,57:PRINT L$(I):LOCATE 4,65:PRINT D$(I) +1900 LOCATE 5,1:PRINT "" +1910 A$=INPUT$(1):GOTO 590 +1920 COLOR 12,0:CLS:PRINT "Ŀ" +1930 PRINT "Numero LOTN LOT TEST DOSE % ANIN TEST DATE " +1940 PRINT "Ĵ":RETURN +1950 IF P!(FE)<0 THEN P$="P" ELSE P$="A" +1960 FE=0:RETURN +1970 LOCATE 25,1:COLOR 14,6:PRINT " MENU des LISTINGS : INTERVAL ... FIN ";+CHR$(24)+" "+CHR$(25)+" ";:COLOR 12,0:RETURN +1980 END:REM ******************************************** Modification ******** +1990 CLS:COLOR 13 +2000 LOCATE 1,24:PRINT ""+STRING$(34,196)+"" +2010 LOCATE 2,24:PRINT " Menu de MODIFICATION des donnes " +2020 LOCATE 3,24:PRINT ""+STRING$(34,196)+"" +2030 COLOR 9:LOCATE 9,31:PRINT "";STRING$(16,196);"":FOR I=1 TO 5:LOCATE ,31:PRINT "";:LOCATE ,48:PRINT "":NEXT :LOCATE ,31:PRINT "";STRING$(16,196);"" +2040 COLOR 10:LOCATE 10,33:PRINT "-1- CORRECTION" +2050 LOCATE 12,33:PRINT "-2- EFFACE" +2060 LOCATE 14,33:PRINT "-3- AJOUTE" +2070 LOCATE 25,1:COLOR 14,6:PRINT " pour retour au menu principal MENU DE MODIFICATIONS ";:COLOR 10,0:LOCATE 10 +2080 A$=INKEY$:IF A$="" THEN 2080 +2090 IF A$=CHR$(27) GOTO 470 +2100 IF A$="1" OR A$="&" THEN 2150 +2110 IF A$="2" OR A$="" THEN 2660 +2120 IF A$="3" THEN 2990 +2130 BEEP:GOTO 2080 +2140 REM ................................ correction .......................... +2150 COLOR 10,0:CLS +2160 LOCATE 25,1:COLOR 14,6:PRINT " Menu MODIFICATION : Correction pour abondont "; +2170 LOCATE 2,1:COLOR 10,0 +2180 INPUT "N du produit .......",V$ +2190 IF V$=CHR$(219) THEN 1990 +2200 INPUT "Suffixe du produit ..",W$ +2210 IF W$=CHR$(219) THEN 1990 +2220 CLS:LOCATE 12,10:PRINT " ----- PATIENTEZ ----- " +2230 R=0:T=0:FOR I=1 TO H +2240 IF N!(I)=VAL(V$) AND N$(I)=W$ THEN R=I +2250 IF N!(I)=VAL(V$) THEN T=T+1:R(T)=I +2260 NEXT:CLS +2270 IF R=0 THEN PRINT "Je n'est pas trouv ..." +2280 IF R<>0 THEN 2350 +2290 IF T=0 THEN PRINT "Mais rien du tout .... " +2300 IF T<>0 THEN 2310 ELSE A$=INPUT$(1):GOTO 1990 +2310 FOR I=1 TO T:PRINT "-";I;N!(R(I));N$(R(I));" ";C$(R(I));C!(R(I));" ";L$(R(I));" ";D$(R(I)):NEXT I +2320 INPUT "> (0 pour fin) quel est votre choix pour la modification >> ",CH +2330 IF CH>T THEN BEEP ELSE IF CH=0 THEN 1990 +2340 CH=R(CH):GOTO 2360 +2350 PRINT N!(R);N$(R);" ";C$(R);C!(R);" ";L$(R);" ";D$(R):PRINT "EST BIEN CECI Oui ou Non":A$=INPUT$(1):IF A$="n" OR A$="N" THEN 1990 ELSE CH=R +2360 CLS:LOCATE 25,1:COLOR 14,6:PRINT " Menu de MODIFICATIONS : Correction pour abandon "; +2370 LOCATE 2,1:COLOR 2,0 +2380 PRINT "-1 : N du PRODUIT.......";N!(CH) +2390 PRINT "-2 : Suffixe du produit.. ";N$(CH) +2400 PRINT "-3 : INITIALES LOT....... ";C$(CH) +2410 PRINT "-4 : N de lot...........";C!(CH) +2420 PRINT "-5 : TEST................ ";T$(CH) +2430 PRINT "-6 : Dose................";D!(CH) +2440 FE=CH:GOSUB 4190:PRINT "-7 : %...................";VA +2450 PRINT "-8 : ACTIF ou PROTECTEUR. ";:IF P!(CH)<0 THEN PRINT "P" ELSE PRINT "A" +2460 PRINT "-9 : Annimal (S-R-G)..... ";E$(CH) +2470 PRINT "-0 : N de l'essai....... ";L$(CH) +2480 PRINT "-A : DATE................ ";D$(CH) +2490 PRINT :PRINT " Votre rubrique modifier ... " +2500 A$=INKEY$:IF A$="" THEN 2500 +2510 IF A$="a" OR A$="A" THEN INPUT "Nouvelle DATE : ",D$(CH):GOTO 2360 +2520 IF A$=CHR$(27) THEN GOTO 1990 ELSE IF A$=CHR$(13) THEN GOSUB 4250:GOTO 1990 +2530 ON VAL(A$)+1 GOSUB 2540,2550,2560,2570,2580,2590,2600,2610,2620,2630:GOTO 2360 +2540 INPUT "N de l'essai.... ",L$(CH):RETURN +2550 INPUT "N du PRODUIT.... ",N!(CH):RETURN +2560 INPUT "Nouveau suffixe.. ",N$(CH):RETURN +2570 INPUT "Initial lot ..... ",C$(CH):RETURN +2580 INPUT "N de lot........ ",C!(CH):RETURN +2590 INPUT "TEST............. ",T$(CH):RETURN +2600 INPUT "DOSE............. ",D!(CH):RETURN +2610 INPUT "%................ ",VA:FE=CH:GOSUB 4210:RETURN +2620 P!(CH)=-P!(CH):RETURN +2630 PRINT "Animal........... ":A$=INPUT$(1):IF A$="r" OR A$="R" THEN E$(CH)="R":RETURN ELSE IF A$="s" OR A$="S" THEN E$(CH)="S":RETURN ELSE E$(CH)="G":RETURN +2640 PRINT "-9 : N de l'essai.......";T$(CH) +2650 REM ................................ effacer ............................. +2660 CLS:COLOR 14,6:LOCATE 25,1:PRINT " MODIFICATIONS : EFFACER DES DONNEES = ABANDON et RETOUR " +2670 COLOR 13,0:LOCATE 2 +2680 INPUT "Numero du produit ..... ",V$ +2690 IF V$=CHR$(219) THEN 1990 ELSE CI!=VAL(V$) +2700 INPUT "Suffixe du produit .... ",V$ +2710 IF V$=CHR$(219) THEN 1990 +2720 CLS +2730 LOCATE 12,10:COLOR 30:PRINT " ---------- PATIENTEZ -----------" +2740 COLOR 13 +2750 R=0:FOR I=1 TO H +2760 IF N!(I)=CI! AND N$(I)=V$ THEN R=I:I=H +2770 NEXT I +2780 IF R<>0 THEN 2820 +2790 T=0:FOR I=1 TO H +2800 IF N!(I)=CI! THEN T=T+1:R(T)=I +2810 NEXT I +2820 CLS +2830 COLOR 13,0:LOCATE 2 +2840 IF R=0 THEN PRINT "Je n'ai pas trouv mais voici des ressenblants.." +2850 IF R<>0 THEN PRINT "J'ai trouv : Est bien celui-ci O/N ":PRINT :PRINT N!(R);N$(R);" ";C$(R);C!(R);" ";T$(R);" ";L$(R);" ";D$(R) +2860 IF T<>0 THEN 2880 +2870 GOTO 2890 +2880 FOR I=1 TO T:PRINT I;" ";N!(R(I));N$(R(I));" ";C$(R(I));C!(R(I));" ";T$(R(I));" ";L$(R(I));" ";D$(R(I)):NEXT I:PRINT:INPUT " ==> lequel (0) pour rien ",C +2890 IF T<>0 AND C=0 THEN 1990 +2900 IF R<>0 THEN C$=INPUT$(1) +2910 IF R<>0 AND (C$="n" OR C$="N") THEN 1990 +2920 IF R<>0 AND (C$="o" OR C$="O") THEN CI=R:GOTO 2950 +2930 IF T<>0 AND C<>0 THEN CI=R(ABS(C)):GOTO 2950 +2940 GOTO 1990 +2950 FOR I=CI TO H +2960 N!(I)=N!(I+1):N$(I)=N$(I+1):C$(I)=C$(I+1):C!(I)=C!(I+1):T$(I)=T$(I+1):D!(I)=D!(I+1):P!(I)=P!(I+1):E$(I)=E$(I+1):L$(I)=L$(I+1):D$(I)=D$(I+1) +2970 NEXT :H=H-1:GOSUB 4390 :GOTO 1990 +2980 REM ................................ ajouter .............................. +2990 CLS:COLOR 14,6:LOCATE 25,1:PRINT " MODIFICATIONS : AJOUTER DES DONNEES = ABANDON et RETOUR " +3000 COLOR 10,0 +3010 P=H +3020 H=H+1:LOCATE 5,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "Numero du PRODUIT .. ",V$ +3030 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE N!(H)=VAL(V$) +3040 LOCATE 6,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "suffixe du PRODUIT . ",V$ +3050 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE N$(H)=V$ +3060 LOCATE 7,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "initiales du PRODUIT ",V$ +3070 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE C$(H)=V$ +3080 LOCATE 8,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "N de LOT .......... ",V$ +3090 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE C!(H)=VAL(V$) +3100 LOCATE 9,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "TEST ............... ",V$ +3110 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE T$(H)=V$ +3120 LOCATE 10,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "Dose ............... ",V$ +3130 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE D!(H)=VAL(V$) +3140 LOCATE 11,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "% .................. ",V$ +3150 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE FE=H:VA=VAL(V$):GOSUB 4210 +3160 LOCATE 12,2:PRINT "(A)ctif (P)rotection ":A$=INPUT$(1) +3170 IF A$=CHR$(219) THEN H=P:GOTO 1990 +3180 IF A$="p" OR A$="P" THEN P!(H)=-P!(H):LOCATE 12,23:PRINT "P" ELSE LOCATE 12,23:PRINT "A" +3190 LOCATE 13,2:PRINT "(R)at (S)ouris (G).":A$=INPUT$(1) +3200 IF A$=CHR$(219) THEN H=P:GOTO 1990 +3210 IF A$="r" OR A$="R" THEN E$(H)="R" +3220 IF A$="s" OR A$="S" THEN E$(H)="S" ELSE IF E$(H)="" THEN E$(H)="G" +3230 LOCATE 13,23:PRINT E$(H) +3240 LOCATE 14,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "N de l'ESSAI.......",V$ +3250 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE L$(H)=V$ +3260 LOCATE 15,2:PRINT SPACE$(70);:LOCATE ,2:INPUT "DATE ................",V$ +3270 IF V$=CHR$(219) THEN H=P:GOTO 1990 ELSE D$(H)=V$ +3280 LOCATE 17,10 :BEEP:PRINT " ENCORE O/N ...":A$=INPUT$(1) +3290 IF A$="o" OR A$="O" OR A$=CHR$(13) THEN 3020 +3300 IF A$="n" OR A$="N" THEN 3320 +3310 GOTO 3280 +3320 GOSUB 4250 +3330 GOTO 1990 +3340 END:REM ******************************************** Recherches ********** +3350 COLOR 12,0:CLS +3360 LOCATE 1,29:PRINT ""+STRING$(19,196)+"" +3370 LOCATE 2,29:PRINT " ";:COLOR 11,1:PRINT "MENU DE RECHERCHE";:COLOR 12,0:PRINT " "+CHR$(195)+CHR$(196)+CHR$(191) +3380 LOCATE 3,29:PRINT ""+STRING$(17,196)+" " +3390 LOCATE 4,31:PRINT ""+STRING$(19,196)+"" +3400 LOCATE 25,1:COLOR 14,6:PRINT "MENU RECHERCHE pour QUITER ";:LOCATE 5,1:COLOR 10,0 +3410 PRINT +3420 INPUT "INITIAL DU LOT ... ",C$ +3430 IF C$=CHR$(219) THEN 470 +3440 INPUT "DOSE ............ ",D$ +3450 IF D$=CHR$(219) THEN 470 +3460 M$=D$:GOSUB 4040:D1=V1:D2=V2 +3470 INPUT "% ................ ",P$ +3480 IF P$=CHR$(219) THEN 470 +3490 M$=P$:GOSUB 4040:P1=V1:P2=V2 +3500 PRINT "

ROT CTIF .. "; +3510 A$=INPUT$(1):IF A$=CHR$(219) THEN 470 +3520 IF A$<>"p" AND A$<>"a" AND A$<>"P" AND A$<>"a" AND A$<>" " THEN BEEP:GOTO 3510 +3530 IF A$="P" OR A$="p" THEN U=-1 ELSE IF A$<>" " THEN U=1 ELSE U=0 +3540 PRINT A$ +3550 PRINT "Animal ........... "; +3560 A$=INPUT$(1):IF A$=CHR$(219) THEN 470 +3570 IF A$<>"R" AND A$<>" " AND A$<>"r" AND A$<>"G" AND A$<>"g" AND A$<>"s" AND A$<>"S" THEN BEEP:GOTO 3560 +3580 IF A$="R" OR A$="r" THEN E$="R" +3590 IF A$="S" OR A$="s" THEN E$="S" +3600 IF A$="G" OR A$="g" THEN E$="G" +3610 IF A$=" " THEN E$="" +3620 IF E$<>"" THEN PRINT E$ ELSE PRINT "TOUS" +3630 INPUT "MOIS MINI ........ ",DT$ +3640 IF DT$=CHR$(219) THEN 470 +3650 DM=VAL(DT$) +3660 INPUT "MOIS MAXI ........ ",DT$ +3670 IF DT$=CHR$(219) THEN 470 +3680 DB=VAL(DT$) +3690 CLS:PRINT :PRINT ".................... PATIENTEZ ................................................." +3700 R(1)=0:O=0:FOR I=1 TO H +3710 IF C$<>"" THEN IF C$<>C$(I) THEN 3880 +3720 IF D1=-1 AND D2=-1 THEN 3750 +3730 IF D1<>-1 THEN IF D!-1 THEN IF D!>D2 THEN 3880 +3750 IF P1=-1 AND P2=-1 THEN 3800 +3760 IF P1=0 THEN P1=.001 +3770 IF P1<>-1 THEN IF ABS(P!(I))-1 THEN IF ABS(P!(I))>P2 THEN 3880 +3800 IF U=0 THEN 3830 +3810 IF U=1 THEN IF P!(I)<0 THEN 3880 +3820 IF U=-1 THEN IF P!(I)>0 THEN 3880 +3830 IF E$<>"" THEN IF E$<>E$(I) THEN 3880 +3840 DA$=MID$(D$(I),3,2):D0=VAL(DA$) +3850 IF DM<>0 THEN IF D00 THEN IF D0>DB THEN 3880 +3870 O=O+1:R(O)=I +3880 NEXT I:IF R(1)=0 THEN PRINT "Desol aucun produit ne correpond ...":A$=INPUT$(1):GOTO 470 +3890 COLOR 12 +3900 GOSUB 1920 +3910 LM=INT(O/21)+1:Z=0:LOCATE 25,1:COLOR 14,6:PRINT " MENU des RECHERCHES A CONDITION FIN ";+CHR$(24)+" "+CHR$(25)+" ";:COLOR 12,0 +3920 FOR I=1+(20*Z) TO 20+(20*Z):W=I-(Z*20):M=R(I) +3930 LOCATE W+3,1:PRINT " "; +3940 LOCATE W+3,2:PRINT N!(M):LOCATE W+3,11:PRINT N$(M):LOCATE W+3,15:PRINT C$(M) +3950 LOCATE W+3,19:PRINT C!(M):LOCATE W+3,27:PRINT T$(M):LOCATE W+3,37:PRINT D!(M):LOCATE W+3,51:FE=M:GOSUB 1950:PRINT P$ +3960 FE=M:GOSUB 4190:LOCATE W+3,44:PRINT VA:LOCATE W+3,54:PRINT E$(M):LOCATE W+3,57:PRINT L$(M):LOCATE W+3,65:PRINT D$(M) +3970 IF I>=O THEN 3980 ELSE NEXT I +3980 LOCATE W+4,1:PRINT "";:LOCATE 1,1 +3990 A$=INKEY$:IF A$="" THEN 3990 +4000 IF A$=CHR$(27) GOTO 470 +4010 IF A$="2" OR A$="`" OR A$=CHR$(0)+"P" THEN CLS:GOSUB 1920:GOSUB 1970 :Z=Z-1:IF Z<0 THEN Z=LM-1:GOTO 3920 ELSE 3920 +4020 IF A$="8" OR A$="~" OR A$=CHR$(0)+"H" THEN CLS:GOSUB 1920:GOSUB 1970:Z=Z+1:IF Z>LM-1 THEN Z=0:GOTO 3920 ELSE 3920 +4030 BEEP:GOTO 3990 +4040 LM=LEN(M$) +4050 FOR I=1 TO LM +4060 VM$=MID$(M$,I,1):IF VM$="-" THEN 4090 +4070 V1$=V1$+VM$ +4080 NEXT I +4090 V1=VAL(V1$) +4100 FOR U=I+1 TO LM +4110 V2$=V2$+MID$(M$,U,1):NEXT U +4120 V2=VAL(V2$):IF V1=0 THEN V1=-1 +4130 IF V2=0 THEN V2=-1 +4140 IF V2=V1 AND V1=-1 THEN 4160 +4150 IF V2-1 THEN BEEP:PRINT "VALEUR MAXIMAL INFERIEUR A LA VALEUR MINIMAL !!! JE VAIS LES MODIFIER..":V=V1:V1=V2:V2=V:V=0 +4160 RETURN +4170 END +4180 CLOSE:OPEN "O",#1,U$:CLOSE:RESUME +4190 IF ABS(P!(FE))=.001 THEN FE=0:VA=0:RETURN +4200 VA=ABS(P!(FE)):FE=0:RETURN +4210 IF VA=0 THEN VA=.001 +4220 IF P!(VA)<0 THEN K=-1 ELSE K=1 +4230 P!(FE)=K*VA:K=0:FE=0:RETURN +4240 REM -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= SOUS PROG DE TRIAGE =-=-=-=-=-=-= +4250 FOR I=1 TO H +4260 FOR J=I+1 TO H +4270 IF N!(I)>> Entrez l ! >>> :",DA$ +160 ' ===================== ROUTINE =================================== +170 V$="":K%=0 +180 I%=1:WHILE K%<3 +190 WHILE INSTR("/-. ",MID$(DA$,I%,1))=0 AND I%<>LEN(DA$)+1 +200 V$=V$+MID$(DA$,I%,1) +210 I%=I%+1 +220 WEND +230 K%=K%+1:I%=I%+1 +240 S%(K%)=VAL(V$):V$="" +250 WEND +260 D1%=S%(1)+S%(2)*100 +270 D2%=S%(3) +280 IF D2%<1000 OR S%(1)<0 OR S%(1) > 31 OR S%(2) >12 OR S%(2) < 1 THEN PRINT "erreur dans l'entre de la date !!! vrifier ... ":GOTO 150 +290 PRINT " D1% =";D1% +300 PRINT " D2% =";D2% +310 ' vrification +320 PRINT "la date est :"; +330 M%=INT(D1%/100) +340 J%=D1%-M%*100 +350 PRINT J%;"/";M%;"/";D2% +% =";D2% +310 ' vr \ No newline at end of file diff --git a/DE50.BAS b/DE50.BAS new file mode 100644 index 0000000..3b234ee --- /dev/null +++ b/DE50.BAS @@ -0,0 +1,114 @@ +0 SCREEN 2:SCREEN 0,0,0 +11 COLOR 7,0:PRINT :PRINT +12 PRINT " Une CREATION de DARCHE YOANN" +15 LOCATE 6,33:PRINT "Edition " +16 PRINT +17 LOCATE ,15:PRINT " " +18 LOCATE ,15:PRINT " " +19 LOCATE ,15:PRINT " " +20 LOCATE ,15:PRINT " " +21 LOCATE ,15:PRINT " " +22 LOCATE ,15:PRINT " " +23 LOCATE ,15:PRINT " " +24 PRINT +25 LOCATE ,28:PRINT " " +26 LOCATE ,28:PRINT " " +27 LOCATE ,28:PRINT " " +28 LOCATE ,28:PRINT " " +29 LOCATE ,28:PRINT " " +999 A$=INPUT$(1) +1000 SCREEN 2:SCREEN 0,0,0 +1010 CLS:KEY OFF +1020 PRINT :PRINT " LITCHFIELD et WILCOXON" +1030 PRINT +1040 INPUT "Produit : ",PRODUIT$ +1050 INPUT "Voie : ",VOIE$ +1060 INPUT "Prventif: ",PREVE$ +1070 INPUT "Espce : ",ESPE$ +1080 INPUT "DATE : ",DAT$ +1090 INPUT "TEST : ",TEST$ +1100 CLS +1110 PRINT :PRINT " LITCHFIELD et WILCOXON" +1120 PRINT :PRINT +1130 K=1:DIM D(20,3) +1134 IF K>=16 THEN 1200 +1135 LOCATE 10:PRINT "TEST n";K +1140 LOCATE 11:INPUT "Dose mg/kg :",D(K,1) +1150 LOCATE 12:INPUT "Nombre d'animaux :",D(K,2) +1160 LOCATE 13:INPUT "% Rel :",D(K,3) +1170 LOCATE 14:PRINT " ENCORE O/N ":A$=INPUT$(1) +1180 IF A$="n" OR A$="N" THEN 1190 ELSE K=K+1:GOTO 1134 +1190 GOSUB 4000 +1200 FOR I=1 TO K :N=N+D(I,2):NEXT +1210 FOR I=1 TO K:Y=Y+D(I,3):NEXT +1220 FOR I=1 TO K:X=X+D(I,1):NEXT +1230 FOR I=1 TO K:XY=XY+(D(I,1)*D(I,3)):NEXT +1240 FOR I=1 TO K:X2=X2+(D(I,1)^2):NEXT +1250 FOR I=1 TO K:Y2=Y2+(D(I,3)^2):NEXT +1260 B=(K*XY-X*Y)/(K*X2-X^2) +1270 A=(Y-B*X)/K +1280 POI=(16-A)/B:GOSUB 60000:D16=POI +1290 POI=(50-A)/B:GOSUB 60000:D50=POI +1291 POI=(84-A)/B:GOSUB 60000:D84=POI +1300 S=(D84/D50+D50/D16)/2:POI=S:GOSUB 60000:S=POI +1301 FOR I=1 TO K +1310 IF D(I,3)>=16 AND D(I,3)<=84 THEN N1=N1+D(I,2) +1320 NEXT +1330 POI=SQR(N1):GOSUB 60000:N2=POI:POI=2.77/N2:GOSUB 60000:EX=POI:POI=S^EX:GOSUB 60000:F=POI +1410 POI=D50/F:GOSUB 60000:LCI=POI:POI=D50*F:GOSUB 60000:LCS=POI +1420 CLS:COLOR 13 +1430 PRINT " LITCHFIELD et WILCOXON" +1440 PRINT +1500 LOCATE 3,1:PRINT "Produit :";PRODUIT$ +1510 LOCATE 4,1:PRINT "Voie :";VOIE$ +1520 LOCATE 5,1:PRINT "Preventif:";PREVE$ +1530 LOCATE 6,1:PRINT "Espce :";ESPE$ +1540 LOCATE 6,40:PRINT "TEST :";TEST$ +1550 LOCATE 3,40:PRINT "DATE :";DAT$ +1560 LOCATE 8,1:PRINT " Dose en mg/kg Nombre d'animaux Pourcentage ":VIEW PRINT 9 TO 25 +1570 LOCATE 18,1 +1571 PRINT " D16 D50 D84 S EX F" +1572 LOCATE 19,6:PRINT D16;:LOCATE ,18:PRINT D50;:LOCATE ,30:PRINT D84;:LOCATE ,40:PRINT S;:LOCATE ,48:PRINT EX;:LOCATE ,57:PRINT F +1573 LOCATE 20,1:PRINT "-------------------------------------------------------------------------------" +1574 LOCATE 21,1:PRINT " LCI DE50 LCS " +1575 LOCATE 22,21:PRINT LCI:LOCATE 22,38:PRINT D50:LOCATE 22,53:PRINT LCS +1576 LOCATE 23,1:PRINT "-------------------------------------------------------------------------------" +1580 LOCATE 9:VIEW PRINT 9 TO 17:FOR I=1 TO K:LOCATE ,2:PRINT D(I,1);:LOCATE ,24:PRINT D(I,2);:LOCATE ,50:PRINT D(I,3):NEXT +1999 A$=INPUT$(1):CLS +2000 PRINT :PRINT " X ESTIME POUR Y DONNE ET INVERSE " +2010 PRINT :PRINT +2011 PRINT " 1- Y DONNE 2- X DONNE":A$=INPUT$(1) +2012 IF A$="1" THEN 3000 ELSE 2020 +2020 INPUT " DOSE ",DX +2030 RE=A+DX*B:PRINT "Estimation ...>>>:";RE +2040 PRINT :PRINT "Encore [O/N]..":A$=INPUT$(1) +2050 IF A$="n" OR A$="N" THEN 2060 ELSE CLS:GOTO 2000 +2060 PRINT " eprise du programme ou bandon ....!!! ":A$=INPUT$(1) +2070 IF A$="r" OR A$="R" THEN RUN +2080 IF A$<>"a" AND A$<>"A" THEN BEEP:GOTO 2060 ELSE 50000 +3000 INPUT " POURCENTAGE : ",DX +3010 RE=(DX-A)/B:PRINT "Estimation ...>>>:";RE +3020 PRINT :PRINT "Encore [O/N]..":A$=INPUT$(1) +3030 IF A$="n" OR A$="N" THEN 2060 ELSE CLS:GOTO 2000 +4000 CLS +4010 PRINT " Correction ." +4015 PRINT " Y / X"," 1"," 2"," 3" +4020 FOR I=1 TO K +4030 PRINT I,D(I,1),D(I,2),D(I,3):NEXT +4040 PRINT " Correct O/N":A$=INPUT$(1) +4050 IF A$="o" OR A$="O" THEN RETURN +4060 INPUT " X,Y :",X,Y +4065 PRINT "Ancienne Valeur :";D(Y,X) +4070 INPUT "Nouvelle Valeur : ",VA +4080 D(Y,X)=VA :X=0:Y=0:VA=0:GOTO 4000 +50000 VIEW PRINT:CLS +50010 PRINT "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" +50020 PRINT " save ,p +59999 REM NEW +60000 FX$=STR$(POI):FX=INT(POI):FX1$=STR$(FX) +60010 LO=LEN(FX$) +60020 FX$=RIGHT$(FX$,LO-1) +60030 LO1=LEN(FX1$):FX1$=RIGHT$(FX1$,LO1-1):LO=LEN(FX$):LO1=LEN(FX1$) +60040 FX$=LEFT$(FX$,LO-(LO-2*LO1-2)) +60050 POI=VAL(FX$):LO=0:LO1=0:FX$="":FX1$="":FX=0:RETURN + \ No newline at end of file diff --git a/DE50B.BAS b/DE50B.BAS new file mode 100644 index 0000000..6805f20 --- /dev/null +++ b/DE50B.BAS @@ -0,0 +1,119 @@ +0 SCREEN 2:SCREEN 0,0,0:KEY OFF:COLOR 14:CLS +10 LK#=.4342944758723107# +12 PRINT " Une CREATION de DARCHE YOANN" +15 LOCATE 6,33:PRINT "Edition " +16 PRINT +17 LOCATE ,15:PRINT " " +18 LOCATE ,15:PRINT " " +19 LOCATE ,15:PRINT " " +20 LOCATE ,15:PRINT " " +21 LOCATE ,15:PRINT " " +22 LOCATE ,15:PRINT " " +23 LOCATE ,15:PRINT " " +24 PRINT +25 LOCATE ,28:PRINT " " +26 LOCATE ,28:PRINT " " +27 LOCATE ,28:PRINT " " +28 LOCATE ,28:PRINT " " +29 LOCATE ,28:PRINT " " +999 A$=INPUT$(1) +1000 SCREEN 2:SCREEN 0,0,0 +1010 COLOR 10:CLS:KEY OFF +1020 PRINT :PRINT " LITCHFIELD et WILCOXON" +1030 PRINT +1040 INPUT "Produit : ",PRODUIT$ +1050 INPUT "Voie : ",VOIE$ +1060 INPUT "Prventif: ",PREVE$ +1070 INPUT "Espce : ",ESPE$ +1080 INPUT "DATE : ",DAT$ +1090 INPUT "TEST : ",TEST$ +1100 CLS +1110 PRINT :PRINT " LITCHFIELD et WILCOXON" +1120 PRINT :PRINT +1130 K=1:DIM D(20,3) +1134 IF K>=16 THEN 1200 +1135 LOCATE 10:PRINT "TEST n";K +1136 LOCATE 11:PRINT SPACE$(40) +1140 LOCATE 11:INPUT "Dose mg/kg :",D:POI=LOG(D)*LK#:GOSUB 60000:D(K,1)=W +1146 COLOR 12:LOCATE 11:PRINT SPACE$(40) +1150 LOCATE 12:INPUT "Nombre d'animaux :",D(K,2) +1156 COLOR 13:LOCATE 13:PRINT SPACE$(40) +1160 LOCATE 13:INPUT "% Rel :",D(K,3) +1170 LOCATE 14:PRINT " ENCORE O/N ":A$=INPUT$(1) +1180 IF A$="n" OR A$="N" THEN 1190 ELSE K=K+1:GOTO 1134 +1190 GOSUB 4000 +1200 FOR I=1 TO K :N=N+D(I,2):NEXT +1210 FOR I=1 TO K:Y=Y+D(I,3):NEXT +1220 FOR I=1 TO K:X=X+D(I,1):NEXT +1230 FOR I=1 TO K:XY=XY+(D(I,1)*D(I,3)):NEXT +1240 FOR I=1 TO K:X2=X2+(D(I,1)^2):NEXT +1250 FOR I=1 TO K:Y2=Y2+(D(I,3)^2):NEXT +1260 B=(K*XY-X*Y)/(K*X2-X^2) +1270 A=(Y-B*X)/K +1280 Q=(16-A)/B:GOSUB 40000:D16=W:W=0 +1290 Q=(50-A)/B:GOSUB 40000:D50=W:W=0 +1291 Q=(84-A)/B:GOSUB 40000:D84=W:W=0 +1300 S=(D84/D50+D50/D16)/2:POI=S:GOSUB 60000:S=POI +1301 FOR I=1 TO K +1310 IF D(I,3)>=16 AND D(I,3)<=84 THEN N1=N1+D(I,2) +1320 NEXT +1330 POI=SQR(N1):GOSUB 60000:N2=POI:POI=2.77/N2:GOSUB 60000:EX=POI:POI=S^EX:GOSUB 60000:F=POI +1410 POI=D50/F:GOSUB 60000:LCI=POI:POI=D50*F:GOSUB 60000:LCS=POI +1420 CLS:COLOR 13 +1430 PRINT " LITCHFIELD et WILCOXON" +1440 PRINT +1500 LOCATE 3,1:PRINT "Produit :";PRODUIT$ +1510 LOCATE 4,1:PRINT "Voie :";VOIE$ +1520 LOCATE 5,1:PRINT "Preventif:";PREVE$ +1530 LOCATE 6,1:PRINT "Espce :";ESPE$ +1540 LOCATE 6,40:PRINT "TEST :";TEST$ +1550 LOCATE 3,40:PRINT "DATE :";DAT$ +1560 LOCATE 8,1:PRINT " Dose en mg/kg Nombre d'animaux Pourcentage " +1570 LOCATE 18,1 +1571 PRINT " D16 D50 D84 S EX F" +1572 LOCATE 19,6:PRINT D16;:LOCATE ,18:PRINT D50;:LOCATE ,30:PRINT D84;:LOCATE ,40:PRINT S;:LOCATE ,48:PRINT EX;:LOCATE ,57:PRINT F +1573 LOCATE 20,1:PRINT "-------------------------------------------------------------------------------" +1574 LOCATE 21,1:PRINT " LCI DE50 LCS " +1575 LOCATE 22,21:PRINT LCI:LOCATE 22,38:PRINT D50:LOCATE 22,53:PRINT LCS +1576 LOCATE 23,1:PRINT "-------------------------------------------------------------------------------" +1580 LOCATE 9:FOR I=1 TO K:LOCATE ,2:PRINT D(I,1);:LOCATE ,24:PRINT D(I,2);:LOCATE ,50:PRINT D(I,3):NEXT +1999 A$=INPUT$(1):CLS +2000 PRINT :PRINT " X ESTIME POUR Y DONNE ET INVERSE " +2010 PRINT :PRINT +2011 PRINT " 1- Y DONNE 2- X DONNE":A$=INPUT$(1) +2012 IF A$="1" THEN 3000 ELSE 2020 +2020 INPUT " DOSE ",DX:POI=LOG(DX)*LK#:GOSUB 60000:DX=POI +2030 RE=A+DX*B:PRINT "Estimation ...>>>:";RE +2040 PRINT :PRINT "Encore [O/N]..":A$=INPUT$(1) +2050 IF A$="n" OR A$="N" THEN 2060 ELSE CLS:GOTO 2000 +2060 PRINT " eprise du programme ou bandon ....!!! ":A$=INPUT$(1) +2070 IF A$="r" OR A$="R" THEN RUN +2080 IF A$<>"a" AND A$<>"A" THEN BEEP:GOTO 2060 ELSE 50000 +3000 INPUT " POURCENTAGE : ",DX +3010 RE=(DX-A)/B:Q=RE:GOSUB 40000:RE=W:PRINT "Estimation ...>>>:";RE +3020 PRINT :PRINT "Encore [O/N]..":A$=INPUT$(1) +3030 IF A$="n" OR A$="N" THEN 2060 ELSE CLS:GOTO 2000 +4000 CLS +4010 PRINT " Correction ." +4015 PRINT " Y / X"," 1"," 2"," 3" +4020 FOR I=1 TO K +4030 PRINT I,D(I,1),D(I,2),D(I,3):NEXT +4040 PRINT " Correct O/N":A$=INPUT$(1) +4050 IF A$="o" OR A$="O" THEN RETURN +4060 INPUT " X,Y :",X,Y +4065 PRINT "Ancienne Valeur :";D(Y,X) +4070 INPUT "Nouvelle Valeur : ",VA +4080 D(Y,X)=VA :X=0:Y=0:VA=0:GOTO 4000 +40000 POI=10^Q:GOSUB 60000:RETURN +50000 CLS +50010 PRINT "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" +50020 PRINT " save ,p +59999 REM NEW +60000 W=POI:IF W=INT(W) THEN RETURN +60010 F1$=STR$(W):W1=INT(W):F2$=STR$(W1) +60020 F1=LEN(F1$):F2=LEN(F2$) +60030 F1$=RIGHT$(F1$,F1-1):F2$=RIGHT$(F2$,F2-1) +60040 IF F2$<>"0" THEN F1$=RIGHT$(F1$,F1-(1+F2)) ELSE F1$=RIGHT$(F1$,F1-2) +60050 F1$=LEFT$(F1$,2):F$=F2$+"."+F1$:W=VAL(F$):POI=W:F1$="":F2$="":F$="":F1=0:F2=0 +60060 RETURN + \ No newline at end of file diff --git a/DE51.BAS b/DE51.BAS new file mode 100644 index 0000000..004a79d --- /dev/null +++ b/DE51.BAS @@ -0,0 +1,139 @@ +0 B$="Ŀ" +1 CB$=" " +2 CC$=" CALCUL DE LA DE 50 PAR LA METHODE DES TOTAUX CUMULATIFS " +3 CD$=" Ŀ " +4 CE$=" PAR DARCHE YOANN ÿ " +5 CF$=" ٳ " +6 CG$=" " +7 REM +8 CH$=" PG : 3 Production : Helciziem " +9 REM +10 C$="" +11 CLS:KEY OFF:COLOR 13 +12 D$="":PRINT STRING$(80,176):PRINT STRING$(80,176) +13 PRINT D$;B$;D$ +14 PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;CB$;D$ +15 PRINT D$;CC$;D$ +16 PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;CB$;D$ +17 PRINT D$;CD$;D$:PRINT D$;CE$;D$:PRINT D$;CF$;D$:PRINT D$;CG$;D$ +18 PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;CB$;D$ +19 PRINT D$;CH$;D$ +20 PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;CB$;D$:PRINT D$;C$;D$; +21 LOCATE 25,1:PRINT STRING$(80,176); +22 LOCATE 24,1:PRINT STRING$(80,176); +23 LOCATE 21,23:COLOR 15:PRINT " FIN autre touche pour SUITE " +24 A$=INPUT$(1):IF A$=CHR$(27) THEN END +25 COLOR 13:CLS +999 REM +1000 F$="|--------|------------|------------|-----|-----|--------------|------|" +1001 PRINT F$ +1003 H$="| | | | | | | |" +1005 PRINT "| DOSE | Animaux + | Animaux - | C + | C - | R C+/C- + C+ | % |" +1006 PRINT F$ +1008 GOSUB 60000 +1009 DIM DO(8,ND) +1010 LOCATE 4,1:FOR O=1 TO ND +1015 PRINT H$:NEXT:PRINT F$ +1020 LOCATE 4,1:PCOPY 0,1 +1030 GOSUB 60400 +1060 A$=INKEY$:IF A$=CHR$(27) THEN END +1061 IF A$="" THEN 1060 +1062 IF A$="E" OR A$="e" THEN LOCATE 25,1:COLOR 15:PRINT "EDITION: FIN pour changer la dose 8 4 6 2 ou ";CHR$(24);" ";CHR$(25);" ";CHR$(26);" ";CHR$(27);" <%> calcule %";:GOSUB 60200:LOCATE 25,1:PRINT SPACE$(80); +1070 IF A$="I" OR A$="i" THEN LOCATE 25,1:PRINT SPACE$(80);:LCOPY:GOTO 1060 +1080 IF A$="c" OR A$="C" THEN 2010 +1998 COLOR 14:LOCATE 25,1:PRINT " diter mprimer alcule la DE50 fin "; +1999 GOTO 1060 +2000 REM ****************** CALCULE DE LA DE50 ********************************* +2010 PCOPY 0,2:GX=1E+10 +2020 IF TEST=0 THEN LOCATE 12,20:COLOR 0,7:BEEP:PRINT "FAITES UN CALCULE DES POURCENTAGES puid <%>":COLOR 13,0:A$=INPUT$(1):PCOPY 2,0:GOTO 1060 +2030 FOR I=1 TO ND +2031 IF DO(8,I)>PX AND DO(8,I)<50 THEN PX=DO(8,I):P=I +2032 IF DO(8,I)50 THEN GX=DO(8,I):G=I +2033 NEXT I +2034 GNBA=DO(2,G)+DO(3,G) +2035 PNBA=DO(2,P)+DO(3,P) +2040 LOCATE 23,10:PRINT "(";PNBA;"+";GNBA;") x":LOCATE 22,24:PRINT " 50 -";PX +2050 LOCATE 23,24:PRINT "" +2060 LOCATE 24,24:PRINT GX;"-";PX; +2070 V=(PNBA+GNBA)*(50-PX)/(GX-PX) +2080 LOCATE 23,39:PRINT " = ";V;" ";TDOSE$:PCOPY 0,1:GOTO 1060 +59999 STOP:REM ***************************************************************** +60000 PCOPY 0,1:LOCATE 11,10:PRINT "Ŀ" +60010 LOCATE 12,10:PRINT " Nombre de dose : " +60020 LOCATE 13,10:PRINT "" +60030 X=29:Y=12:V=1:GOSUB 60100 +60039 PCOPY 1,0:ND=VAL(G$):G$="" +60040 IF ND>=16 OR ND<=0 THEN BEEP:GOTO 60000 ELSE RETURN +60049 REM ********************************************************************** +60050 K=LEN(M$):Q=INT((L-K)/2):M$=STRING$(Q," ")+M$+STRING$(Q," ") +60051 IF (L-K)/2 <> Q THEN M$=M$+" " +60052 RETURN +60099 REM ********************************************************************** +60100 A$=INKEY$:IF A$=CHR$(27) THEN RETURN ELSE IF A$="" THEN 60100 +60110 IF LEN(A$)>1 THEN 60120 ELSE 60130 +60120 IF A$=CHR$(0)+"K" OR A$="4" THEN G$=LEFT$(G$,LEN(G$)-1):GOTO 60100 +60125 GOTO 60100 +60130 IF A$=CHR$(13) THEN 60150 +60140 G$=G$+A$:LOCATE Y,X:PRINT G$;:GOTO 60100 +60150 IF V=1 THEN IF VAL(G$)=0 AND G$<>"0" THEN G$="":BEEP:GOTO 60100 ELSE RETURN +60160 RETURN +60199 REM ********************************************************************** +60200 LX=2:LY=1:A(1)=2:A(2)=11:A(3)=24:FX=11:FY=4:L=12:M$=STR$(DO(LX,LY)):GOSUB 60050:L$=M$:B(1)=8:B(2)=12:B(3)=12:LOCATE FY,FX:COLOR 15:PRINT M$ +60210 A$=INKEY$:IF A$=CHR$(27) THEN LOCATE FY+3,FX:COLOR 13:PRINT L$:RETURN ELSE IF A$="" THEN 60210 +60220 IF (A$=CHR$(0)+"H" OR A$="8") AND LY>=2 THEN LY=LY-1 +60230 IF (A$=CHR$(0)+"P" OR A$="2") AND LY<=ND-1 THEN LY=LY+1 +60240 IF (A$=CHR$(0)+"M" OR A$="6") AND LX<=2 THEN LX=LX+1 +60250 IF (A$=CHR$(0)+"K" OR A$="4") AND LX>=2 THEN LX=LX-1 +60255 IF A$="" OR A$="%" THEN GOSUB 60500:GOTO 60270 +60260 IF A$="D" OR A$="d" THEN GOSUB 60410 +60270 IF A$=CHR$(13) OR A$=" " THEN 60300 +60280 COLOR 13:LOCATE FY+3,FX:PRINT L$:COLOR 15:LOCATE 3+LY,A(LX):L=B(LX):M$=STR$(DO(LX,LY)):GOSUB 60050:PRINT M$:L$=M$:FX=A(LX):FY=LY +60290 PCOPY 0,1:GOTO 60210 +60300 PCOPY 0,1:PCOPY 0,2 +60310 COLOR 14:LOCATE 10,20:PRINT "Ŀ" +60312 LOCATE 11,20:PRINT " ANCIENNE VALEUR : " +60314 LOCATE 12,20:PRINT " NOUVELLE VALEUR : " +60316 LOCATE 13,20:PRINT "" +60318 COLOR 15:LOCATE 11,40:PRINT DO(LX,LY); +60319 X=41:Y=12:V=1:GOSUB 60100 +60320 IF VAL(G$)=DO(LX,LY) THEN G$="":PCOPY 2,0:GOTO 60290 +60330 DO(LX,LY)=VAL(G$):G$="" +60340 IF LX=1 THEN GOSUB 60400 +60342 IF LX=2 THEN GOSUB 60350:GOSUB 60400 +60343 IF LX=3 THEN GOSUB 60370:GOSUB 60400 +60344 M$=STR$(DO(LX,LY)):L=B(LX):GOSUB 60050:LOCATE LY+3,A(LX):COLOR 15:PRINT M$:L$=M$:GOTO 60290 +60349 REM *********************** C + ****************************************** +60350 IO=0:FOR I=1 TO ND +60351 IO=IO+DO(2,I):DO(4,I)=IO:DO(6,I)=IO:DO(7,I)=DO(5,I)+IO:NEXT:RETURN +60369 REM *********************** C - ****************************************** +60370 IO=0:FOR I=ND TO 1 STEP -1 +60371 IO=IO+DO(3,I):DO(5,I)=IO:DO(7,I)=DO(6,I)+IO:NEXT:RETURN +60399 REM *************** AFFICHE DONNEES ************************************** +60400 PCOPY 1,0:COLOR 13:LOCATE 4,1:FOR O=1 TO ND +60401 M$=STR$(DO(1,O)):L=8:GOSUB 60050:LOCATE ,2:PRINT M$; +60402 M$=STR$(DO(2,O)):L=12:GOSUB 60050:LOCATE ,11:PRINT M$; +60403 M$=STR$(DO(3,O)):L=12:GOSUB 60050:LOCATE ,24:PRINT M$; +60404 M$=STR$(DO(4,O)):L=5:GOSUB 60050:LOCATE ,37:PRINT M$; +60405 M$=STR$(DO(5,O)):L=5:GOSUB 60050:LOCATE ,43:PRINT M$; +60406 M$=STR$(DO(6,O))+"/"+STR$(DO(7,O)):L=14:GOSUB 60050:LOCATE ,49:PRINT M$; +60407 M$=STR$(DO(8,O)):L=6:GOSUB 60050:LOCATE ,64:PRINT M$ +60408 NEXT:PCOPY 0,1:RETURN +60409 REM ************************** DOSE ************************************** +60410 IF TDOSE$="" THEN TDOSE$="DOSE" +60420 PCOPY 0,1 +60430 LOCATE 10,11:PRINT "Ŀ" +60440 LOCATE 11,11:PRINT " Ancien titre : " +60450 LOCATE 12,11:PRINT " Nouveau titre : " +60455 LOCATE 13,11:PRINT "" +60460 LOCATE 11,28:PRINT TDOSE$ +60470 LOCATE 12,28:INPUT "",TD$:IF TD$<>"" THEN TDOSE$=TD$ +60480 IF LEN(TDOSE$)>8 THEN BEEP:PRINT :PRINT "TROP LONG !!!!":TDOSE$="DOSE":GOTO 60455 +60490 PCOPY 1,0:M$=TDOSE$:L=8:GOSUB 60050:COLOR 13:LOCATE 2,2:PRINT M$:PCOPY 0,1:RETURN +60499 REM ***************************** % ************************************** +60500 PCOPY 0,1:ER=0:FOR O=1 TO ND +60510 IF DO(7,O)=0 THEN ER=ER+1:DO(8,O)=0:GOTO 60530 +60520 DO(8,O)=INT(DO(6,O)/DO(7,O)*1000)/10 +60530 NEXT +60531 IF ER>=1 THEN LOCATE 20,15:COLOR 0,7:PRINT ER;" CALCULE(S) IMPOSSIBLE(S) [DIVISION PAR 0] ":COLOR 13,0:A$=INPUT$(1):PCOPY 1,0 ELSE TEST=1 +60532 GOSUB 60400:PCOPY 0,1:RETURN + \ No newline at end of file diff --git a/DECOMPO.BAS b/DECOMPO.BAS new file mode 100644 index 0000000..c95a525 Binary files /dev/null and b/DECOMPO.BAS differ diff --git a/DESSIN.3D b/DESSIN.3D new file mode 100644 index 0000000..77b11a4 Binary files /dev/null and b/DESSIN.3D differ diff --git a/DESSIN.BAS b/DESSIN.BAS new file mode 100644 index 0000000..34a9e82 --- /dev/null +++ b/DESSIN.BAS @@ -0,0 +1,63 @@ + + +x%=160:y%=100:c%=1 +screen 1 + +debut : + +a$=inkey$ +if a$="6" and x%<319 then x%=x%+1 +if a$="4" and x%>0 then x%=x%-1 +if a$="8" and y%>0 then y%=y%-1 +if a$="2" and y%<199 then y%=y%+1 +if a$=" " or a$=chr$(13) then pset(x%,y%),c%:ac%=c% +if a$="S" or a$="s" then goto sauve +if a$="L" or a$="l" then goto rapel +if a$="p" or a$="P" then goto peint +if a$="c" or a$="C" then goto couleur +if a$="r" or a$="R" then goto rond +if x%=ax% and y%=ay% then goto debut + +pset(ax%,ay%),ac% +ac%=point(x%,y%):pset(x%,y%),c%:ax%=x%:ay%=y% +line (0,0)-(319,199),0,b +goto debut + +sauve : +def seg=&hb800 +s$=input$(1) +Bsave "b:IMAGE.DA"+s$,0,16384 +sa%=1 +goto debut + +rapel : +if sa%=0 then line(0,0)-(319,199),1,b:a$=input$(1):if a$="q" or a$="Q" then goto debut +cls +INPUT "Nom de l'image",n$ +def seg=&hb800 +bload n$ +sa%=0 +goto debut + +peint : +line (0,0)-(319,199),2,b +co%=1:a$=input$(1) +if a$="A" or a$="a" then co%=1 +if a$="z" or a$="Z" then co%=2 +if a$="e" or a$="E" then co%=3 +pset (x%,y%),0:paint(x%,y%),co%,c%:ac%=co% +goto debut + +couleur : +a$=input$(1) +if a$="a" or a$="A" then c%=1 +if a$="z" or a$="Z" then c%=2 +if a$="e" or a$="E" then c%=3 +goto debut + +rond : +line (0,0)-(319,199),2,b +a$=input$(2) +circle (x%,y%),val(a$),c% +goto debut + \ No newline at end of file diff --git a/DUNNETT.BAS b/DUNNETT.BAS new file mode 100644 index 0000000..a8949c3 Binary files /dev/null and b/DUNNETT.BAS differ diff --git a/DUNNETT2.BAS b/DUNNETT2.BAS new file mode 100644 index 0000000..76d7d71 Binary files /dev/null and b/DUNNETT2.BAS differ diff --git a/ECHELLE.BAS b/ECHELLE.BAS new file mode 100644 index 0000000..e7bd695 Binary files /dev/null and b/ECHELLE.BAS differ diff --git a/ECRITURE.BAS b/ECRITURE.BAS new file mode 100644 index 0000000..978a6fb --- /dev/null +++ b/ECRITURE.BAS @@ -0,0 +1,358 @@ +1000 ' +1010 ' +1020 ' +1030 ' +1040 ' +1050 ' +1060 ' +1070 ' +1080 ' +1090 ' +1100 '========================================================================== +1110 ' DEBUT +1120 '========================================================================== +1130 DIM ALPHA(255,14):SCREEN 2:KEY OFF:CLS:GOSUB 2380 +1140 DEF SEG:FO=0:CO=7:C$="-":N$="":S$="N":L1=1:H1=1:GOSUB 2930 +1145 IF FO=0 AND CO=7 THEN SCR=2:SCREEN 2:CLS ELSE SCR=1:SCREEN 1:CLS +1150 ON ERROR GOTO 2920:GOSUB 2840:FO=POINT(319-(SCR=2)*320,199):GOTO 1210 +1160 PAINT (1,1),FO:GOSUB 2760:GOTO 1210 +1170 '-------------------------------------------------------------------------- +1180 TRAITEMENT ET CORRECTION DES PARAMTRES +1190 '-------------------------------------------------------------------------- +1200 GOSUB 2930::SCREEN SCR:CLS:GOSUB 2840:FLAG=0 +1210 X2=X:Y2=Y:SN=SIN(A):CS=COS(A):L1=L:H1=H:FLAG=FLAG+1:A2=A +1220 IF ABS(DX)>=L THEN DX=SGN(DX)*(L-1) +1230 IF ABS(DY)>=H THEN DY=SGN(DY)*(H-1) +1240 IF IX<>0 THEN IX=1*SGN(IX) +1250 IF IY<>0 THEN IY=1*SGN(IY) +1260 IF P<>0 THEN P=P/ABS(P):IF FLAG=2 THEN 1280 +1270 IF P=1 THEN L=1:H=1:GOTO 1210 ELSE IF P=1 THEN L=LEN(A$):H=L:GOTO 1210 +1280 IF P1<>0 THEN P1=1 +1290 IF E<>0 THEN E=1 +1300 FLAG=1:PL=0:D=1:CO=CO+(CO=FO):IF CO=0 THEN CO=8 +1310 '========================================================================== +1320 ' PROGRAMME PRINCIPAL +1330 '========================================================================== +1340 FOR K=1 TO LEN(A$) +1350 IF P>0 THEN L=L1*K*P:H=H1*K*P +1360 IF P<0 THEN L=L1/LEN(A$)*(LEN(A$)-K+1):H=H1/LEN(A$)*(LEN(A$)-K+1) +1370 CA=ASC(MID$(A$,K,1)) +1380 FOR J=0 TO 7:J1=J*H*SN:J2=J*H*CS:I1=IX*J +1390 IF P1=1 THEN GOSUB 1600 +1400 V=ALPHA(CA,(J+1)*FLAG+8*PL) +1410 IF D=2 THEN GOSUB 2080 +1420 FOR C=1 TO 8:C1=(C-1)*L*CS:C2=(C-1)*L*SN:I2=IY*C +1430 Z=INT (2^(8-C)) +1440 IF V>=Z THEN GOSUB 1950 ELSE 1450 +1450 NEXT C +1460 NEXT J +1470 ON D GOSUB 2140,2260 +1480 NEXT K +1490 IF S$="O" OR S$="o" THEN 1730 +1500 GOSUB 2760:SCREEN 0,0:WIDTH 80 +1510 COLOR 7,2:CLS:COLOR 7,1:FOR I=11 TO 15:LOCATE I,26:PRINT SPACE$(30):NEXT I +1520 LOCATE 13,30:PRINT "Autre texte ( O ou N )";:T$="" +1530 T$=INKEY$:IF T$="" THEN 1530 +1540 IF T$="o" OR T$="O" THEN 1200 ELSE IF T$<>"n" AND T$<>"N" THEN 1520 +1550 SCREEN SCR:CLS:GOSUB 2840:T$="" +1560 T$=INKEY$:IF T$="" THEN 1560 ELSE SCREEN 0,0:CLS:END +1570 '========================================================================== +1580 ' Effacement pour priorit +1590 '========================================================================== +1600 FOR C=1 TO 8:C1=(C-1)*L*CS:C2=(C-1)*L*SN:I2=IY*C +1610 FOR S=0 TO L-1:FOR T=0 TO H-1 +1620 X1=C1-J1+S*CS-T*SN+I1+X+S*DX*CS-T*DY*SN +1630 X1=INT((X1-INT(X1))*10/5+INT(X1)) +1640 Y1=C2+J2+S*SN+T*CS+I2+Y+S*DX*SN+T*DY*CS +1650 Y1=INT((Y1-INT(Y1))*10/5+INT(Y1)) +1660 PSET (X1,Y1),FO*(1-E)+CO*P1 +1670 NEXT T,S,C:RETURN +1680 '========================================================================== +1690 ' Paramtres pour symtries +1700 '-------------------------------------------------------------------------- +1710 ' symtrie polaire +1720 '-------------------------------------------------------------------------- +1730 S$="N":IF C$="o" OR C$="O" THEN A=A+3.14:SN=SIN(A):CS=COS(A) +1740 IF P<>0 THEN L=L1:H=H1 +1750 IF C$<>"O" OR C$<>"o" THEN 1820 +1760 X=X2+(16*H-1)*SN+(2*L+1)*CS:Y=Y2-(16*H-1)*CS+(2*L+1)*SN +1770 X=INT((X-INT(X))*10/5+INT(X)) +1780 Y=INT((Y-INT(Y))*10/(+INT(Y)):GOTO 1340 +1790 '-------------------------------------------------------------------------- +1800 ' Symtrie par X +1810 '-------------------------------------------------------------------------- +1820 FLAG=-1:PL=1:X=X2-8*H*SN:Y=Y2+8*H*CS +1830 X=INT((X-INT(X))*10/5+INT(X)) +1840 Y=INT((Y-INT(Y))*10/5+INT(Y)) +1850 IF C$="X" OR C$="x" THEN 1340 +1860 '-------------------------------------------------------------------------- +1870 ' Symtrie par Y +1880 '-------------------------------------------------------------------------- +1890 X=X2-8*L*CS:Y=Y2-8*L*SN:D=2:FLAG=1:PL=0 +1900 X=INT((X-INT(X))*10/5+INT(X)) +1910 Y=INT((Y-INT(Y))*10/5+INT(Y)):GOTO 1340 +1920 '========================================================================== +1930 ' Ecriture +1940 '========================================================================== +1950 FOR S=0 TO L-1:FOR T=0 TO H-1 +1960 X1=C1-J1+S*CS-T*SN+I1+X+S*DX*CS-T*DY*SN +1970 X1=INT((X1-INT(X1))*10/5+INT(X1)) +1980 Y1=C2+J2+S*SN+T*CS+I2+Y+S*DX*SN+T*DY*CS +1990 Y1=INT((Y1-INT(Y1))*10/5+INT(Y1)) +2000 Z$=STR$(X1):W$=STR$(Y1) +2010 DRAW"B M"+Z$+","+W$:B=POINT(X1,Y1):IF B<>E*FO THEN 1980 +2020 PSET (X1,Y1),CO*(1-E)+FO*E +2030 NEXT T,S +2040 V=V-Z:RETURN +2050 '========================================================================== +2060 ' Carractre pour symtrie Y +2070 '========================================================================== +2080 V1=0:FOR C=1 TO 8 +2090 Z=INT(2^(8-C)):IF V>=Z THEN V1=V1+INT(2^(C-1)):V=V-Z +2100 NEXT C:V=V1:RETURN +2110 '========================================================================== +2120 ' Calcul des Coordonnes +2130 '========================================================================== +2140 IF P=0 THEN X=8*L*CS+X+EX +2150 IF P>0 THEN X=8*L*CS+X+ABS(P-PL)*8*H1*SN+EX +2160 IF P<0 THEN X=8*L*CS+X-(ABS(P)-PL)*8*SN+EX +2170 IF P=0 THEN Y=8*L*SN+Y+EY +2180 IF P>0 THEN Y=8*L*SN+Y-ABS(P-PL)*8*H1*CS+EY +2190 IF P<0 THEN Y=8*L*SN+Y+ABS(P)-PL)*8*CS+EY +2200 X=INT((X-INT(X))*10/5+INT(X)) +2210 Y=INT((Y-INT(Y))*10/5+INT(Y)) +2220 RETURN +2230 '========================================================================== +2240 ' Calcul des coordonnes pour symtrie Y +2250 '========================================================================== +2260 IF P=0 THEN X=-8*L*CS+X-EX +2270 IF P>0 THEN X=-8*(L+1)*CS+X+ABS(P-PL)*8*H1*SN-EX +2280 IF P<0 THEN X=-8*(L-1)*CS+X-(ABS(P)-PL)*8*SN-EX +2290 IF P=0 THEN Y=-8*L*SN+Y+EY-SN +2300 IF P>0 THEN Y=-8*(L+1)*SN+Y-ABS(P-PL)*8*H1*CS+EY +2310 IF P<0 THEN Y=-8*(L-1)*SN+Y+(ABS(P)-PL)*8*CS+EY +2320 X=INT((X-INT(X))*10/5+INT(X)) +2330 Y=INT((Y-INT(Y))*10/5+INT(Y)) +2340 RETURN +2350 '========================================================================== +2360 ' POLICE DE CARACTERES +2370 '========================================================================== +2380 FOR I=1 TO 255:IF I=7 THEN I=8 ELSE IF I=9 THEN I=14 ELSE IF I=28 THEN I=32 +2390 PRINT CHR$(I); +2400 NEXT I:LOCATE 14,30:PRINT " P A T I E N T E Z " +2410 DEF SEG=&HB800 +2420 ADRESSE=0:CURSEUR=0 +2430 FOR I=1 TO 255:IF I=7 THEN I=8 ELSE IF I=9 THEN I=14 ELSE IF I=28 THEN I=32 +2440 FOR J=1 TO 8 STEP 2 +2450 ALPHA (I,J)=PEEK(ADRESSE):ALPHA (I,J+1)=PEEK(ADRESSE+8192) +2460 ADRESSE=ADRESSE+80 +2470 NEXT J:CURSEUR=CURSEUR+1:ADRESSE=CURSEUR +2480 IF I=90 THEN CURSEUR=4*80:ADRESSE=CURSEUR +2490 IF I=170 THEN CURSEUR=8*80:ADRESSE=CURSEUR +2500 IF I=250 THEN CURSEUR=12*80:ADRESSE=CURSEUR +2510 NEXT I +2520 CLS:RETURN +2530 DEF SEG=0 +2540 FOR I=1 TO 255:IF I=7 THEN I=8 ELSE IF I=9 THEN I=14 ELSE IF I=28 THEN I=32 +2550 A$="":PRINT" Valeur Adresse d'lment ASCII (I) LIGNE (J)";SPACE$(12); +2560 PRINT "Dessin":PRINT :FOR J=1 TO 8 +2570 A=ALPHA(I,J):PRINT " ";A, +2580 IF A>127 THEN A$=A$+"":A=A-128 ELSE A$=A$+" " +2590 IF A>63 THEN A$=A$+"":A=A-64 ELSE A$=A$+" " +2600 IF A>31 THEN A$=A$+"":A=A-32 ELSE A$=A$+" " +2610 IF A>15 THEN A$=A$+"":A=A-16 ELSE A$=A$+" " +2620 IF A>7 THEN A$=A$+"":A=A-8 ELSE A$=A$+" " +2630 IF A>3 THEN A$=A$+"":A=A-4 ELSE A$=A$+" " +2640 IF A>1 THEN A$=A$+"":A=A-2 ELSE A$=A$+" " +2650 IF A>0 THEN A$=A$+"":A=A-1 +2660 PRINT VAPTR(ALPHA(I,J)),I,J;:LOCATE CSRLIN,60:PRINT A$:A$="" +2670 IF INKEY$="" THEN 2670 +2680 NEXT J:PRINT +2690 NEXT I +2700 RETURN +2710 '========================================================================== +2720 ' Ecran-Disque +2730 '========================================================================== +2740 ' Sauvegarde +2750 '-------------------------------------------------------------------------- +2760 DEF SEG=&HB800:BSAVE N$,0,16384 +2770 ' +2780 ' +2790 ' +2800 RETURN +2810 '-------------------------------------------------------------------------- +2820 ' Lecture +2830 '-------------------------------------------------------------------------- +2840 DEF SEG=&HB800:BLOAD N$,0 +2850 ' +2860 ' +2870 ' +2880 RETURN +2890 '-------------------------------------------------------------------------- +2900 ' Traitement d'erreur:"Fichier non existent" +2910 '-------------------------------------------------------------------------- +2920 RESUME 1160 +2930 '========================================================================== +2940 ' MENU PRINCIPAL +2950 '========================================================================== +2960 ' Affichage des donnes courantes +2970 '-------------------------------------------------------------------------- +2980 SCREEN 0,0:WIDTH 80:COLOR 7,4:CLS:COLOR 7,2:A=A2:A1=INT(A*180/3.14):L=L1:H=H1:C$="-" +2990 LOCATE 2,5:PRINT SPACE$(72); +3000 FOR I=3 TO 22:LOCATE I,5:PRINT" ";:COLOR 7,1:PRINT SPACE$(36); +3010 PRINT STRING$(22,46);" [ ] ";:COLOR 7,2:PRINT" ";:NEXT I +3020 LOCATE 22,5:PRINT" ";:COLOR 7,1:PRINT" ";STRING$(57,46);"......]"; +3030 COLOR 7,2:LOCATE 23,5:PRINT SPACE$(72);:LOCATE 24,5:PRINT SPACE$(72); +3040 COLOR 3,5:LOCATE 2,31:PRINT "Choix des PARAMETRES":COLOR 7,1 +3050 LOCATE 3,9:PRINT"Couleur du FOND FO":LOCATE 3,67:PRINT FO; +3060 LOCATE 4,9:PRINT"Nom d'ECRAN ,ANCIEN ou CREER N$":LOCATE 4,68:PRINT N$; +3070 LOCATE 5,9:PRINT"Image avec SYMETRIE (O ou N) S$":LOCATE 5,68:PRINT S$; +3080 LOCATE 6,9:PRINT"Par raport X,Y ou O (lettre) C$":LOCATE 6,68:PRINT C$; +3090 LOCATE 7,9:PRINT"Origine du texte, ABSCISSE X":LOCATE 7,67:PRINT X; +3100 LOCATE 8,9:PRINT"Origine du texte, ORDONNEE Y":LOCATE 8,67:PRINT Y; +3110 LOCATE 9,9:PRINT"Angle en DEGRES (- si<0) A":LOCATE 9,67:PRINT A1; +3120 LOCATE 10,9:PRINT"Cofficient de LARGEUR L":LOCATE 10,67:PRINT L; +3130 LOCATE 11,9:PRINT"Cofficient d' HAUTEUR H":LOCATE 11,67:PRINT H; +3140 LOCATE 12,9:PRINT"Cofficient de DEFORMATION X DX":LOCATE 12,67:PRINT DX; +3150 LOCATE 13,9:PRINT"Cofficient de DEFORMATION Y DY":LOCATE 13,67:PRINT DY; +3160 LOCATE 14,9:PRINT"Cofficient d' INCLINAISON X IX":LOCATE 14,67:PRINT IX; +3170 LOCATE 15,9:PRINT"Cofficient d' INCLINAISON Y IY":LOCATE 15,67:PRINT IY; +3180 LOCATE 16,9:PRINT"Cofficient de PERSPECTIVE P":LOCATE 16,67:PRINT P; +3190 LOCATE 17,9:PRINT"Cofficient de PRIORITE P1":LOCATE 17,67:PRINT P1; +3200 LOCATE 18,9:PRINT"Effet de l'ESCALIER, sens X EX":LOCATE 18,67:PRINT EX; +3210 LOCATE 19,9:PRINT"Effet de l'ESCALIER, sens Y EY":LOCATE 19,67:PRINT EY; +3220 LOCATE 20,9:PRINT"Ecriture INVERSE E":LOCATE 10,67:PRINT E; +3230 LOCATE 21,9:PRINT"Couleur d'ENCRE CO":LOCATE 21,67:PRINT CO; +3240 LOCATE 22,9:PRINT"Texte crire :[";A$; +3250 COLOR 3,5:LOCATE 23,7 +3260 PRINT" Dplacements: ";CHR$(24);",";CHR$(25); +3270 PRINT" / PARAMETRE, PUIS RETURN / [ESC] pour terminer ";:COLOR 7,1 +3280 '-------------------------------------------------------------------------- +3290 ' Modification des paramtres +3300 '-------------------------------------------------------------------------- +3310 IF DRA=1 THEN 3340 +3320 LIN=3:LINA=LIN:P$=STR$(FO):GOSUB 3430 +3330 LIN =4:GOSUB 3520 +3340 LIN =5:LINA=4:P$=" "+N$:GOSUB 3600:GOTO 3370 +3350 I$=INKEY$:IF I$="" THEN 3350 ELSE IF I$=CHR$(27) THEN COLOR 7,1:RETURN +3360 IF I$<>CHR$(0)+CHR$(72) AND I$<>CHR$(0)+CHR$(80) THEN 3390 +3370 IF I$=CHR$(0)+CHR$(72) THEN LIN=LIN-1:IF LIN<5 THEN LIN=5:LOCATE LIN,67 +3380 IF I$=CHR$(0)+CHR$(80) THEN LIN=LIN+1:IF LIN>22 THEN LIN=22:LOCATE LIN,67 +3390 IF LIN=5 THEN GOSUB 3600:GOTO 3350 +3400 IF LIN=6 THEN GOSUB 3700:GOTO 3350 +3410 ON LIN-6 GOSUB 3800,3910,3930,4050,4160,4170,4180:IF LIN<14 THEN 3350 +3420 ON LIN-13 GOSUB 4190,4200,4210,4220,4230,4240,4250,4260,4360:GOTO 3350 +3430 GOSUB 4490:LOCATE LIN,67:PRINT FO;:LINA=LIN:IN$=" " +3440 I$=INKEY$:IF I$="" THEN 3440 +3450 IF ASC(I$)=13 AND IN$<>" " THEN FO=VAL(IN$):GOTO 3490 +3460 IF ASC(I$)<48 OR ASC(I$)>57 THEN PLAY"o2l8g":GOTO 3440 +3470 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +3480 IF LEN(IN$)<3 THEN GOTO 3440 ELSE PLAY"o2l8f" +3490 IF FO<0 OR FO>7 THEN PLAY"O2L8A":GOTO 3430 +3500 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +3510 RETURN +3520 GOSUB 4490:LOCATE LIN,68:PRINT N$;:LINA=LIN:P$=" "+N$:IN$=" " +3530 I$=INKEY$:IF I$=""THEN 3530 +3540 IF ASC(I$)=13 AND IN$<>" " THEN N$=MID$(IN$,2,3):P$=IN$:GOTO 3580 +3550 IF ASC(I$)<48 OR ASC(I$)>127 THEN PLAY"O2L8G":GOTO 3530 +3560 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +3570 IF LEN(IN$)<5 THEN GOTO 3530 ELSE PLAY"O2L8G":N$="":GOTO 3520 +3580 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +3590 RETURN +3600 GOSUB 4490:LOCATE LIN,68:PRINT S$;:LINA=LIN:P$=" "+S$:IN$=" " +3610 IF DRA=1 THEN 3630 ELSE DRA=1:GOTO 3620 +3620 I$=INKEY$:IF I$="" THEN 3620 +3630 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +3640 IF ASC(I$)=13 AND IN$<>" " THEN S$=MID$(IN$,2,1):P$=" "+S$:GOTO 3690 +3650 IF I$<>"n" AND I$<>"N" AND I$<>"o" AND I$<>"O" THEN PLAY"O2L8G":GOTO 3620 +3660 IF I$="n" OR I$="N" THEN I$="N" ELSE I$="O" +3670 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +3680 IF LEN (IN$)<3 THEN 3620 ELSE PLAY "O2L8G":S$="":GOTO 3600 +3690 RETURN +3700 GOSUB 4490:LOCATE LIN,68:PRINT C$;:LINA=LIN:P$=" "+C$:IN$=" ":GOTO 3730 +3710 IF S$="N" THEN RETURN +3720 I$=INKEY$:IF I$=" " THEN 3720 +3730 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +3740 IF ASC(I$)=13 AND IN$<>" " THEN C$=MID$(IN$,2,1):P$=" "+C$:GOTO 3790 +3750 IF I$="x" THEN I$="X" ELSE IF I$="y" THEN I$="Y" ELSE IF I$="o" THEN I$="O" +3760 IF I$<>"X" AND I$<>"Y" AND I$<>"O" THEN PLAY"O2L8G":GOTO 3720 +3770 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +3780 IF LEN(IN$)<3 THEN GOTO 3720 ELSE PLAY"O2L8G":C$="":GOTO 3700 +3790 RETURN +3800 SE=X:T$="X" :GOSUB 3810:X=SE:RETURN +3810 GOSUB 4490:LOCATE LIN,67:PRINT SE;:LINA=LIN:P$=STR$(SE):IN$=" ":GOTO 3830 +3820 I$=INKEY$:IF I$="" THEN 3820 +3830 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +3840 IF ASC(I$)=13 AND IN$<>" " THEN SE=VAL(IN$):GOTO 3880 +3850 IF ASC(I$)<48 OR ASC(I$)>57 THEN PLAY"O2L8G":GOTO 3820 +3860 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +3870 IF LEN(IN$)<5 THEN GOTO 3820 ELSE PLAY"O2L8G":I$=" ":GOTO 3800 +3880 IF SE<0 OR SE>319-320*(SCR=2) AND T$="X" THEN PLAY"O2L8G":GOTO 3800 +3885 IF SE<0 OR SE>199 AND T$="Y" THEN PLAY"O2L8G":GOTO 3800 +3890 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +3900 RETURN +3910 SE=Y:T$="Y":GOSUB 3810:Y=SE:RETURN +3920 RETURN +3930 SE=INT(A*180/3.14):T$="0":GOSUB 3940:A=SE*3.14/180:RETURN +3940 GOSUB 4490:LOCATE LIN,67:PRINT SE;:LINA=LIN:P$=STR$(SE):IN$=" ":GOTO 3960 +3950 I$=INKEY$:IF I$="" THEN 3950 +3960 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +3970 IF ASC(I$)=13 AND IN$<>" " THEN SE=VAL(IN$):GOTO 4020 +3980 IF I$="-" THEN IN$="-":GOTO 3950 +3990 IF ASC(I$)<48 OR ASC(I$)>57 THEN PLAY"O2L8G":GOTO 3950 +4000 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +4010 IF LEN(IN$)<5 THEN GOTO 3950 ELSE PLAY"O2L8G":I$=" ":GOTO 3930 +4020 IF T$="1" THEN SE=ABS(SE):IN$=" "+MID$(IN$,2,LEN(IN$)-1) +4030 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +4040 RETURN +4050 SE=L:GOSUB 4060:L=SE:RETURN +4060 GOSUB 4490:LOCATE LIN,67:PRINT SE;:LINA=LIN:P$=STR$(SE):IN$=" ":GOTO 4080 +4070 I$=INKEY$:IF I$="" THEN 4070 +4080 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +4090 IF ASC(I$)=13 AND I$<>" " THEN SE=VAL(IN$):GOTO 4130 +4100 IF ASC(I$)<48 OR ASC(I$)>57 THEN PLAY"O2L8G":GOTO 4070 +4110 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +4120 IF LEN(IN$)<4 THEN GOTO 4070 ELSE PLAY"O2G8":I$=" ":GOTO 4060 +4130 IF SE<1 OR SE>40 THEN PLAY"O2L8G":GOTO 4060 +4140 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +4150 RETURN +4160 SE=H:GOSUB 4060:H=SE:RETURN +4170 SE=DX:T$="0":GOSUB 3940:DX=SE:RETURN +4180 SE=DY:T$="0":GOSUB 3940:DY=SE:RETURN +4190 SE=IX:T$="0":GOSUB 3940:IX=SE:RETURN +4200 SE=IY:T$="0":GOSUB 3940:IY=SE:RETURN +4210 SE=P:T$="0":GOSUB 3940:P=SE:RETURN +4220 SE=P1:T$="1":GOSUB 3940:P1=SE:RETURN +4230 SE=EX:T$="0":GOSUB 3940:EX=SE:RETURN +4240 SE=EY:T$="0":GOSUB 3940:EY=SE:RETURN +4250 SE=E:T$="1":GOSUB 3940:E=SE:RETURN +4260 GOSUB 4490:LOCATE LIN,67:PRINT CO;:LINA=LIN:P$=STR$(CO):IN$=" ":GOTO 4280 +4270 I$=INKEY$:IF I$="" THEN 4270 +4280 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +4290 IF ASC(I$)=13 AND IN$<>" " THEN COP=VAL(IN$):GOTO 4330 +4300 IF ASC(I$)<48 OR ASC(I$)>57 THEN PLAY"O2L8G":GOTO 4270 +4310 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,67:PRINT IN$; +4320 IF LEN(IN$)<4 THEN GOTO 4270 ELSE PLAY"O2L8G":GOTO 4260 +4330 IF CO<0 OR CO>15 THEN PLAY"O2L8G":CO=0:GOTO 4260 +4340 P$=IN$:GOSUB 4490:LOCATE LIN,67:PRINT P$ +4350 RETURN +4360 GOSUB 4490:LOCATE LIN,26:PRINT A$;SPACE$(46-LEN(A$));:LINA=LIN:P$=A$ +4370 IN$="":GOTO 4390 +4380 I$=INKEY$:IF I$="" THEN 4380 +4390 IF I$=CHR$(0)+CHR$(72) OR I$=CHR$(0)+CHR$(80) THEN RETURN +4400 IF ASC(I$)=13 AND IN$<>" " THEN A$=IN$:GOTO 4440 +4410 IF I$=SPACE$(LEN(I$)) THEN I$=STRING$(LEN(I$),CHR$(255)) +4420 IN$=IN$+I$:GOSUB 4490:LOCATE LIN,26:PRINT IN$; +4430 IF LEN(IN$)<46 THEN GOTO 4380 ELSE PLAY "O2L8G":GOTO 4360 +4440 P$=IN$:GOSUB 4490:LOCATE LIN,26:PRINT P$ +4450 RETURN +4460 '-------------------------------------------------------------------------- +4470 ' Sous-routine d'Affichage +4480 '-------------------------------------------------------------------------- +4490 IF LIN=22 THEN 4530 +4500 LOCATE LINA,67:COLOR 7,1:PRINT" ":LOCATE LINA,67:PRINT P$ +4510 IF LIN=22 THEN LOCATE LIN,26:COLOR 2,4:PRINT SPACE$(46):RETURN +4520 LOCATE LIN,67:COLOR 2,4:PRINT" ":RETURN +4530 LOCATE LINA,26:COLOR 7,1:PRINT STRING$(46,46):LOCATE LINA,26:PRINT P$ +4540 GOTO 4510 + \ No newline at end of file diff --git a/EQUA.BAS b/EQUA.BAS new file mode 100644 index 0000000..f60a488 Binary files /dev/null and b/EQUA.BAS differ diff --git a/ERRSON.BAS b/ERRSON.BAS new file mode 100644 index 0000000..800bde6 Binary files /dev/null and b/ERRSON.BAS differ diff --git a/ESSAI b/ESSAI new file mode 100644 index 0000000..9c1dd21 --- /dev/null +++ b/ESSAI @@ -0,0 +1,2 @@ + 64406 ,RP,BYE, 19531 ,TEST1234, 32 ,-12.5 ,G,DAF1000,21/08/89 + \ No newline at end of file diff --git a/ESSAI.ADR b/ESSAI.ADR new file mode 100644 index 0000000..e69de29 diff --git a/ESSAI.DON b/ESSAI.DON new file mode 100644 index 0000000..e69de29 diff --git a/ESSAILE.BAS b/ESSAILE.BAS new file mode 100644 index 0000000..b650b85 --- /dev/null +++ b/ESSAILE.BAS @@ -0,0 +1,15 @@ + +DEF SEG = &HB800 +open "a:command.com" As #1 LEN = 1 + +FIELD #1,1 AS NC$ + +K=25555 +FOR I=1 TO LOF(1) +K=(K+2) AND (K < 4000) + GET #1,I + LOCATE 25,1:PRINT LOF(1)-I; + POKE K,ASC(NC$) +NEXT I +Close + diff --git a/ESSAI_L.BAS b/ESSAI_L.BAS new file mode 100644 index 0000000..70895fe Binary files /dev/null and b/ESSAI_L.BAS differ diff --git a/F(X).BAS b/F(X).BAS new file mode 100644 index 0000000..13859d9 Binary files /dev/null and b/F(X).BAS differ diff --git a/FAITCADR.ROU b/FAITCADR.ROU new file mode 100644 index 0000000..2e37fac --- /dev/null +++ b/FAITCADR.ROU @@ -0,0 +1,4 @@ +180 DEF SEG=&HB800:POKE 0,201:FOR K=2 TO 156 STEP 2:POKE K,205:POKE K+320,205 +190 POKE K+3680,205:NEXT K:POKE 158,187:POKE 160,186:POKE 318,186:POKE 320,204 +200 POKE 478,185:POKE 3680,200:POKE 3838,188:FOR K=480 TO 3520 STEP 160 +210 POKE K,186:POKE K+158,186:NEXT:RETURN \ No newline at end of file diff --git a/FENETRE.BAS b/FENETRE.BAS new file mode 100644 index 0000000..e6927dd Binary files /dev/null and b/FENETRE.BAS differ diff --git a/FFF.IM b/FFF.IM new file mode 100644 index 0000000..48c4400 Binary files /dev/null and b/FFF.IM differ diff --git a/FICHDATA.BAS b/FICHDATA.BAS new file mode 100644 index 0000000..f0368e3 Binary files /dev/null and b/FICHDATA.BAS differ diff --git a/FONTE.BAS b/FONTE.BAS new file mode 100644 index 0000000..e227e73 --- /dev/null +++ b/FONTE.BAS @@ -0,0 +1,169 @@ +10 '**************************************************************************** +20 '** Programme tir de PCompatible n39 p 56 et 57 ** +30 '** FONTES.BAS ** +40 '** ** +50 '** Appel GW au choix : BASIC /M:&HE000 ou BASIC (plantage assur) ** +60 '**************************************************************************** +70 SCREEN 2:KEY OFF:CLS:LOCATE 12,32:PRINT "Patientez..."; +80 GOSUB 920 ' Pour initialisation des routines et des fontes +90 GOSUB 690 ' Pour dmonstration. +100 '--------------------------------------------------------------------------- +110 END +120 '--------------------------------------------------------------------------- +130 '--------------------------------------------------------------------------- +140 '| CHANGER DE FONTE. SUB FONTE(FONTE$) | +150 '--------------------------------------------------------------------------- +160 DATA 85 , 139 , 236 , 30 , 6 , 87 , 86 , 184 , 0 +170 DATA 0 , 142 , 192 , 191 , 124 , 0 , 197 , 118 , 6 +180 DATA 139 , 4 , 38 , 137 , 5 , 131 , 199 , 2 , 140 +190 DATA 216 , 38 , 137 , 5 , 94 , 95 , 7 , 31 , 93 +200 DATA 202 , 4 , 0 +210 ' +220 ' Nombre d'octets : 39 +230 ' push bp / mov bp, sp / push ds / push es / push di / push si +240 ' mov ax,0 / mov es, ax / mov di, 7CH / lds si, [bp+6] / mov ax, [si] +250 ' mov [es:di], ax / add di, 2 / mov ax, ds / mov [es:di], ax +260 ' pop si / pop di / pop es / pop ds / pop bp / ret 4 (202, 4, 0) +270 ' |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +280 ' || Attend en entre deux variables : :: +290 ' :: CALL(S) GETGRAFTABL (SEGMENT%, ADRESSE%) || +300 ' || qui reoivent l'adresse complte de la table des caractres || +310 ' || graphiques || +320 ' |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +330 DATA 85 , 139 , 236 , 30 , 6 , 87 , 86 , 196 , 126 +340 DATA 6 , 184 , 0 , 0 , 142 , 216 , 190 , 124 , 0 +350 DATA 165 , 196 , 126 , 10 , 165 , 94 , 95 , 7 , 31 +360 DATA 93 , 202 , 8 , 0 +370 ' +380 ' Nombre d'octets : 31 +390 'push bp / mov bp, sp / push ds / push es / les di, [bp+06H] / mov ax,0 +400 'mov ds, ax / mov si, 7CH / movsw / les di, [bp+0AH] / movsw / pop es +410 'pop ds / pop bp / RET 8 ( 202, 8, 0). +420 '||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +430 '|| Attend en entre deux variables : || +440 '|| CALL(S) PUTGRAFTABL (SEGMENT%, ADRESSE%) || +450 '|| qui dfinissent la nouvelle adresse de la table des caractres || +460 '|| graphiques. || +470 '||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +480 DATA 85 , 139 , 236 , 30 , 6 , 197 , 118 , 6 , 184 +490 DATA 0 , 0 , 142 , 192 , 191 , 124 , 0 , 165 , 197 +500 DATA 118 , 10 , 165 , 7 , 31 , 93 , 202 , 8 , 0 +510 ' +520 ' Nombre d'octets : 27 +530 ' push bp / mov bp, sp / push ds / push es / lds si, [bp+06H] +540 ' mov ax,0 / mov es, ax / mov di , 7CH / movsw / lds si, [bp+0AH] +550 ' movsw / pop es / pop ds / pop bp / RET 8 (202 , 8 , 0 ) +560 '--------------------------------------------------------------------------- +570 ' ROUTINE D'AFFICHAGE +580 '--------------------------------------------------------------------------- +590 LOCATE LIGNE%,COLONNE% : PRINT A$ +600 RETURN +610 ' +620 LOCATE LIGNE%,COLONNE% +630 FOR I%=1 TO LEN(A$) +640 A%=ASC(MID$(A$,I%,1))+96 : PRINT CHR$(A%); +650 NEXT I% +660 RETURN +670 '--------------------------------------------------------------------------- +680 ' +690 ' PROGRAMME PRINCIPAL DE FONTE.BAS +700 ' +710 '--------------------------------------------------------------------------- +720 FOR I%=128 TO 250 : SORTIE$=SORTIE$+CHR$(I%)+CHR$(128) :NEXT +730 ' +740 LOCATE 12,12 +750 PRINT "Les trois fontes sont disponibles. Frappez une touche ." +760 WHILE INKEY$="" : WEND : LINE (0,0)-(639,199),1,B +770 ' +780 CALLS FONTE(GRAF96%) +790 A$=SORTIE$ : LIGNE%=4 : COLONNE%=1 : GOSUB 590 +800 A$="Ecriture avec GRAF96":LIGNE%=8 : COLONNE%=30 : GOSUB 620 +810 CALLS FONTE(GRAS%) +820 A$=SORTIE$: LIGNE%=10 : COLONNE%=1 : GOSUB 590 +830 A$="Ecriture avec fonte grasse" : LIGNE%=14:COLONNE%=30: GOSUB 620 +840 CALLS FONTE(GRIS%) +850 A$=SORTIE$ : LIGNE%=16 : COLONNE%=1 : GOSUB 590 +860 A$="Ecriture avec fonte grise" : LIGNE% = 20 :COLONNE%=30 : GOSUB 620 +870 ' +880 CALLS PUTGRAFTABL(ANCIENSGRAF%, ANCIENAGRAF%) 'pour restitution. +890 ' +900 RETURN +910 '--------------------------------------------------------------------------- +920 ' INITIALISATION DES ROUTINES ASSEMBLEUR. +930 '--------------------------------------------------------------------------- +940 ' +950 BON=9231 : RESTORE +960 FOR I=1 TO 97 : READ X : VERIF =VERIF+X : NEXT +970 IF VERIF<>BON THEN PRINT " Erreur de saisie dans les DATA ": END +980 ' +990 'POKage des routines : +1000 GETGRAFTABL=&HE000 : RESTORE 330 +1010 FOR I=0 TO 30 : READ X : POKE GETGRAFTABL+I, X : NEXT +1020 PUTGRAFTABL=GETGRAFTABL+35 : RESTORE 480 +1030 FOR I=0 TO 26 : READ X : POKE PUTGRAFTABL+I, X : NEXT +1040 FONTE=PUTGRAFTABL+30 : RESTORE 160 +1050 FOR I=0 TO 38 : READ X : POKE FONTE+I, X :NEXT +1060 PRINT "."; +1070 ' +1080 ' pokage des fontes : +1090 ' +1100 CALLS GETGRAFTABL (ANCIENSGRAF%, ANCIENAGRAF%) ' Pour sauvegarde +1110 SGRAFTABL = ANCIENSGRAF% : GRAFTABL=ANCIENAGRAF% +1120 ' +1130 GRAF=FONTE+40 +1140 FOR CAR%=0 TO 127 +1150 FOR OCTET%=0 TO 7 +1160 DECAL=(CAR%*8)+OCTET% +1170 DEF SEG=SGRAFTABL : VALEUR=(PEEK(GRAFTABL+DECAL)) +1180 DEF SEG : POKE GRAF+DECAL, VALEUR +1190 NEXT +1200 NEXT +1210 PRINT "."; +1220 '-------------------------------------------------------------------------- +1230 ' REMPLIR LES TABLEAUX GRAF96%() ET SUIVANTS +1240 ' Cration d'un tableau de base pour les caractres reproduisant +1250 ' l'alphabet et repoussant les caractres accentus en queue. Il +1260 ' sert de base la cration des autres fontes. +1270 '-------------------------------------------------------------------------- +1280 GRAF96=GRAF+1025 +1290 FOR I%=0 TO 30 +1300 FOR OCTET%=0 TO 7 +1310 VALEUR%=PEEK(GRAF+(I%*8)+OCTET%) +1320 POKE GRAF96+((I%+96)*8)+OCTET%, VALEUR% +1330 NEXT +1340 NEXT +1350 FOR OCTET%=0 TO 7 : POKE GRAF96+(31+96)*8+OCTET%,0 : NEXT +1360 CARSEG%=&HF000 : CARAD%=&HFA6E+(32*8) +1370 FOR I%=0 TO 95 +1380 FOR OCTET%=0 TO 7 +1390 DEF SEG=CARSEG% : VALEUR%=(PEEK(CARAD%+(I%*8)+OCTET%)) +1400 DEF SEG : POKE GRAF96+(I%*8)+OCTET%, VALEUR% +1410 NEXT +1420 NEXT +1430 PRINT "."; +1440 ' +1450 'fonte gras : +1460 GRAS = GRAF96+1025 +1470 FOR I%=0 TO 1023 +1480 V%=PEEK(GRAF96+I%) : V%=V% XOR &HFF : V%=V% OR (V%/2) +1490 VALEUR%=V% XOR &HFF +1500 POKE GRAS+I%, VALEUR% +1510 NEXT +1520 PRINT "."; +1530 ' +1540 'fonte grise : +1550 GRIS=GRAS+1025 +1560 FOR I%=0 TO 1023 +1570 V%=PEEK(GRAF96+I%): VALEUR%=V% AND &H55 ' (=1010101) +1580 POKE GRIS+I%, ABS(VALEUR%) +1590 NEXT +1600 PRINT "."; +1610 ' +1620 GRAF%=GRAF : GRAF96%=GRAF96 : GRAS%=GRAS : GRIS%=GRIS +1630 ' +1640 RETURN +2000 REM *********************************************************************** +2010 REM ** Taper par DARCHE Yoann le 09/06/1990 Sur Commodore PC1 ** +2020 REM ** & Quellesques modifications signes DARCHE Yoann ** +2030 REM *********************************************************************** + \ No newline at end of file diff --git a/FRAC1.BAS b/FRAC1.BAS new file mode 100644 index 0000000..83ba2ca Binary files /dev/null and b/FRAC1.BAS differ diff --git a/FRAC2.BAS b/FRAC2.BAS new file mode 100644 index 0000000..804655a Binary files /dev/null and b/FRAC2.BAS differ diff --git a/FRACTAL1.BAS b/FRACTAL1.BAS new file mode 100644 index 0000000..a1d4924 --- /dev/null +++ b/FRACTAL1.BAS @@ -0,0 +1,135 @@ +0 CLS +10 DEFINT A,B,C,E-Y +20 DIM H(128,128),C(320) +30 REM =========================== Menu ======================================== +40 SCREEN 7:WINDOW (0,0)-(639,399) +50 COLOR 13:PRINT "1> nouvelle surface" +60 PRINT "2> carte +70 PRINT "3> vue en strates" +80 PRINT "4> vue en ombres" +90 PRINT "5> vue en fil de fer " +100 PRINT "6> le jeu" +110 PRINT +120 INPUT ">",I:IF I>6 OR I<0 OR I<>INT(I) THEN 120 +130 ON I GOSUB 180,780,990,1160,860,1380 +140 PRINT CHR$(7) +150 WHILE INKEY$="":WEND +160 GOTO 40 +170 REM ========================= Paramtres =================================== +180 INPUT "Maille (0-3) : ",M +190 P=2^(7-M) +200 PRINT " ---->> pas =";P +210 INPUT "Hauteur de base : ",H +220 INPUT "Deviation : ",D +230 INPUT "Graine : ",Z +240 INPUT "Taille (128,64,32): ",L +250 REM =========================== Calcul ===================================== +260 RANDOMIZE TIMER +270 N=H/16:GOSUB 710 +280 COLOR 3 +290 REM =========================== surface de base . +300 FOR X=0 TO L STEP P +310 FOR Y=0 TO L STEP P +320 H(X,Y)=RND*H:IF H(X,Y)15 THEN C=15 +340 PSET (X*4,Y*2),C +350 NEXT Y,X +360 REM ========================== Calcul fractal . +370 WHILE P>1 +380 Q=P/2:E=D/2 +390 FOR X=Q TO L-Q STEP P +400 FOR Y=Q TO L-Q STEP P +410 H=(H(X-Q,Y-Q)+H(X-Q,Y+Q)+H(X+Q,Y-Q)+H(X+Q,Y+Q))/4+D*RND-E +420 IF H15 THEN C=15 +440 H(X,Y)=H:PSET (X*4,Y*2),C +450 NEXT Y,X +460 FOR X=P TO L-P STEP P +470 FOR Y=Q TO L-Q STEP P +480 H=(H(X-Q,Y)+H(X+Q,Y)+H(X,Y-Q)+H(X,Y+Q))/4+D*RND-E +490 IF H15 THEN C=15 +510 H(X,Y)=H:PSET(X*4,Y*2),C +520 H=(H(Y-Q,X)+H(Y+Q,X)+H(Y,X-Q)+H(Y,X+Q))/4+D*RND-E +530 IF H15 THEN C=15 +550 H(Y,X)=H:PSET (Y*4,X*2),C +560 NEXT Y,X +570 FOR I=Q TO L-Q STEP P +580 H=(H(0,I-Q)+H(0,I+Q)+H(Q,I))/3+D*RND-E:IF H15 THEN C=15 +820 PSET (X*4,Y*2),C +830 NEXT X,Y +840 RETURN +850 REM ====================== Fil de fer +860 CLS:O=160:K=0 +870 PSET (0,40):LINE -(320,0),1:LINE -(640,40) +880 ERASE C:'DIM C(320) +890 FOR Y=0 TO L STEP 2:PSET (O*4-320,C(O+K)) +900 K=0:O=160-Y:IF O<0 THEN K=-O +910 FOR X=K TO L STEP 2 +920 T=H(X,Y)+Y+X +930 IF C(X+O)>T THEN H=C(X+O) ELSE H=T +935 C(X+O)=H +940 LINE -((O+X)*4-320,H) +950 NEXT X:LINE -((O+X)*4-322,FH):FH=H +960 NEXT Y +970 RETURN +980 REM =============== strates +990 CLS:NM=N*4 +1000 FOR I=0 TO 80:H=H(0,I)+I:IF H319 THEN 1130 +1080 H=(H(X,Y)+X+Y) +1090 C=H(X,Y)/N:IF C>15 THEN C=15 +1100 IF HC(A) THEN PSET (A*4,C(A)+2):LINE -(A*4,H),C:C(A)=H +1130 NEXT X,Y +1140 RETURN +1150 REM ====================================== ombres +1160 CLS +1170 REM +1180 FOR I=0 TO 80:C(80-I)=H(0,I)+I-2:C(80+I)=H(I,0)+I-2:NEXT +1190 FOR Y=0 TO L:O1=0:O2=0 +1200 FOR X=L TO 0 STEP -1 +1210 A=80-Y+X:IF A<0 OR A>319 THEN 1290 +1220 H=(H(X,Y)+X+Y) +1230 C=3 +1240 IF H(X,Y)>=O1 THEN O1=H(X,Y)+1 ELSE C=2 +1250 IF H(X,Y)>=O2 THEN O2=H(X,Y)+2 ELSE C=1 +1260 IF H nouvelle surface" +110 PRINT "2> carte +120 PRINT "3> vue en strates" +130 PRINT "4> vue en ombres" +140 PRINT "5> vue en fil de fer " +150 PRINT "0> fin" +160 PRINT +170 INPUT ">",I:IF I>5 OR I<0 OR I<>INT(I) THEN 170 +180 IF I=0 THEN END +190 ON I GOSUB 240,850,1080,1260,930 +200 PRINT CHR$(7) +210 WHILE INKEY$="":WEND +220 GOTO 90 +230 REM ========================= Paramtres =================================== +240 INPUT "Maille (0-3) : ",M +250 P=2^(7-M) +260 PRINT " ---->> pas =";P +270 INPUT "Hauteur de base : ",H +280 INPUT "Deviation : ",D +290 INPUT "Graine : ",Z +300 INPUT "Taille (128,64,32): ",L +310 IF L=128 THEN WINDOW (0,0)-(639,399) +320 REM =========================== Calcul ===================================== +330 RANDOMIZE Z +340 N=H/16:GOSUB 780 +350 CLS +360 REM =========================== surface de base . +370 FOR X=0 TO L STEP P +380 FOR Y=0 TO L STEP P +390 H(X,Y)=RND*H:IF H(X,Y)3 THEN C=3 +410 PSET (X*4,Y*2),C +420 NEXT Y,X +430 REM ========================== Calcul fractal . +440 WHILE P>1 +450 Q=P/2:E=D/2 +460 FOR X=Q TO L-Q STEP P +470 FOR Y=Q TO L-Q STEP P +480 H=(H(X-Q,Y-Q)+H(X-Q,Y+Q)+H(X+Q,Y-Q)+H(X+Q,Y+Q))/4+D*RND-E +490 IF H3 THEN C=3 +510 H(X,Y)=H:PSET (X*4,Y*2),C +520 NEXT Y,X +530 FOR X=P TO L-P STEP P +540 FOR Y=Q TO L-Q STEP P +550 H=(H(X-Q,Y)+H(X+Q,Y)+H(X,Y-Q)+H(X,Y+Q))/4+D*RND-E +560 IF H3 THEN C=3 +580 H(X,Y)=H:PSET(X*4,Y*2),C +590 H=(H(Y-Q,X)+H(Y+Q,X)+H(Y,X-Q)+H(Y,X+Q))/4+D*RND-E +600 IF H3 THEN C=3 +620 H(Y,X)=H:PSET (Y*4,X*2),C +630 NEXT Y,X +640 FOR I=Q TO L-Q STEP P +650 H=(H(0,I-Q)+H(0,I+Q)+H(Q,I))/3+D*RND-E:IF H3 THEN C=3 +890 PSET (X*4,Y*2),C +900 NEXT X,Y +910 RETURN +920 REM ====================== Fil de fer +930 CLS:O=160:K=0 +940 IF L>=128 THEN WINDOW (0,0)-(639,399) +950 PSET (0,40):LINE -(320,0):LINE -(640,40) +960 FOR I=1 TO 320:C(I)=0:NEXT +970 FOR Y=0 TO L STEP 2:PSET (O*4-320,C(O+K)) +980 K=0:O=160-Y:IF O<0 THEN K=-O +990 FOR X=K TO L STEP 2 +1000 T=H(X,Y)+Y+X +1010 IF C(X+O)>T THEN H=C(X+O) ELSE H=T +1020 C(X+O)=H +1030 LINE -((O+X)*4-320,H) +1040 NEXT X:LINE -((O+X)*4-322,FH):FH=H +1050 NEXT Y +1060 RETURN +1070 REM =============== strates +1080 CLS:NM=N*4:IF L=>128 THEN WINDOW (0,0)-(639,399) +1090 PSET (0,40):LINE -(320,0):LINE -(640,40) +1100 FOR I=0 TO 80:H=H(0,I)+I:IF H319 THEN 1230 +1180 H=(H(X,Y)+X+Y) +1190 C=H(X,Y)/N:C=INT(C/6)+1:IF C>3 THEN C=3 +1200 IF HC(A) THEN PSET (A*4,C(A)+2):LINE -(A*4,H),C:C(A)=H +1230 NEXT X,Y +1240 RETURN +1250 REM ====================================== ombres +1260 CLS:IF L=>128 THEN WINDOW (0,0)-(639,399) +1270 PSET (0,40):LINE -(320,0):LINE -(640,40) +1280 FOR I=0 TO 80:C(80-I)=H(0,I)+I-2:C(80+I)=H(I,0)+I-2:NEXT +1290 FOR Y=0 TO L:O1=0:O2=0 +1300 FOR X=L TO 0 STEP -1 +1310 A=80-Y+X:IF A<0 OR A>319 THEN 1390 +1320 H=(H(X,Y)+X+Y) +1330 C=3 +1340 IF H(X,Y)>=O1 THEN O1=H(X,Y)+1 ELSE C=2 +1350 IF H(X,Y)>=O2 THEN O2=H(X,Y)+2 ELSE C=1 +1360 IF H5000) : ",RAY +250 CT=COS(THETA*COEF):ST=SIN(THETA*COEF) +260 CP=COS(PHI*COEF):SP=SIN(PHI*COEF) +270 XOBS=RAY*CT*CP +280 YOBS=RAY*CT*SP +290 ZOBS=RAY*ST +300 PRINT :PRINT "Selectionnez un type de trace " +310 PRINT " -1- Rapide " +320 PRINT " -2- Parties caches" +330 PRINT " -3- Surface claire" +340 INPUT " > ",TYPE +350 IF TYPE<>3 THEN 450 +360 PRINT +370 INPUT "Angle vertical d'clairage Alpha (-905000) : ",R +400 ALPHA =ALPHA*COEF:BETA=BETA *COEF +410 XECL=R*COS(ALPHA)*COS(BETA) +420 YECL=R*COS(ALPHA)*SIN(BETA) +430 ZECL=R*SIN(ALPHA) +440 INPUT "Dsirez-vous les contours des facettes ? (O/N) : ",BORD$ +450 LOCATE 23,17:PRINT "Les calculs sont en cour : veuillez patienter" +460 TPAV=TIMER +470 GOSUB 2630:GOSUB 2950 +490 REM ************************************************************************ +500 REM -=- Sous Programe d'affichage -=- +510 REM ************************************************************************ +520 CLS +530 IF TYPE =1 THEN GOSUB 1840:GOTO 570 +540 IF PHI>=120 AND PHI<240 THEN GOSUB 630:GOTO 570 +550 IF PHI<120 THEN GOSUB 1030 :GOTO 570 +560 GOSUB 1430 +570 BEEP +580 TEMPS=INT(TIMER-TPAV+.5):HEU=TEMPS\3600:MINU=(TEMPS\60)MOD 60:SEC=TENPS MOD 60 +590 A$=INPUT$(1) +600 IF A$=CHR$(13) THEN LOCATE 1,1:INPUT "",NOM$:BEEP:DEF SEG=&HB800:BSAVE NOM$,0,16000 +610 IF A$="t" OR A$="T" THEN LOCATE 2,6:PRINT MINU;"Min ";SEC;"s":IF HEU<>0 THEN 2,1:PRINT HEU;"h" +620 GOTO 590 +630 IF PHI<180 THEN DEB=1:SENS=1 ELSE FIN=1:SENS=-1 +640 FOR I=2 TO DN +650 TST=0:IF PHI<180 THEN FIN=DN-I+1 ELSE DEB =DN-I+1 +660 FOR J=DEB TO FIN STEP SENS +670 IF PHI<180 THEN GOSUB 710:GOSUB 870 ELSE GOSUB 870:GOSUB 710 +680 NEXT J +690 NEXT I +700 RETURN +710 CI=I-1:CJ=J:GOSUB 3320 +720 FOR L=1 TO 3 +730 V1(L)=C(L):PT(1,L)=C(L) +740 NEXT L +750 CI=I:GOSUB 3320 +760 FOR L=1 TO 3 +770 V1(L)=V1(L)-C(L):PT(2,L)=C(L) +780 NEXT L +790 IF TST=0 THEN TST=1:GOTO 860 +800 IF PHI<180 THEN CJ=J-1 ELSE CJ=J+1:CI=I-1 +810 GOSUB 3320 +820 FOR L=1 TO 3 +830 PT(3,L)=C(L) +840 NEXT L +850 GOSUB 2020 +860 RETURN +870 CI=I-1:CJ=J+1:GOSUB 3320 +880 FOR L=1 TO 3 +890 V2(L)=C(L):PT(1,L)=C(L) +900 NEXT L +910 CI=I:CJ=J:GOSUB 3320 +920 FOR L=1 TO 3 +930 V2(L)=V2(L)-C(L):PT(2,L)=C(L) +940 NEXT L +950 IF TST=0 THEN TST=1:GOTO 1020 +960 IF PHI<180 THEN CI=I-1 ELSE CJ=J=1 +970 GOSUB 3320 +980 FOR L=1 TO 3 +990 PT(3,L)=C(L) +1000 NEXT L +1010 GOSUB 2020 +1020 RETURN +1030 IF PHI>60 THEN DEB=1:SENS=1 ELSE FIN=1:SENS=-1 +1040 FOR I=2 TO DN +1050 TST=0:IF PHI>60 THEN FIN=DN-I+1 ELSE DEB =DN-I+1 +1060 FOR J=DEB TO FIN STEP SENS +1070 IF PHI>60 THEN GOSUB 1110:GOSUB 1270 ELSE GOSUB 1270:GOSUB 1110 +1080 NEXT J +1090 NEXT I +1100 RETURN +1110 CI=J:CJ=I-1:GOSUB 3320 +1120 FOR L=1 TO 3 +1130 V2(L)=C(L):PT(1,L)=C(L) +1140 NEXT L +1150 CJ=I:GOSUB 3320 +1160 FOR L=1 TO 3 +1170 V2(L)=V2(L)-C(L):PT(2,L)=C(L) +1180 NEXT L +1190 IF TST=0 THEN TST=1:GOTO 1260 +1200 IF PHI>60 THEN CI=J-1 ELSE CI=J+1:CJ=I-1 +1210 GOSUB 3320 +1220 FOR L=1 TO 3 +1230 PT(3,L)=C(L) +1240 NEXT L +1250 GOSUB 2020 +1260 RETURN +1270 CI=J+1:CJ=I-1:GOSUB 3320 +1280 FOR L=1 TO 3 +1290 V1(L)=C(L):PT(1,L)=C(L) +1300 NEXT L +1310 CI=J:CJ=I:GOSUB 3320 +1320 FOR L=1 TO 3 +1330 V1(L)=V1(L)-C(L):PT(2,L)=C(L) +1340 NEXT L +1350 IF TST=0 THEN TST=1:GOTO 1420 +1360 IF PHI>60 THEN CJ=I-1 ELSE CI=J+1 +1370 GOSUB 3320 +1380 FOR L=1 TO 3 +1390 PT(3,L)=C(L) +1400 NEXT L +1410 GOSUB 2020 +1420 RETURN +1430 IF PHI<300 THEN DEB=1:SENS=1:ELSE FIN=1:SENS=-1 +1440 FOR I=DN-1 TO 1 STEP -1 +1450 TST=0:IF PHI <300 THEN FIN=I ELSE DEB=I +1460 FOR J=DEB TO FIN STEP SENS +1470 K=I+1-J +1480 IF PHI <300 THEN GOSUB 1520 :GOSUB 1680 ELSE GOSUB 1680:GOSUB 1520 +1490 NEXT J +1500 NEXT I +1510 RETURN +1520 CI=J:CJ=K+1 :GOSUB 3320 +1530 FOR L=1 TO 3 +1540 V1(L)=C(L):PT(1,L)=C(L) +1550 NEXT L +1560 CJ=K:GOSUB 3320 +1570 FOR L=1 TO 3 +1580 V1(L)=V1(L)-C(L):PT(2,L)=C(L) +1590 NEXT L +1600 IF TST=0 THEN TST=1:GOTO 1670 +1610 IF PHI<300 THEN CI=J-1:CJ=K+1 ELSE CI=J+1 +1620 GOSUB 3320 +1630 FOR L=1 TO 3 +1640 PT(3,L)=C(L) +1650 NEXT L +1660 GOSUB 2020 +1670 RETURN +1680 CI=J+1:CJ=K:GOSUB 3320 +1690 FOR L=1 TO 3 +1700 V2(L)=C(L):PT(1,L)=C(L) +1710 NEXT L +1720 CI=J:GOSUB 3320 +1730 FOR L=1 TO 3 +1740 V2(L)=V2(L)-C(L):PT(2,L)=C(L) +1750 NEXT L +1760 IF TST=0 THEN TST=1:GOTO 1830 +1770 IF PHI<300 THEN CJ=K+1 ELSE CI=J+1:CJ=K-1 +1780 GOSUB 3320 +1790 FOR L=1 TO 3 +1800 PT(3,L)=C(L) +1810 NEXT L +1820 GOSUB 2020 +1830 RETURN +1840 C=1 +1850 FOR I=2 TO DN +1860 FOR J=1 TO DN-I+1 +1870 CI=I:CJ=J:GOSUB 3220 +1880 XE(1)=XE*ECHX+XCENT:YE(1)=YE*ECHY+YCENT +1890 CI=I-1:GOSUB 3220 +1900 XE(2)=XE*ECHX+XCENT:YE(2)=YE*ECHX+YCENT +1910 CJ=J+1:GOSUB 3220 +1920 XE(3)=XE*ECHX+XCENT:YE(3)=YE*ECHY+YCENT +1930 GOSUB 3600 +1940 NEXT J +1950 NEXT I +1960 RETURN +1970 REM +1980 REM *********************************************************************** +1990 REM -=- Calcul des couleurs et remplissage des facettes -=- +2000 REM *********************************************************************** +2010 REM +2020 INDM=0:NCOUL =0 +2030 IF PT(1,3)=MER AND PT(2,3)=MER AND PT(3,3)=MER THEN INDM=1:GOTO 2300 +2040 VN(1)=V1(2)*V2(3)-V1(3)*V2(2) +2050 VN(2)=V1(3)*V2(1)-V1(1)*V2(3) +2060 VN(3)=V1(1)*V2(2)-V1(2)*V2(1) +2070 VN=SQR(VN(1)^2+VN(2)^2+VN(3)^2) +2080 FOR N=1 TO 3 +2090 BARY(N)=(PT(1,N)+PT(2,N)+PT(3,N))/3 +2100 NEXT N +2110 VOBS(1)=BARY(1)-XOBS +2120 VOBS(2)=BARY(2)-YOBS +2130 VOBS(3)=BARY(3)-ZOBS +2140 PROSC=VN(1)*VOBS(1)+VN(2)*VOBS(2)+VN(3)*VOBS(3) +2150 VOBS=SQR(VOBS(1)^2+VOBS(2)^2+VOBS(3)^2) +2160 COSANG=PROSC/(VN*VOBS) +2170 ANG=ATN(SQR(1-COSANG^2)/COSANG) +2180 IF ANG>0 THEN NCOUL=1 +2190 IF NCOUL=1 OR TYPE=2 THEN 2300 +2200 VECL(1)=BARY(1)-XECL +2210 VECL(2)=BARY(2)-YECL +2220 VECL(3)=BARY(3)-ZECL +2230 PROSC=VN(1)*VECL(1)+VN(2)*VECL(2)+VN(3)*VECL(3) +2240 VECL=SQR(VECL(1)^2+VECL(2)^2+VECL(3)^2) +2250 COSANG=PROSC/(VN*VECL) +2260 ANG=ANT(SQR(1-COSANG^2)/COSANG) +2270 IF ANG<0 THEN ANG=ANG+3.141593 +2280 COUL=INT(ANG/FANG+.5) +2290 IF COUL<>0 THEN FREQ=15/COUL ELSE FREQ=1E+30 +2300 FOR N=1 TO 3 +2310 C(1)=PT(N,1):C(2)=PT(N,2):C(3)=PT(N,3) +2320 GOSUB 3230 +2330 XE(N)=INT(XE*ECHX+XCENT+.5):YE(N)=INT(YE*ECHY+YCENT+.5) +2340 NEXT N +2350 IF YE(2)>=YE(1) AND YE(2)>=YE(3) THEN EXX=XE(1):EXY=YE(1):XE(1)=XE(2):YE(1)=YE(2):XE(2)=EXX:YE(2)=EXY:GOTO 2370 +2360 IF YE(3)>=YE(1) AND YE(3)>=YE(2) THEN EXX=XE(1):EXY=YE(1):XE(1)=XE(3):YE(1)=YE(3):XE(3)=EXX:YE(3)=EXY +2370 IF YE(3)>YE(2) THEN EXX=XE(2):EXY=YE(2):XE(2)=XE(3):YE(2)=YE(3):XE(3)=EXX:YE(3)=EXY +2380 EX1=XE(1)-XE(2):EY1=YE(1)-YE(2) +2390 EX2=XE(1)-XE(3):EY2=YE(1)-YE(3) +2400 EX3=XE(2)-XE(3):EY3=YE(2)-YE(3) +2410 IF EY1<>0 THEN STP1=EX1/EY1 +2420 IF EY2<>0 THEN STP2=EX2/EY2 +2430 IF EY3<>0 THEN STP3=EX3/EY3 +2440 PCH=INT(RND*FREQ+1.5):COMP=1 +2450 CPT2=0 +2460 FOR CPT1=0 TO EY1 +2470 X1=INT(XE(1)-CPT1*SPT1+.5):X2=INT(XE(1)-CPT2*STP2+.5):Y1=YE(1)-CPT1 +2480 IF EY1=0 THEN X1=XE(2) +2490 IF EY2=0 THEN X2=XE(3) +2500 GOSUB 3420 +2510 NEXT CPT1 +2520 FOR CPT1=1 TO EY3 +2530 X1=INT(XE(2)-CPT1*STP3+.5):X2=INT(XE(1)-CPT2*STP2+.5):Y1=YE(1)-CPT2 +2540 GOSUB 3420 +2550 NEXT CPT1 +2560 IF (TYPE=2 AND NCOUL=0 AND INDM=0) OR (TYPE=3 AND NCOUL=1) OR BORD$="O" OR BORD$="o" THEN C=1:GOSUB 3600 +2570 RETURN +2580 REM +2590 REM ======================================================================= +2600 REM Gnration de la Matrice +2610 REM ======================================================================= +2620 REM Gnration de la Matrice +2630 RANDOMIZE ALEA +2640 DN=2^MAIL+1:PAS=DN-1:ECH=4000 +2650 DIM NOEUD (DN,DN) +2660 WHILE PAS>1 +2670 FOR I=1 TO DN-PAS STEP PAS +2680 FOR J=1 TO DN-I-PAS+1 STEP PAS +2690 A=I+PAS/2:B=J+PAS/2:C=I+PAS:D=J+PAS +2700 GOSUB 2870 +2710 NOEUD (I,B)=(NOEUD(I,J)+NOEUD(I,D))/2+ALT +2720 GOSUB 2870 +2730 NOEUD (A,J)=(NOEUD(I,J)+NOEUD(C,J))/2+ALT +2740 GOSUB 2870 +2750 NOEUD (A,B)=(NOEUD(C,J)+NOEUD(I,D))/2+ALT +2760 NEXT J +2770 NEXT I +2780 PAS=PAS/2 +2790 ECH=ECH/2 +2800 WEND +2810 RETURN +2820 REM +2830 REM ======================================================================= +2840 REM Calcul alatoire d'altitude +2850 REM ======================================================================= +2860 REM +2870 ALT=RND*ECH +2880 IF RND>PROF/100 THEN ALT=-ALT +2890 RETURN +2900 REM +2910 REM ======================================================================= +2920 REM Sous-programme de calcul du centrage +2930 REM ======================================================================= +2940 REM +2950 XEMIN=1000:YEMIN=1000 +2960 XEMAX=-1000:YEMAX=-1000 +2970 IF MAIL>5 THEN STP=2^(MAIL-5) ELSE STP=1 +2980 FOR I=1 TO DN STEP STP +2990 FOR J=1 TO DN-I+1 STEP STP +3000 CI=I:CJ=J +3010 GOSUB 3220 +3020 IF XEXEMAX THEN XEMAX=XE +3040 IF YEYEMAX THEN YEMAX=YE +3060 NEXT J +3070 NEXT I +3080 ECRX=600:ECRY=190 +3090 RAP=2.62 +3100 ECHX=ECRX/(XEMAX-XEMIN)/RAP +3110 ECHY=ECRY/(YEMAX-YEMIN) +3120 IF ECHYX2 THEN 3470 +3450 IF COMP=INT(PCH+.5) THEN PSET(X1,Y1),1 ELSE PSET(X1,Y1),0 +3460 GOTO 3530 +3470 FOR N=X1 TO X2 STEP SGN(X2-X1) +3480 C=0 +3490 IF COMP=INT(PCH+.5) THEN C=1:PCH=PCH+FREQ +3500 PSET (N,Y1),C +3510 COMP=COMP+1 +3520 NEXT N +3530 CPT2=CPT2+1 +3540 RETURN +3550 REM +3560 REM =============================== +3570 REM trac des contours +3580 REM =============================== +3590 REM +3600 LINE (XE(1),YE(1))-(XE(2),YE(2)),C +3610 LINE (XE(2),YE(2))-(XE(3),YE(3)),C +3620 LINE (XE(3),YE(3))-(XE(1),YE(1)),C +3630 RETURN + \ No newline at end of file diff --git a/FWF.BAS b/FWF.BAS new file mode 100644 index 0000000..5db6a81 --- /dev/null +++ b/FWF.BAS @@ -0,0 +1,33 @@ +5 CLS:dim b(10000) +10 SCREEN 1:DX=20:'window (0,0)-(319,199) +15 'WINDOW SCREEN (0,0)-(1500,1500):DX=1000:DY=1000 +20 REM ************************************************************************ +30 REM *** FWF INSIGNE de DARCHE Yoann en BASICA avec un cran CGA *** +40 REM ************************************************************************ +50 DATA 32,75,95,75,120,111,135,85,120,50,129,50,145,75,162,50,171,50,153,85,170 +60 DATA 111,189,83,-1,-1,204,84,225,88,225,100,195,100,170,150,145,100,120,150 +70 DATA 86,85,22,96,-2,-2 +80 REM -1,-1 = arrt pas de liason avec la prochne coordonne. -2,-2 fin +90 READ X,Y:IF X=-2 THEN 200 'fin +100 PSET (X+DX,Y+DY),1 +110 READ X1,Y1:IF X1=-2 THEN 200' fin +120 IF X1=-1 THEN 90 'pas de liaison avec la prochaine coordonne +130 LINE -(X1+DX,Y1+DY),1:GOTO 110 +199 REM *************************$ Les cercles ********************************* +200 CIRCLE (145+DX,150+DY),149,1,1,3.14 +210 CIRCLE (151+DX,146+DY),142,1,0,3.18 +220 LINE (-4+DX,150+DY)-(9+DX,150+DY),1 +230 CIRCLE (227+DX,91+DY),41,1,1.3,2.3,2.5/2 +240 LINE (170+DX,111+DY)-(205+DX,60+DY),1 +250 CIRCLE (237+DX,137+DY),71,1,.6,2.3,2.8/2 +260 PAINT (145+DX,90+DY),1 +270 PAINT (10+DX,100+DY),1 +280 LINE (163+DX,28+DY)-(166+DX,28+DY),1 +290 PSET(172+DX,29+DY),1:PSET (256+DX,67+DY),1 +300 PSET(262+DX,74+DY),1:PSET(263+DX,75+DY),1:PSET(24+DX,95+DY),1 +310 get (0,0)-(319,199),b:cls +Put (0,0),b,pset +def seg=&hb800 +bsave "a:fwf.pic",0,16384 + + diff --git a/FWF.PIC b/FWF.PIC new file mode 100644 index 0000000..c128a57 Binary files /dev/null and b/FWF.PIC differ diff --git a/G.IM b/G.IM new file mode 100644 index 0000000..02a7e63 Binary files /dev/null and b/G.IM differ diff --git a/GDF1.BAS b/GDF1.BAS new file mode 100644 index 0000000..204893e Binary files /dev/null and b/GDF1.BAS differ diff --git a/GDF2.BAS b/GDF2.BAS new file mode 100644 index 0000000..f2540a4 Binary files /dev/null and b/GDF2.BAS differ diff --git a/GDF3.BAS b/GDF3.BAS new file mode 100644 index 0000000..6c8603a Binary files /dev/null and b/GDF3.BAS differ diff --git a/GDF4.BAS b/GDF4.BAS new file mode 100644 index 0000000..0f848ea Binary files /dev/null and b/GDF4.BAS differ diff --git a/GEODESIC.BAS b/GEODESIC.BAS new file mode 100644 index 0000000..a28c019 --- /dev/null +++ b/GEODESIC.BAS @@ -0,0 +1,83 @@ +0 SCREEN 2 +10 LX=640:LY=200 +20 PP=SQR(3)/2 +30 UI=0:UM=6.283184:VI=0:VM=6.283184 +40 DU=(UM-UI)/1000:DV=(VM-VI)/1000 +50 INPUT "paramtre U et V initiaux ",U,V +100 INPUT "paramtre U et V initiaux ",U,V +105 GOSUB 1000:GOSUB 1100 +107 XX=XP:YY=YP +110 INPUT "VITESSE INITIAL TU ET TV ";TU,TV +111 IF TU=0 AND TV=0 THEN 110 +112 GOSUB 1200 +113 MV=SQR(UX*UX+UY+UZ*UZ)*TU+SQR(VX*VX+VY+VZ*VZ)*TV +115 DT=2/MV +117 CLS:GOSUB 2000 +120 FOR I=1 TO 5000 +125 GOSUB 1500:GOSUB 1700 +130 U=U+DT*TU:V=V+DT*TV +140 TU=TU+DT*GU:TV=TV+DT*GV +150 GOSUB 1000:GOSUB 1100 +155 GOSUB 1200 +157 N=(UY*VZ-UZ*VY)+(UZ*VX-UX*VZ)+(UX*VY-UY*VX) +158 IF N<0 THEN PSET (XP,VP):GOTO 170 +160 LINE (XX,YY)-(XP,YP) +170 XX=XP:YY=YP +180 NEXT I:INPUT R$:END +1000 REM +1005 R1=80:R2=40 +1010 X=COS(U)*(R1+R2*COS(V)) +1020 Y=SIN(U)*(R1+R2*COS(V)) +1030 Z=R2*SIN(V) +1040 RETURN +1100 REM +1120 XP=LX/2+(Y-X)*PP +1130 YP=(LY+X+Y)/2-Z +1140 RETURN +1200 REM +1220 US=U:VS=V:GOSUB 1000:X0=X:Y0=Y:Z0=Z +1230 U=U+DU:GOSUB 1000:X1=X:Y1=Y:Z1=Z +1240 U=US:V=V+DV:GOSUB 1000 +1250 UX=(X1-X0)/DU:VX=(X-X0)/DV +1260 UY=(Y1-Y0)/DU:VY=(Y-Y0)/DV +1270 UZ=(Z1-Z0)/DU:VZ=(Z-Z0)/DV +1280 V=VS:RETURN +1500 REM +1520 U0=U:V0=V:GOSUB 1200 +1530 U1=UX:U2=UY:U3=UZ +1540 V1=VX:V2=VY:V3=VZ +1550 U=U+DU:GOSUB 1200 +1560 EX=(UX-U1)/DU:FX=(VX-V1)/DU +1570 EY=(UY-U2)/DU:FY=(VY-V2)/DU +1580 EZ=(UZ-U3)/DU:FZ=(VZ-V3)/DU +1590 U=U0:V=V0+DV:GOSUB 1200 +1600 GX=(VX-V1)/DV +1610 GY=(VY-V2)/DV +1620 GZ=(VZ-V3)/DV +1630 V=V0:GOSUB 1200 +1640 RETURN +1699 REM +1700 UU=UX*UX+UY*UY+UZ*UZ +1710 UV=UX*VX+UY*VY+UZ*VZ +1720 VV=VX*VX+VY*VY+VZ*VZ +1730 UE=UX*EX+UY*EY+UZ*EZ +1740 UF=UX*FX+UY*FY+UZ*FZ +1750 UG=UX*GX+UY*GY+UZ*GZ +1760 VE=VX*EX+VY*EY+VZ*EZ +1770 VF=VX*FX+VY*FY+VZ*FZ +1780 VG=VX*GX+VY*GY+VZ*GZ +1790 CU=-(TU*TU*UE+2*TU*TV*UF+TV*TV*UG) +1800 CV=-(TU*TU*VE+2*TU*TV*VF+TV*TV*VG) +1810 GU=(CU*VV*CV*UV)/(UU*VV-UV*UV) +1820 GV=(UU*CV-UV*CU)/(UU*VV-UV*UV) +1830 RETURN +1999 REM +2000 UU=U:VV=V:KU=80:KV=40:FOR U=UI TO UM STEP (UM-UI)/KU +2005 FOR V=VI TO VM STEP (VM-VI)/KV +2006 GOSUB 1200 +2007 N=(UY*VZ-UZ*VY)+(UZ*VX-UX*VZ)+(UX*VY-UY*VX) +2008 IF N<0 THEN 2040 +2010 GOSUB 1000:GOSUB 1100 +2020 PSET (XP,YP) +2040 NEXT V:NEXT U:U=UU:V=VV:RETURN + \ No newline at end of file diff --git a/GEOGRAPH.BAS b/GEOGRAPH.BAS new file mode 100644 index 0000000..48e1b64 Binary files /dev/null and b/GEOGRAPH.BAS differ diff --git a/GRAPHI.BAS b/GRAPHI.BAS new file mode 100644 index 0000000..a496c90 --- /dev/null +++ b/GRAPHI.BAS @@ -0,0 +1,69 @@ +10 ' Enchainement d'images graphiques en gwbasic. +20 ' basic /M:&HE000 +120 SCREEN 1: KEY OFF : GOSUB 540 +130 LOCATE 12,4 : PRINT "Cration de deux fichiers images " +135 GOSUB 500 +136 CLS +140 ' +150 FOR I%=1 TO 100 +160 COULEUR%=1+(2*RND) : X%=639*RND : Y%=199*RND : RAYON%=200*RND +170 CIRCLE(X%,Y%),RAYON%,COULEUR% +180 NEXT +190 ' +200 DEF SEG=&HB800 : BSAVE "IMAGE1.BLD", 0, &H4000 +210 LINE (0,0)-(639,199),3,BF +220 ' +230 FOR I%=1 TO 100 +240 COULEUR%=(2*RND) : X1%=639*RND : Y1%=199*RND : X2%=639*RND : Y2%=199*RND +250 LINE (X1%,Y1%)-(X2%,Y2%),COULEUR%,B +260 NEXT +270 ' +280 BSAVE "IMAGE2.BLD", 0, &H4000 +290 ' +300 DEF SEG : CLS : LOCATE 12,4 : PRINT "Reprise et affichage des fichiers " +310 ' +320 DIM IMG1%(&H2000),IMG2%(&H2000) +330 ' +340 ADRESSE1%=VARPTR(IMG1%(0)) : BLOAD "IMAGE1.BLD", ADRESSE1% +360 ADRESSE2%=VARPTR(IMG2%(0)) : BLOAD "IMAGE2.BLD", ADRESSE2% +380 ' +390 WHILE INKEY$="" +400 CALLS TRANS(IMG1%(0)) : GOSUB 500 +420 CALLS TRANS(IMG2%(0)) : GOSUB 500 +440 WEND +460 '------------------------------------------------------------------------- +470 SCREEN 0 : WIDTH 80 : END +480 '------------------------------------------------------------------------- +490 ' attente +500 FOR I%=1 TO 5000 : NEXT +510 RETURN +515 ' +520 ' enlever les deux ligne de vrification si tout fonctionne bien +530 ' +540 FOR I=0 TO 122 : READ X : VERIF = VERIF+X : NEXT +550 IF VERIF <> 14655 THEN PRINT "ERREUR DE SAISIE DANS LES DATA ":END +555 ' +560 ' POKage de RCLS : +570 TRANS = &HE000 : RESTORE 630 : DEF SEG +580 FOR I=0 TO 122 : READ X : POKE TRANS+I, X : NEXT +590 RETURN +600 '------------------------------------------------------------------------ +610 ' roUtine ASSEMBLEUR . +620 '------------------------------------------------------------------------ +630 DATA 85 , 139 , 236 , 30 , 6 , 197 , 118 , 6 , 139 +640 DATA 198 , 139 , 232 , 51 , 192 , 205 , 26 , 184 , 1 +650 DATA 0 , 11 , 208 , 129 , 250 , 160 , 15 , 118 , 6 +660 DATA 129 , 234 , 160 , 15 , 235 , 244 , 82 , 139 , 194 +670 DATA 51 , 210 , 185 , 5 , 0 , 247 , 241 , 131 , 250 +680 DATA 0 , 90 , 116 , 219 , 209 , 226 , 205 , 17 , 169 +690 DATA 48 , 0 , 117 , 5 , 184 , 0 , 176 , 235 , 3 +700 DATA 184 , 0 , 184 , 142 , 192 , 51 , 255 , 185 , 160 +710 DATA 15 , 139 , 4 , 38 , 137 , 5 , 139 , 132 , 0 +720 DATA 32 , 38 , 137 , 133 , 0 , 32 , 3 , 250 , 129 +730 DATA 255 , 62 , 31 , 118 , 4 , 129 , 239 , 64 , 31 +740 DATA 139 , 199 , 139 , 240 , 139 , 197 , 3 , 245 , 81 +750 DATA 185 , 100 , 0 , 144 , 226 , 253 , 89 , 226 , 212 +760 DATA 7 , 31 , 93 , 202 , 4 , 0 +770 ' +780 ' pour routine inline TB, enlever Les 3 dernier codes. + \ No newline at end of file diff --git a/GRAPHIC.BAS b/GRAPHIC.BAS new file mode 100644 index 0000000..4ee43c0 --- /dev/null +++ b/GRAPHIC.BAS @@ -0,0 +1,21 @@ +0 CLEAR,,,32768!:SCREEN 5 +10 CLS +20 FOR I=0 TO 10 +30 LINE (150,I*10)-(150-I*10,100) +31 LINE (51,100-I*10)-(51+I*10,1) +32 LINE (150+I*10,1)-(250,I*10) +33 LINE (51,I*10+100)-(51+I*10,200) +34 LINE (150+I*10,200)-(250,200-I*10) +35 LINE (150,I*10)-(150+I*10,100) +36 LINE (150,200-I*10)-(150-I*10,100) +37 LINE (150,200-I*10)-(150+I*10,100) +40 NEXT +41 LINE (50,199)-(250,199) +45 GOTO 45 +60 FOR I=0 TO 10 +65 LINE (200,100-I*10)-(200+I*10,1) +66 LINE (200+I*10,1)-(300,I*10) +67 LINE (200,I*10)-(200+I*10,100) +68 LINE (200+I*10,100)-(300,100-I*10) +70 NEXT + \ No newline at end of file diff --git a/GRAPHICS.PAS b/GRAPHICS.PAS new file mode 100644 index 0000000..74c41a2 --- /dev/null +++ b/GRAPHICS.PAS @@ -0,0 +1,44 @@ +Program Graphics; +{ fait par drche yoann pour IBM & Copactible } + + + + + +const + co=2; +var + x,y,x1,y1 :integer; + +Procedure TRACE; + +Begin + Draw(x,y,x1,y1,co); +End; + + +Procedure Calcule; + +Begin + x := x+1; + x1:= x1-1 ; + y:= y-1 ; + y1:= y1+1; + Trace; +End; + { debut du programme } + +Begin +Begin +GraphColorMode; +Palette(2); + Calcule; + trace; + + trace; + calcule; + +end + + + \ No newline at end of file diff --git a/GRAPHIMP.BAS b/GRAPHIMP.BAS new file mode 100644 index 0000000..d6d4a73 --- /dev/null +++ b/GRAPHIMP.BAS @@ -0,0 +1,9 @@ +10 CLS +20 LOCATE 12,1:PRINT " Allumez votre imprimante et appuyer sur une touche" +30 A$=INPUT$(1) +40 LPRINT CHR$(27);"!" +50 LPRINT CHR$(18) +60 PRINT "Votre imprimante est configure en mode Graphique !!! " +70 LOCATE 22,70:PRINT "Darche Yoann" +80 END + \ No newline at end of file diff --git a/H.IM b/H.IM new file mode 100644 index 0000000..4b7debc Binary files /dev/null and b/H.IM differ diff --git a/IMAGE.DAZ b/IMAGE.DAZ new file mode 100644 index 0000000..3af33a6 Binary files /dev/null and b/IMAGE.DAZ differ diff --git a/IMAGE.IM b/IMAGE.IM new file mode 100644 index 0000000..2c83d79 Binary files /dev/null and b/IMAGE.IM differ diff --git a/IMP.BAS b/IMP.BAS new file mode 100644 index 0000000..acc32b0 --- /dev/null +++ b/IMP.BAS @@ -0,0 +1,5 @@ +cls +lprint chr$(18) +print "IMPRIMANTE OK pour graphiques " +end + \ No newline at end of file diff --git a/IMPRIME.BAS b/IMPRIME.BAS new file mode 100644 index 0000000..bcafc46 --- /dev/null +++ b/IMPRIME.BAS @@ -0,0 +1,7 @@ +lprint chr$(27);"!" +lprint chr$(27);chr$(22) +Lprint chr$(27);chr$(77) +lprint "tftytvv" +lprint "jhu" + + diff --git a/IN-IMP.BAS b/IN-IMP.BAS new file mode 100644 index 0000000..407bd9d --- /dev/null +++ b/IN-IMP.BAS @@ -0,0 +1,46 @@ +'******************* PROGRAMME D'INITIATION DE L'IMPRIMANTE ******************* + + +DEBUT : + COLOR 11,1:CLS + MENU$="IN-IMP.EXE" + GOSUB FAITECRAN + LOCATE 12,18:PRINT " -- Initiation de l'imprimante Ver 2.1 -- " + A$=INPUT$(1):IF A$=CHR$(27) THEN END + + +PROG : + + COLOR 13,0:CLS + menu$="CHOIX" + GOSUB FAITECRAN + LOCATE 10,20:PRINT " -1- GRAPHIQUE " + LOCATE 12,20:PRINT " -2- NORMAL " + LOCATE 14,20:PRINT " Pour SORTIR + A$=INPUT$(1):IF A$=CHR$(27) THEN CLS:END + IF A$="&" OR A$="1" THEN GOTO GRAPHI + IF A$="" OR A$="2" THEN GOTO NORMAL + BEEP:COLOR ,7:CLS:BEEP:COLOR ,4:CLS:BEEP:COLOR ,1:CLS:GOTO PROG + +NORMAL : +LPRINT CHR$(27);"!":CLS:END + +GRAPHI : +LPRINT CHR$(27);"!" +LPRINT CHR$(18); +CLS:END + +FAITECRAN : + + MENU$=" "+MENU$+" " + LONG=LEN(MENU$):IT%=INT((80-LONG)/2) + LOCATE 1,IT%:PRINT "";STRING$(LONG,205);""; + LOCATE 2,1 + PRINT "";STRING$(IT%-2,205);"";MENU$;"";STRING$(78-IT%-LONG,205);""; + LOCATE 3,IT%:PRINT "";STRING$(LONG,205);""; + FOR I=3 TO 22 :LOCATE I,1 :PRINT "":LOCATE I,80:PRINT "";:NEXT I + LOCATE 23,1:PRINT "";STRING$(78,205);""; + LOCATE 4,1 +RETURN + + \ No newline at end of file diff --git a/ITALIQUE.BAS b/ITALIQUE.BAS new file mode 100644 index 0000000..4d9f401 Binary files /dev/null and b/ITALIQUE.BAS differ diff --git a/KAL1.BAS b/KAL1.BAS new file mode 100644 index 0000000..c7cb055 Binary files /dev/null and b/KAL1.BAS differ diff --git a/KAL2.BAS b/KAL2.BAS new file mode 100644 index 0000000..f39f4e4 Binary files /dev/null and b/KAL2.BAS differ diff --git a/KAL3.BAS b/KAL3.BAS new file mode 100644 index 0000000..97fe74d Binary files /dev/null and b/KAL3.BAS differ diff --git a/KAL4.BAS b/KAL4.BAS new file mode 100644 index 0000000..e7bd695 Binary files /dev/null and b/KAL4.BAS differ diff --git a/KKKK.IM b/KKKK.IM new file mode 100644 index 0000000..96e31f0 Binary files /dev/null and b/KKKK.IM differ diff --git a/LABY.BAS b/LABY.BAS new file mode 100644 index 0000000..d86db88 --- /dev/null +++ b/LABY.BAS @@ -0,0 +1,256 @@ +10 KEY 5,"LIST 3000-5000"+CHR$(13) +20 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +30 REM :: PROGRAMME ECRIT EN (GW)BASIC(A) POUR IBM :: +40 REM :: imagine,compose,et ralise par DARCHE YOANN ........... :: +50 REM :: =-=-=-=-=-=-=-=-=-=-=-=-= :: +60 REM :: Le LABYRINTHE INFERNAL VERSION 1.1 :: +70 REM :: =-=-=-=-=-=-=-=-=-=-=-=-= :: +80 REM :: Commenc le : 3/06/1990 fini le : 04/06/1990 :: +90 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +100 DEFINT X,Y,I,J,B,A +110 DIM P$(10,10),AF$(10,10) +120 X=2:Y=3:XM=1:YM=Y +130 SCREEN 2:SCREEN 0:COLOR 1,0 +140 CLS +150 GOSUB 340:CLS:SCREEN 1 +160 D$=P$(X,Y):B=VAL(D$) +170 'COLOR 1,0:LOCATE YM+2,XM:PRINT AF$(XM,YM); +180 'COLOR 14,0:LOCATE Y+2,X:PRINT AF$(X,Y); +190 IF B=17 THEN 5000 +200 IF B=16 THEN X=XM:Y=YM :B=12 +210 IF B=12 OR B=13 OR B=14 OR B=15 THEN IM = 8:FLAG=1:GOTO 230 ELSE FLAG=0 +220 ON B GOSUB 2010,2040,2070,2100,2130,2160,2190,2250,2290,2330,2370 +230 ON IM GOSUB 4010,4090,4160,4220,4290,4370,4450,4530 +240 T$=INPUT$(1):IF T$=CHR$(27) THEN END +250 XN=XM:YN=YM +260 IF T$="2" THEN SWAP X,XM:SWAP Y,YM:GOTO 160 +270 IF FLAG=1 THEN 300 +280 XM=X:YM=Y +290 ON B GOSUB 3030,3070,3110,3150,3190,3230,3270,3410,3490,3570,3650 +300 IF (XM=X AND YM=Y) THEN XM=XN:YM=YN:LOCATE 25,1:PRINT "Non ! Seulement ";MES$;" ";:BEEP:GOTO 240 +310 GOTO 160 +320 END +330 REM LECTURE ET AFFICHAGE DU LABYRINTHE +340 RESTORE +350 FOR J=1 TO 9 +360 FOR I=1 TO 9 +370 READ A$ +380 P$(I,J)=A$ +390 IF A$="1" THEN AFF%=205 +400 IF A$="2" THEN AFF%=186 +410 IF A$="3" THEN AFF%=201 +420 IF A$="4" THEN AFF%=200 +430 IF A$="5" THEN AFF%=188 +440 IF A$="6" THEN AFF%=187 +450 IF A$="7" THEN AFF%=206 +460 IF A$="16" THEN AFF%=69 +470 IF A$="17" THEN AFF%=83 +480 IF A$="12" THEN AFF%=26 +490 IF A$="13" THEN AFF%=24 +500 IF A$="14" THEN AFF%=25 +510 IF A$="15" THEN AFF%=27 +520 IF A$="8" THEN AFF%=203 +530 IF A$="9" THEN AFF%=202 +540 IF A$="10" THEN AFF%=204 +550 IF A$="11" THEN AFF%=185 +560 LOCATE J+2,I:PRINT CHR$(AFF%);:AF$(I,J)=CHR$(AFF%) +570 NEXT I +580 NEXT J +590 RETURN +2000 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +2010 IF X < XM THEN A=1 ELSE A=2 +2020 IM=1:RETURN +2030 REM ======================================================================= +2040 IF Y < YM THEN A=1 ELSE A=2 +2050 IM=1:RETURN +2060 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +2070 IF X < XM THEN A=1:IM = 3 ELSE A=2:IM=2 +2080 RETURN +2090 REM ======================================================================= +2100 IF X < XM THEN A=1:IM = 2 ELSE A=2:IM=3 +2110 RETURN +2120 REM ======================================================================= +2130 IF X > XM THEN A=1:IM = 3 ELSE A=2:IM=2 +2140 RETURN +2150 REM ======================================================================= +2160 IF X > XM THEN A=1:IM = 2 ELSE A=2:IM=3 +2170 RETURN +2180 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +2190 IM=7 +2200 IF Y=YM AND X>XM THEN A=1:RETURN +2210 IF Y=YM AND XYM THEN A=3:RETURN +2230 A=4:RETURN +2240 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +2250 IF X > XM THEN A=1:IM=5:RETURN +2260 IF X < XM THEN A=2:IM=6:RETURN +2270 A=3:IM=4:RETURN +2280 REM ======================================================================= +2290 IF X > XM THEN A=1:IM=6:RETURN +2300 IF X < XM THEN A=2:IM=5:RETURN +2310 A=3:IM=4:RETURN +2320 REM ======================================================================= +2330 IF Y > YM THEN A=1:IM=6:RETURN +2340 IF Y < YM THEN A=2:IM=5:RETURN +2350 A=3:IM=4:RETURN +2360 REM ======================================================================= +2370 IF Y > YM THEN A=1:IM=5:RETURN +2380 IF Y < YM THEN A=2:IM=6:RETURN +2390 A=3:IM=4:RETURN +3000 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +3010 REM ************ CALCULE DES DEPLACEMENTS ******************************** +3020 REM ======================== B=1 : ===================================== +3030 IF A=1 AND T$="8" THEN X=X-1:RETURN +3040 IF A=2 AND T$="8" THEN X=X+1:RETURN +3050 RETURN +3060 REM ======================== B=2 : ====================================== +3070 IF T$="8" AND A=1 THEN Y=Y-1:RETURN +3080 IF T$="8" AND A=2 THEN Y=Y+1:RETURN +3090 RETURN +3100 REM ========================== B=3 : ==================================== +3110 IF T$="4" AND A=1 THEN Y=Y+1:RETURN +3120 IF T$="6" AND A=2 THEN X=X+1:RETURN +3130 RETURN +3140 REM ========================== B=4 : ==================================== +3150 IF T$="6" AND A=1 THEN Y=Y-1:RETURN +3160 IF T$="4" AND A=2 THEN X=X+1:RETURN +3170 RETURN +3180 REM ========================== B=5 : ==================================== +3190 IF T$="4" AND A=1 THEN Y=Y-1:RETURN +3200 IF T$="6" AND A=2 THEN X=X-1:RETURN +3210 RETURN +3220 REM ========================== B=6 : ==================================== +3230 IF T$="6" AND A=1 THEN Y=Y+1:RETURN +3240 IF T$="4" AND A=2 THEN X=X-1:RETURN +3250 RETURN +3260 REM ========================== B=7 : ==================================== +3270 IF T$="8" AND A=1 THEN X=X+1:RETURN +3280 IF T$="4" AND A=1 THEN Y=Y-1:RETURN +3290 IF T$="6" AND A=1 THEN Y=Y+1:RETURN +3300 IF T$="8" AND A=2 THEN X=X-1:RETURN +3310 IF T$="4" AND A=2 THEN Y=Y+1:RETURN +3320 IF T$="6" AND A=2 THEN Y=Y-1:RETURN +3330 IF T$="8" AND A=3 THEN Y=Y+1:RETURN +3340 IF T$="4" AND A=3 THEN X=X+1:RETURN +3350 IF T$="6" AND A=3 THEN X=X-1:RETURN +3360 IF T$="8" AND A=4 THEN Y=Y-1:RETURN +3370 IF T$="4" AND A=4 THEN X=X-1:RETURN +3380 IF T$="6" AND A=4 THEN X=X+1:RETURN +3390 RETURN +3400 REM ========================== B=8 : ==================================== +3410 IF A=1 AND T$="6" THEN Y=Y+1:RETURN +3420 IF A=1 AND T$="8" THEN X=X+1:RETURN +3430 IF A=2 AND T$="4" THEN Y=Y+1:RETURN +3440 IF A=2 AND T$="8" THEN X=X-1:RETURN +3450 IF A=3 AND T$="4" THEN X=X-1:RETURN +3460 IF A=3 AND T$="6" THEN X=X+1:RETURN +3470 RETURN +3480 REM ========================== B=9 : ==================================== +3490 IF A=1 AND T$="4" THEN Y=Y-1:RETURN +3500 IF A=1 AND T$="8" THEN X=X+1:RETURN +3510 IF A=2 AND T$="6" THEN Y=Y-1:RETURN +3520 IF A=2 AND T$="8" THEN X=X-1:RETURN +3530 IF A=3 AND T$="4" THEN X=X+1:RETURN +3540 IF A=3 AND T$="6" THEN X=X-1:RETURN +3550 RETURN +3560 REM ========================== B=10: ==================================== +3570 IF A=1 AND T$="4" THEN X=X+1:RETURN +3580 IF A=1 AND T$="8" THEN Y=Y+1:RETURN +3590 IF A=2 AND T$="6" THEN X=X+1:RETURN +3600 IF A=2 AND T$="8" THEN Y=Y-1:RETURN +3610 IF A=3 AND T$="4" THEN Y=Y+1:RETURN +3620 IF A=3 AND T$="6" THEN Y=Y-1:RETURN +3630 RETURN +3640 REM ========================== B=11: ==================================== +3650 IF A=1 AND T$="6" THEN X=X-1:RETURN +3660 IF A=1 AND T$="8" THEN Y=Y+1:RETURN +3670 IF A=2 AND T$="4" THEN X=X-1:RETURN +3680 IF A=2 AND T$="8" THEN Y=Y-1:RETURN +3690 IF A=3 AND T$="4" THEN Y=Y-1:RETURN +3700 IF A=3 AND T$="6" THEN Y=Y+1:RETURN +3710 RETURN +4000 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +4010 CLS:LOCATE 1,1:PRINT " C'EST UNE SIMPLE ALLEE ":MES$=" (8) ou (2) " +4020 LINE (110,70)-(10,10),1 +4030 LINE -(310,190),1,B +4040 LINE -(210,130),1 +4050 LINE (310,10)-(210,70),1 +4060 LINE -(110,130),1,B +4070 LINE -(10,190),1 +4080 RETURN +4081 REM ======================================================================= +4090 CLS:LOCATE 1,1:PRINT " C'est un virage droit ";:MES$=" (6) ou (2) " +4100 LINE (10,10)-(310,190),1,B +4110 LINE (110,70)-(250,130),2,BF +4120 LINE (310,10)-(250,46),1:LINE -(250,154),1:LINE -(310,190),1 +4130 LINE (10,10)-(110,70),1 +4140 LINE (110,130)-(10,190),1 +4150 RETURN +4151 REM ======================================================================= +4160 CLS:LOCATE 1,1:PRINT " C'est un virage Gauche ";:MES$=" (4) ou (2) " +4170 LINE (10,10)-(310,190),1,B +4180 LINE (70,70)-(210,130),2,BF +4190 LINE -(310,190),1:LINE (210,70)-(310,10),1 +4200 LINE (10,190)-(70,154),1:LINE -(70,46),1:LINE -(10,10),1 +4210 RETURN +4211 REM ======================================================================= +4220 CLS:LOCATE 1,1:PRINT " c'est un T ";:MES$=" (4) (2) (6) " +4230 LINE (10,10)-(310,190),1,B +4240 LINE -(230,150),1:LINE -(230,50),1:LINE -(310,10),1 +4250 LINE (10,10)-(90,50),1 +4260 LINE -(90,150),1:LINE -(10,190),1 +4270 LINE (90,140)-(230,60),2,BF +4280 RETURN +4281 REM ======================================================================= +4290 CLS:LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a droite";:MES$=" (8) (6) (2) " +4300 LINE (10,10)-(310,190),1,B +4310 LINE -(280,172),1:LINE -(280,28),1: LINE -(310,10),1 +4320 LINE (10,10)-(110,70),1:LINE -(210,130),1,B: LINE -(250,154),1 +4330 LINE -(250,46),1:LINE -(210,70),1 +4340 LINE (110,130)-(10,190),1 +4350 LINE (250,46)-(280,154),2,BF +4360 RETURN +4361 REM ======================================================================= +4370 CLS:LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a gauche";:MES$=" (8) (4) (2) " +4380 LINE (310,190)-(10,10),1,B +4390 LINE -(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4400 LINE (310,190)-(210,130),1:LINE -(110,70),1,B +4410 LINE -(70,46),1:LINE -(70,154),1:LINE -(110,130),1 +4420 LINE (40,46)-(70,154),2,BF +4430 LINE (210,70)-(310,10),1 +4440 RETURN +4441 REM ======================================================================= +4450 CLS:LOCATE 1,1:PRINT "C'est une intersection + ";:MES$=" (2) (8) (4) (6) " +4460 LINE (10,10)-(310,190),1,B:LINE (110,70)-(210,130),1,B +4470 LINE (40,46)-(70,154),2,BF:LINE (250,46)-(280,154),2,BF +4480 LINE (310,10)-(280,28),1:LINE -(280,172),1:LINE -(310,190),1 +4490 LINE (10,10)-(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4500 LINE (110,70)-(70,46),1:LINE (70,154)-(110,130),1 +4510 LINE (210,70)-(250,46),1:LINE (250,154)-(210,130),1 +4520 RETURN +4521 REM ======================================================================= +4530 CLS:LOCATE 1,1:PRINT " C'EST UN CUL DE SAC ":MES$=" (2) " +4540 LINE (110,70)-(10,10),1 +4550 LINE -(310,190),1,B +4560 LINE -(210,130),1 +4570 LINE (310,10)-(210,70),1 +4580 LINE -(110,130),2,BF +4590 LINE -(10,190),1 +4600 RETURN +4601 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +5000 CLS:LOCATE 12,1:PRINT " Vous avez reussit ....." +5010 LOCATE 21,5:PRINT "Encore O/N" +5015 FOR I=1 TO 10:A$=INKEY$:NEXT I +5016 A$=INPUT$(1) +5020 IF A$="o" OR A$="O" THEN 120 +5030 SCREEN 2:SCREEN 0:END +6000 DATA 17, 1, 1, 1, 1, 1, 1, 1, 6 +6010 DATA 3, 1, 8, 1, 1,12,15, 6, 2 +6020 DATA 10,16, 4, 1, 6, 3, 6, 2, 2 +6030 DATA 10, 6, 3,12, 2, 2, 2, 2, 2 +6040 DATA 2, 2, 2, 3, 5, 2, 2,10, 5 +6050 DATA 2, 2, 2, 2,15, 5, 2, 4, 6 +6060 DATA 2, 2, 2, 4, 1, 1,11, 3, 5 +6070 DATA 2,14, 4, 1, 1, 1, 7, 5,13 +6080 DATA 4, 1, 1, 1, 1, 1, 9, 1, 5 +6090 DATA -1 diff --git a/LABY.PAS b/LABY.PAS new file mode 100644 index 0000000..b24a930 --- /dev/null +++ b/LABY.PAS @@ -0,0 +1,220 @@ +{cette version de LABY contien : } +{ -Creation d'un labyrinthe 38*11 27/11/1987} +{ -recherche de la solution 27/01/1988} +{ -Optimisation de l'algorythme: 14/02/1988} +{ gnration du laby => 9"50 sur XT ,2"30 sur AT } + +CONST xmax=38; + YMAX=11; + AD=$B800; + +TYPE Pointeur_vers_piece = ^piece; + Piece = RECORD + Precedent : Pointeur_vers_piece; + x,y,r : byte; + END; + +VAR debut_de_liste,ptr1,ptr2:Pointeur_vers_piece; + r,d,i,x,xp,y,yp,moy:byte; + dx,dy:integer; + rep:char; + +{-----------------------------------------------------------------------------} +{ Procedures pour gnrer le labyrinthe } +{-----------------------------------------------------------------------------} + +PROCEDURE Direction(dr:byte;var sx,sy:integer); + Begin + sx:=((2*dr+1) div 3)-1; + sy:=((2*dr+1) mod 3)-1; + End; + +FUNCTION Trace(mr,mx,my:byte):boolean; { Y a-t-il une trace de l'autre cot } + var vx,vy:integer; { du mur dans la direction mr ? } + Begin { Coord laby } + Direction(mr,vx,vy); + if Mem[ad:320*(my+vy)+4*(mx+vx)]=32 then Trace:=false else Trace:=true; + End; + +PROCEDURE Enlever_mur(our,ox,oy:byte); { Enlve le mur de la piece ox,oy } + Var odx,ody:integer; { dans la direction our } + Begin { Coord laby } + Direction(our,odx,ody); + Mem[ad:160*(2*oy+ody)+2*(2*ox+odx)]:=32; + End; + +FUNCTION Distance(drr,dix,diy:byte):byte; { Donne la distance en nombre } + Begin { de pieces entre la piece dix,diy } + Case drr of { et le bord du labyrinthe } + 0: Distance:=dix-1; { dans la direction drr } + 1: Distance:=diy-1; { Coord laby } + 2: Distance:=ymax-diy; + 3: Distance:=xmax-dix; + end; + End; + +FUNCTION Possible_avancer(pr,a,b:byte):boolean; { Est-il posible d'avancer } + Var vx,vy:integer; { dans la direction pr } + Begin { sans crer de boucle } + Direction(pr,vx,vy); { Coord laby } + + if (Trace(pr,a,b)) and (Mem[ad:160*(b*2+vy)+2*(a*2+vx)]<>32) + then Possible_avancer:=false + else Possible_avancer:=true; + End; + +PROCEDURE Remplissage; { Remplis les coins suivant } + Var d,i,exp2,n,x,y,rx,ry:byte; { la position des murs attenant } + vx,vy:integer; + Begin + for x:=0 to xmax do begin + for y:=0 to ymax do begin + rx:=2*x+1; + ry:=2*y+1; + n:=0;exp2:=1; + for i:=0 to 3 do begin + Direction(i,vx,vy); + if Mem[ad:160*(ry+vy)+2*(rx+vx)]<>32 then n:=n+exp2; + exp2:=exp2*2 + end; + Case n of + 0: d:= 32; 1: d:= 181; 2: d:= 208; 3: d:= 188; + 4: d:= 210; 5: d:= 187; 6: d:= 186; 7: d:= 185; + 8: d:= 198; 9: d:= 205; 10: d:= 200; 11: d:= 202; + 12: d:= 201; 13: d:= 203; 14: d:= 204; 15: d:= 206; + end; + Mem[ad:160*ry+2*rx]:=d; + end; + end; + End; +{-----------------------------------------------------------------------------} +{ Procedure pour rechercher la solution } +{-----------------------------------------------------------------------------} + +FUNCTION Sens_interdit(r,x,y:byte):boolean; { Permet de savoir s'il est } + Var ax,ay:integer; { possible d'avencer dans } + Begin { la direction r } + Direction(r,ax,ay); + if ( Mem[ad:160*(2*y+ay)+2*(2*x+ax)]<>32) + or ( Mem[ad:320*(y+ay)+4*(x+ax)]<>32) + then Sens_interdit:=true + else Sens_interdit:=false; + End; + +{-----------------------------------------------------------------------------} +{ Gnration du Labyrinthe } +{-----------------------------------------------------------------------------} + +BEGIN + + Clrscr;{------------ Prparation de l'cran----------------------------------} + + for y:=0 to ymax do for x:=1 to xmax do Mem[ad:320*y+4*x+160]:=205; { dessin } + for y:=1 to ymax do for x:=0 to xmax do Mem[ad:320*y+4*x+2]:=186; {des murs} + + Remplissage; {Dessin des coins} + Mem[ad:324]:=79; {entre} + Mem[ad:320*ymax+4*xmax+2]:=32; {Sortie} + for dx:=0 to 1999 do Mem[ad:2*dx+1]:=7; {Encre normal} + + Randomize; + Moy:=(xmax+ymax) *2; +{-----------------------Fabrication du Labyrinthe-----------------------------} + + For yp:=1 to ymax do begin { Balayage de toute les pices } + for xp:=1 to xmax do begin + (** Recherche du dbut d'un couloir **) + if Mem[ad:320*yp+4*xp]=32 then + + BEGIN + r:=random(4); { Choix direction } + while (not Trace(r,xp,yp)) or (Distance(r,xp,yp)=0) + do r:=(r+1) mod 4; + + Enlever_mur(r,xp,yp); { Ouverture sur un autre couloir } + x:=xp; y:=yp; + (** Gneration du couloir **) + For i:=1 to moy do begin + r:=random(4); { Choix direction } + while Distance(r,x,y)=0 do r:=(r+1) mod 4; { viter le bord } + + Direction(r,dx,dy); + D:=random(Distance(r,x,y)) mod 3 +1; { Choix longueur des petites } + { avances } + while Possible_avancer(r,x,y) and (D>0) do + begin { On avance en dtruisant } + Enlever_mur(r,x,y); { des murs et en laissant } + Mem[ad:160*2*y+2*2*x]:=176; { des traces derrire soi } + x:=x+dx; + y:=y+dy; + Mem[ad:160*2*y+2*2*x]:=219; + D:=D-1; + end; + end; + Mem[ad:160*2*y+2*2*x]:=254; { On quitte ce couloir } + END; { Fin de la gnration du couloir } + End; { Fin couloir, Fin balayage } + End; + +{---------------------------Finition------------------------------------------} + + Remplissage; { Dessin de coins } + { Efface les traces } + for y:=1 to ymax do for x:=1 to xmax do Mem[ad:320*y+4*x]:=32; + Mem[ad:324]:=79; + +gotoxy(5,25);write('Pressez une touche ...');read(kbd,rep);gotoxy(1,25);clreol; +{-----------------------------------------------------------------------------} +{ Recherche de la solution } +{-----------------------------------------------------------------------------} + + NEW ( Debut_de_liste ); { Cration de la premire pice } + + With Debut_de_liste^ do begin + Precedent:=NIL; + x:=1; + y:=1; + r:=0; + end; + + Ptr1:=debut_de_liste; + x:=1; y:=1; r:=0; + + REPEAT {-------------------Dplacement--------------------------------------} + + While (Sens_interdit(r,x,y)) and (r<4) do r:=r+1; { Cherche r pour avancer } + IF r=4 + THEN begin + Ptr2:=Ptr1^.precedent; + r:=Ptr2^.r; + x:=Ptr2^.x; + y:=Ptr2^.y; + Direction(r,dx,dy); + Mem[ad:160*(2*y+dy)+2*(2*x+dx)]:=32; + Mem[ad:320*(y+dy)+4*(x+dx)]:=32; + DISPOSE(Ptr1); + Ptr1:=Ptr2; + r:=r+1; + end + ELSE begin + NEW(ptr2); + Ptr2^.precedent:=Ptr1; + Ptr1^.r:=r; + Direction(r,dx,dy); + if (r=0) or (r=3) then Mem[ad:160*(2*y+dy)+2*(2*x+dx)]:=196 + else Mem[ad:160*(2*y+dy)+2*(2*x+dx)]:=179; + x:=x+dx; + y:=y+dy; + Mem[ad:320*y+4*x]:=219; + Ptr2^.x:=x; + ptr2^.y:=y; + ptr2^.r:=0; + r:=0; + ptr1:=ptr2; + end; + UNTIL (x=xmax) and (y=ymax); + +{----------------------------- Fin du programme ------------------------------} + sound(1500);delay(50);Nosound;gotoxy(1,24); +End. + \ No newline at end of file diff --git a/LABY2.BAS b/LABY2.BAS new file mode 100644 index 0000000..11fa2aa Binary files /dev/null and b/LABY2.BAS differ diff --git a/LABY2E.BAS b/LABY2E.BAS new file mode 100644 index 0000000..ac81711 --- /dev/null +++ b/LABY2E.BAS @@ -0,0 +1,168 @@ +20 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +30 REM :: PROGRAMME ECRIT EN (GW)BASIC(A) POUR IBM :: +40 REM :: imagine,compose,et ralise par DARCHE YOANN ........... :: +50 REM :: =-=-=-=-=-=-=-=-=-=-=-=-= :: +60 REM :: Le LABYRINTHE INFERNAL VERSION 1.2 :: +70 REM :: =-=-=-=-=-=-=-=-=-=-=-=-= :: +80 REM :: Commenc le : 6/06/1990 fini le : ../../19.. :: +90 REM ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +100 DEFINT X,Y,I,J,B,A +110 DIM P$(10,10),AF$(10,10) +120 X=2:Y=3:XM=1:YM=Y:Y2=YM:X2=XM +130 SCREEN 1 +150 GOSUB 340 +155 ' +160 XM=X2:YM=Y2:D$=P$(X,Y):B=VAL(D$):GOSUB 3000 +185 ' +190 IF B=17 THEN 5000 +200 IF B=16 THEN B=12 +210 IF B=12 OR B=13 OR B=14 OR B=15 THEN IM = 8:FLAG=1:GOTO 230 ELSE FLAG=0 +230 ON IM GOSUB 4010,4090,4160,4220,4290,4370,4450,4530 +235 ' +240 T$=INPUT$(1):IF T$=CHR$(27) THEN END +260 IF T$="2" THEN SWAP X,X2:SWAP Y,Y2:GOTO 160 +270 IF FLAG=1 THEN 300 +280 X2=X:Y2=Y +285 'ͼ +290 GOTO 2010 '================= calcule des dplacement ==================== +295 ' +300 LOCATE 25,1:PRINT "Non ! Seulement ";MES$;" ";:BEEP:GOTO 240 +310 GOTO 160 +330 REM LECTURE ET AFFICHAGE DU LABYRINTHE +340 RESTORE +350 FOR J=1 TO 9 +360 FOR I=1 TO 9 +370 READ A$ +380 P$(I,J)=A$ +570 NEXT I +580 NEXT J +590 RETURN +2000 REM ====================== Calcule de dplacement ====================== +2001 ' ::::::::::::::::::::::::: T$="8" ( Tout droit ) :::::::::::::::::::::: +2010 IF T$<>"8" THEN GOTO 2090 +2020 IF (X>XM) AND ( B=7 OR B=8 OR B=9) THEN X=X+1:GOTO 160 +2030 IF (XYM) AND ( B=7 OR B=10 OR B=11 OR B=2) THEN Y=Y+1:GOTO 160 +2050 IF (Y>YM) AND ( B=2 ) THEN Y=Y+1:GOTO 160 +2060 IF (YXM) AND ( B=1 ) THEN X=X+1:GOTO 160 +2080 GOTO 300 +2089 ' ::::::::::::::::::::::::: T$="6" ( A droite ) :::::::::::::::::::::::: +2090 IF T$<>"6" THEN GOTO 2190 +2100 IF (X=XM) AND ( B=3 OR B=8 ) THEN X=X+1:GOTO 160 +2110 IF (YYM) AND ( B=7 OR B=11) THEN X=X-1:GOTO 160 +2140 IF (X>XM) AND ( B=6 OR B=7 OR B=8 ) THEN Y=Y+1:GOTO 160 +2150 IF (Y=YM) AND ( B=11 ) THEN Y=Y+1:GOTO 160 +2160 IF (X"4" THEN GOTO 300 +2200 IF (X=XM) AND ( B=4 OR B=9 ) THEN X=X+1:GOTO 160 +2210 IF (Y>YM) AND ( B=7 OR B=10) THEN X=X+1:GOTO 160 +2220 IF (X=XM) AND ( B=6 OR B=8 ) THEN X=X-1:GOTO 160 +2230 IF (YXM) AND ( B=5 OR B=7 OR B=9) THEN Y=Y-1:GOTO 160 +2260 IF (Y=YM) AND ( B=11 ) THEN Y=Y-1:GOTO 160 +2270 IF (Y=YM) AND ( B=10 ) THEN Y=Y+1:GOTO 160 +2280 GOTO 300 +2999 REM :::::::::::::::::::::::::::::::::::::::: Calcule image :::::::::::::::: +3000 IF B=1 OR B=2 THEN IM=1:RETURN +3010 IF X=XM AND (B=3 OR B=5) OR XXM AND B=6 THEN IM=2:RETURN +3020 IF X=XM AND (B=4 OR B=6) OR XXM AND B=5 THEN IM=3:RETURN +3030 IF B=7 THEN IM=7:RETURN +3040 IF (X>XM AND B=8) OR (XYM AND B=11) THEN IM=5:RETURN +3050 IF (X>XM AND B=9) OR (XYM AND B=10) THEN IM=6:RETURN +3060 IF (X=XM AND (B=8 OR B=9)) OR (Y=YM AND (B=10 OR B=11)) THEN IM=4:RETURN +3070 RETURN +4000 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +4010 CLS:LOCATE 1,1:PRINT " C'EST UNE SIMPLE ALLEE ":MES$=" (8) ou (2) " +4020 LINE (110,70)-(10,10),1 +4030 LINE -(310,190),1,B +4040 LINE -(210,130),1 +4050 LINE (310,10)-(210,70),1 +4060 LINE -(110,130),1,B +4070 LINE -(10,190),1 +4080 RETURN +4081 REM ======================================================================= +4090 CLS:LOCATE 1,1:PRINT " C'est un virage droit ";:MES$=" (6) ou (2) " +4100 LINE (10,10)-(310,190),1,B +4110 LINE (110,70)-(250,130),2,BF +4120 LINE (310,10)-(250,46),1:LINE -(250,154),1:LINE -(310,190),1 +4130 LINE (10,10)-(110,70),1 +4140 LINE (110,130)-(10,190),1 +4150 RETURN +4151 REM ======================================================================= +4160 CLS:LOCATE 1,1:PRINT " C'est un virage Gauche ";:MES$=" (4) ou (2) " +4170 LINE (10,10)-(310,190),1,B +4180 LINE (70,70)-(210,130),2,BF +4190 LINE -(310,190),1:LINE (210,70)-(310,10),1 +4200 LINE (10,190)-(70,154),1:LINE -(70,46),1:LINE -(10,10),1 +4210 RETURN +4211 REM ======================================================================= +4220 CLS:LOCATE 1,1:PRINT " c'est un T ";:MES$=" (4) (2) (6) " +4230 LINE (10,10)-(310,190),1,B +4240 LINE -(230,150),1:LINE -(230,50),1:LINE -(310,10),1 +4250 LINE (10,10)-(90,50),1 +4260 LINE -(90,150),1:LINE -(10,190),1 +4270 LINE (90,140)-(230,60),2,BF +4280 RETURN +4281 REM ======================================================================= +4290 CLS:LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a droite";:MES$=" (8) (6) (2) " +4300 LINE (10,10)-(310,190),1,B +4310 LINE -(280,172),1:LINE -(280,28),1: LINE -(310,10),1 +4320 LINE (10,10)-(110,70),1:LINE -(210,130),1,B: LINE -(250,154),1 +4330 LINE -(250,46),1:LINE -(210,70),1 +4340 LINE (110,130)-(10,190),1 +4350 LINE (250,46)-(280,154),2,BF +4360 RETURN +4361 REM ======================================================================= +4370 CLS:LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a gauche";:MES$=" (8) (4) (2) " +4380 LINE (310,190)-(10,10),1,B +4390 LINE -(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4400 LINE (310,190)-(210,130),1:LINE -(110,70),1,B +4410 LINE -(70,46),1:LINE -(70,154),1:LINE -(110,130),1 +4420 LINE (40,46)-(70,154),2,BF +4430 LINE (210,70)-(310,10),1 +4440 RETURN +4441 REM ======================================================================= +4450 CLS:LOCATE 1,1:PRINT "C'est une intersection + ";:MES$=" (2) (8) (4) (6) " +4460 LINE (10,10)-(310,190),1,B:LINE (110,70)-(210,130),1,B +4470 LINE (40,46)-(70,154),2,BF:LINE (250,46)-(280,154),2,BF +4480 LINE (310,10)-(280,28),1:LINE -(280,172),1:LINE -(310,190),1 +4490 LINE (10,10)-(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4500 LINE (110,70)-(70,46),1:LINE (70,154)-(110,130),1 +4510 LINE (210,70)-(250,46),1:LINE (250,154)-(210,130),1 +4520 RETURN +4521 REM ======================================================================= +4530 CLS:LOCATE 1,1:PRINT " C'EST UN CUL DE SAC ":MES$=" (2) " +4540 LINE (110,70)-(10,10),1 +4550 LINE -(310,190),1,B +4560 LINE -(210,130),1 +4570 LINE (310,10)-(210,70),1 +4580 LINE -(110,130),2,BF +4590 LINE -(10,190),1 +4600 RETURN +4601 REM ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||| +5000 CLS:LOCATE 12,1:PRINT " Vous avez reussit ....." +5010 LOCATE 21,5:PRINT "Encore O/N" +5015 FOR I=1 TO 10:A$=INKEY$:NEXT I +5016 A$=INPUT$(1) +5020 IF A$="o" OR A$="O" THEN 120 +5030 SCREEN 2:SCREEN 0:END +6000 DATA 17, 1, 1, 1, 1, 1, 1, 1, 6 +6010 DATA 3, 1, 8, 1, 1,12,15, 6, 2 +6020 DATA 10,16, 4, 1, 6, 3, 6, 2, 2 +6030 DATA 10, 6, 3,12, 2, 2, 2, 2, 2 +6040 DATA 2, 2, 2, 3, 5, 2, 2,10, 5 +6050 DATA 2, 2, 2, 2,15, 5, 2, 4, 6 +6060 DATA 2, 2, 2, 4, 1, 1,11, 3, 5 +6070 DATA 2,14, 4, 1, 1, 1, 7, 5,13 +6080 DATA 4, 1, 1, 1, 1, 1, 9, 1, 5 +6090 DATA -1 + \ No newline at end of file diff --git a/LABY3.BAS b/LABY3.BAS new file mode 100644 index 0000000..de9d3bd --- /dev/null +++ b/LABY3.BAS @@ -0,0 +1,128 @@ +10 CLEAR:DEFINT A-Z:SCREEN 1:OPTION BASE 1:DIM CF(9),G(2000):CLS:EN = 150 +20 LOCATE 5,10:PRINT "Le Labyrinthe infernal":PRINT:PRINT "de Darche Yoann" +25 PRINT:PRINT "Directions (2)(8)(6)(4) (P)rendre (ESC)ape " +27 PRINT:PRINT "Veuillez patienter, Preparation du jeu ... " +30 RESTORE:READ XME,YME,X,Y,XM,YM:DIM P(XME,YME,3) +40 FOR J=1 TO YME:FOR I=1 TO XME:READ C$:K=1:P(I,J,2)=0:VA=VAL(C$) +50 IF VA=0 AND C$<>"0" THEN C$=MID$(C$,2,2):P(I,J,2)=1:READ F$:P(I,J,3)=VAL(F$) +60 IF VA<0 THEN K=-1: P(I,J,2)=2:READ F$:P(I,J,3)=VAL(F$) +70 P(I,J,1)=VAL(C$)*K:NEXT I:NEXT J:X2=XM:Y2=YM +99 REM =================================== Programme Principal =============== +100 XM=X2:YM=Y2:B=P(X,Y,1):GOSUB 3000:CLS:EN=EN-1:FL=0:TP=0 +101 LOCATE 25,1:PRINT "Pts d'endurance :";EN; +110 IF B=17 THEN GOTO 5000 +120 IF B>=12 AND B<=16 THEN IM=8:FLAG=1 ELSE FLAG=0 +130 ON IM GOSUB 4010,4090,4160,4220,4290,4370,4450,4530 +135 IF EN<=0 THEN LOCATE 12,15:PRINT "Vous avez Perdu !!!!":GOTO 5010 +140 FL=0:ON P(X,Y,2)+1 GOTO 150,1000,1500 +150 T$=INPUT$(1):IF T$=CHR$(27) THEN 5010 +160 IF (T$="p" OR T$="P") AND FL=1 THEN 1600 +170 IF T$<>"2" AND TP=1 THEN BEEP:LOCATE 25,1:PRINT "- Porte fermee !";:GOTO 150 +180 IF T$="2" THEN SWAP X,X2:SWAP Y,Y2:GOTO 100 +190 IF FLAG=1 THEN 300 ELSE X2=X:Y2=Y:GOTO 2010 +300 LOCATE 25,1:PRINT "Non ! Seulement ";MES$;" ";:BEEP:GOTO 150 +999 REM =========================== GRAPHIQUES SUPLEMENTAIRE (Coffre,Grille) == +1000 LINE (40,28)-(280,172),3,B:GET (141,65)-(199,172),G:TP=0 +1010 FOR Q=40 TO 280 STEP 20:LINE (Q,28)-(Q,172),3:NEXT +1020 FOR Q=28 TO 172 STEP 18:LINE (40,Q)-(280,Q),3:NEXT:CF=CF(P(X,Y,3)) +1030 IF CF=0 THEN TP=1:LINE (141,65)-(199,172),3,BF ELSE PUT(141,65),G,PSET +1040 GOTO 150 '==================== (Coffre )================================== +1500 LINE (160,180)-(120,160),,B:LINE -(140,140):LINE -(180,140):LINE -(160,160) +1510 LINE (130,150)-(170,150):LINE -(170,170):LINE -(160,180):FL=1:GOTO 150 +1600 IF P(X,Y,3)>0 THEN LOCATE 25,1:PRINT "vous trouvez une cle";:CF(P(X,Y,3))=1 +1610 IF P(X,Y,3)>0 THEN P(X,Y,2)=0:GOTO 150 '========= (TESTE PRISE d'obj.) === +1620 V=RND(1)*100:IF V/2=INT(V/2) THEN N=1:N$="donne" ELSE N=-1:N$="retire" +1630 LOCATE 25,1:PRINT "La fiole avalee vous ";N$;" 10 pts";:EN=EN+10*N:GOTO 150 +2000 ' ==================== calcule de deplacement =========================== +2010 IF T$<>"8" THEN GOTO 2090 ' ::::: T$="8" tout droit :::::::::::::::::::: +2020 IF (X>XM) AND ( B=7 OR B=8 OR B=9) THEN X=X+1:GOTO 100 +2030 IF (XYM) AND ( B=7 OR B=10 OR B=11 OR B=2) THEN Y=Y+1:GOTO 100 +2050 IF (Y>YM) AND ( B=2 ) THEN Y=Y+1:GOTO 100 +2060 IF (YXM) AND ( B=1 ) THEN X=X+1:GOTO 100 +2080 GOTO 300 +2090 IF T$<>"6" THEN GOTO 2190 ': T$="6" ( A droite ) ::::::::::::::::::::::: +2100 IF (X=XM) AND ( B=3 OR B=8 ) THEN X=X+1:GOTO 100 +2110 IF (YYM) AND ( B=7 OR B=11) THEN X=X-1:GOTO 100 +2140 IF (X>XM) AND ( B=6 OR B=7 OR B=8 ) THEN Y=Y+1:GOTO 100 +2150 IF (Y=YM) AND ( B=11 ) THEN Y=Y+1:GOTO 100 +2160 IF (X"4" THEN GOTO 300 ':: T$="4" ( A gauche ) :::::::::::::::::::: +2200 IF (X=XM) AND ( B=4 OR B=9 ) THEN X=X+1:GOTO 100 +2210 IF (Y>YM) AND ( B=7 OR B=10) THEN X=X+1:GOTO 100 +2220 IF (X=XM) AND ( B=6 OR B=8 ) THEN X=X-1:GOTO 100 +2230 IF (YXM) AND ( B=5 OR B=7 OR B=9) THEN Y=Y-1:GOTO 100 +2260 IF (Y=YM) AND ( B=11 ) THEN Y=Y-1:GOTO 100 +2270 IF (Y=YM) AND ( B=10 ) THEN Y=Y+1:GOTO 100 +2280 GOTO 300 '::::::::::::::::::::::::::::::: Calcule image :::::::::::::::: +3000 IF B=1 OR B=2 THEN IM=1:RETURN +3010 IF X=XM AND (B=3 OR B=5) OR XXM AND B=6 THEN IM=2:RETURN +3020 IF X=XM AND (B=4 OR B=6) OR XXM AND B=5 THEN IM=3:RETURN +3030 IF B=7 THEN IM=7:RETURN +3040 IF (X>XM AND B=8) OR (XYM AND B=11) THEN IM=5:RETURN +3050 IF (X>XM AND B=9) OR (XYM AND B=10) THEN IM=6:RETURN +3060 IF (X=XM AND (B=8 OR B=9)) OR (Y=YM AND (B=10 OR B=11)) THEN IM=4:RETURN +3070 RETURN '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +4010 LOCATE 1,1:PRINT " C'EST UNE SIMPLE ALLEE ":MES$=" (8) ou (2) " +4020 LINE (110,70)-(10,10),1:LINE -(310,190),1,B:LINE -(210,130),1 +4050 LINE (310,10)-(210,70),1:LINE -(110,130),1,B:LINE -(10,190),1:RETURN '--- +4090 LOCATE 1,1:PRINT " C'est un virage droit ";:MES$=" (6) ou (2) " +4100 LINE (10,10)-(310,190),1,B:LINE (110,70)-(250,130),2,BF +4120 LINE (310,10)-(250,46),1:LINE -(250,154),1:LINE -(310,190),1 +4130 LINE (10,10)-(110,70),1:LINE (110,130)-(10,190),1:RETURN '---------------- +4160 LOCATE 1,1:PRINT " C'est un virage Gauche ";:MES$=" (4) ou (2) " +4170 LINE (10,10)-(310,190),1,B:LINE (70,70)-(210,130),2,BF +4190 LINE -(310,190),1:LINE (210,70)-(310,10),1 +4200 LINE (10,190)-(70,154),1:LINE -(70,46),1:LINE -(10,10),1:RETURN '--------- +4220 LOCATE 1,1:PRINT " c'est un T ";:MES$=" (4) (2) (6) " +4230 LINE (10,10)-(310,190),1,B +4240 LINE -(230,150),1:LINE -(230,50),1:LINE -(310,10),1 +4250 LINE (10,10)-(90,50),1:LINE -(90,150),1:LINE -(10,190),1 +4270 LINE (90,140)-(230,60),2,BF:RETURN '-------------------------------------- +4290 LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a droite"; +4300 LINE (10,10)-(310,190),1,B:MES$=" (8) (6) (2) " +4310 LINE -(280,172),1:LINE -(280,28),1: LINE -(310,10),1 +4320 LINE (10,10)-(110,70),1:LINE -(210,130),1,B: LINE -(250,154),1 +4330 LINE -(250,46),1:LINE -(210,70),1:LINE (110,130)-(10,190),1 +4350 LINE (250,46)-(280,154),2,BF:RETURN '------------------------------------ +4370 LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a gauche"; +4380 LINE (310,190)-(10,10),1,B:MES$=" (8) (4) (2) " +4390 LINE -(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4400 LINE (310,190)-(210,130),1:LINE -(110,70),1,B +4410 LINE -(70,46),1:LINE -(70,154),1:LINE -(110,130),1 +4420 LINE (40,46)-(70,154),2,BF:LINE (210,70)-(310,10),1:RETURN '------------- +4450 LOCATE 1,1:PRINT "C'est une intersection + ";:MES$=" (2) (8) (4) (6) " +4460 LINE (10,10)-(310,190),1,B:LINE (110,70)-(210,130),1,B +4470 LINE (40,46)-(70,154),2,BF:LINE (250,46)-(280,154),2,BF +4480 LINE (310,10)-(280,28),1:LINE -(280,172),1:LINE -(310,190),1 +4490 LINE (10,10)-(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4500 LINE (110,70)-(70,46),1:LINE (70,154)-(110,130),1 +4510 LINE (210,70)-(250,46),1:LINE (250,154)-(210,130),1:RETURN '=============== +4530 LOCATE 1,1:PRINT " C'EST UN CUL DE SAC ":MES$=" (2) " +4540 LINE (110,70)-(10,10),1:LINE -(310,190),1,B:LINE -(210,130),1 +4570 LINE (310,10)-(210,70),1:LINE -(110,130),2,BF:LINE -(10,190),1:RETURN ':: +5000 CLS:LOCATE 12,15:PRINT " Vous avez reussit ....." +5010 LOCATE 21,15:PRINT "Encore O/N":FOR I=1 TO 10:A$=INKEY$:NEXT I:A$=INPUT$(1) +5020 IF A$="o" OR A$="O" THEN 10 ELSE SCREEN 2:SCREEN 0:END +6000 DATA 14,11,4,1,4,2 +6010 DATA 3,P1,1,17,16,-15,2,8,-12,3,3,-1,0,1,-1,6,P1,8,8,6 +6020 DATA 10,8,6,-2,0,3,7,1,9,1,6,3,6,4,11 +6030 DATA 2,p2,3,p2,2,4,11,10,1,1,6,2,2,10,8,11 +6040 DATA 2,2,10,-12,7,4,5,-15,4,6,2,2,p2,6,2,14,2 +6050 DATA 10,11,4,1,1,6,3,9,11,4,-5,8,10,-1,1,11 +6060 DATA 2,4,1,6,3,9,9,6,10,8,p1,7,5,3,11 +6070 DATA p2,4,3,6,2,4,1,6,4,11,p2,9,3,1,11,2 +6080 DATA 4,5,4,7,1,1,9,p1,2,11,2,2,-15,9,11,-2,0 +6090 DATA 3,1,1,9,8,6,3,p1,5,11,2,4,8,11,2 +6100 DATA 4,-1,0,8,1,5,10,5,-15,5,11,4,1,7,5,2 +6110 DATA 15,1,9,1,-1,0,9,1,p1,5,9,1,-1,0,9,1,5 + \ No newline at end of file diff --git a/LABY4.BAS b/LABY4.BAS new file mode 100644 index 0000000..11e8ae0 --- /dev/null +++ b/LABY4.BAS @@ -0,0 +1,152 @@ +10 CLEAR:DEFINT A-S,U-Z:OPTION BASE 1:DIM CF(9),G(2000):CLS:GOSUB 20000 +20 LOCATE 5:PRINT "Le Labyrinthe infernal de Darche Yoann" '[ Ver 1.4 08/1990 ] +25 PRINT:PRINT "Dir:(2)(8)(6)(4) (P)rendre (ESC)ape " +27 PRINT:PRINT " (C)arte , Preparation du jeu !" +30 RESTORE:READ XE,YE,X,Y,XM,YM,TA:DIM P(XE,YE,3):XI=2*XE:YI=2*YE +40 FOR J=1 TO YE:FOR I=1 TO XE:READ C$:K=1:P(I,J,2)=0:VA=VAL(C$) +45 IF VA=17 THEN SX=I:SY=J +50 IF VA=0 AND C$<>"0" THEN C$=MID$(C$,2,2):P(I,J,2)=1:READ F$:P(I,J,3)=VAL(F$) +60 IF VA<0 THEN K=-1: P(I,J,2)=2:READ F$:P(I,J,3)=VAL(F$) +70 P(I,J,1)=VAL(C$)*K:NEXT I:NEXT J:X2=XM:Y2=YM:T=TIMER 'Programme principal == +100 CLS:XM=X2:YM=Y2:B=P(X,Y,1):GOSUB 3000:FL=0:TP=0 +110 IF B=17 THEN GOTO 5000 +120 IF B>=12 AND B<=16 THEN IM=8:FLAG=1 ELSE FLAG=0 +130 ON IM GOSUB 4010,4090,4160,4220,4290,4370,4450,4530 +135 IF TKX>=320 THEN LOCATE 12,15:PRINT "Vous avez Perdu !!!!":GOTO 5010 +140 FL=0:ON P(X,Y,2)+1 GOTO 150,1000,1500 +145 TKX=INT(3.2*((TIMER-T)/TA*100)):LINE (0,195)-(TKX,199),2,BF +150 T$=INKEY$:IF T$=CHR$(27) THEN 5010 ELSE IF T$="" THEN 145 +160 IF (T$="p" OR T$="P") AND FL=1 THEN 1600 +162 IF T$="c" OR T$="C" THEN GOTO 900 +170 IF T$<>"2" AND TP=1 THEN BEEP:LOCATE 25,1:PRINT "- Porte fermee !";:GOTO 150 +180 IF T$="2" THEN SWAP X,X2:SWAP Y,Y2:GOTO 100 +190 IF FLAG=1 THEN 300 ELSE X2=X:Y2=Y:GOTO 2010 +300 LOCATE 25,1:PRINT "Non ! Seulement ";MES$;" ";:BEEP:GOTO 150 +900 GX=(306-XI)/2:GY=(186-YI)/2:HX=GX+XI+14:HY=GY+YI+14:GET(GX,GY)-(HX,HY),G +910 LINE(GX,GY)-(HX,HY),0,BF:LINE(GX+6,GY+6)-(HX-6,HY-6),1,B +920 M=SGN(X-SX)*2:N=SGN(Y-SY)*2:V=SGN(X-XM):W=SGN(Y-YM):D=GX+5+2*SX:F=GY+5+2*SY +930 IF M<0 THEN LINE(HX,98)-(HX-4,102),2,BF ELSE LINE(GX,98)-(GX+4,102),M,BF +940 IF N<0 THEN LINE(158,HY)-(162,HY-4),2,BF ELSE LINE(158,GY)-(162,GY+4),N,BF +950 IF V<0 THEN CIRCLE(GX+2,100),1,3 ELSE CIRCLE(HX-2,100),1,V +960 IF W<0 THEN CIRCLE(160,GY+2),1,3 ELSE CIRCLE(160,HY-2),1,W +965 G=GX+5+2*X:H=GY+5+2*Y:LINE (D,F)-(D+1,F+1),2,BF +970 LINE (G,H)-(G+1,H+1),3,BF:T$=INPUT$(1):PUT(GX,GY),G,PSET:GOTO 160 +1000 LINE (40,28)-(280,172),3,B:GET (141,65)-(199,172),G:TP=0 +1010 FOR Q=40 TO 280 STEP 20:LINE (Q,28)-(Q,172),3:NEXT +1020 FOR Q=28 TO 172 STEP 18:LINE (40,Q)-(280,Q),3:NEXT:CF=CF(P(X,Y,3)) +1030 IF CF=0 THEN TP=1:LINE (141,65)-(199,172),3,BF ELSE PUT(141,65),G,PSET +1040 GOTO 150 '==================== (Coffre )================================== +1500 LINE (160,180)-(120,160),,B:LINE -(140,140):LINE -(180,140):LINE -(160,160) +1510 LINE (130,150)-(170,150):LINE -(170,170):LINE -(160,180):FL=1:GOTO 150 +1600 IF P(X,Y,3)>0 THEN LOCATE 25,1:PRINT "vous trouvez une cle";:CF(P(X,Y,3))=1 +1610 IF P(X,Y,3)>0 THEN P(X,Y,2)=0:GOTO 150 '========= (TESTE PRISE d'obj.) === +1620 V=RND(1)*100:IF V/2=INT(V/2) THEN N=-1:N$="retire" ELSE N=1:N$="rajoute" +1630 LOCATE 25,1:PRINT "La fiole avalee vous ";N$;"30 sec";:T=T+30*N:GOTO 150 +2010 IF T$<>"8" THEN GOTO 2090 ' ::::: T$="8" tout droit :::::::::::::::::::: +2020 IF (X>XM) AND ( B=7 OR B=8 OR B=9) THEN X=X+1:GOTO 100 +2030 IF (XYM) AND ( B=7 OR B=10 OR B=11 OR B=2) THEN Y=Y+1:GOTO 100 +2050 IF (Y>YM) AND ( B=2 ) THEN Y=Y+1:GOTO 100 +2060 IF (YXM) AND ( B=1 ) THEN X=X+1:GOTO 100 ELSE 300 +2090 IF T$<>"6" THEN GOTO 2190 ': T$="6" ( A droite ) ::::::::::::::::::::::: +2100 IF (X=XM) AND ( B=3 OR B=8 ) THEN X=X+1:GOTO 100 +2110 IF (YYM) AND ( B=7 OR B=11) THEN X=X-1:GOTO 100 +2140 IF (X>XM) AND ( B=6 OR B=7 OR B=8 ) THEN Y=Y+1:GOTO 100 +2150 IF (Y=YM) AND ( B=11 ) THEN Y=Y+1:GOTO 100 +2160 IF (X"4" THEN GOTO 300 ':: T$="4" ( A gauche ) :::::::::::::::::::: +2200 IF (X=XM) AND ( B=4 OR B=9 ) THEN X=X+1:GOTO 100 +2210 IF (Y>YM) AND ( B=7 OR B=10) THEN X=X+1:GOTO 100 +2220 IF (X=XM) AND ( B=6 OR B=8 ) THEN X=X-1:GOTO 100 +2230 IF (YXM) AND ( B=5 OR B=7 OR B=9) THEN Y=Y-1:GOTO 100 +2260 IF (Y=YM) AND ( B=11 ) THEN Y=Y-1:GOTO 100 +2270 IF (Y=YM) AND ( B=10 ) THEN Y=Y+1:GOTO 100 ELSE 300 +3000 IF B=1 OR B=2 THEN IM=1:RETURN ':::::::::: Calcule image :::::::::::::::: +3010 IF X=XM AND (B=3 OR B=5) OR XXM AND B=6 THEN IM=2:RETURN +3020 IF X=XM AND (B=4 OR B=6) OR XXM AND B=5 THEN IM=3:RETURN +3030 IF B=7 THEN IM=7:RETURN +3040 IF (X>XM AND B=8) OR (XYM AND B=11) THEN IM=5:RETURN +3050 IF (X>XM AND B=9) OR (XYM AND B=10) THEN IM=6:RETURN +3060 IF (X=XM AND (B=8 OR B=9)) OR (Y=YM AND (B=10 OR B=11)) THEN IM=4:RETURN +3070 RETURN '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +4010 LOCATE 1,1:PRINT " C'EST UNE SIMPLE ALLEE ":MES$=" (8) ou (2) " +4020 LINE (110,70)-(10,10),1:LINE -(310,190),1,B:LINE -(210,130),1 +4050 LINE (310,10)-(210,70),1:LINE -(110,130),1,B:LINE -(10,190),1:RETURN '--- +4090 LOCATE 1,1:PRINT " C'est un virage droit ";:MES$=" (6) ou (2) " +4100 LINE (10,10)-(310,190),1,B:LINE (110,70)-(250,130),2,BF +4120 LINE (310,10)-(250,46),1:LINE -(250,154),1:LINE -(310,190),1 +4130 LINE (10,10)-(110,70),1:LINE (110,130)-(10,190),1:RETURN '---------------- +4160 LOCATE 1,1:PRINT " C'est un virage Gauche ";:MES$=" (4) ou (2) " +4170 LINE (10,10)-(310,190),1,B:LINE (70,70)-(210,130),2,BF +4190 LINE -(310,190),1:LINE (210,70)-(310,10),1 +4200 LINE (10,190)-(70,154),1:LINE -(70,46),1:LINE -(10,10),1:RETURN '--------- +4220 LOCATE 1,1:PRINT " c'est un T ";:MES$=" (4) (2) (6) " +4230 LINE (10,10)-(310,190),1,B +4240 LINE -(230,150),1:LINE -(230,50),1:LINE -(310,10),1 +4250 LINE (10,10)-(90,50),1:LINE -(90,150),1:LINE -(10,190),1 +4270 LINE (90,140)-(230,60),2,BF:RETURN '-------------------------------------- +4290 LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a droite"; +4300 LINE (10,10)-(310,190),1,B:MES$=" (8) (6) (2) " +4310 LINE -(280,172),1:LINE -(280,28),1: LINE -(310,10),1 +4320 LINE (10,10)-(110,70),1:LINE -(210,130),1,B: LINE -(250,154),1 +4330 LINE -(250,46),1:LINE -(210,70),1:LINE (110,130)-(10,190),1 +4350 LINE (250,46)-(280,154),2,BF:RETURN '------------------------------------ +4370 LOCATE 1,1:PRINT "vous pouvez aller tout droit ou a gauche"; +4380 LINE (310,190)-(10,10),1,B:MES$=" (8) (4) (2) " +4390 LINE -(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4400 LINE (310,190)-(210,130),1:LINE -(110,70),1,B +4410 LINE -(70,46),1:LINE -(70,154),1:LINE -(110,130),1 +4420 LINE (40,46)-(70,154),2,BF:LINE (210,70)-(310,10),1:RETURN '------------- +4450 LOCATE 1,1:PRINT "C'est une intersection + ";:MES$=" (2) (8) (4) (6) " +4460 LINE (10,10)-(310,190),1,B:LINE (110,70)-(210,130),1,B +4470 LINE (40,46)-(70,154),2,BF:LINE (250,46)-(280,154),2,BF +4480 LINE (310,10)-(280,28),1:LINE -(280,172),1:LINE -(310,190),1 +4490 LINE (10,10)-(40,28),1:LINE -(40,172),1:LINE -(10,190),1 +4500 LINE (110,70)-(70,46),1:LINE (70,154)-(110,130),1 +4510 LINE (210,70)-(250,46),1:LINE (250,154)-(210,130),1:RETURN '=============== +4530 LOCATE 1,1:PRINT " C'EST UN CUL DE SAC ":MES$=" (2) " +4540 LINE (110,70)-(10,10),1:LINE -(310,190),1,B:LINE -(210,130),1 +4570 LINE (310,10)-(210,70),1:LINE -(110,130),2,BF:LINE -(10,190),1:RETURN ':: +5000 CLS:LOCATE 12,15:PRINT " Vous avez reussit ....." +5010 LOCATE 21,15:PRINT "Encore O/N":FOR I=1 TO 10:A$=INKEY$:NEXT I:A$=INPUT$(1) +5020 IF A$="o" OR A$="O" THEN 10 ELSE SCREEN 2:SCREEN 0:END +6000 DATA 14,11,4,1,4,2,1200 +6010 DATA 3,P1,1,17,16,-15,2,8,-12,3,3,-1,0,1,-1,6,P1,8,8,6 +6020 DATA 10,8,6,-2,0,3,7,1,9,1,6,3,6,4,11 +6030 DATA 2,p2,3,p2,2,4,11,10,1,1,6,2,2,10,8,11 +6040 DATA 2,2,10,-12,7,4,5,-15,4,6,2,2,p2,6,2,14,2 +6050 DATA 10,11,4,1,1,6,3,9,11,4,-5,8,10,-1,1,11 +6060 DATA 2,4,1,6,3,9,9,6,10,8,p1,7,5,3,11 +6070 DATA p2,4,3,6,2,4,1,6,4,11,p2,9,3,1,11,2 +6080 DATA 4,5,4,7,1,1,9,p1,2,11,2,2,-15,9,11,-2,0 +6090 DATA 3,1,1,9,8,6,3,p1,5,11,2,4,8,11,2 +6100 DATA 4,-1,0,8,1,5,10,5,-15,5,11,4,1,7,5,2 +6110 DATA 15,1,9,1,-1,0,9,1,p1,5,9,1,-1,0,9,1,5 +20000 CLS:SCREEN 2:SCREEN 0:COLOR 15 +20010 LOCATE 2,24:PRINT " DARCHE Yoann vous prsente : " +20020 LOCATE 5 +20022 PRINT " " +20025 PRINT " ۰" +20030 PRINT " ۰۰۰۰۰۰۰۰۰" +20040 PRINT " ۰۱۱۰۱۰۱۱۱۱۰۱۱" +20050 PRINT " ۰۱۱۱۱۱۱۱۱۱۱" +20060 PRINT " ۰۱۰۱۱۱۰۱" +20070 PRINT " ۰۱۱۱۱۰۱۱۱۱" +20080 PRINT " ۰۱۱۱۱۱۱۰۰۱۰۱۱" +20090 PRINT " ۰۰۱۱۱۱۱۱۰" +20100 PRINT " ۰" +20110 PRINT " ۰" +20120 PRINT " " +20130 PRINT +20140 LOCATE 23,5:COLOR 15,0:PRINT " Mr DARCHE Yoann 71 avenue d'Orlans 91800 BRUNOY tel : 69-39-51-26"; +20150 A$=INPUT$(1):SCREEN 1:RETURN +5:COLOR 15,0:PRINT " Mr DARCHE Yoann 71 avenue d'Orlans 91800 BRUNOY tel : 69-39-51-26"; +20150 A$=INPUT$(1):S \ No newline at end of file diff --git a/LABY4.TXT b/LABY4.TXT new file mode 100644 index 0000000..4c10722 --- /dev/null +++ b/LABY4.TXT @@ -0,0 +1,132 @@ + Ŀ + LABYRINTHE INFERNAL VERSION 1.3 + + + Vous tes entrez dans un labyrinthe,et la porte par laquelle vous tes arriv +c'est referme. Mais il exestiste une autre sortie, vous de la trouver !! + + Quellesques indications : + + - Dans ce labyrinthe il y a des grilles avec des portes fermes clef + les clefs qui permettent l'ouverture de ces portes sont rparties dans + des coffres dispercs dans le labyrinthe. Il y a 9 sortes de clef au maximum ! + Attention dans certain coffre il y a une fiole qui peut vous donnez ou + vous retirez des points d'endurances .... + + - Il faut que vous trouviez la sortie avant que vous n'ayez plus de + points d'endurance, sinon vous perissez jamais dans ce Labyrinthe. + + - Vous regardez toujours devant vous, vous tes dedans et non au + dessus ! + + - Pour vous aider vous disposez d'une carte o est uniquement idique + votre position et celle de la sortie. + Vous tes reprsent par un carr de la couleur des messages, la sortie + d'un carr d'une autre couleur. + Les carr qui se trouvent autour du cadre sont les directions de la sortie + La croit vous indique la direction de votre regard. + + - Les deplacements : + + Ils s'effectuent au moyen du pav numerique : + ( Avancer ) + 8 Ŀ + Ne pas oublier que vous regardez Ŀ + ( Gauche ) 4 6 ( Droite ) toujour devant vous ! + + 2 + ( Demi-tour ) + +(C) pour la carte, (P) pour prendre quelque chose, pour abandonner le jeu + =-=-=-=-=-=-=-=-=-=-=-=-=-= + + Cration d'un labyrinthe : + ~~~~~~~~~~~~~~~~~~~~~~~~~~ + table de codification d'un labyrinthe : + --------------------------------------- + 1 : 3 : 6 : 8: + 7: 10: <-- 11 + 2 : 4 : 5 : 9: + + de 12 15 (inclus) ce sont les cul de sac + + 12 : ͵ 13 : 14: 15: + 16 : Code de l' entre + 17 : Code de la sortie + + Codage des coffres : + -------------------- + De -1 -15 suivie du code qui correspond sa contenance : + 0 : Une fiole de 1 9 : numero de la clef. + + ex : data .. , .. , -1 , 5 + Dans le coffre il y aura la clef n5 + Le signe - indique que dans cette alle il y aura + un coffre (Le chiffre qui suit est un code qui reprsente une alle dfinie + ci dessus ici le 1 designe un simple alle horizontal). + + Codage des portes : + ------------------- + De P1 P11 suivie d'un code qui correspond la clef qui ouvre la porte. + ex : data ..... , P3 , 8 , ... + La clef n8 permet l'ouverture de cette porte. + Le P signifie qu'il y a une porte dans ce virage + ( Cf le code 3 si dessus ). + Les 7 premiers code : + --------------------- + Dans la premire ligne de DATA doit figurer ces 7 codes imperativement : + +dans l'ordre : + XME : dimention du labyrinthe en caractre en abscice + YME : dimention du labyrinthe en caractre en ordonne + X,Y : coordonnes de dpart + Xm,Ym : coordonnes o le joueur doit ce trouver pour le second coup . + EN : Nombre de point d'endurence . + + Exemple de codification d'un labyrinthe : + ----------------------------------------- + On se propose de coder ce labyrinthe : + + 1 1 1 1 1 + 1 2 3 4 5 6 7 8 9 0 1 2 3 4 Legende : + 1+S E +ͻ + 2ͻ * ͻ ͻ ͹ .........cul de sac. + 3 + + ͹ ͻ ͹ + .........porte + 4 ͼ ͻ + + 5͹ ͻ ͹ ͼ ͹ * ...alle avec un coffre + 6 ͻ ͻ +ͼ ͹ contenant une boisson + 7+ ͻ *ͻ ͹ + ͹ + 8ͼ +͹ ͹ * E..........Entre + 9ͻ +͹ ͹ S..........Sortie + 10*ͼ ͼ ͹ ͼ + 11*+*ͼ + + Coordonnes des porte suivie du numero de la clef qui l'ouvre : + (2,1):1, (12,1):8, (2,3):3, (3,3):3, (11,4):6, (11,6):7, (1,7):4, (10,7):9, + (8,8):2, (8,9):5, (8,11):5 + + Coordonnes des coffre et leur clef qu'ils contiennent : + (5,1):2, (7,1):3, (11,1):6, (4,4):7, (7,4):4, (11,5):8, (13,5):1, (12,8):9, + (8,10):5. + + CODAGE : (Voir LISTING de 6000-6110). + +Quellesques remarques sur l'organisation du programme. +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + de la ligne 30 70 : Lecture du Labyrinthe en DATA + 100 300 : Aiguillage pour l'affichage et corps du Prog. + 1000 1040 : Affichage de la grille + 1500 1510 : Aff. du coffre + 1600 1630 : calcule des consquence de l'objet pris dans le coffre + 2000 2280 : calcule des dplacement du joueur + 2280 3070 : calcule de l'image afficher + 4010 5020 : image des diffrente alles + 6000 la fin : mmorisation du Labyrinthe + +Les variables : X,Y coordonne de l'actuelle position +-------------- XM,YM coordonne de l'ancienne position + B type d'alle (Virage,intersection etc...) + P() memorisation du labyrinthe + + Programme crit en GWBASIC (Ver 2) compilable en Turbo Basic. CGA Couleur + Darche Yoann 6/08/90 \ No newline at end of file diff --git a/LABYPRO.BAS b/LABYPRO.BAS new file mode 100644 index 0000000..ca9941e Binary files /dev/null and b/LABYPRO.BAS differ diff --git a/LABYRINT.BAS b/LABYRINT.BAS new file mode 100644 index 0000000..ca9941e Binary files /dev/null and b/LABYRINT.BAS differ diff --git a/LCARTE.BAS b/LCARTE.BAS new file mode 100644 index 0000000..5e9896f Binary files /dev/null and b/LCARTE.BAS differ diff --git a/LINK.BAS b/LINK.BAS new file mode 100644 index 0000000..83c655c --- /dev/null +++ b/LINK.BAS @@ -0,0 +1,67 @@ +' LINKER SpeciAle YOANN DARCHE + +ON ERROR GOTO Erreur + +de = 0: j = 0: + +DIM n$(100) +CLS : COLOR 12,0 +INPUT " Directorie de lecture : ",DIR$ +CLS:COLOR 13,0 +FILES DIR$+"\*.*" +COLOR 11,1 +LOCATE 25,1:PRINT " =====-===== Le linker methode DARCHE Yoann =====-===== "; +LOCATE 10,1:COLOR 12,0 +INPUT " Nom du fichier de destination : ",ND$ +OPEN ND$ AS #2 len = 8 +FIELD #2,8 as LF$ + +n$(0)=ND$ + + PIMAGE : +K=K+1 +PRINT " Non de l'image n";K;" : "; +INPUT "",N$(K) +IF N$(K)="FIN" OR N$=chr$(13) THEN K=K-1:GOTO Suite + +Goto Pimage + +Suite : + +FOR I=0 TO K:PRINT N$(I):NEXT I + +FOR J=1 TO K + + OPEN DIR$+"\"+N$(J) AS #1 len = 8 + FIELD #1,8 as L$ + + +PRINT " THE Linkage du fichier ";N$(J);" dans ";N$(0) +Print string$(79,"-") + +For I=2 TO 501 + get #1,I +KL=I+(J-1)*500-1 +GET #2,KL +p$=mid$(l$,2,1)+mid$(l$,1,1)+mid$(l$,4,1)+mid$(l$,3,1)+mid$(l$,6,1) +p$=p$+mid$(l$,5,1)+mid$(l$,8,1)+mid$(l$,7,1) +Lset LF$=p$ +p$="" +PUT #2,KL +NEXt I +CLOSE 1 +NEXT J + +CLS:PRINT " ----- J'ai Fini le boulot bonhomme -------- " +PRINT " Appuyer sur une touche pour finir et retour au DOS ..." +A$=input$(1) +CLOSE +END + +Erreur : + Print "Une erreur fatal c'est produite ..... " + IF err=64 then print N$(j);" N'est pas un nom de fichier valide" + IF err=53 then print n$(j);" est introuvable .. " + PRINT " Donc punition oblige retour direct au dos " + end + diff --git a/LOAD.EXE b/LOAD.EXE new file mode 100644 index 0000000..f5bd444 Binary files /dev/null and b/LOAD.EXE differ diff --git a/LP.BAS b/LP.BAS new file mode 100644 index 0000000..33b27eb --- /dev/null +++ b/LP.BAS @@ -0,0 +1,3 @@ +lprint chr$(27);"!" +end + \ No newline at end of file diff --git a/LUMINEUX.BAS b/LUMINEUX.BAS new file mode 100644 index 0000000..4b90031 Binary files /dev/null and b/LUMINEUX.BAS differ diff --git a/MASTER-M.BAS b/MASTER-M.BAS new file mode 100644 index 0000000..651286d --- /dev/null +++ b/MASTER-M.BAS @@ -0,0 +1,77 @@ +10 SCREEN 7 +50 CLS:PRINT " jeu du ";:COLOR 12:PRINT "MASTER MIND ";:COLOR 13:PRINT " LE CERVEAU" +60 COLOR 12:PRINT :PRINT "Ce programe est proteg par LEPOU .. car il de race violette :";:COLOR 14:PRINT " PRIERE DE NE PAS LE RECOPIER " +65 COLOR 9:PRINT :PRINT "INTERDIT POUR LES SOCIALO..":COLOR 13 +70 PRINT :PRINT :PRINT "voulez-vous avoir la regle de jeu O/N " +80 A$=INKEY$:IF A$="" THEN 80 ELSE IF A$="O" OR A$="o" THEN 90 ELSE 1000 +90 CLS +100 PRINT:PRINT " C'est trs simples il faut trouver la combinaison que l'ordinateur va choisir. +110 COLOR 12:PRINT " pour cela vous allez tapez sur les chiffres qui correspondent des couleurs.Puis lordinateur indiquera si vous avez des couleur bien placer ou mal placer." +120 PRINT " Si il repond rien c'est que vous n'aviez aucune couleur de sa cobinaison " +121 COLOR 14:PRINT " Il peut y avoir 2 3 ou 4 cases de la mme couleur sans oublier les trouts...":PRINT :PRINT +122 COLOR 10:PRINT "Bonne Chance":PRINT " Darche Yoann " +123 PRINT "app sur une touche " +124 A$=INKEY$:IF A$="" THEN 124 ELSE 1000 +999 STOP +1000 PALETTE 6,7 +1001 CLS:REM AFFICHAGE DU JEU VIDE ....... +1002 ' +1008 LOCATE 10,28:COLOR 12:PRINT " BIEN PLACE ":LOCATE 11,28:COLOR 11:PRINT " MAL PLACE" +1009 LOCATE 5,29:COLOR 13:PRINT "MASTER MIND":LOCATE 6,28:COLOR 12:PRINT "DE DARCHE Y." +1010 LINE (122,17)-(198,182),14,B +1011 FOR I=17 TO 182 STEP 15:LINE (122,I)-(197,I),14:NEXT:PAINT (123,18),9,14 +1012 FOR I=122 TO 182 STEP 15:LINE (I,17)-(I,182),14:NEXT:PAINT (183,18),14 +1013 LOCATE 1,16:PRINT "1 2 3 4 R":LOCATE 4,12:PRINT "????" +1014 LINE (190,32)-(190,182),14 +1015 FOR I=32 TO 182 STEP 7.5:LINE (182,I)-(198,I),14:NEXT +1016 FOR I=1 TO 6:COLOR I:PRINT I:NEXT +1017 COLOR 14:PRINT "pour trous 0 " +1100 ' +1101 ' Choix des couleurs cacher +1102 ' =-=-=-=-=-=-=-=-=-=-=-=-=-= +1103 LOCATE 24,1:PRINT "appuyez sur une touge"; +1104 X=5:RANDOMIZE TIMER:X=RND(1)*X:A$=INKEY$:X=RND(X*TIMER):RANDOMIZE X/TIMER:IF A$="" THEN 1104 +1105 LOCATE 24,1:PRINT " "; +1106 C1=INT(RND(1)*6):RANDOMIZE TIMER*C1 +1107 C2=INT(RND(1)*6):RANDOMIZE TIMER*C2 +1108 C3=INT(RND(1)*6):RANDOMIZE TIMER*C3 +1109 C4=INT(RND(1)*6):RANDOMIZE TIMER*C4 +1200 Y=17+5:' =-=-=-=-=-=-=-=-=-=-=-=-=-= +1201 ' --------- J E U --------- +1202 Y=200-Y:' =-=-=-=-=-=-=-=-=-=-=-=-=-= +1203 IF Y=<28 THEN LOCATE 14,1:PRINT "perdu .......":GOTO 1400 +1204 FOR I=1 TO 4 +1205 RTTT=0:LOCATE 14,1:PRINT "couleur n";I +1206 A$=INKEY$:IF A$="" THEN 1205 ELSE A=VAL(A$) +1207 IF A=0 AND A$<>"0" THEN BEEP :GOTO 1205 +1208 IF A>=7 THEN BEEP:GOTO 1205 ELSE CJ(I)=A:NEXT +1209 PAINT (127,Y),CJ(1),14:PAINT (147,Y),CJ(2),14:PAINT (164,Y),CJ(3),14:PAINT (179,Y),CJ(4),14:E(1)=C1:E(2)=C2:E(3)=C3:E(4)=C4 +1210 IF CJ(1)=C1 AND CJ(2)=C2 AND CJ(3)=C3 AND CJ(4)=C4 THEN LOCATE 14,1:PRINT "GAGNE .........":GOTO 1400 +1211 FOR I=1 TO 4 +1212 IF CJ(I)=E(I) THEN CJ(I)=42:E(I)=32:GOSUB 1300 +1213 NEXT +1214 FOR I=1 TO 4 +1215 FOR T=1 TO 4 +1216 IF CJ(I)=E(T) THEN CJ(I)=42:E(T)=32:GOSUB 1310 +1217 NEXT :NEXT :Y=Y-15:GOTO 1203 +1300 ' ************************************************************************* +1301 ' * Coup bien placer ==> affichage * +1302 ' ************************************************************************* +1304 RTTT=RTTT+1:IF RTTT >=5 THEN RTTT=1 +1305 ON RTTT GOTO 1306,1307,1308,1309 +1306 PAINT(171+15,Y-8),12,14:RETURN +1307 PAINT(180+15,Y-8),12,14:RETURN +1308 PAINT(180+15,Y+3),12,14:RETURN +1309 PAINT(171+15,Y+3),12,14:RETURN +1310 ' ************************************************************************* +1311 ' * Coup mal plac ==> affichage * +1312 ' ************************************************************************* +1313 RTTT=RTTT+1:IF RTTT >=5 THEN RTTT=1 +1314 ON RTTT GOTO 1315,1316,1317,1318 +1315 PAINT(171+15,Y-8),11,14:RETURN +1316 PAINT(180+15,Y-8),11,14:RETURN +1317 PAINT(180+15,Y+3),11,14:RETURN +1318 PAINT(171+15,Y+3),11,14:RETURN +1400 LOCATE 4,4:PRINT C1;C2;C3;C4;:PAINT (123,18),C1,14:PAINT (138,18),C2,14:PAINT (153,18),C3,14:PAINT (180,18),C4,14 +1401 LOCATE 24,1:PRINT " Voulez vous recomancer ? O/N ....... "; +1402 A$=INKEY$: IF A$="" THEN 1402 ELSE IF A$="O" OR A$="o" THEN 1000 ELSE END diff --git a/MATH_01.CHI b/MATH_01.CHI new file mode 100644 index 0000000..ac24aba --- /dev/null +++ b/MATH_01.CHI @@ -0,0 +1,228 @@ +\1cw +\U1STANDARD +\U3ITALIC +\U4BOLD +\U5FOREIGN +\U7GREEK +\U9MATHI +\U!UNDERLIN +\U"ORATOR +\U#SCRIPT +\FD +\+ +\+ +\+ +\^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \@\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^\, +\= +\+ +\, +\+ +\^\ \ \ \ \ \ \ \ \ \ \ \"INTERSECTION ET PARALLELISME DANS L'ESPACE\ \ \ \ \ \ \ \ \ \ \ \^\, +\+ +\, +\+ +\!I_LE_PLAN_:\, +\+ +\, +\+ +\ \#D\5w\#finition axiomatique du plan :\, +\+ +\, +\+ + \3Axiome 1 : \1Par deux points distincts \ passe \ une \ droite \ et \ une +\+ +seule.\, +\+ + \3Axiome 2 : \1Par trois non alini\5w\1s passe un plan et un seul\, +\+ + \3Axiome 3 : \1Une droite passant par deux points distincts \ A \ et \ B +\+ +d'un plan \#P \1est inclue dans \#P\1.\, +\+ + \3Axiome 4 : \ \1Tout \ plan \ partage \ l'espace \ en \ deux \ demi-Espaces +\+ +convexes. Tout segment [AB] ayant une extraimit\5w \1dans \ chacun \ des +\+ +demi-Espaces poss\5r\1de une intersection unique dans \#P\, +\+ +\, +\+ + D\5w\#termination d\1'\#un plan :\, +\+ +\, +\+ + \1Un plan est enti\5r\1rement d\5w\1termin\5w \1par la donn\5w\1e de :\, +\+ + \4- Soit trois points non alignes\, +\+ + - Une droite et un point hors de cette droite\, +\+ + - Deux droites strictement paralleles\, +\+ +\, +\+ + \#Vocabulaire :\, +\+ +\, +\+ + \1On dit que des points sont \!coplanaires \1lorsqu'ils \!appartiennent +\+ +\5f \1un m\5e\1me plan .\, +\+ + On dit que \ des \ droites \ sont \!coplanaires \1lorsqu'elles \ sont +\+ +\!inclusent \1dans un m\5e\1me Plan.\, +\+ +\, +\+ +\!II_Position_relative_de_Droites_et_de_Plans_:\, +\+ +\, +\+ + \#Droites parall\5r\#les :\, +\+ +\, +\+ + \1Dans l'espace \ deux \ droites \ sont \ parall\5r\1les \ ssi \ elles \ sont +\+ +coplanaires, et parall\5r\1les dans ce plan\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 1 (ADMIS) :\, +\+ +\1Par un point exterieur \5f \#D\1, on ne peut mener qu'une \ seule \ droite +\+ +parall\5r\1le \5f \#D\1.\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 2 :\, +\+ +\1Si deux droites sont parall\5r\1les tout plan qui \ coupe \ l'une \ coupe +\+ +l'autre.\, +\+ + Hypoth\5r\1ses : D // \7D\1, \#P \9n \1D = {A}\, +\+ +\, +\+ +\, +\+ +\, +\+ +\, +\+ +\, +\+ + * Si D et \7D \1confondus, si \#P \1coupe D alors \#P \1coupe \7D \1(car D = \7D\1)\, +\+ + * Si D et \7D \1strictement parall\5r\1les, alors D \ et \ \7D \ \1engendre \ un +\+ +plan \#Q\1. \#P \1et \3Q \1ont en commun donc une droite \#D\1' passant par A\, +\+ + Dans \#Q \1: \#D \1et \7D \1parall\5r\1les et \#D\1' coupe \#D\1, donc \#D\1' coupe \7D \1en B.\, +\+ + B est \5w\1l\5w\1ment de \#D\1' donc de \#P\1, donc \#P \1coupe \7D \1en B\, +\+ +\, +\+ +\,\/ +\+ +\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 3 (ADMIS) :\, +\+ +\1Si deux droites sont parall\5r\1les elles m\5e\1mes \5f \1une troisi\5r\1me \ alors +\+ +elles sont parall\5r\1les entres elles.\, +\+ +\, +\+ + \#Droites et Plans parall\5r\#les :\, +\+ +\, +\+ + \1On dit qu'un Plan et une droite \ D \ sont \ parall\5r\1les \ ssi \ D \ est +\+ +incluse dans P, ou si D et P n'ont pas de point en commeun .\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 1 (ADMIS) :\, +\+ +\1Une droite \#D \1est parall\5r\1le \5f \1un plan \#P \1ssi \#D \1est parall\5r\1le \ \5f \ \1une +\+ +droite de \#P\1.\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 2 :\, +\+ +\1Si une droite \#D \1est \ parall\5r\1le \ \5f \ \1un \ plan \ \#P\1, \ alors \ tout \ plan +\+ +contenant \#D \1et coupant \#P\1, le coupe suivant une droite parall\5r\1le \ \5f +\+ +\#D\1.\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \3Hypoth\5r\3ses : \#D \3// \#P\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ Q \ \3un \ plan \ contenant \ \#D \ \ \3et +\+ +\ \ \ \ \ \ \ \ \ coupant \#P \3suivant \7D\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \3Prouvons que \#D \3// \7D \3.\, +\+ +\, +\+ +\, +\+ +\, +\+ +\, +\+ +\1Utilisons le raisonnement par l'absurde :\, +\+ + Dans \#Q\1, \ \#D \ \1et \ \7D \ \1sont \ coplanaires, \ si \ elles \ n'\5w\1taient \ pas +\+ +parall\5r\1les elles seraient s\5w\1cantes et auraient donc \ un \ point \ en +\+ +commun le point A, A serait donc \5w\1l\5w\1ment de \7D \1don \#P\1, et \ de \ \#D \ \1ce +\+ +qui contredirait le fait que \#D \1et \#P \1soient parall\5r\1les ( car \#D \1et \#P +\+ +\1auraient A en commun ).\, +\+ +\, +\+ + \3Th\5w\3or\5r\3me 3 :\, +\+ +\1Si deux droites sont parall\5r\1les, tout plan parall\5r\1le \5f \1l'une est +\+ +parall\5r\1le \5f \1l'autre.\, +\+ +\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \3Hypoth\5r\3ses : \#D \3// \7D\3, \#D \3// \#P\, +\+ +\, +\+ +\, +\+ +\, +\+ +\, +\+ + \1Si \7D \1et \#P \1n'\5w\1taient pas parall\5r\1les, alors \#P \1couperait \ \7D \ \1donc \ \#D +\+ +\1qui lui est parall\5r\1le . \#P \1et \#D \1auraient un point en commun ce \ qui +\+ +contredit que \#D \1et \#P \1sont parall\5r\1les .\, +\+ +\, +\+ +\, +\= + \ No newline at end of file diff --git a/MATH_DS1.CHI b/MATH_DS1.CHI new file mode 100644 index 0000000..2e3c28e --- /dev/null +++ b/MATH_DS1.CHI @@ -0,0 +1,343 @@ +\1cw +\U1STANDARD +\U3ITALIC +\U5FOREIGN +\U7GREEK +\U8LINEDRAW +\U9MATHI +\U0MATHII +\U!UNDERLIN +\U"ORATOR +\U#SCRIPT +\FD +\+ +\+ +\+ +\^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \@\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^\, +\= +\+ +\, +\+ +\, +\+ +\^\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \"PRODUITS SCALAIRES DANS LE PLAN\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \^\, +\+ +\, +\+ +\, +\+ + \!Produit_Scalaire_de_deux_vecteurs_:\, +\+ +\, +\+ \8L L L L + \1u.v = \9N\1u\9N \1x \9N\1v\9N \1x cos(\7a\1)\, +\+ +\3Th\5w\3or\5r\3me :\, +\+ +\, +\+ +\, +\+ + +\+ +\, +\+ + \1Etant donn\5w\1es trois point A,B,C et H la projection de \ C \ sur \ un +\+ +axe passant par A et B\, +\- +\+ \8-L -L -- -- + \1AB . AC = AB x AH\, +\- +\+ \8-L -L -L -L + \1AB . AC = AB . AH\, +\+ +\, +\+ +\!Distance_d'un_point_a_une_droite_:\, +\+ +\, +\+ + \1Dans un rep\5r\1re orthonormal, la distance du point A(X\ ,Y\ ) \5f \ \1la +\- o o +\+ +droite \#D \1d'\5w\1quation ax + by + c = 0 est \, +\+ +\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \81\ \1aX\ + bY\ + c \81\, +\- \1o o +\+ + d(A,\#D\1) = \8===================\, +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \0\\\ \ 5\8----------\, +\+ \12 2 +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \0\\/\ \ \1a\ + b\, +\+ +\, +\+ +\!Cercle_et_disque_forme_:\, +\+ +\, +\+ + \1Soit \7W \1un point de \#P \1et R un r\5w\1el positif.\, +\+ + 1) On appelle cercle \#C \1de centre \7W \1et de rayon R \ l'ensemble \ des +\+ +points M tels que \7W\1M = R :\, +\+ +\, +\+ + \#C \1= { M, M \9e \#P \1/ \7W\1M = R }\, +\+ +\, +\+ + On note \#C\1(\7W\1,R).\, +\+ +\, +\+ + 2) On appelle \ disque \ ouvert \ \#D \ \1de \ centre \ \7W \ \1et \ de \ rayon \ R +\+ +l'ensemble des points M du plan tels que \7W\1M < R :\, +\+ +\, +\+ + \#D \1= { M, M \9e \#P \1/ \7W\1M < R }\, +\+ +\, +\+ + 3) On appelle disque ferm\5w \#D \1de centre \7W \1et de rayon R l'ensemble +\+ +des points M du plan tels que \7W\1M \9< \1R.\, +\+ +\, +\+ + \#D \1= { M, M \9e \#P \1/ \7W\1M \9< \1R }\, +\+ +\, +\+ +\!Equation_d'un_cercle_:\, +\+ +\, +\+ + \1Dans un rep\5r\1re orthogonal, une \5w\1quation \ du \ cercle \ de \ centre +\+ +\7W\1(a,b) et de rayon R est :\, +\+ +\, +\+ 2 2 2 + ( x - a ) + ( y - b )\ = R\, +\+ +\,\/ +\+ +\, +\+ +\!Etude_Reciproque_:\, +\+ +\, +\+ + \1Soit \7a\1,\7b\1,\7g \ \1trois \ nombres \ re\5w\1ls. \ Consid\5w\1rons \ l'ensemble \ E +\+ +d\5w\1fini dans un rep\5r\1re orthogonal par :\, +\+ +\, +\+ 2 2 + E = { M(x,y) / x\ + y\ + \7a\1x + \7b\1y + \7g \1= 0 }\, +\+ +\, +\+ +Quelle est la nature de E ?\, +\+ +\, +\+ 2 2 + x\ + y\ + \7a\1x + \7b\1y + \7g \1= 0 s'\5w\1crit :\, +\+ + \, +\+ 2 2 +\+ \0& \7a \0*\12 \7a \0& \7b \0*\12 \7b + \ \ \ \ \ \ \81 \1x + \8---\ 1\ \1- \8---\ \1+ \81 \1y + \8--- 1\ \1- \8---\ \1+ \7g \1= 0\, +\- \07 \12 \08 \14 \07 \12 \08 \14 +\+ + +\+ 2 2 +\+ \0& \7a \0*\12 \0& \7b \0*\12 \7a \1+ \7b \1- 4\7g + \ \ \ \ \ \ \81 \1x + \8---\ 1\ \1+ \81 \1y + \8--- 1\ \1= \8--------------\, +\- \07 \12 \08 7 \12 \08 \14 +\+ +\, +\+ \0& \7a b \0* +\1Soit \7W \1le point de coordonn\5w\1es \81 - ---\ \1, \8- --- 1 \1et M(x,y) :\, +\- \07 \12 2 \08 +\+ & \7a \0* +\ \ \ \ \ \ \ \ \ \ \ \ \81 \1x + \8---\ 1\, +\- 1 \12 \81 +\+ +\ \ \ \ \ \ \ \ \ \7W\1M\ \81\ \ \ \ \ \ \ \ \ 1\, +\+ \7b + \81\ \1y + \8---\ 1\, +\- \07 \12 \08 +\+ +\, +\+ \12 2 +\+ \7a \1+ \7b \1- 4\7g + \9N\7W\1M\9N \1= k, k = \8--------------\, +\- \14 +\+ +\, +\+ 2 +donc E = { M(x,y) / \9N\7W\1M\9N\ \1= k\ }\, +\+ + si k < 0 alors il est \5w\1vident que E est vide : E = \9o \, +\+ + \1si k = 0 alors E est r\5w\1duit au seul point \7W \1: E = {\7W\1}\ \ \ \ \ \ \056\, +\+ + \1si k > 0 alors E est le cercle de centre \7W \1et de rayon R = \0r\ \1k\, +\+ +\, +\+ +\3Th\5w\3or\5r\3me :\, +\+ +\, +\+ \12 2 + Soit E = { M(x,y) / x\ + y\ + \7a\1x + \7b\1y + \7g \1= 0 }\, +\+ + dans un rep\5r\1re orthonormal l'ensemble E est un cercle,\, +\+ + \5w\1ventuellement r\5w\1duit \5f \1un point , ou l' ensemble vide\, +\+ +\, +\+ +\!Courbes_de_niveau_:\, +\+ +\, +\+ \9L +\+ + \#P \1: plan, \#V\ \ \1ensemble des vecteurs associ\5w\1s au plan .\, +\+ +\, +\+ 2 2 + 1) { M(x,y) / x\ + y\ + \7a\1x + \7b\1x + \7g\ \1= 0 }\, +\+ +\, +\+ \8L + \#Theoreme \ : \ \1Si \ u \ est \ \ un +\+ + vecteur non nul et k un r\5w\1el\, +\+ + quelconque alors l'ensemble \, +\+ + des \ points \ M du plan \ tels +\+ \8L -L + \1que u.OM = k est une \ droite +\+ \8-L L + \1orthogonale \5f \1(OA) si OA = u\, +\+ \8-L -L +\1Pour d\5w\1terminer cette droite : \ OA.OM \ = \ k, \ soit \ H \ le \ projet\5w +\+ \8-L +\1orthogonal de M sur (OA) qui est orient\5w \1par OA on a :\, +\+ \8-- -- -L + \1OA x OH = k si (OA) est orient\5w \1par OA\, +\+ +\+ \8-- \1k + \ \ \ \ \ \ \ \ \ \ \ \ OH =\ \8----\, +\- -- +\- \1OA\/ +\+ +\, +\+ 2 2 +2) { M \9e \#P \81 \1MA\ - MB\ = k, k \9e \0R\1, A \9e \#P\1, B \9e \#P \1}.\, +\+ +\, +\+ 2 2 \8-L\12 \8-L\12 + MA\ - MB\ = MA\ - MB\, +\+ +\+ \8-L -L -L -L +\1=\ ( MA + MB ) . ( MA - MB )\, +\+ +\+ \8-L -L +\1= 2MI . BA si I milieu de [AB]\, +\+ +\+ 2 2 \8-L -L + \1MA\ - MB\ = 2MI . BA \, +\+ 2 2 \8-L -L +\ \ \1Si on cherche M tels que MA\ - MB\ = k on a 2AB . IM = k\, +\+ \8-L +\1Soit H la projection orthogonal de M sur (AB) orient\5w \1par AB\, +\+ \8-- -- + \12.AB x IH = k\, +\+ +\+ \8-- \1k + IH = \8------\, +\- -- +\- \12.AB +\+ 2 2 + \3Th\5w\3or\5r\3me : \1L'ensemble des points M du plan tel que MA\ - MB\ \ = \ k +\+ +o\5i \1k est r\5w\1el donn\5w \1et A et B deux points quelconque du \ plan \ est +\+ +une droite orthogonal \5f \1(AB)\, +\+ +\, +\+ 2 2 + 3) { M \9e \#P \81 \1MA\ + MB\ = k, k \9e \0R\1, A \9e \#P\1, B \9e \#P \1}\, +\+ +\, +\+ 2 2 \8-L\12 \8-L\12 + MA\ + MB\ = MA\ + MB\ soit I le milieu de [AB]\, +\+ +\, +\+ \8-L -L \12 \8-L -L \12 +\ \ \ = ( MI + IA )\ + ( MI + IB )\, +\+ +\+ \8-L\12 \8-L\12 \8-L -L -L\12 \8-L\12 \8-L -L +\ \ \ \1= MI\ + IA\ + 2MI.IA + MI\ + IB\ + 2MI.IB\, +\+ +\+ 2 2 2 \8-L -L -L + \1= 2MI\ + IA\ + IB\ + 2MI.( IA + IB )\, +\+ +\, +\+ 2 2 +\+ 2 AB AB \8L + \1= 2MI\ + \8--- \1+ \8--- \1+ 0\, +\- 4 4 +\- +\+ 2 +\+ 2 2 2 AB + \ MA\ + MB\ = 2MI\ + \8---\, +\- \12 +\+ 2 2 + Si on cherche l'ensemble des points M tels que MA\ + MB\ = k on a\, +\+ +\+ 2 2 +\+ 2 AB 2 k AB + 2MI\ + \8--- \1= k <==> MI\ = \8---\ - ---\, +\- \12 2 4 +\+ +\+ 2 +\+ k AB + * Si \8---- --- \1positif, l'ensemble des points M est le \ cercle \ de \, +\- 2 4 +\+ +\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \05\8---------\06\, +\+ \12 +\+ \0\\ / \1k AB +centre I et de rayon \ \ \ \ \ \8--- - ---\, +\- \0\\/ \12 4 +\+ +\+ 2 +\+ k AB + * Si \8---- --- \1est nul M est en I\, +\- 2 4 +\+ +\+ 2 +\+ k AB + * Si \8---- --- \1est n\5w\1gatif l'ensemble cherch\5w \1est l'ensemble Vide\, +\- 2 4 +\+ 2 2 +\3Th\5w\3or\5r\3me : \1L'ensemble des points M du plan tels que MA\ + MB\ \ = \ k +\+ +o\5i \1k est un r\5w\1el donn\5w \1est soit un cercle, \ soit \ un \ point, \ soit +\+ +l'ensemble vide . +\= + \ No newline at end of file diff --git a/MEMOPRO1.BAS b/MEMOPRO1.BAS new file mode 100644 index 0000000..ed433e3 --- /dev/null +++ b/MEMOPRO1.BAS @@ -0,0 +1,217 @@ +'*************************************************************************** +'** + +def seg=&hb800 ' ****$ &hB000 pour un HERCULE ********** +CY%=1:CX%=1 +DIM CARTE%(16,4),C1%(32),C2%(32),C3%(32),C4%(32),C%(8) +randomize timer + +FOR I=1 TO 32:READ C1%(I),C2%(I),C3%(I),C4%(I):NEXT I ' READ LES DATAS !!! + +' constante MONOCHROME : ( eh oui !! il en faut je me passerai bien ! ) + +C%(1)=219 : C%(5)=233 +C%(2)=254 : C%(6)=240 +C%(3)=079 : C%(7)=042 +C%(4)=120 : C%(8)=004 + +' encore et toujours des constantes !!! (video en plus) ==================== + +F1$=CHR$(24):F2$=CHR$(25):F3$=CHR$(27):F4$=CHR$(26) + +REM Vives les datas tralala !!!! ********* CONSTANTE : FORMES/COULEUR ****** + ' 1,2,3,4,5,6,7,8 = couleurs (caractres pour mono ) + ' un type de carte est form de 4 couleurs/formes + +formesC : + + DATA 1,1,1,1 ,2,2,2,2 ,3,3,3,3 ,4,4,4,4 ,5,5,5,5 ,6,6,6,6 ,7,7,7,7 ,8,8,8,8 + DATA 1,2,1,2 ,2,1,2,1 ,3,2,3,2 ,8,2,8,2 ,8,6,8,6 ,8,5,8,5 ,7,1,7,1 ,1,7,1,7 + DATA 4,2,2,4 ,1,3,3,1 ,8,1,1,8 ,6,3,3,6 ,1,1,2,2 ,5,5,4,4 ,5,5,7,7 ,6,6,8,8 + DATA 4,5,5,4 ,3,6,6,3 ,2,7,7,2 ,2,6,6,2 ,6,2,2,6 ,5,7,7,5 ,8,5,5,8 ,2,5,2,5 + +'=========================================================================== +' PROGRAMME PRINCIPAL AL AL ALLEEEE !!!!! +'=========================================================================== + +SCREEN 2:SCREEN 0 +COLOR 7:MENU$="INITIALISATION ECRAN":gosub faitcadre +locate 10,20:PRINT "-1- Pour cran CGA couleur " +locate 12,20:PRINT "-2- Pour cran CGA monochrome / CGA Plasma " +locate 14,20:PRINT "-3- Pour cran HERCULE " +Locate 16,20:PRINT "-Q- Pour fin ( ou tout moment du jeu )" + +PrendReponse : + + R$=INPUT$(1):if R$=chr$(27) or r$="q" or R$="Q" then goto FINPROG + + IF R$="1" or R$="&" THEN MONO%=0 :DEF SEG = &HB800:GOTO JEU + IF R$="2" OR R$="" THEN MONO%=-1:DEF SEG = &HB800:GOTO JEU + IF R$="3" OR R$=CHR$(34) THEN MONO%=-1:DEF SEG = &HB000:GOTO JEU + + BEEP:GOTO PrendReponse + +Jeu : ' ah a va enfin pter dans l'cran !!!! (pas trop ouffff !!) + +CLS:COLOR 7,0:MENU$="MEMO LE JEU DE MEMOIR":gosub faitcadre + +Locate 5,20:PRINT " Choisisez le niveau de difficulter !! " +Locate 7,10:Print " Attention ne pas se surestimer sinon c'est la gamelle !!! HiHi !!" + +Locate 12,20:PRINT "-1- Trs facile (L'ordinateur est nul !!)" +Locate 14,20:PRINT "-2- Moyen (Il faut une meilleure mmoire)" +Locate 16,20:PRINT "-3- Trs Dre (alors il faut tre un pro !! )" +Locate 18,20:PRINT "-Q- Salut !!! la prochaine ( == ) " + +PrendrEponse1 : + + R$=INPUT$(1):if R$=chr$(27) or r$="q" or R$="Q" then goto FINPROG + + IF R$="1" or R$="&" THEN GOSUB Faitpage:GOTO JEU1 + IF R$="2" OR R$="" THEN GOSUB Faitpage:GOTO JEU2 + IF R$="3" OR R$=CHR$(34) THEN GOSUB Faitpage:GOTO JEU3 + + BEEP:GOTO PrendReponse1 + +JEU1: +GOSUB PREMIERE:LOCATE 24,70:PRINT "FACILE !"; + +Gosub ChoixDeLui:k=0 +joue : + +X1=0:Y1=0:X2=0:Y2=0 + +While (carte%(X1,Y1)=0) + X1=INT(RND(1)*16)+1:Y1=INT(RND(1)*4)+1 +Wend + +While (CARTE%(X2,Y2)=0 or (X1=X2 AND Y1=Y2)) + X2=INT(RND(1)*16)+1:Y2=INT(RND(1)*4)+1 +Wend + +x=x1:y=y1:gosub AfficheCarte 'Montre les cartes +x=x2:y=y2:gosub AfficheCarte + +IF CARTE%(X1,Y1)=CARTE%(X2,Y2) THEN CARTE%(X1,Y1)=0:CARTE%(X2,Y2)=0:m$=" Je les gagne ":m=1 else m$=" J'ai perdu ..":m=0 + +COLOR 28,0 +LOCATE 22,30:PRINT M$;:IF MONO THEN COLOR 15,0 ELSE COLOR 11,1 + +if m=0 THEN + x=x1:y=y1:gosub cadrerenverser + x=x2:y=y2:gosub cadrerenverser + ELSE + k=k+1 + END IF + +IF K=>32 THEN END + +GOTO JOUE: +CHOIXDELUI: +RETURN +JEU2: +JEU3: +END +'=========================================================================== +' LES DIVERSES SOUS PROCEDURES DE TOUT TYPE COUCOU c'est Yoyo !!! +'=========================================================================== +faitpage : ' *************************************** INITIALISATION ****** + +CLS +For X=1 to 16 + For Y=1 to 4 + gosub cadrerenverser + next Y +next X + + For I=1 TO 32 + + For J=1 to 2 + + X=INT(RND(1)*16)+1:Y=INT(RND(1)*4)+1 + + IF carte%(X,Y)=0 then carte%(x,y)=i:goto nf + + For x=1 to 16 + For y=1 to 4 + IF carte%(x,y)=0 then carte%(x,y)=i :goto nf + + NEXT y + NEXT x + +nf : + + Next J:NEXT I + +RETURN + + +cadrerenverser : ' FAIT UNE CARTE RENVERSE A LA POSITION X,Y ************** + ' Chouette des peek des pook des peek, pook, popekopoke !!!! + xr%=(x-1)*10 + yr%=(y-1)*800 + CT%=480+yr%+xr% + +POKE XR%+YR% ,201 :POKE CT% ,200 :POKE XR%+YR%+160,186 :POKE XR%+YR%+162,176 +POKE XR%+YR%+2,205 :POKE CT%+2,205 :POKE XR%+YR%+320,186 :POKE XR%+YR%+164,176 +POKE XR%+YR%+4,205 :POKE CT%+4,205 :POKE XR%+YR%+166,186 :POKE XR%+YR%+324,176 +POKE XR%+YR%+6,187 :POKE CT%+6,188 :POKE XR%+YR%+326,186 :POKE XR%+YR%+322,176 + + FOR M%=YR% TO YR%+480 step 160 + FOR K%=XR%+1 TO XR%+7 step 2 : POKE K%+M%,4 :NEXT K% + NEXT M% + +RETURN + +AfficheCarte : + + + XR%=(X-1)*10 + YR%=(Y-1)*800 + N=CARTE%(X,Y) + +IF MONO% THEN ' MONO% =-1 monochromme MONO%=0 couleur ! + POKE XR%+YR%+162,c%(C1%(N)) + POKE XR%+YR%+164,C%(C2%(N)) + POKE XR%+YR%+324,C%(C3%(N)) + POKE XR%+YR%+322,C%(C4%(N)) + + ELSE + POKE XR%+YR%+162,219:POKE XR%+YR%+163,C1%(N)+7 + POKE XR%+YR%+164,219:POKE XR%+YR%+165,C2%(N)+7 + POKE XR%+YR%+324,219:POKE XR%+YR%+325,C3%(N)+7 + POKE XR%+YR%+322,219:POKE XR%+YR%+323,C4%(N)+7 + END IF + +RETURN + +REM Cn%(N) revoit pour un ecran monochrome le code caractre +REM pour un cran couleur la couleur + + +FaitCadre : ' CELA FAIT UN CADRE A L'ECRAN !!! + +POKE 0,201:FOR K=2 TO 156 STEP 2:POKE K,205:POKE K+320,205 +POKE K+3680,205:NEXT K:POKE 158,187:POKE 160,186:POKE 318,186:POKE 320,204 +POKE 478,185:POKE 3680,200:POKE 3838,188:FOR K=480 TO 3520 STEP 160 +POKE K,186:POKE K+158,186:NEXT +LX=int((80-len(menu$))/2):locate 2,lx:print menu$:return + +PREMIERE : '**************************************************************** + +IF NOT MONO% THEN COLOR 14,4 ELSE COLOR 0,7 +LOCATE 25,1 +PRINT " Fin / (8) ";F1$;" / (2) ";F2$;" / (4) ";F3$;" / (6) ";F4$;" / ou pour choix "; + +IF MONO% THEN COLOR 15,0 ELSE COLOR 13,1 +LOCATE 24,60 :PRINT " NIVEAU : "; + + +RETURN + +FINPROG : ' Dj !!! oh! non non non c'tait trop bien pourquoi finir ???!! + + CLS:PRINT " UN GRAND OU PETIT BONJOUR DE DARCHE Yoann .. ":END + +' et c'est dj fini ..... + diff --git a/MEMOPROG.BAS b/MEMOPROG.BAS new file mode 100644 index 0000000..256de6d --- /dev/null +++ b/MEMOPROG.BAS @@ -0,0 +1,558 @@ +'**************************************************************************** +'*** *** +'*** Programme crit par DARCHE Yoann EN QUICK-BASIC Ver 2.0 *** +'*** *** +'*** Programme Ludique : bas sur le jeu connu MEMORY *** +'*** *** +'*** Version 1.4 acheve le 9/11/1990 *** +'*** *** +'*** Compilable En Quick-Basic et Turbo-Basic *** +'*** *** +'**************************************************************************** + +DEFINT A-Z +CLS:SCREEN 2:SCREEN 0:GOSUB PUBLICITE +def seg=&hb800 ' ****$ &hB000 pour un HERCULE ********** +CY=1:CX=1:MX=1:MY=1:MAXITI=4 +DIM Carte(16,4),C1%(32),C2%(32),C3%(32),C4%(32),C%(8),YM(32),XM(32) + +'******** Vives les Scores !!!!! Fichiers !! ******************************* + +OPEN "SCORES." AS #1 LEN = 18 +FIELD #1,10 as NOM$,8 as SC$ +IF LOF(1)=0 THEN Gosub Initialise + +randomize timer '*************** debut de la fin *************************** + +FOR I=1 TO 32:READ C1%(I),C2%(I),C3%(I),C4%(I):NEXT I ' READ LES DATAS !!! + +' constante MONOCHROME : ( eh oui !! il en faut je me passerai bien ! ) + +C%(1)=219 : C%(5)=233 +C%(2)=254 : C%(6)=240 +C%(3)=079 : C%(7)=042 +C%(4)=120 : C%(8)=004 + +' encore et toujours des constantes !!! (video en plus) ==================== + +F1$=CHR$(24):F2$=CHR$(25):F3$=CHR$(27):F4$=CHR$(26) + +REM Vives les datas tralala !!!! ********* CONSTANTE : FORMES/COULEUR ****** + ' 1,2,3,4,5,6,7,8 = couleurs (caractres pour mono ) + ' un type de Carte est form de 4 couleurs/formes + +formesC : + + DATA 1,1,1,1 ,2,2,2,2 ,3,3,3,3 ,4,4,4,4 ,5,5,5,5 ,6,6,6,6 ,7,7,7,7 ,8,8,8,8 + DATA 1,2,1,2 ,2,1,2,1 ,3,2,3,2 ,8,2,8,2 ,8,6,8,6 ,8,5,8,5 ,7,1,7,1 ,1,7,1,7 + DATA 4,2,2,4 ,1,3,3,1 ,8,1,1,8 ,6,3,3,6 ,1,1,2,2 ,5,5,4,4 ,5,5,7,7 ,6,6,8,8 + DATA 4,5,5,4 ,3,6,6,3 ,2,7,7,2 ,2,6,6,2 ,6,2,2,6 ,5,7,7,5 ,8,5,5,8 ,2,5,2,5 + +'=========================================================================== +' PROGRAMME PRINCIPAL AL AL ALLEEEE !!!!! +'=========================================================================== + +COLOR 7:CLS:MENU$="INITIALISATION ECRAN":gosub faitcadre +locate 10,20:PRINT "-1- Pour cran CGA couleur " +locate 12,20:PRINT "-2- Pour cran CGA monochrome / CGA Plasma " +locate 14,20:PRINT "-3- Pour cran HERCULE " +Locate 16,20:PRINT "-Q- Pour fin ( ou tout moment du jeu )" + +PrendReponse : + + R$=INPUT$(1):if R$=chr$(27) or r$="q" or R$="Q" then goto FINPROG + + IF R$="1" or R$="&" THEN MONO%=0 :DEF SEG = &HB800:GOTO JEU + IF R$="2" OR R$="" THEN MONO%=-1:DEF SEG = &HB800:GOTO JEU + IF R$="3" OR R$=CHR$(34) THEN MONO%=-1:DEF SEG = &HB000:GOTO JEU + + BEEP:GOTO PrendReponse + +Jeu : ' ah a va enfin pter dans l'cran !!!! (pas trop ouffff !!) + + IF MONO% THEN + C1=15:F1=0 ' Couleur JeJoue1ur + C2=7 :F2=0 ' Couleur Ordinateur + C3=7 :F3=0 ' Couleur Message Normal + C4=0 :F4=7 ' Couleur Massage Inverse + C5=15 ' Couleur Curseur (Spcial POKE !!) + C6=143 + ELSE + C1=13:F1=0 + C2=11:F2=0 + C3=4 :F3=0 + C4=14:F4=4 + C5=15 + C6=143 + + END IF +OJ=0 +Gosub Fichier +Coucou : +COLOR C3,F3:CLS:MENU$="OPTIONS POSSIBLES":Gosub FaitCadre + +Locate 08,20:PRINT "-1- Ordinateur Seul " +Locate 10,20:PRINT "-2- Joueur Contre Ordinateur " +Locate 12,20:PRINT "-3- Selection du temps de mmorisation" +Locate 14,20:PRINT "-4- Pour effacer les Scores ( Option pour les nuls )" +Locate 16,20:PRINT "-Q- Salut !!! la prochaine ( == ) " +Locate 18,20:print " ou pour Confirmer " +Reaffiche : +Color C3,F3 +Locate 23,3:PRINT " Delais de Mmorisation : ";:COLOR C4,F4:PRINT MAXITI +Color C3,F3 +Locate 22,3:PRINT " Option de Jeu : ";:COLOR C4,F4 +IF OJ THEN PRINT " Joueur - Ordinateur " ELSE PRINT " Ordinateur - Seul " +Color C3,F3 + +PrendrEponse2 : + + R$=INPUT$(1):if R$=chr$(27) or r$="q" or R$="Q" then goto FINPROG + + IF R$="1" or R$="&" THEN OJ=00:GOTO Reaffiche + IF R$="2" OR R$="" THEN OJ=-1:GOTO Reaffiche + IF R$="3" OR R$=CHR$(34) THEN Gosub ResetMaxiTI:GOTO Coucou + IF R$="4" OR R$="'" THEN Gosub Initialise:GOTO Coucou + IF R$=CHR$(13) or R$=" " THEN Goto Suivant + + BEEP:GOTO PrendReponse2 + +Suivant : + +CLS:COLOR C3,F3:MENU$="MEMO LE JEU DE MEMOIR":gosub faitcadre + +Locate 5,20:PRINT " Choisisez le niveau de difficulter !! " +Locate 7,10:Print " Attention ne pas se surestimer sinon c'est la gamelle !!! HiHi !!" + +Locate 12,20:PRINT "-1- Trs facile (L'ordinateur est nul !!)" +Locate 14,20:PRINT "-2- Moyen (Il faut une meilleure mmoire)" +Locate 16,20:PRINT "-3- Trs Dre (alors il faut tre un pro !! )" +Locate 18,20:PRINT "-Q- Salut !!! la prochaine ( == ) " +A$="" + +PrendrEponse1 : + + R$=INPUT$(1):if R$=chr$(27) or r$="q" or R$="Q" then goto FINPROG + + IF R$="1" or R$="&" THEN GOSUB Faitpage:DJ=0:GOTO JEU1 + IF R$="2" OR R$="" THEN GOSUB Faitpage:DJ=1:GOTO JEU2 + IF R$="3" OR R$=CHR$(34) THEN GOSUB Faitpage:DJ=2:GOTO JEU3 + + BEEP:GOTO PrendReponse1 + +JEU1:'*********************** NIVEAU FADO(REMI) ************************** +GOSUB PREMIERE:LOCATE 24,70:PRINT "FACILE !"; + +IlJoue1 : +IF OJ THEN Gosub ChoixDeLui + +JeJoue1 : +X1=0:Y1=0:X2=0:Y2=0 + +While (Carte(X1,Y1)=0) + X1=INT(RND(1)*16)+1:Y1=INT(RND(1)*4)+1 +Wend + +While (Carte(X2,Y2)=0 or (X1=X2 AND Y1=Y2)) + X2=INT(RND(1)*16)+1:Y2=INT(RND(1)*4)+1 +Wend + +GOSUB ChoixOrdinateur + +IF M=1 THEN GOTO JeJoue1 ELSE GOTO IlJoue1 + +JEU2:' **************************** UN PEU PLUS DIFFICILE SI SI !!! ******** +GOSUB PREMIERE:LOCATE 24,70:PRINT "MOYEN !"; +X2=0:Y2=1 +X1=0:Y1=0 + +DebutJeu2 : + + While Carte(x1,y1)=0 + X1=INT(RND(1)*16)+1 + Y1=int(RND(1)*4)+1 + WEND + +Incrementation : + + X2=X2+1 + IF X2 => 17 THEN Y2=Y2+1:X2=1 + IF Y2 => 5 THEN Y2=1:X2=1 + IF CARTE(X2,Y2)=0 OR (X1=X2 AND Y1=Y2) THEN Goto Incrementation + +Gosub ChoixOrdinateur + +IF M=1 THEN GOTO DebutJeu2 + +IlJoue2 : + M=0 + IF OJ THEN Gosub ChoixDelui + IF CARTE(X1,Y1)=0 THEN Goto DebutJeu2 ELSE Goto Incrementation + +JEU3:'************************* DIFFICILE !!!!! **************************$* + +For K=1 to 32:YM(K)=0:XM(K)=0:NEXt K ' Rinitialisation de sa petite mmoire +GOSUB PREMIERE:LOCATE 24,70:PRINT "DIFFICILE"; + +DebutJeu3 : + + X1=0:Y1=0:X2=0:Y2=0 + While Carte(x1,y1)=0 + X1=INT(RND(1)*16)+1 + Y1=int(RND(1)*4)+1 + WEND + +Nc=Carte(X1,Y1) +IF XM(Nc)=X1 AND YM(Nc)=Y1 THEN Goto DebutJeu3 +IF XM(Nc)=0 THEN Goto Recherche + +X2=XM(Nc):Y2=YM(Nc) +If Carte(X2,Y2)=0 THEN XM(Nc)=0:YM(Nc)=0:Goto Recherche 'Une Gourde !! +Gosub ChoixOrdinateur +Goto FinJeu3 + +Recherche : '****************** Il ne la pas encore en mmoire ************** + ' Donc il en prend une au hasard (sans tricher) +While (Carte(X2,Y2)=0 or (X1=X2 AND Y1=Y2)) + X2=INT(RND(1)*16)+1 + Y2=INT(RND(1)*4)+1 +Wend + +IF Carte(X2,Y2)=Nc THEN GOSUB ChoixOrdinateur:Goto FinJeu3 + +Mc=CARTE(X2,Y2) '************ Il n'a pas trouver la bonne mais il la retient +YM(Mc)=Y2:XM(Mc)=X2 +YM(Nc)=Y1:XM(Nc)=X1 +Gosub ChoixOrdinateur + +FinJeu3 : +IF M=1 THEN GOTO DebutJeu3 + IF OJ THEN Gosub ChoixDelui + Goto DebutJeu3 + + +END +'=========================================================================== +' LES DIVERSES SOUS PROCEDURES DE TOUT TYPE COUCOU c'est Yoyo !!! +'=========================================================================== +faitpage : ' *************************************** INITIALISATION ****** + +CLS +For X=1 to 16 + For Y=1 to 4 + Cl=C3 + gosub cadre:gosub remplis + next Y +next X + + For I=1 TO 32 + + For J=1 to 2 + + X=INT(RND(1)*16)+1:Y=INT(RND(1)*4)+1 + + IF Carte(X,Y)=0 then Carte(x,y)=i:goto nf + + For x=1 to 16 + For y=1 to 4 + IF Carte(x,y)=0 then Carte(x,y)=i :goto nf + + NEXT y + NEXT x + +nf : + + Next J:NEXT I + +RETURN + + +cadre : ' FAIT UNE Carte RENVERSE A LA POSITION X,Y ************** + ' Chouette des peek des pook des peek, pook, popekopoke !!!! + xr%=(x-1)*10 + yr%=(y-1)*800 + CT%=480+yr%+xr% + +POKE XR%+YR% ,201 :POKE CT% ,200 :POKE XR%+YR%+160,186 +POKE XR%+YR%+2,205 :POKE CT%+2,205 :POKE XR%+YR%+320,186 +POKE XR%+YR%+4,205 :POKE CT%+4,205 :POKE XR%+YR%+166,186 +POKE XR%+YR%+6,187 :POKE CT%+6,188 :POKE XR%+YR%+326,186 + ' ****************** LES COULEURS NOW !!!!! Eh oui encore des pokes !!! **** +POKE XR%+YR%+1,CL :POKE CT%+1,CL :POKE XR%+YR%+161,CL +POKE XR%+YR%+3,CL :POKE CT%+3,CL :POKE XR%+YR%+321,CL +POKE XR%+YR%+5,CL :POKE CT%+5,CL :POKE XR%+YR%+167,CL +POKE XR%+YR%+7,CL :POKE CT%+7,CL :POKE XR%+YR%+327,CL +RETURN + +Remplis : ' ************ Fait Quatre petit carr au centre de la Carte ***** +CT%=(x-1)*10+(y-1)*800 +POKE CT%+162,176:POKE CT%+163,CL +POKE CT%+164,176:POKE CT%+165,CL +POKE CT%+324,176:POKE CT%+325,CL +POKE CT%+322,176:POKE CT%+323,CL +RETURN + +AfficheCarte : '******* Affiche les couleurs/formes de la Carte x,y ******** + + XR%=(X-1)*10 + YR%=(Y-1)*800 + N=Carte(X,Y) + +IF MONO% THEN ' MONO% =-1 monochromme MONO%=0 couleur ! + POKE XR%+YR%+162,c%(C1%(N)) + POKE XR%+YR%+164,C%(C2%(N)) + POKE XR%+YR%+324,C%(C3%(N)) + POKE XR%+YR%+322,C%(C4%(N)) + + ELSE + POKE XR%+YR%+162,219:POKE XR%+YR%+163,C1%(N)+7 + POKE XR%+YR%+164,219:POKE XR%+YR%+165,C2%(N)+7 + POKE XR%+YR%+324,219:POKE XR%+YR%+325,C3%(N)+7 + POKE XR%+YR%+322,219:POKE XR%+YR%+323,C4%(N)+7 + END IF +REM Cn%(N) revoit pour un ecran monochrome le code caractre +REM pour un cran couleur la couleur +RETURN + +FaitCadre : ' CELA FAIT UN CADRE A L'ECRAN !!! ****************************** + +POKE 0,201:FOR K=2 TO 156 STEP 2:POKE K,205:POKE K+320,205 +POKE K+3680,205:NEXT K:POKE 158,187:POKE 160,186:POKE 318,186:POKE 320,204 +POKE 478,185:POKE 3680,200:POKE 3838,188:FOR K=480 TO 3520 STEP 160 +POKE K,186:POKE K+158,186:NEXT +LX=int((80-len(menu$))/2):locate 2,lx:print menu$:return + +PREMIERE : '**************************************************************** +PJ=0:PO=0:CJ=0:CO=0 +LOCATE 25,1:COLOR C4,F4 +PRINT " Fin / (8) ";F1$;" / (2) ";F2$;" / (4) ";F3$;" / (6) ";F4$;" / ou pour choix "; + +COLOR C3,F3:LOCATE 24,60 :PRINT " NIVEAU : "; +RETURN + +ChoixDeLui : '************** eh si tu veux JeJoue1r laisse cette procedure ! *** + +CJ=CJ+1 +b$=chr$(0):NN=0:GOTO AGIT + +PrendSaTouche : + +Gosub AfficheLesResultat + + a$="" + While a$="" : A$=INKEY$ : WEND + + if A$="q" or a$="Q" or a$=chr$(27) then goto FinProg + + IF (A$="8" OR A$=B$+"H") AND CY>1 THEN CY=CY-1 + IF (A$="2" OR A$=B$+"P") AND CY<4 THEN CY=CY+1 + IF (A$="4" OR A$=B$+"K") AND CX>1 THEN CX=CX-1 + IF (A$="6" OR A$=B$+"M") AND CX<16 THEN CX=CX+1 + IF A$=CHR$(13) or A$=" " THEN Goto VerifieSaDonnee + IF A$="A" or A$="a" THEN Goto Coucou +AGIT : + IF CX=MCX and CY=MCY THEN GOTO PRENDSATOUCHE + X=MX:Y=MY:CL=C3:Gosub Cadre + X=CX:Y=CY:CL=C5:Gosub Cadre + MX=CX:MY=CY +GOTO PrendSaTouche : + +VerifieSaDonnee : + + IF Carte(CX,CY)=0 THEN BEEP:GOTO PrendSaTouche + IF Cx=MCX and Cy=MCY Then BEEP:GOTO PrendSaTouche + + X=CX:Y=CY:GOSUB AfficheCarte + + IF Nn=0 THEN MCX=CX:MCY=CY:MX=0:MY=0:NN=1:GOTO PrendSaTouche + +NN=0 + IF Carte(Mcx,Mcy)=Carte(CX,CY) THEN + PJ=PJ+1 + Carte(Mcx,Mcy)=0:Carte(Cx,CY)=0 + X=CX:Y=CY:CL=C3:GOSUB Cadre + X=MCX:Y=MCY:GOSUB Cadre:mcx=0 + Locate 23,35:COLOR C1,F1:PRINT " Gagn " + GOSUB THETIME + Goto PrendSaTouche + ELSE + Locate 23,35:COLOR C1,F1:PRINT " Perdu " + END IF + + GOSUB THETIME + X=CX:Y=CY:CL=C3:Gosub Cadre:GOsub Remplis + X=MCX:Y=MCY :Gosub Cadre:Gosub Remplis + MCX=0:MCY=0 + +RETURN + +AfficheLesResultat : '****************************** COUCOU LES NOTES !! *** + +COLOR C1,F1:LOCATE 21,1:PRINT "Vous Avez : ";:Print Using "##";PJ;:PRINT " Pt" +COLOR C2,F2:LOCATE 22,1:PRINT " J'ai : ";:Print Using "##";PO;:PRINT " Pt" +COLOR C1,F1:LOCATE 21,20:PRINT "en ";:PRINT USING "####";CJ;:PRINT " Coups" +COLOR C2,F2:LOCATE 22,20:PRINT "en ";:PRINT USING "####";CO;:PRINT " Coups" +COLOR C4,F4:LOCATE 21,60:PRINT "Delais : ";:PRINT USING "##";MAXITI;:Print " Sec." +COLOR C3,F3 +LOCATE 23,35:PRINT " " +IF PJ+PO => 32 THEN + COLOR C3,F3:LOCATE 23,35 + IF PJ > PO THEN PRINT " Vous avez gagn(e)(s) " + IF PJ < PO THEN PRINT " Vous avez perdu(e) " + IF PJ = PO THEN PRINT " Egalit " + COLOR C4,F4 +LOCATE 25,1:PRINT space$(29);"APPUYER SUR UNE TOUCHE";SPACE$(29);:LOCATE 1,1 +COLOR C3,F3 + A$=INPUT$(1) + CLS:GOsub GestionScore:Goto Jeu + ELSE + RETURN + END IF + +THETIME :'****************************************************************** + +TI!=INT(TIMER):a$="" +WHILE ABS(TIMER-TI!) < MAXITI+0.1 +A$=INKEY$ +IF A$<>"" THEN RETURN +WEND +RETURN + +ChoixOrdinateur : '********************** Affiche & Bidouille de l'Ordi ** +CO=CO+1 +If a$=chr$(27) then goto CouCou + +x=x1:y=y1:gosub AfficheCarte:Cl=C6:gosub cadre 'Montre les Cartes +x=x2:y=y2:gosub AfficheCarte:Cl=C6:gosub cadre + +IF Carte(X1,Y1)=Carte(X2,Y2) THEN + Carte(X1,Y1)=0:Carte(X2,Y2)=0 + M$=" Je les gagne ":M=1 + ELSE + M$=" J'ai perdu ..":M=0 + END IF + +COLOR C2,F2:LOCATE 23,35:PRINT M$;:COLOR C3,F3 + +GOSUB THETIME + +if m=0 THEN + x=x1:y=y1:CL=C3:gosub cadre:Gosub Remplis + x=x2:y=y2:CL=C3:gosub cadre:Gosub Remplis + ELSE + PO=PO+1 + X=X1:Y=Y1:Cl=C3:GOSUB CADRE + X=X2:Y=Y2: GOSUB CADRE +END IF + +GOSUB AfficheLesResultat:RETURN + +ResetMaxiTi : +COLOR C3,F3:CLS:MENU$="Initialise Le Delais":gosub FaitCadre +Locate 11,3:Print " Delais en Seconde [";MaxiTi;"] :"; +INPUT "",MA$ +If ma$="" then Return +Ma=Val(MA$):If MA<0 Or Ma>10 Then Locate 14,5:print " IIIIdiot !! ":a$=input$(1):goto ResetMaxiTi +Maxiti=Ma:Return + +FINPROG : ' Dj !!! oh! non non non c'tait trop bien pourquoi finir ???!! + + CLS:PRINT " UN GRAND OU PETIT BONJOUR DE DARCHE Yoann .. ":END + +' et c'est dj fini ..... + +PUBLICITE : '*************** IL en faut pour vivre !!! *********************** +LOCATE 1,1:color 0,15 +PRINT "" +PRINT "۰۰۰۰" +PRINT "۱۰۰۱۰" +PRINT "۰۰۰۰۰۰۰" +PRINT "۰۱۱۰۰۰۰۰۰۰۰۰۰۰" +PRINT "۱۰۰۱۱۱۱۱۰۱۰۰۰۰۰" +PRINT "۰۰۰۱۱۰۰۰۱۰۰۰۰۰" +PRINT "۰۰۱۰۰۱۱۱۰۰۰۰" +PRINT "۱۰۱۰۱۱۰۱۱۱۰۰۰۰" +PRINT "۰۱۱۰۱۰۰۱۰۱۰۰۰۰۱" +PRINT "۰۱۰۱۱۱۰۰۱۰۰۰۱" +PRINT "" +PRINT "" +PRINT:color 14,0 +PRINT " Vous Prsente un logiciel ludique " +PRINT +PRINT " ͻ ͻ ͻ ͻ ͻ ͻ ͻ ͻ " +PRINT " Ȼɼ Ȼɼ " +PRINT " ȼ ͹ ȼ ͼ ͼ " +PRINT " Ȼ " +PRINT " ͼ ͼ ͼ Ver 1.4 " +PRINT " de DARCHE Yoann " +PRINT " 71 avenue d'Orlans 91800 BRUNOY (FRANCE) " +PRINT " Tel : 69-39-51-26 "; +LOCATE 1:A$=input$(1):return + +FICHIER : '****************** Gestion des scores !!!! ********************** +Color C3,F3:CLS:MENU$="LES SCORES (Hum ! Hum !)" +Gosub FaitCadre + +Color C4,F4 +Locate 6,10:PRINT " Trs Facile Mdiocre Trs Difficile " +FOR I=0 TO 2 + IF I=0 THEN COLOR C3,F3 + IF I=1 THEN COLOR C1,F1 + IF I=2 THEN COLOR C2,F2 + FOR J=1 TO 10 + GET #1,(I*10+J) + LOCATE J+7,I*20+10:PRINT NOM$;" ";SC$ + NEXT J +NEXT I +Locate 20,10:Print " Appuyez sur une touche pour continuer " +a$=input$(1):return + +GESTIONSCORE : +CLS:COLOR C4,F4 +LOCATE 12,10:PRINT " Je Regarde Si vous pouvez tre dans les 10 Meilleurs " +TP!=INT((PJ*CO)/(PO*CJ+1)*(1000/(MaxiTi+1))) + +FOR I=1 TO 10 + GET #1,DJ*10+I + if val(SC$) 10 Then + BEEP:COLOR C4,F4 + Locate 15,30:PRINT "Moins DE 10 Caractres" + COLOR C3,F3:A$=input$(1) + GOTO SuiteGestion + End If + +FOR t=10 to i+1 Step -1 + GET #1,DJ*10+T-1 + nom2$=nom$:sc2$=sc$ + GET #1,Dj*10+T + Lset nom$=nom2$:Lset sc$=sc2$ + PUT #1,Dj*10+T +NEXT T + +GET #1,DJ*10+I +LSET SC$=STR$(TP!) +Lset NOM$=N$ +PUT #1,DJ*10+I +RETURN + +INITIALISE : '********************************************* +FOR I=1 TO 30 +GET #1,I +LSET NOM$="Mmory":Lset SC$="00000000" +PUT #1,I +NEXT I +RETURN diff --git a/MENU.BAS b/MENU.BAS new file mode 100644 index 0000000..1a1a6a5 Binary files /dev/null and b/MENU.BAS differ diff --git a/MESSAGE.BAS b/MESSAGE.BAS new file mode 100644 index 0000000..0d28d93 --- /dev/null +++ b/MESSAGE.BAS @@ -0,0 +1,168 @@ + +REM *********************** + +DIM CH$(4) +' Constante +cls +DEF SEG = &hB800 ' Il faudra mettre 1hB000 + +OPEN "MEG." as #1 len = 128 +FIELD #1,32 as L1$,32 as L2$,32 as L3$,32 as L4$ +NT = LOF(1)/128 + +MenuPrincipal : + +Color 7,0 +CLS : Menu$="Menu Principal : ":GOSUB FaitCadre +Locate 7,20:Print " -1- Enregistrer un Message " +Locate 9,20:Print " -2- Lire un ou des message(s) " +'Locate 11,20:Print " -3- Speciale Special " +Locate 13,20:PRINT " -Q- Fin " +Locate 16,20:Print " pour fin " + +prendCaracter : +A$=input$(1):If a$=chr$(27) or a$="q" or a$="Q" then Goto Fin + +If a$="1" or a$="&" THEN Goto ENREGISTRE +If a$="2" or a$="" Then Goto LIT +'If a$="3" or a=chr$(34) ' Then Goto Speciale +Beep:goto prendCaracter + +'************************************************************************** +ENREGISTRE : +CLS +IF NT>=40 THEN NA=1 else na=nt+1 +GET #1,na +menu$=" Enregistrement n"+str$(na):Gosub Faitcadre +Gosub FaitPage +POKE (x+DX)*2+(y+DY)*160+1,112 +m=(x+DX)*2+(y+DY)*160+1 +Locate 5,10:Print "Enter pour changer de ligne les flches pour dplacer le " +Locate 6,10:Print "Curseur , et pour Valider , pour abandonner " +Locate 18,10:Print "Vous devriez retenir votre pour voir si il y a une reponse !" +Locate 20,25:Print " pour se casser ! " + +prendsatouche : +B$=chr$(0) +M$="ABCDEFGHIJKLMNOPQR -+=STUVWXYZabcdefghijklmnopqrstuvwxyz1234567890)(&'!?/:.;,$*%<>#@\" +A$=inkey$:if a$="" then goto prendsatouche + + If a$=chr$(27) then goto EnSuite + If a$=b$+"" Then Goto MenuPrincipal + If a$=b$+"H" Then y=y-1 + If a$=b$+"P" Then y=y+1 + If a$=b$+"K" Then x=x-1 + If a$=b$+"M" Then x=x+1 + IF a$=chr$(13) Then Y=Y+1:X=1 + + If X=>33 then X=1 + If X<=0 then X=32 + If Y=>5 then Y=1 + If Y<=0 then Y=4 + POKE M,7:POKE (x+DX)*2+(y+DY)*160+1,112 :m=(x+DX)*2+(y+DY)*160+1 + + A = INSTR(M$,A$):IF a=0 Then beep:goto PrendSaTouche + + MID$(CH$(Y),X,1)=A$ + POKE (x+DX)*2+(y+DY)*160,asc(A$) + POKE M,7:X=X+1:IF X=>33 THEN X=1:Y=Y+1:IF Y>=5 THEN Y=1 + POKE (x+DX)*2+(y+DY)*160+1,112:m=(x+DX)*2+(y+DY)*160+1 + GOTO PrendsaTouche + +ENSUITE : +LSET L1$=CH$(1) +LSET L2$=CH$(2) +LSET L3$=CH$(3) +LSET L4$=CH$(4) +PUT #1,na +NT=NT+1 +Goto menuPrincipal + +'*************************************************************************** +LIT : +IF NT>40 then nt=40 +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Locate 10,20:PRINT "-1- En entrant le numro de la fiche " +Locate 12,20:Print "-2- Tous ( dfilement avec les flche ! ) " +Locate 14,20:PRINT "-Q- Pour se barrer et revenir au Menu" +Locate 20,20:PRINT " pour Fin " + +prendCaracte2 : +A$=input$(1):If a$=chr$(27) then Goto Fin + +If a$="1" or a$="&" THEN Goto LectPart +If a$="2" or a$="" Then Goto LITOUT +If a$="Q" or a$="q" Then Goto MenuPrincipal +Beep:goto prendCaracte2 + +LectPart : '++++++++++++++++++ +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Gosub FaitPage +Numero : +Locate 5,20:INPUT " Numero : ",NP +If Np>NT or Np<0 Then Beep :goto numero +If Np=0 then goto Lit + +Get #1,np +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +A$=input$(1):goto numero + +LITOUT : +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Gosub FaitPage +Locate 6,10:PRINT " Flche haut et bas pour changer ! " +Locate 20,20:Print " Fin " +CN=1 + +LitAff : +GET #1,CN +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +Color 0,7 +Locate 10,31:PRINt "Numro du message =";CN:COLOR 7,0 +pt : +A$=inkey$:if a$="" then goto pt +if a$=chr$(0)+"H" and cn>1 then cn=cn-1:goto LITAFF +if a$=chr$(0)+"P" and cn pour fin " + +prendCaracter : +A$=input$(1):If a$=chr$(27) or a$="q" or a$="Q" then Goto Fin + +If a$="1" or a$="&" THEN Goto ENREGISTRE +If a$="2" or a$="" Then Goto LIT +'If a$="3" or a=chr$(34) ' Then Goto Speciale +Beep:goto prendCaracter + +'************************************************************************** +ENREGISTRE : +CLS +IF NT>=40 THEN NA=1 else na=nt+1 +GET #1,na +menu$=" Enregistrement n"+str$(na):Gosub Faitcadre +Gosub FaitPage +POKE (x+DX)*2+(y+DY)*160+1,112 +m=(x+DX)*2+(y+DY)*160+1 +Locate 5,10:Print "Enter pour changer de ligne les flches pour dplacer le " +Locate 6,10:Print "Curseur , et pour Valider , pour abandonner " +Locate 18,10:Print "Vous devriez retenir votre pour voir si il y a une reponse !" +Locate 20,25:Print " pour se casser ! " + +prendsatouche : +B$=chr$(0) +M$="ABCDEFGHIJKLMNOPQR -+=STUVWXYZabcdefghijklmnopqrstuvwxyz1234567890)(&'!?/:.;,$*%<>#@\" +A$=inkey$:if a$="" then goto prendsatouche + + If a$=chr$(27) then goto EnSuite + If a$=b$+"" Then Goto MenuPrincipal + If a$=b$+"H" Then y=y-1 + If a$=b$+"P" Then y=y+1 + If a$=b$+"K" Then x=x-1 + If a$=b$+"M" Then x=x+1 + IF a$=chr$(13) Then Y=Y+1:X=1 + + If X=>33 then X=1 + If X<=0 then X=32 + If Y=>5 then Y=1 + If Y<=0 then Y=4 + POKE M,7:POKE (x+DX)*2+(y+DY)*160+1,112 :m=(x+DX)*2+(y+DY)*160+1 + + A = INSTR(M$,A$):IF a=0 Then beep:goto PrendSaTouche + + MID$(CH$(Y),X,1)=A$ + POKE (x+DX)*2+(y+DY)*160,asc(A$) + POKE M,7:X=X+1:IF X=>33 THEN X=1:Y=Y+1:IF Y>=5 THEN Y=1 + POKE (x+DX)*2+(y+DY)*160+1,112:m=(x+DX)*2+(y+DY)*160+1 + GOTO PrendsaTouche + +ENSUITE : +LSET L1$=CH$(1) +LSET L2$=CH$(2) +LSET L3$=CH$(3) +LSET L4$=CH$(4) +PUT #1,na +NT=NT+1 +Goto menuPrincipal + +'*************************************************************************** +LIT : +IF NT>40 then nt=40 +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Locate 10,20:PRINT "-1- En entrant le numro de la fiche " +Locate 12,20:Print "-2- Tous ( dfilement avec les flche ! ) " +Locate 14,20:PRINT "-Q- Pour se barrer et revenir au Menu" +Locate 20,20:PRINT " pour Fin " + +prendCaracte2 : +A$=input$(1):If a$=chr$(27) then Goto Fin + +If a$="1" or a$="&" THEN Goto LectPart +If a$="2" or a$="" Then Goto LITOUT +If a$="Q" or a$="q" Then Goto MenuPrincipal +Beep:goto prendCaracte2 + +LectPart : '++++++++++++++++++ +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Gosub FaitPage +Numero : +Locate 5,20:INPUT " Numero : ",NP +If Np>NT or Np<0 Then Beep :goto numero +If Np=0 then goto Lit + +Get #1,np +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +A$=input$(1):goto numero + +LITOUT : +Cls:Menu$="Lecture des messages :":Gosub faitCadre +Gosub FaitPage +Locate 6,10:PRINT " Flche haut et bas pour changer ! " +Locate 20,20:Print " Fin " +CN=1 + +LitAff : +GET #1,CN +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +Color 0,7 +Locate 10,31:PRINt "Numro du message =";CN:COLOR 7,0 +pt : +A$=inkey$:if a$="" then goto pt +if a$=chr$(0)+"H" and cn>1 then cn=cn-1:goto LITAFF +if a$=chr$(0)+"P" and cn LE SEGMENT sera mit dans ADR% ** +'**************************************************************************** +Sub ChercheSegment(SegEcr%) Static + + DEF SEG = &h40 + TE%=(PEEK(&h10) AND &h30):DEF SEG + IF TE%=0 THEN PRINT " Programme non utilisable sur cette appareille ! [ECRAN] ":END + IF TE%=&h30 Then SegEcr%=&hB000 Else SegEcr%=&hB800 + +End Sub + +'---------------------------------------------------------------------------- +' Affiche un memu + un curseur et retourne le choix +' Syntaxe CALL MENU(MENU$,LM%,X1%,Y1%,CN%,FN%,CI%,FI%,Chx%,MH%) +' +' Menu$ = l'expression du menu ex: "--FIN--**FIN**//FIN//" +' LM% = longueur d'un choix menu ici: LM%=7 +' X1%,Y1% position du menu en caractre Attention au erreur ( Hors cran ) +' CN%,FN% dffinisse la couleur normal +' CI%,FI% "" "" "" "" "" inverse +' Chx% est le retour du choix -1 quand c'est +' MH%=0 quand <- et -> non autoriss =-1 quand elles sont OK +' dans ce cas Chx% retourne -> ===> -3 +' <- ===> -2 +' ===> -1 +'Cette Sub-routine Utilise SUb FAITUNCADRE() et conseill CherSegment +'---------------------------------------------------------------------------- +Sub MENU(MENU$,L%,X1%,Y1%,CN%,FN%,CI%,FI%,Chx%,MH%,XT%,MXT%) Static + +STATIC NT%,YT%,YTM% + +NT%=INT(LEN(MENU$)/L%) +X2%=X1%+L%:Y2%=Y1%+NT% +If chx%<=0 then chx%=1 + +Call FaitUnCadre(X1%,Y1%,X2%,Y2%,CN%,FN%):COLOR CN%,FN% + + FOR I=1 TO NT + Locate Y1%+I,X1%:PRINT MID$(MENU$,(I-1)*L%+1,L%) + NEXT I + +YT%=Chx%:YTM%=YT%:B$=chr$(0):T=0:A$="d" + + While T=0 + While A$="":A$=INKEY$:Wend + +IF (A$="4" or A$=B$+"K") And XT% > 1 And MH% Then Chx%=-2:T=1 +IF (A$="6" or A$=B$+"M") And XT% < MXT% And MH% Then Chx%=-3:T=1 +IF (A$="2" or A$=B$+"P") Then YT%=YT%+1 +IF (A$="8" or A$=B$+"H") Then YT%=YT%-1 +IF A$=CHR$(27) Then CHX%=-1 :T=1 +IF A$=CHR$(13) or a$=" " Then CHX%=YT%:T=1 +IF YT%>NT% THEN YT%=1 +IF YT%<1 THEN YT%=NT% + + Color CN%,FN% + Locate Y1%+YTM%,X1%:PRINT MID$(MENU$,(YTM%-1)*L%+1,L%) + Color CI%,FI% + Locate Y1%+YT% ,X1%:PRINT MID$(MENU$,(YT%-1)*L%+1,L%) + YTM%=YT%:Color CN%,FN% + A$="" + Wend:End Sub + +SUB FaitUnCadre(X1%,Y1%,X2%,Y2%,CN%,FN%) Static +Color CN%,FN% +SHARED SEGEC% +def seg = SegEC% +STATIC P1,P2,P3,P4,PX,PY,K%,CO%,I + X1%=X1%-3:Y1%=Y1%-1 + P1=X1%*2+Y1%*160 : P2 =X2%*2+160*Y1% : P3 =X1%*2+160*Y2% : P4=X2%*2+160*Y2% + PY = P3-P1 :PX= P2-P1:K%=-1:CO%=CN%+16*FN% + + FOR I=P1 TO P3 STEP 160 + POKE I+1,CO:POKE I+1+PX,CO:POKE I,186:POKE I+PX,186 + K%=K%+1:LOCATE Y1%+1+K%,X1%+2:PRINT STRING$(X2%-X1%-1,32); + NEXT I + + FOR I=P1 TO P2 STEP 2:POKE I+1,CO:POKE I,205:POKE I+1+PY,CO:POKE I+PY,205 + NEXT I + + POKE P1,201:POKE P2,187:POKE P3,200:POKE P4,188:X1%=X1%+3:Y1%=Y1%+1 + + FOR I=P2+160 TO P4+160 STEP 160:POKE I+3,7:NEXT I + FOR I=P3+162 TO P4+160 STEP 2 :POKE I+1,7:NEXT I + +End Sub + + +REM *********************** CONSTANTES et TABleau *************************** + +DIM CH$(4) + +'************************** OVERTURE DU FICHIER ***************************** + +OPEN "MEG." as #1 len = 128 +FIELD #1,32 as L1$,32 as L2$,32 as L3$,32 as L4$ +GET #1,1 +NT = val(L1$) + +'---------------------- Dbut du programme +'---------------------- Cherche le segment ---------------------------------- +CALL ChercheSegment(SegEc) +IF SEGEC=&hB800 THEN CN=11:FN=1:CI=14:FI=4 else CN=15:FN=0:CI=0:FI=7 +COUN=CN+16*FN:COUI=CI+16*FI + +'----------------------- MENU PRINCIPAL ------------------------------------- +MenuPrincipal : + +DEF seg = SEGEC +FOR Y=0 TO 24:FOR X=0 TO 79:K=Y*160+X*2:POKE K,176:POKE K+1,X+24:NEXT X:NEXT Y +MENU$="ENREGISTRER UN MESSAGELIRE UN OU DES MESSAGES -- EFFACER -- **** FIN **** " +Chx=4 +CALL MENU(MENU$,23,23,10,CN,FN,CI,FI,Chx,0,0,0) +IF CHX=-1 or chx=4 then goto FIN + +ON CHX GOTO ENREGISTRE,LIT,EFFACER + +'------------------------- ENREGISTREMENT ----------------------------------- +ENREGISTRE : +COLOR CN,FN:CLS +IF NT>=40 THEN NA=1 else na=nt+1 +GET #1,na+1 +kk=-1 +menu$=" Enregistrement n"+str$(na):Gosub Faitcadre +Gosub FaitPage +POKE (x+DX)*2+(y+DY)*160+1,COUI +m=(x+DX)*2+(y+DY)*160+1 +Locate 5,10:Print "Enter pour changer de ligne les flches pour dplacer le " +Locate 6,10:Print "Curseur , et pour Valider , pour abandonner " +Locate 18,10:Print "Vous devriez retenir votre pour voir si il y a une reponse !" +Locate 20,25:Print " pour se casser ! " + +prendsatouche : +B$=chr$(0) +M$="ABCDEFGHIJKLMNOPQR -+=STUVWXYZabcdefghijklmnopqrstuvwxyz1234567890)(&'!?/:.;,$*%<>#@\" +A$=inkey$:if a$="" then goto prendsatouche + + If a$=chr$(27) then goto EnSuite + If a$=b$+"" Then Goto MenuPrincipal + If a$=b$+"H" Then y=y-1 + If a$=b$+"P" Then y=y+1 + If a$=b$+"K" Then x=x-1 + If a$=b$+"M" Then x=x+1 + IF a$=chr$(13) Then Y=Y+1:X=1 + + If X=>33 then X=1 + If X<=0 then X=32 + If Y=>5 then Y=1 + If Y<=0 then Y=4 + POKE M,COUN:POKE (x+DX)*2+(y+DY)*160+1,COUI :m=(x+DX)*2+(y+DY)*160+1 + + A = INSTR(M$,A$):IF a=0 Then goto PrendSaTouche + + MID$(CH$(Y),X,1)=A$:KK=0 + POKE (x+DX)*2+(y+DY)*160,asc(A$) + POKE M,COUN:X=X+1:IF X=>33 THEN X=1:Y=Y+1:IF Y>=5 THEN Y=1 + POKE (x+DX)*2+(y+DY)*160+1,COUI:m=(x+DX)*2+(y+DY)*160+1 + GOTO PrendsaTouche + +ENSUITE : + +IF kk then Goto menuPrincipal +LSET L1$=CH$(1) +LSET L2$=CH$(2) +LSET L3$=CH$(3) +LSET L4$=CH$(4) +PUT #1,na+1 +NT=NT+1 +GET #1,1 +LSET L1$=STR$(NT) +PUT #1,1 + +Goto menuPrincipal + +'*************************************************************************** +LIT : +COLOR CN,FN:CLS +LITT : +IF NT>40 then nt=40 +Menu$="Lecture des messages :":Gosub faitCadre:chx=3 +MENU$="Un numro prcis TOUS revenir au menu " +Locate 20,30:PRINT " pour Fin " +CALL MENU(MENU$,16,30,10,CN,FN,CI,FI,Chx,0,0,0) + +IF CHX=-1 then Goto FIN +ON CHX GOTO LectPart,Litout,MenuPrincipal + +LectPart : '++++++++++++++++++ +COLOR CN,FN:Cls:Menu$="Lecture des messages :":Gosub faitCadre:Gosub FaitPage +Numero : +locate 5,20:print space$(60);"" +Locate 5,20:INPUT " Numero : ",NP +If Np>NT or Np<0 Then goto numero +If Np=0 then goto Litt + +Get #1,np+1 +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +A$=input$(1):goto numero + +LITOUT : +COLOR CN,FN:Cls:Menu$="Lecture des messages :":Gosub faitCadre +Gosub FaitPage +Locate 6,10:PRINT " Flche haut et bas pour changer ! " +Locate 20,20:Print " Fin " +CNn=1:gosub LitAFF:goto pt + +LitAff : +GET #1,CNn+1 +Locate 12,26:Print L1$ +Locate 13,26:Print L2$ +Locate 14,26:Print L3$ +Locate 15,26:Print L4$ +Color CI,FI +Locate 10,31:PRINt "Numro du message =";CNn:COLOR CN,FN +Return + +pt : +A$=inkey$:if a$="" then goto pt +if a$=chr$(0)+"H" and cnn>1 then cnn=cnn-1:gosub LITAFF +if a$=chr$(0)+"P" and cnnCODE$ THEN SOUND 100,1:SOUND 2000,1:SOUND 100,1:GOTO MENUPRINCIPAL + +COLOR CN,FN:CLS +MENU$="EFFACEMENT d'UNE ANNONCE":gosub FAITcadre:gosub FaitPAge:CNN=1 +locate 18,32:Print " pour Sortir" + +locate 5,10:print " Utilisez les flches pour choisir le message " +locate 6,10:print " effacer et pressez pour valider et confirmez " +locate 7,10:print " en rpondant par (O)ui (N)on " + +ok : +CNN=1:GOSUB LITAFF + +ptO : +A$=inkey$:if a$="" then goto pto +if a$=chr$(0)+"H" and cnn>1 then cnn=cnn-1:gosub LITAFF +if a$=chr$(0)+"P" and cnn3 THEN BEEP:GOTO 16 +18 ON A GOTO 19,20,21 +19 R$="":GOTO 30 +20 R$="":GOTO 30 +21 R$="" +30 R=LEN(R$) +31 CLS:X=11 +100 COLOR 14:PRINT +110 PRINT " " +120 FOR I=1 TO 20 +130 PRINT " " +140 NEXT +150 LOCATE 22,1:PRINT " " ; +160 LOCATE 5,6 +161 COLOR 13:LOCATE 5,6:PRINT "" +162 COLOR 1:LOCATE 6,6:PRINT "" +163 COLOR 12:LOCATE 7,6:PRINT "" +164 COLOR 3:LOCATE 8,6:PRINT "" +165 COLOR 8:LOCATE 9,6:PRINT "" +166 COLOR 2 +167 VX=1:VY=1:ABX=17:ABY=12 +170 IF AX<>X THEN LOCATE 22,9:PRINT SPACE$(21) +171 P=X-(R-1)/2+6:LOCATE 22,P:PRINT R$ +172 AX=X +175 IF BY=23 THEN LOCATE 12,20:PRINT "perdu uuuuuu":][ 5,15,15:A$=INPUT$(3):RUN +180 A$=INKEY$ +190 IF A$=CHR$(0)+"M" THEN X=X+1 +200 IF A$=CHR$(0)+"K" THEN X=X-1 +210 IF X=(R-1)/2+2 THEN X=X+1 +215 IF X+(R-1)/2=24 THEN X=X-1 +220 LOCATE BY,BX:PRINT "o" +221 LOCATE ABY,ABX:PRINT " " +222 ABY=BY:ABX=BX +230 IF VX=1 THEN BX=BX+1 +240 IF VX=0 THEN BX=BX-1 +250 IF VY=1 THEN BY=BY+1 +260 IF VY=0 THEN BY=BY-1 +270 IF SCREEN(BY,BX)=219 AND (SCREEN (BY,BX,1)=14 OR SCREEN (BY,BX,1)=2) THEN GOSUB 1000:GOTO 230 +280 IF SCREEN(BY,BX)=219 AND SCREEN (BY,BX,1)<>14 THEN GOSUB 1200:GOTO 230 +290 GOTO 170 +999 REM ||||||||||||||||||| 1re +1000 IF BY<>22 THEN 1040 +1010 IF VX=1 AND X<27 THEN VX=1:VY=0 +1011 IF VX=1 AND X=27 THEN VX=0:VY=0 +1020 IF VX=0 AND X>6 THEN VX=0:VY=0 +1021 IF VX=0 AND X=6 THEN VX=1:VY=0 +1025 RETURN +1039 REM ||||||||||||||||||| 2me +1040 IF BY<>2 THEN 1080 +1045 IF VX=1 AND X<27 THEN VX=1:VY=1 +1047 IF VX=1 AND X=27 THEN VX=0:VY=1 +1050 IF VX=0 AND X>6 THEN VX=0:VY=1 +1052 IF VX=0 AND X=6 THEN VX=1:VY=1 +1053 RETURN +1079 REM ||||||||||||||||| 3 & 4 me +1080 IF BX<=6 THEN VX=1 ELSE VX=0 +1085 RETURN +1200 PTS=PTS+SCREEN (BY,BX,1):LOCATE 25,1:COLOR 12:PRINT " SCORE :";PTS:COLOR 2 +1205 LOCATE BY,BX:PRINT " " +1210 IF VY=1 THEN VY=0:RETURN +1220 IF VY=0 THEN VY=1:RETURN +1221 RETURN + \ No newline at end of file diff --git a/N-PREMIE b/N-PREMIE new file mode 100644 index 0000000..c8da39d --- /dev/null +++ b/N-PREMIE @@ -0,0 +1,122 @@ + 2 , 3 , 5 , 7 , 11 , 13 , 17 + 19 , 23 , 29 , 31 , 37 , 41 , 43 + 47 , 53 , 59 , 61 , 67 , 71 , 73 + 79 , 83 , 89 , 97 , 101 , 103 , 107 + 109 , 113 , 127 , 131 , 137 , 139 , 149 + 151 , 157 , 163 , 167 , 173 , 179 , 181 + 191 , 193 , 197 , 199 , 211 , 223 , 227 + 229 , 233 , 239 , 241 , 251 , 257 , 263 + 269 , 271 , 277 , 281 , 283 , 293 , 307 + 311 , 313 , 317 , 331 , 337 , 347 , 349 + 353 , 359 , 367 , 373 , 379 , 383 , 389 + 397 , 401 , 409 , 419 , 421 , 431 , 433 + 439 , 443 , 449 , 457 , 461 , 463 , 467 + 479 , 487 , 491 , 499 , 503 , 509 , 521 + 523 , 541 , 547 , 557 , 563 , 569 , 571 + 577 , 587 , 593 , 599 , 601 , 607 , 613 + 617 , 619 , 631 , 641 , 643 , 647 , 653 + 659 , 661 , 673 , 677 , 683 , 691 , 701 + 709 , 719 , 727 , 733 , 739 , 743 , 751 + 757 , 761 , 769 , 773 , 787 , 797 , 809 + 811 , 821 , 823 , 827 , 829 , 839 , 853 + 857 , 859 , 863 , 877 , 881 , 883 , 887 + 907 , 911 , 919 , 929 , 937 , 941 , 947 + 953 , 967 , 971 , 977 , 983 , 991 , 997 + 1009 , 1013 , 1019 , 1021 , 1031 , 1033 , 1039 + 1049 , 1051 , 1061 , 1063 , 1069 , 1087 , 1091 + 1093 , 1097 , 1103 , 1109 , 1117 , 1123 , 1129 + 1151 , 1153 , 1163 , 1171 , 1181 , 1187 , 1193 + 1201 , 1213 , 1217 , 1223 , 1229 , 1231 , 1237 + 1249 , 1259 , 1277 , 1279 , 1283 , 1289 , 1291 + 1297 , 1301 , 1303 , 1307 , 1319 , 1321 , 1327 + 1361 , 1367 , 1373 , 1381 , 1399 , 1409 , 1423 + 1427 , 1429 , 1433 , 1439 , 1447 , 1451 , 1453 + 1459 , 1471 , 1481 , 1483 , 1487 , 1489 , 1493 + 1499 , 1511 , 1523 , 1531 , 1543 , 1549 , 1553 + 1559 , 1567 , 1571 , 1579 , 1583 , 1597 , 1601 + 1607 , 1609 , 1613 , 1619 , 1621 , 1627 , 1637 + 1657 , 1663 , 1667 , 1669 , 1693 , 1697 , 1699 + 1709 , 1721 , 1723 , 1733 , 1741 , 1747 , 1753 + 1759 , 1777 , 1783 , 1787 , 1789 , 1801 , 1811 + 1823 , 1831 , 1847 , 1861 , 1867 , 1871 , 1873 + 1877 , 1879 , 1889 , 1901 , 1907 , 1913 , 1931 + 1933 , 1949 , 1951 , 1973 , 1979 , 1987 , 1993 + 1997 , 1999 , 2003 , 2011 , 2017 , 2027 , 2029 + 2039 , 2053 , 2063 , 2069 , 2081 , 2083 , 2087 + 2089 , 2099 , 2111 , 2113 , 2129 , 2131 , 2137 + 2141 , 2143 , 2153 , 2161 , 2179 , 2203 , 2207 + 2213 , 2221 , 2237 , 2239 , 2243 , 2251 , 2267 + 2269 , 2273 , 2281 , 2287 , 2293 , 2297 , 2309 + 2311 , 2333 , 2339 , 2341 , 2347 , 2351 , 2357 + 2371 , 2377 , 2381 , 2383 , 2389 , 2393 , 2399 + 2411 , 2417 , 2423 , 2437 , 2441 , 2447 , 2459 + 2467 , 2473 , 2477 , 2503 , 2521 , 2531 , 2539 + 2543 , 2549 , 2551 , 2557 , 2579 , 2591 , 2593 + 2609 , 2617 , 2621 , 2633 , 2647 , 2657 , 2659 + 2663 , 2671 , 2677 , 2683 , 2687 , 2689 , 2693 + 2699 , 2707 , 2711 , 2713 , 2719 , 2729 , 2731 + 2741 , 2749 , 2753 , 2767 , 2777 , 2789 , 2791 + 2797 , 2801 , 2803 , 2819 , 2833 , 2837 , 2843 + 2851 , 2857 , 2861 , 2879 , 2887 , 2897 , 2903 + 2909 , 2917 , 2927 , 2939 , 2953 , 2957 , 2963 + 2969 , 2971 , 2999 , 3001 , 3011 , 3019 , 3023 + 3037 , 3041 , 3049 , 3061 , 3067 , 3079 , 3083 + 3089 , 3109 , 3119 , 3121 , 3137 , 3163 , 3167 + 3169 , 3181 , 3187 , 3191 , 3203 , 3209 , 3217 + 3221 , 3229 , 3251 , 3253 , 3257 , 3259 , 3271 + 3299 , 3301 , 3307 , 3313 , 3319 , 3323 , 3329 + 3331 , 3343 , 3347 , 3359 , 3361 , 3371 , 3373 + 3389 , 3391 , 3407 , 3413 , 3433 , 3449 , 3457 + 3461 , 3463 , 3467 , 3469 , 3491 , 3499 , 3511 + 3517 , 3527 , 3529 , 3533 , 3539 , 3541 , 3547 + 3557 , 3559 , 3571 , 3581 , 3583 , 3593 , 3607 + 3613 , 3617 , 3623 , 3631 , 3637 , 3643 , 3659 + 3671 , 3673 , 3677 , 3691 , 3697 , 3701 , 3709 + 3719 , 3727 , 3733 , 3739 , 3761 , 3767 , 3769 + 3779 , 3793 , 3797 , 3803 , 3821 , 3823 , 3833 + 3847 , 3851 , 3853 , 3863 , 3877 , 3881 , 3889 + 3907 , 3911 , 3917 , 3919 , 3923 , 3929 , 3931 + 3943 , 3947 , 3967 , 3989 , 4001 , 4003 , 4007 + 4013 , 4019 , 4021 , 4027 , 4049 , 4051 , 4057 + 4073 , 4079 , 4091 , 4093 , 4099 , 4111 , 4127 + 4129 , 4133 , 4139 , 4153 , 4157 , 4159 , 4177 + 4201 , 4211 , 4217 , 4219 , 4229 , 4231 , 4241 + 4243 , 4253 , 4259 , 4261 , 4271 , 4273 , 4283 + 4289 , 4297 , 4327 , 4337 , 4339 , 4349 , 4357 + 4363 , 4373 , 4391 , 4397 , 4409 , 4421 , 4423 + 4441 , 4447 , 4451 , 4457 , 4463 , 4481 , 4483 + 4493 , 4507 , 4513 , 4517 , 4519 , 4523 , 4547 + 4549 , 4561 , 4567 , 4583 , 4591 , 4597 , 4603 + 4621 , 4637 , 4639 , 4643 , 4649 , 4651 , 4657 + 4663 , 4673 , 4679 , 4691 , 4703 , 4721 , 4723 + 4729 , 4733 , 4751 , 4759 , 4783 , 4787 , 4789 + 4793 , 4799 , 4801 , 4813 , 4817 , 4831 , 4861 + 4871 , 4877 , 4889 , 4903 , 4909 , 4919 , 4931 + 4933 , 4937 , 4943 , 4951 , 4957 , 4967 , 4969 + 4973 , 4987 , 4993 , 4999 , 5003 , 5009 , 5011 + 5021 , 5023 , 5039 , 5051 , 5059 , 5077 , 5081 + 5087 , 5099 , 5101 , 5107 , 5113 , 5119 , 5147 + 5153 , 5167 , 5171 , 5179 , 5189 , 5197 , 5209 + 5227 , 5231 , 5233 , 5237 , 5261 , 5273 , 5279 + 5281 , 5297 , 5303 , 5309 , 5323 , 5333 , 5347 + 5351 , 5381 , 5387 , 5393 , 5399 , 5407 , 5413 + 5417 , 5419 , 5431 , 5437 , 5441 , 5443 , 5449 + 5471 , 5477 , 5479 , 5483 , 5501 , 5503 , 5507 + 5519 , 5521 , 5527 , 5531 , 5557 , 5563 , 5569 + 5573 , 5581 , 5591 , 5623 , 5639 , 5641 , 5647 + 5651 , 5653 , 5657 , 5659 , 5669 , 5683 , 5689 + 5693 , 5701 , 5711 , 5717 , 5737 , 5741 , 5743 + 5749 , 5779 , 5783 , 5791 , 5801 , 5807 , 5813 + 5821 , 5827 , 5839 , 5843 , 5849 , 5851 , 5857 + 5861 , 5867 , 5869 , 5879 , 5881 , 5897 , 5903 + 5923 , 5927 , 5939 , 5953 , 5981 , 5987 , 6007 + 6011 , 6029 , 6037 , 6043 , 6047 , 6053 , 6067 + 6073 , 6079 , 6089 , 6091 , 6101 , 6113 , 6121 + 6131 , 6133 , 6143 , 6151 , 6163 , 6173 , 6197 + 6199 , 6203 , 6211 , 6217 , 6221 , 6229 , 6247 + 6257 , 6263 , 6269 , 6271 , 6277 , 6287 , 6299 + 6301 , 6311 , 6317 , 6323 , 6329 , 6337 , 6343 + 6353 , 6359 , 6361 , 6367 , 6373 , 6379 , 6389 + 6397 , 6421 , 6427 , 6449 , 6451 , 6469 , 6473 + 6481 , 6491 , 6521 , 6529 , 6547 , 0 , 0 + \ No newline at end of file diff --git a/OP.BAS b/OP.BAS new file mode 100644 index 0000000..9b0ff87 Binary files /dev/null and b/OP.BAS differ diff --git a/PARSON.BAS b/PARSON.BAS new file mode 100644 index 0000000..f652bee Binary files /dev/null and b/PARSON.BAS differ diff --git a/PROALAIN.BAS b/PROALAIN.BAS new file mode 100644 index 0000000..585a22e --- /dev/null +++ b/PROALAIN.BAS @@ -0,0 +1,379 @@ +'*************************************************************************** +'**** PROGRAMME A MANGER ( Classification de recettes et gestion ) **** +'**** **** +'**** UNIQUEMENT UTILISABLE AVEC QUICK-BASIC **** +'**** **** +'**** CGA Couleur Version 1.1 DE DARCHE Yoann 09/90 **** +'**** **** +'*************************************************************************** + +DEF SEG = &HB800:OPTION BASE 1:CLS +DEFINT X,Y,I,J,K,D,C,F +DE=4096 + +DIM D(20,4) '*** Coordonnes des tableaux ( voir les datas ) *** +GOSUB LECTURETAB + +c=15:f=04: XTAB = 1 : XTABM = 1 +CI=11:FI=1 +Chemin$="B:\" +TG$=" SYSTEME CREATIONS MODIFICATIONS RECHERCHE " + +for x=0 to 79:for y=0 to 24:poke x*2+y*160+1,Y+1+60:poke x*2+y*160,177:next y:next x + +'**********************$ OUVERTURE DES FICHIERS A ACCES SEQUENTIEL ********** +'KIll Chemin$+"TypeAlim.DAT" + +OPEN Chemin$+"TypeAlim.DAT" AS #1 len = 20 +OPEN Chemin$+"SortAlim.DAT" AS #2 len = 19 +OPEN CHEMIN$+"Config .FIC" AS #3 len = 4 + +FIELD #1,19 AS TYPE$,1 AS NC$ +FIELD #2,19 AS SORT$ +FIELD #3,4 AS HE$ + +LT=LOF(1)/20 +LS=LOF(2)/19 + +GET #3,1: H$=HE$ + +'*********************** Affichage de l'tat actuelle des fichiers ********** + +X1=19:X2=60:Y1=9:Y2=17:GOSUB OuvreFenetre + + Locate 12,24:PRINT USING "#####";lt + Locate 12,30:PRINT "TYPES D'ALIMENTS DEFINIES" + Locate 14,24:PRINT USING "#####";LS + Locate 14,30:PRINT "SORTES D'ALIMENTS DEFINIES" + Locate 16,22:PRINT "Appuyer sur une touche pour Continuer" + +Gosub HexaCode + +A$=input$(1):Gosub Fermefenetre + +'************************ Affichage du menu pricipal ************************ + +LOCATE 1,6:color c,f:print " "+tg$+" " + +Deb1 : +gosub affichetab + + color c,f :locate 1,7+15*(xtabm-1):print mid$(tg$,15*(xtabm-1)+1,13) + color ci,fi:locate 1,7+15*(xtab-1):print mid$(tg$,15*(xtab-1)+1,13) + xtabm=xtab + +Prendcar : +A$=INkey$ + + If A$="" then Color c,f:LOCATE 1,70:PRINT TIME$: Goto Prendcar + + if A$="4" and XTAB > 1 THEN gosub fermefenetre:XTAB=XTAB-1:goto Deb1 + if A$="6" and XTAB < 4 THEN gosub fermefenetre:XTAB=XTAB+1:goto deb1 + if A$="2" and YTAB < NT THEN YTAB=YTAB+1: gosub afficheCUR + if A$="8" and YTAB > 1 THEN YTAB=YTAB-1: gosub afficheCUR + IF a$=chr$(27) then Goto FinProg + If A$=" " or A$=CHR$(13) THEN GOSUB AIGUILLAGE + + +Goto prendcar + + +'============================================================================ +ouvrefenetre : ' *********** Cration du cadre et sauvegarde cran ******** + +PCOPY 0,1:COLOR C,F + +ouvrefenetre2 : + + P1 = X1*2+Y1*160 : P2 = X2*2+160*Y1 : P3 =X1*2+160*Y2 : P4=X2*2+160*Y2 + PY = P3-P1 :PX= P2-P1:K=-1 + + FOR I=P1 TO P3 STEP 160 + POKE I+1,C:POKE I+1+PX,C:POKE I,186:POKE I+PX,186 + K=K+1:LOCATE Y1+1+K,X1+2:PRINT STRING$(X2-X1-1,32); + NEXT I + + FOR I=P1 TO P2 STEP 2:POKE I+1,C:POKE I,205:POKE I+1+PY,C:POKE I+PY,205 + NEXT I + + POKE P1,201:POKE P2,187:POKE P3,200:POKE P4,188 + +RETURN + +'============================================================================ +fermefenetre : ' ***** Restution de l'cran 0 partir de l'cran 1 ***** + + PX=X1:MY=Y2:PY=Y1:MX=X2:IF X2-X1 > Y2-Y1 THEN K=Y2-Y1 ELSE K=X2-X1 + + FOR J=MY TO PY STEP -1 + D= J*160+PX*2:POKE D,PEEK(D+DE):POKE D+1,PEEK(D+DE+1):NEXT J + + FOR I=1 TO INT(K/2+1) + FOR J=PX TO MX + D=PY*160+ J*2:POKE D,PEEK(D+DE):POKE D+1,PEEK(D+DE+1):NEXT J:PX=PX+1 + FOR J=PY TO MY + D= J*160+MX*2:POKE D,PEEK(D+DE):POKE D+1,PEEK(D+DE+1):NEXT J:PY=PY+1 + FOR J=MX TO PX STEP -1 + D=MY*160+ J*2:POKE D,PEEK(D+DE):POKE D+1,PEEK(D+DE+1):NEXT J:MX=MX-1 + FOR J=MY TO PY STEP -1 + D= J*160+PX*2:POKE D,PEEK(D+DE):POKE D+1,PEEK(D+DE+1):NEXT J:MY=MY-1 + NEXT I + RETURN + +'============================================================================ +AfficheTAB : '************ Choix de la fentre *************************** + + YTAB=1:YTABM=1 + On XTAB GOSUB TAB1,TAB2,TAB3,TAB4 + + x1=d(xtab,1):y1=d(xtab,2):x2=d(XTAB,3):y2=d(XTAB,4) + gosub ouvrefenetre + DLX = x1+2 : DLY = y1+2 + FOR I=1 TO NT + LOCATE DLY+I,DLX+1:PRINT MID$(t$,(I-1)*(LX+1)+1,LX) + NEXT I + GOSUB afficheCUR + return + +TAB1 : '*** SYSTEME *** + T$="CONFIG .SAV-CONF.RAP-CONF.QUITTER " + LX=8:NT=4 + RETURN + +TAB2 : '*** CREATION *** + T$="ALIMENT .SORTE ALIM..RECETTE " + LX=11:NT=3 + RETURN + +TAB3 : '*** MODIFICATION *** + T$="ALIMENT .SORTE ALIM..RECETTE " + LX=11:NT=3 + RETURN + +TAB4 : ' ****** RECHERCHE ***** + T$="RECETTE ==> ALIMENTS.ALIMENTS ==> RECETTES" + LX=21:NT=2 + RETURN + +AfficheCUR : '************ Affiche le Curseur dans la fentre ************** + + Color C,F + LOCATE DLY+YTABM,DLX+1:PRINT MID$(t$,(YTABM-1)*(LX+1)+1,LX) + Color CI,FI + LOCATE DLY+YTAB ,DLX+1:PRINT MID$(t$,(YTAB -1)*(LX+1)+1,LX) + YTABM=YTAB +Return + +Aiguillage : '************ COMMENCE LE DEBUT DU PROGRAMMME CHOISIE ********* + + ON XTAB Goto GTAB1,gTAB2,gTAB3 + + FinAi : + RETURN + + gTAB1 : + ON YTAB GOTO LePlusBeau,FinAi,FinAi,FinProg + + gTAB2 : + ON YTAB GOTO FinAi,FinAi,FinAi + + gTAB3 : + ON YTAB GOTO CreaType,FinAi,FinAi + + gTAB4 : + ON YTAB GOTO FinAi,FinAi + +LectureTAB : '************ Lit le tableau de coordonnes ******************* + + I=0 + DEBL : + I=I+1 + READ K + IF K>0 THEN Read D(I,2),D(I,3),D(I,4):d(I,1)=k else return + goto DEBL + + + +CooTableau : '***********$ DATA TABLEAUX X1,Y1,X2,Y2 *********************** + + DATA 1,3,12,10 + data 11,3,25,9 + DATA 23,13,37,19 + DATA 40,10,64,15 + DATA -1,-1 '****** FIN + +LectCara :'*********** Dans MAXC nombre max de caractres Retour dans p$ *** + ' DXLC,DYLC = dcalage d'impression + +If fx=0 and cx=0 then cx=c:fx=f +p$="" + +B$=chr$(0):LOCATE DYLC,DXLC:PRINT chr$(17) + Delc : + A$=INKEY$ + If A$="" then Color c,f:LOCATE 1,70:PRINT TIME$: Goto Delc + Color cx,fx + IF A$=CHR$(13) THEN cx=0:fx=0:RETURN + IF A$=B$+CHR$(75) OR A$=CHR$(8) OR A$=B$+Chr$(83) THEN goto EFFACE1 + IF LEN(P$)=MAXC THEN BEEP:GOTO Delc + + A=ASC(A$) + IF A=32 OR A=40 or a=41 or a=39 GOTO Suite + IF (A>=48 AND A<=57) or (A>=128 AND A=<154) then goto Suite + IF (A>=128 or a<=64) goto delc + A = A and 95 + IF not ( A>=65 and A<=90 ) then beep:goto Delc + a$=chr$(a) + + Suite : + LOCATE DYLC,DXLC+LEN(P$):PRINT A$+CHR$(17) + P$=P$+A$ + GOTO Delc + +EFFACE1 : + + + If len(p$)=0 then beep:goto delc + + LOCATE DYLC,DXLC+LEN(P$)-1:PRINT CHR$(17)+" " + p$=MID$(p$,1,LEN(p$)-1) + Goto Delc + + + +FinProg : '****************** FIN DU PROGRAMME ***************************** + + CLOSE + CLS + PRINT " SALUT il est ";TIME$ + END + + +CODEBIN : '****************** Traduit un code en Binaire ******************** + +bin$="" + While Casc! <> 0 + R! = (Casc! mod 2) : Casc! = fix( Casc!/2 ) + bin$=right$(str$(R!),1)+bin$ + Wend +Return + +BINCODE : '****************** Traduit un code Binaire en Decimal ************ + +Casc!=0:J=0 +For i=len(Bin$) TO 1 STEP -1 + If mid$(Bin$,i,1)="1" then Casc!=Casc!+2^(j) + j=j+1 +Next i +Return + +HEXACODE : '**************** Traduit un cod hexa en dcimal ***************** + +HD=0 + for I=1 TO LEN(H$) + + K$=MID$(h$,i,1) + K=val(K$) + if Val(k$)=0 and k$<>"0" then K=asc(K$)-55 + HD=HD+k*(16^(4-i)) + +Next I +RETURN + +AfficheList : '************* Affiche une liste de chaines de 19 car chacune ** + ' Maxlist = nombre de chaine a afficher + ' Canal = Canal de lecture disque + ' Retour le choix dans Chx ( Si Chx=-1 alors ) + +NP=int(MaxList/80)+sgn(maxlist mod 80) +PR=1:pcopy 0,3 + + COLOR C,F:cls + + FOR I=1 to 4 + FOR J=1 to 20 + get #1,(i-1)*20+j+(pr-1)*80 + LOCATE j+2,(I-1)*20+1 + PRINT TYPE$ + IF (I-1)*20+J+(PR-1)*80 > MAXLIST THEN GOTO FINIAFF + NEXT j + NEXT i + + FINIAFF: + +COLOR CI,FI:LOCATE 25,1 +print " PAGE ";:PRINT USING " ##";PR;:print " /";:print using " ##";NP; +PRINT " page avant (9), page aprs (3) et ESC pour fin "; +locate 1,1 + + A$=input$(1) + pcopy 3,0 + + +return + +'**************************************************************************** +'*** PROGRAMME PRINCIPAL *** +'**************************************************************************** + +LEPLUSBEAU: + +CreaType : + + Gosub FermeFenetre + +IF LT=0 THEN X1=28:X2=53:Y1=9:Y2=11:Gosub OuvreFenetre:LOCATE 11,32:PRINT " AUCUN TYPE DEFINI !":beep:a$=input$(1):gosub fermefenetre +IF LT>0 THEN maxlist = lt:canal=1:GOSUB AfficheList + +CREAT: + + X1=25:X2=51:y1=5:y2=17:gosub ouvrefenetre + Locate 8,30:print " Vous devez entrer" + Locate 10,35:print "le nouveau" + Locate 12,30:print " Type d'Aliment :" + X1=27:X2=49:y1=13:y2=15:color ci,fi:gosub ouvrefenetre2 + DYLC=15:DXLC=30:MAXC=19:cx=ci:fx=fi:Gosub LectCara + X1=25:X2=51:y1=5:y2=17:gosub fermefenetre + If p$="" Then Goto Deb1 + + Color c,f + X1=11:X2=66:Y1=10:y2=12:gosub ouvrefenetre + Locate 12,14:PRINT "PATIENTEZ, Je regarde s'il n'est pas dj enregistr" + Flag = 0 + + If len(p$) < 19 THEN p$=p$+space$(19-LEN(p$)) + + For I = 1 TO LT + GET #1,I + IF TYPE$=p$ Then FLAG=-1 + NEXT I + + Gosub FermeFenetre + +IF FLAG THEN + + X1=10:X2=68:Y1=6:Y2=16:Gosub ouvrefenetre:beep + COLOR 30,0 + LOCATE 9,14:PRINT " " + LOCATE 10,14:PRINT " Vous avez dj dfinie " + LOCATE 11,14:PRINT " " + LOCATE 12,14:PRINT " Ce type Aliment " + LOCATE 13,14:PRINT " " + LOCATE 14,14:PRINT " Je dois annuler cette enregistrement " + LOCATE 15,14:PRINT " " + Color c,f + a$=INPUT$(1):GOSUB Fermefenetre + + ELSE + LT=LT+1:GET #1,LT :LSET TYPE$=P$:lset NC$=chr$(0):PUT #1,LT + GET #3,LT+1:LSET HE$=HEX$(HD): PUT #3,LT+1 + +END IF + + X1=11:X2=66:Y1=10:y2=12:gosub ouvrefenetre + Locate 12,14:PRINT " Voulez - vous raliser un nouvelle enregistrement"; + a$=input$(1):a$=chr$(asc(a$) and 95) + If a$="O" then Gosub fermefenetre:goto creat + Gosub fermefenetre + Goto Deb1 + diff --git a/PROG1.BAS b/PROG1.BAS new file mode 100644 index 0000000..e814d1b Binary files /dev/null and b/PROG1.BAS differ diff --git a/PURSANG.BAS b/PURSANG.BAS new file mode 100644 index 0000000..18acc08 --- /dev/null +++ b/PURSANG.BAS @@ -0,0 +1,67 @@ +0 SCREEN 2:SCREEN 0,0,0 +1 KEY OFF:G$=" " +2 P$="XY1Z1Y2Z2Y3Z3Y4Z4Y5Z5Ŀ" +3 P1$="XY1Z1Y2Z2Y3Z3Y4Z4Y5Z5" +6 OPTION BASE 1:DIM V(11,12),V$(11,12):MY=1:MX=1:X=1:Y=1 +10 CLS:COLOR 0,7:LOCATE 1,32:PRINT "PURSANG" +11 COLOR 7,0:PRINT :PRINT +12 PRINT " Une CREATION de DARCHE YOANN" +13 LOCATE 23,1:PRINT " Utilisez le pav numrique pour se dplacer . +14 LOCATE 24,1:PRINT " Puis appuyer sur ou une fois la cellule choisie "; +15 LOCATE 6,33:PRINT "Edition " +16 PRINT +17 LOCATE ,15:PRINT " " +18 LOCATE ,15:PRINT " " +19 LOCATE ,15:PRINT " " +20 LOCATE ,15:PRINT " " +21 LOCATE ,15:PRINT " " +22 LOCATE ,15:PRINT " " +23 LOCATE ,15:PRINT " " +29 A$=INPUT$(1):GOSUB 6000:CLS +30 PRINT P$ +50 FOR I=1 TO 11 +51 PRINT ""+CHR$(64+I)+" "; +52 PRINT "Ĵ"; +53 NEXT +54 PRINT "L "; +55 LOCATE 25,1:PRINT P1$; +56 FOR I=1 TO 12 +57 GHJ=V(1,I):LOCATE 2*I,4:PRINT GHJ;:NEXT +69 PCOPY 0,1 +70 REM PROGRAME ........................... +80 A$=INKEY$:IF A$="" THEN 80 +110 IF A$="4" THEN X=X-1:IF X<=0 THEN X=1:BEEP +120 IF A$="6" THEN X=X+1:IF X>=11 THEN X=10:BEEP +130 IF A$="2" THEN Y=Y+1:IF Y>=13 THEN BEEP:Y=12 +140 IF A$="8" THEN Y=Y-1:IF Y<=0 THEN BEEP:Y=1 +141 IF A$=" " OR A$=CHR$(13) THEN 4000 +142 IF A$=CHR$(27) THEN COLOR 7,0:CLS:END +150 N$=RIGHT$(STR$(V(X+1,Y)),LEN(STR$(V(X+1,Y)))-1) +151 RSET G$=N$ +155 COLOR 7,0:LOCATE 2*MY,4+7*MX:PRINT M$;:LOCATE 2*Y,4+7*X:COLOR 0,7:PRINT G$;:M$=G$:MY=Y:MX=X +156 IF N$="" THEN N$="0 " +157 GOTO 80 +4000 PCOPY 0,1:COLOR 7,0 +4010 IF Y>=3 THEN MLK=1 ELSE MLK=0 +4020 LOCATE 10,10:PRINT "";STRING$(58,196);"" +4030 LOCATE 11,10:PRINT "";STRING$(58,32);"" +4040 LOCATE 12,10:PRINT "";STRING$(58,32);"" +4050 LOCATE 13,10:PRINT "";STRING$(58,196);"" +4060 IF X/2=INT(X/2) THEN MKL=1 ELSE MKL=2 +4070 LOCATE 11,11:PRINT "ANCIENNE VALEUR:";V$(X+1,Y) +4080 IF MLK=1 THEN LOCATE 12,11:INPUT "NOUVELLE VALEUR:",M$ +4090 IF MLK=0 THEN LOCATE 12,11:INPUT "MINUTE :";M:LOCATE 12,11:INPUT "SECONDE :";S:IF M>=61 OR S>=61 THEN BEEP:GOTO 4090 +5000 IF MLK=1 THEN V$(X+1,Y)=M$ +5001 IF MLK=0 THEN V$(X+1,Y)=STR$(M)+"'"+STR$(S)+"''" +5002 IF MLK=0 THEN M=M*60+S ELSE M=VAL(M$) +5003 M=M/V(1,Y)*100 +5005 KM=INT(M):IF KM=M THEN 5007 +5006 JLM$=STR$(KM):L=LEN(JLM$):JL$=LEFT$(STR$(M),L+3):M=VAL(JL$) +5007 V(X+1,Y)=M +5008 PCOPY 1,0 +5009 GOTO 150 +6000 CLS:FOR I=1 TO 12 +6005 PRINT CHR$(64+I);"= " +6010 IF I<=2 THEN INPUT "minutes :",M:INPUT "secondes :",S:M=S+M*60 ELSE INPUT "VALEUR :",M +6020 V(1,I)=M:NEXT :RETURN + \ No newline at end of file diff --git a/QTE.ADR b/QTE.ADR new file mode 100644 index 0000000..e69de29 diff --git a/R3.BAS b/R3.BAS new file mode 100644 index 0000000..30ac359 Binary files /dev/null and b/R3.BAS differ diff --git a/R4.BAS b/R4.BAS new file mode 100644 index 0000000..4a717f3 Binary files /dev/null and b/R4.BAS differ diff --git a/README.md b/README.md new file mode 100644 index 0000000..3187d42 --- /dev/null +++ b/README.md @@ -0,0 +1 @@ +# RetroBasicCode diff --git a/REGIMP.BAS b/REGIMP.BAS new file mode 100644 index 0000000..1852887 --- /dev/null +++ b/REGIMP.BAS @@ -0,0 +1,80 @@ +0 DIM W(13),C(13) +1 X=2:N=2:FOR I=1 TO 4:W(I)=1:C(I)=13:NEXT:W(2)=0:C(2)=30 +10 SCREEN 2:SCREEN 0 +11 KEY OFF +20 COLOR 13,1:CLS +30 PRINT :PRINT :PRINT " R E G L A G E D E L ' I M P R I M A N T E" +40 COLOR C(1),W(1):LOCATE 5,21:PRINT"Pour fin ..... " +50 COLOR C(2),W(2):LOCATE 7,21:PRINT "Pour Traitement de Texte " +60 COLOR C(3),W(3) +70 LOCATE 9,21:PRINT "Pour Graphismes " +80 COLOR C(4),W(4) +90 LOCATE 11,21:PRINT "Pour D I V E R S +95 LOCATE 15,22:COLOR 3,1:PRINT "Utilisez :";:COLOR 14,0:PRINT CHR$(24);",";CHR$(25);",ENTER ";:COLOR 3,1:PRINT " pour valider" +100 A$=INKEY$:IF A$=CHR$(13) THEN A=X:GOTO 120 +101 A$=RIGHT$(A$,1) +105 IF A$="H" THEN X=X-1 +106 IF A$="P" THEN X=X+1 +107 IF X<=0 THEN X=4 +108 IF X>=5 THEN X=1 +109 IF X=N THEN 100 +110 C(X)=30:W(X)=0:C(N)=13:W(N)=1:N=X:GOTO 40 +120 ON A GOTO 125,130,140,200 +125 SYSTEM +130 PRINT " APPUYEZ SUR UNE TOUCHE DES QUE VOUS ETES PRES ..." +131 A$=INKEY$:IF A$="" THEN 131 +135 LPRINT CHR$(27);"!";:GOTO 20 +140 PRINT " APPUYEZ SUR UNE TOUCHE DES QUE VOUS ETES PRES ..." +141 A$=INKEY$:IF A$="" THEN 131 +145 LPRINT CHR$(27);"!":LPRINT CHR$(18);:GOTO 20 +200 CLS:PRINT :PRINT :PRINT :PRINT " D I V E R S O P T I O N S " +210 FOR I=1 TO 13:W(I)=1:C(I)=13:NEXT :W(2)=0:C(2)=30:N=2:X=2 +215 COLOR C(1),W(1):LOCATE 6,10:PRINT "Pour Retour au menu " +220 COLOR C(2),W(2):LOCATE ,10:PRINT "Pour Caractres NORMAUX " +230 COLOR C(3),W(3):LOCATE ,10:PRINT "Pour Caractres SERRES" +240 COLOR C(4),W(4):LOCATE ,10:PRINT "Pour Caractres CONDENSES" +250 COLOR C(5),W(5):LOCATE ,10:PRINT "Pour Caractres PROPORTIONNELS" +260 COLOR C(6),W(6):LOCATE ,10:PRINT "Pour Caractres COURRIERS NORMAUX" +270 COLOR C(7),W(7):LOCATE ,10:PRINT "Pour Caractres COURRIERS SERRES" +280 COLOR C(8),W(8):LOCATE ,10:PRINT "Pour Caractres MICROPOLICE" +290 COLOR C(9),W(9):LOCATE ,10:PRINT "DEBUT ALLONGES " +300 COLOR C(10),W(10):LOCATE ,10:PRINT "FIN ALLONGES " +310 COLOR C(11),W(11):LOCATE ,10:PRINT "DEBUT GRAS " +320 COLOR C(12),W(12):LOCATE ,10:PRINT "FIN GRAS " +330 COLOR C(13),W(13):LOCATE ,10:PRINT "ESSAI << ([{2,3=&$#@*><,| >>" +340 LOCATE 23,22:COLOR 3,1:PRINT "Utilisez :";:COLOR 14,0:PRINT CHR$(24);",";CHR$(25);",ENTER ";:COLOR 3,1:PRINT " pour valider" +350 A$=INKEY$:IF A$=CHR$(13) THEN A=X:GOTO 399 +351 A$=RIGHT$(A$,1) +360 IF A$="H" THEN X=X-1 +365 IF A$="P" THEN X=X+1 +367 IF X<=0 THEN X=13 +369 IF X>=14 THEN X=1 +370 IF X=N THEN 350 +371 C(X)=30:W(X)=0:C(N)=13:W(N)=1:N=X:GOTO 215 +372 RUN +399 ON A GOTO 372,410,420,430,440,450,460,470,480,490,500,510,520 +410 LPRINT CHR$(27);CHR$(19); +415 GOTO 200 +420 LPRINT CHR$(27);CHR$(23); +425 GOTO 200 +430 LPRINT CHR$(27);CHR$(20); +435 GOTO 200 +440 LPRINT CHR$(27);CHR$(17); +445 GOTO 200 +450 LPRINT CHR$(27);CHR$(18); +455 GOTO 200 +460 LPRINT CHR$(27);CHR$(29); +465 GOTO 200 +470 LPRINT CHR$(27);CHR$(77); +475 GOTO 200 +480 LPRINT CHR$(27);CHR$(14); +485 GOTO 200 +490 LPRINT CHR$(27);CHR$(15); +495 GOTO 200 +500 LPRINT CHR$(27);CHR$(31); +505 GOTO 200 +510 LPRINT CHR$(27);CHR$(32); +515 GOTO 200 +520 BEEP:LPRINT " ESSAI << ([{2,3=&$#@*><,| >>"; +525 GOTO 200 + \ No newline at end of file diff --git a/REVOL.BAS b/REVOL.BAS new file mode 100644 index 0000000..0747101 Binary files /dev/null and b/REVOL.BAS differ diff --git a/REVOL3D.BAS b/REVOL3D.BAS new file mode 100644 index 0000000..8f8b922 --- /dev/null +++ b/REVOL3D.BAS @@ -0,0 +1,86 @@ +5 CLS +6 SCREEN 2 +7 WINDOW SCREEN (0,0)-(700,450) +10 KEY OFF +20 PI=4*ATN(1) +60 DIM CIBLE(25) +70 DIM R(40),Y(40),H(36),V(36) +80 LOCATE 1,61:PRINT"ENTREE DES SOMMETS" +90 LOCATE 2,64:PRINT"DU PROFIL DE" +95 LOCATE 3,65:PRINT"GENERATION" +100 LOCATE 6,60:PRINT"dplacements de la" +105 LOCATE 7,60:PRINT"cible avec le pav" +106 LOCATE 8,60:PRINT"numrique :" +107 LOCATE 10,62:PRINT"directions: 4 6" +108 LOCATE 9,75:PRINT"7 8 9" +109 LOCATE 11,75:PRINT"1 2 3" +110 LOCATE 12,62:PRINT"pas: + ou -" +111 LOCATE 15,60:PRINT"valider les points" +112 LOCATE 16,60:PRINT"avec ENTREE" +113 LOCATE 19,60:PRINT"valider le profil" +114 LOCATE 20,60:PRINT"avec ECHAP" +115 LOCATE 23,60:PRINT"40 points au maximum" +210 VIEW SCREEN(1,1)-(470,199),,1 :CLS +260 LINE (260, 0)-(260,450),1,,&HF99F +310 LINE (100,98)-(100 ,102),1 +360 LINE (98 ,100)-(102,100),1 +410 PSET (100,100),0 +460 GET (98,98)-(102,102), CIBLE +510 LINE (100,98)-(100 ,102),0 +560 LINE (98 ,100)-(102,100),0 +610 X=258:Y=200:P=10:S=0 +650 S=S+1 +660 PUT (X ,Y ),CIBLE +710 A$=INKEY$:IF A$="" THEN 710 +760 AX=X :AY=Y +810 IF A$="1" AND X>P AND Y<337-P THEN X=X-P:Y=Y+P +860 IF A$="2" AND Y<337-P THEN Y=Y+P +910 IF A$="3" AND X<259-P AND Y<337-P THEN X=X+P:Y=Y+P +960 IF A$="4" AND X>P THEN X=X-P +1010 IF A$="6" AND X<259-P THEN X=X+P +1060 IF A$="7" AND X>P AND Y>P THEN X=X-P:Y=Y-P +1110 IF A$="8" AND Y>P THEN Y=Y-P +1160 IF A$="9" AND X<259-P AND Y>P THEN X=X+P:Y=Y-P +1210 IF A$="+" THEN P=10 +1260 IF A$="-" THEN P=1 +1300 PUT (AX ,AY ),CIBLE,XOR +1310 IF A$=CHR$(13) THEN LINE (X,Y)-(X+4,Y+4):LINE (X,Y+4)-(X+4,Y):R(S)=258-X:Y(S)=Y+2:GOTO 650 +1320 IF A$=CHR$(27) THEN 1500 +1410 GOTO 660 +1500 VIEW:CLS +1504 LINE (0,0)-(521,341),,B +1505 LINE (260, 0)-(260,340),1,,&HF99F +1506 FOR K=1 TO S-2 +1507 LINE (258-R(K),Y(K))-(258-R(K+1),Y(K+1)) +1508 NEXT +1510 LOCATE 6,62:PRINT"Angle de rotation " +1515 LOCATE 7,62:PRINT"en degrs " +1520 LOCATE 7,72:INPUT AN$ +1530 IF AN$="" THEN RUN ELSE CLS +1535 VIEW SCREEN(1,1)-(480,199) :CLS +1540 AN=VAL(AN$)*PI/180 +1550 C=.65*SIN(AN):AXE=COS(AN) +1560 LOCATE 25,63:PRINT"Tranche n" +1570 FOR W=1 TO S-1 +1580 R=R(W) +1590 LOCATE 25,74:PRINT W +1600 YR=166-(166-Y(W))*AXE +1610 GOSUB 2000 +1620 NEXT +1630 LOCATE 25,65:PRINT"TERMINE" +1640 GOTO 1510 +2000 VIEW SCREEN(1,1)-(480,199) +2005 FOR I=10 TO 360 STEP 10 +2010 LT=I/10 +2020 XA=260+R*SIN(I*PI/180) +2030 XP=260+R*SIN((I+10)*PI/180) +2040 YA=YR -R*COS(I*PI/180)*C +2050 YP=YR -R*COS((I+10)*PI/180) *C +2060 PSET(XA,YA) +2070 LINE(XA,YA)-(XP,YP) +2080 IF W>1 THEN LINE (XP,YP)-(H(LT),V(LT)) +2090 H(LT)=XP:V(LT)=YP +2100 NEXT +2105 VIEW +2110 RETURN + \ No newline at end of file diff --git a/REVOL3D2.BAS b/REVOL3D2.BAS new file mode 100644 index 0000000..80ca899 Binary files /dev/null and b/REVOL3D2.BAS differ diff --git a/REVOLD5.BAS b/REVOLD5.BAS new file mode 100644 index 0000000..d78fab7 Binary files /dev/null and b/REVOLD5.BAS differ diff --git a/REVOLD6.BAS b/REVOLD6.BAS new file mode 100644 index 0000000..3aefeab Binary files /dev/null and b/REVOLD6.BAS differ diff --git a/ROSACES.BAS b/ROSACES.BAS new file mode 100644 index 0000000..95f676c Binary files /dev/null and b/ROSACES.BAS differ diff --git a/SBIN.BAS b/SBIN.BAS new file mode 100644 index 0000000..6fed961 Binary files /dev/null and b/SBIN.BAS differ diff --git a/SCOJ1.DAT b/SCOJ1.DAT new file mode 100644 index 0000000..71ff27a --- /dev/null +++ b/SCOJ1.DAT @@ -0,0 +1,11 @@ +YOANN, 50 , 20 , 40 +YOANN, 50 , 18 , 36 +YOANN, 100 , 20 , 20 +RIEN, 150 , 0 , 0 +RIEN, 60 , 0 , 0 +RIEN, 140 , 1 , 0 +RIEN, 140 , 0 , 0 +RIEN, 50 , 0 , 0 +RIEN, 90 , 0 , 0 +RIEN, 50 , 0 , 0 + \ No newline at end of file diff --git "a/SCORES.\302\261\302\261\302\261" "b/SCORES.\302\261\302\261\302\261" new file mode 100644 index 0000000..bc2a0b6 --- /dev/null +++ "b/SCORES.\302\261\302\261\302\261" @@ -0,0 +1 @@ +YOANN 1 2482 Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000Mmory 00000000 \ No newline at end of file diff --git a/SONERR2.BAS b/SONERR2.BAS new file mode 100644 index 0000000..c305a66 --- /dev/null +++ b/SONERR2.BAS @@ -0,0 +1,9 @@ +10 DEFINT A-Z +15 RANDOMIZE TIMER +20 FOR I=1 TO 5 +30 A=INT(RND(1)*1900)+100 +40 SOUND A,.5 +45 RANDOMIZE VAL(RIGHT$(TIME$,2))*100 +50 NEXT I +60 goto 20 + diff --git a/SORTALIM.DAT b/SORTALIM.DAT new file mode 100644 index 0000000..e69de29 diff --git a/STF.BAS b/STF.BAS new file mode 100644 index 0000000..d5345aa Binary files /dev/null and b/STF.BAS differ diff --git a/T1.DAT b/T1.DAT new file mode 100644 index 0000000..6d8e068 --- /dev/null +++ b/T1.DAT @@ -0,0 +1,27 @@ + 11.18 + 9.18 + 10 + 10 + 11 + 10 + 10 + 9 + 11.5 + 12.5 + 9.5 + 10 + 12.5 + 11.5 + 9.5 + 8.5 + 13.5 + 11 + 8.5 + 11 + 11 + 14 + 12.5 + 13.5 + 12 + 11 + \ No newline at end of file diff --git a/T2.DAT b/T2.DAT new file mode 100644 index 0000000..b1b18df --- /dev/null +++ b/T2.DAT @@ -0,0 +1,27 @@ + 11.5 + 7.5 + 11 + 9.5 + 12 + 9 + 9.5 + 9.5 + 11.5 + 12.5 + 9.5 + 11.5 + 11.5 + 10.5 + 9 + 9 + 15 + 12 + 10 + 11.5 + 10.2 + 14 + 12 + 13 + 12 + 10.5 + \ No newline at end of file diff --git a/T3.DAT b/T3.DAT new file mode 100644 index 0000000..a03b024 --- /dev/null +++ b/T3.DAT @@ -0,0 +1,27 @@ + 12.05 + 7.63 + 10.17 + 8.96 + 12.77 + 8.46 + 9.75 + 10.47 + 11.1 + 11.55 + 9.020001 + 10.78 + 12.08 + 11.34 + 10.2 + 9.979999 + 13.65 + 12.16 + 10.62 + 11.73 + 11.01 + 14.23 + 12.07 + 12.69 + 12.49 + 10.58 + \ No newline at end of file diff --git a/T4.DAT b/T4.DAT new file mode 100644 index 0000000..88acbbc --- /dev/null +++ b/T4.DAT @@ -0,0 +1,29 @@ + 11.33 + 1 + 9.66 + 8.05 + 11.5 + 8.83 + 1 + 8.91 + 9.16 + 11 + 12.16 + 1 + 10.33 + 12.75 + 10.91 + 1 + 8.3 + 1 + 13.6 + 1 + 11.5 + 9.33 + 11 + 14.33 + 11.66 + 13.5 + 11.84 + 9.58 + \ No newline at end of file diff --git a/T5.DAT b/T5.DAT new file mode 100644 index 0000000..52e0eb5 --- /dev/null +++ b/T5.DAT @@ -0,0 +1,29 @@ + 11.93 + 1 + 10.09 + 10.44 + 13.02 + 8.2 + 1 + 9.25 + 10.62 + 11.15 + 11.22 + 1 + 11.19 + 12.48 + 10.85 + 1 + 9.75 + 1 + 13.34 + 1 + 10.25 + 9.42 + 12.25 + 13.49 + 11.62 + 12.79 + 11.82 + 11.53 + \ No newline at end of file diff --git a/TAILLE.PIC b/TAILLE.PIC new file mode 100644 index 0000000..be3a817 Binary files /dev/null and b/TAILLE.PIC differ diff --git a/TAILLE2.DAT b/TAILLE2.DAT new file mode 100644 index 0000000..ab4bc8e --- /dev/null +++ b/TAILLE2.DAT @@ -0,0 +1,181 @@ +taille 2t1 + +2 + 2 + +1 + 1 + +1 + 1 + +4 + 4 + +6 + 6 + +4 + 4 + +2 + 2 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 diff --git a/TEXTIMP.BAS b/TEXTIMP.BAS new file mode 100644 index 0000000..3ef6d7e --- /dev/null +++ b/TEXTIMP.BAS @@ -0,0 +1,33 @@ + +Debut : +Cls +PRINT " ATTENTION Suivez les instructions la lettre .... " +PRINT " -------------------------------------------------- " +print + +PRINT " Vous avez choisi le mode graphique, veillez ce que :" +PRINT " - GRAPHICS et GRAFTABL ne soit pas charg " + +print:print +PRINT " Appuyez sur une touche !!!!!! " +a$=input$(1):CLS:COLOR 14 + +PRINT " Allumez l'imprimante ! puis appuyer sur une touche ..." +a$=input$(1) +PRINT:COLOR 15 + +LPRINT CHR$(27);"!" + +Print " Eteignez et rallumez l'imprimante ... Et appuyez sur une touche ..." +PRINT:COLOR 13 + +A$=input$(1) +Lprint " TEST IMPRIMANTE " + +PRINT " L'imprimante est thoriquement prte pour les applications TEXTES" +PRINT " ~~~~~~~~~~~~~~~~~~~~~~~" + +end + + + \ No newline at end of file diff --git a/TF.BAS b/TF.BAS new file mode 100644 index 0000000..26a4d4d Binary files /dev/null and b/TF.BAS differ diff --git a/TF2.BAS b/TF2.BAS new file mode 100644 index 0000000..8d04f56 Binary files /dev/null and b/TF2.BAS differ diff --git a/TFICH.BAS b/TFICH.BAS new file mode 100644 index 0000000..773d9f5 Binary files /dev/null and b/TFICH.BAS differ diff --git a/TIMER.BAS b/TIMER.BAS new file mode 100644 index 0000000..342bdd9 --- /dev/null +++ b/TIMER.BAS @@ -0,0 +1,12 @@ +cls:screen 1:t=timer:ta=47 + +deb: +ti=timer-t +tp=ti/ta*100 +locate 1,1:print ti;"/";ta;"=";tp;"%" +x= 3.2*tp +line(0,190)-(x,200),2,bf + +a$=inkey$ +if a$="" then goto deb +end \ No newline at end of file diff --git a/TOTURE.BAS b/TOTURE.BAS new file mode 100644 index 0000000..c9ca2d6 Binary files /dev/null and b/TOTURE.BAS differ diff --git a/TRACE1.BAS b/TRACE1.BAS new file mode 100644 index 0000000..6964d73 Binary files /dev/null and b/TRACE1.BAS differ diff --git a/TRACEY.BAS b/TRACEY.BAS new file mode 100644 index 0000000..5f4e947 Binary files /dev/null and b/TRACEY.BAS differ diff --git a/TRAVERCE.BAS b/TRAVERCE.BAS new file mode 100644 index 0000000..81465ca --- /dev/null +++ b/TRAVERCE.BAS @@ -0,0 +1,28 @@ +10 SCREEN 2:SCREEN 0:CLS:KEY OFF +20 COLOR 13 :FOR I=1 TO 24:PRINT " Y O A N N";:NEXT +30 X1=1:Y1=10:X=1:Y=10:LOCATE 10,1:COLOR 14:PRINT "*" +40 A$=INKEY$:IF A$="" THEN 150 +45 IF X=80 THEN 1100 +50 IF (A$="8" OR A$="~") AND Y >1 THEN Y=Y-1:GOTO 100 +60 IF (A$="2" OR A$="`") AND Y<24 THEN Y=Y+1:GOTO 100 +70 IF A$="6" AND X<80 THEN X=X+1:GOTO 100 +80 IF (A$="4" OR A$="|") AND X>1 THEN X=X-1:GOTO 100 +90 GOTO 110 +100 AA=1 +110 IF SCREEN (Y,X)=35 THEN E=E+1:LOCATE 1,1:PRINT "* = ";E:GOTO 120 +115 IF SCREEN (Y,X)=32 THEN 120 +116 IF AA = 0 THEN 150 +117 IF E => 1 THEN AM=1 :GOTO 120 +118 CLS:PRINT " MISSION EJOUE !!!!!!!!":GOTO 1000 +120 LOCATE Y1,X1:PRINT " ";:LOCATE Y,X:COLOR 14:PRINT "*";:X1=X:Y1=Y +130 IF AM =1 THEN 140 ELSE 150 +140 LOCATE 1,1:E=E-1:PRINT "* = ";E:AM=0 +150 RANDOMIZE Z*X*X1*Y*Y2*X2/Y1*AM-TIMER:Z=INT(RND*45):X2=INT(RND*80):Y2=INT(RND*24):IF X2 =0 OR Y2=0 THEN 150 +160 IF Z MOD 23 <>0 THEN LOCATE Y2,X2:COLOR 3:PRINT "H";:GOTO 40 +170 LOCATE Y2,X2:COLOR 8:PRINT "#";:GOTO 40 +1000 PRINT "VOULEZ - VOUS REJOUER ?? " +1010 A$=INKEY$:IF A$="" THEN 1010 +1011 IF A$="O" OR A$="o" THEN RUN ELSE END +1100 CLS:COLOR 12:PRINT " V O U S A V E Z G A G N E R A U j E U X I M P O S S I B L E " +1101 GOTO 1000 + \ No newline at end of file diff --git a/TUYAU.DAT b/TUYAU.DAT new file mode 100644 index 0000000..151953e --- /dev/null +++ b/TUYAU.DAT @@ -0,0 +1 @@ +A001DR080FB001DR080OC001DR054OC001FC002DR081OR082FC002FR057OC003DR400OC003FC004DR500OC004FB001FR010OB002DR020OC001DR030OC001FR987OR988OC002DR045OC002FC003DR060OC003FB002FR090OA001F \ No newline at end of file diff --git a/TYPEALIM.DAT b/TYPEALIM.DAT new file mode 100644 index 0000000..0b625c5 Binary files /dev/null and b/TYPEALIM.DAT differ diff --git a/VOYAGE.BAS b/VOYAGE.BAS new file mode 100644 index 0000000..9b1cc3e --- /dev/null +++ b/VOYAGE.BAS @@ -0,0 +1,109 @@ +0 DIM T1(1225),T2(400),T3(1225),T4(286),P(10) +1 REM |||||||||||||||||| UN VOYAGE DE L'ICONUE ||||||||||||||||||||||||||||||| +2 SCREEN 8:GOSUB 60000:GOTO 64:SCREEN 2:SCREEN 0:COLOR 13,0,0:CLS:KEY OFF:LOCATE ,,7,0,7:PRINT:PRINT +3 PRINT " B O N J O U R !!!!!! " +4 PRINT :PRINT " Avez - vous charchez kick/M O ou N ":PRINT :COLOR 20 +5 A$=INKEY$:IF A$="" THEN 5 ELSE IF A$= "o" OR A$="O" THEN 6 ELSE 7 +6 PRINT " VOUS DEVEZ RELANCEZ LE SYSTEME << CTRL - ALT - DELETE >> ": STOP +7 REM +8 REM +9 REM +10 COLOR 3:PRINT :PRINT +15 PRINT :PRINT " V O U L E Z - V O U S L E S E X P L I C A T I O N S O / N " +16 A$=INKEY$:IF A$="" THEN 16 ELSE IF A$= "o" OR A$="O" THEN 20 ELSE 30 +20 COLOR 9:CLS:PRINT :PRINT :PRINT " U N V O Y A G E D E L ' I N C O N U E " +21 COLOR 2:PRINT :PRINT " Ceci est un jeu qui se passe dans une ville I N C A ,nous sommes en 2548 vous possdez d'une corde ,d'un cadrant solair ,d'une lampe de poche ,un peu d'argent : 2000 Frs " +22 COLOR 3:PRINT :PRINT " Tout au long de cette aventure vous pourez trouver des objets, de l'argent , des parchemins , des indices etc... " +23 COLOR 4:PRINT:PRINT " L'ecrant sera diviser en deux partie : partie TEXTE ,partie GRAPHISME. Pour vous deplacer ,vous utiliserez les chiffres,pour realiser des actions vous utiliserez les lettre qui seront indiques (ex A pour prendr" +24 PRINT "clef ect.)":PRINT +25 COLOR 20:PRINT " Pour sortir du jeux : ";:COLOR 5:PRINT " 0 ":PRINT +26 PRINT " App Sur une touche pour commencer Bonne Chance " +27 A$=INKEY$:IF A$="" THEN 27 ELSE IF A$="0" OR A$="" THEN SYSTEM +30 SCREEN 6:CLS:COLOR 2 +31 PRINT :PRINT " Ce matin - la vous tes Paris ,vous avez dj pris votre petit djeuner ... Quand soudain sous votre porte une lettre si glissa . " +32 PRINT :PRINT " -A- pour ouvrir la porte et regarder qui a gliss cette lettre " +33 PRINT " -B- pour ouvrir la lettre et la lire " +34 PALETTE 1,6:PALETTE 2,3 +35 LINE (1,100)-(639,199),1,B:LINE (2,101)-(229,139),2,BF:LINE (411,101)-(638,139),2,BF +36 LINE (229,101)-(411,159),1,BF:LINE (2,159)-(639,199),2,BF:LINE (250,159)-(240,179):LINE -(320,179):LINE -(330,159):LINE -(250,159):PAINT (301,161),3:LINE (250,159)-(320,179),0:LINE (330,159)-(240,179),0 +37 GOSUB 9000 +38 IF A$="A" THEN 39 ELSE IF A$="B" THEN 40 ELSE GOTO 37 +39 CLS:LOCATE 11,1:PRINT " Vous ouvrez la porte d'un geste rapide et sec , mais Helas ... Vous regarder les portes de l'ascenseur qui se ferment d'un air dsespr .. Vous ouvrez l'enveloppe et ..... ":PLAY "P1P1P1P1":GOTO 40 +40 COLOR 1,15:PALETTE 1,0:PALETTE 3,13 +41 CLS:PRINT :PRINT " B O N J O U R .... " :PRINT +42 PRINT " Je vous derange peut tre ,M A I S ce que j'ai a vous dire est plus I M P O R T A N T que le reste : effet je vous engage a rechercher TILKA une statuette d'une grande importance car en effet celle - ci pourrait " +43 PRINT " sauver la vie hummaine du monde en entier ":PRINT :PRINT " A T T E N T I O N cette mission est tres dangereuse car la ville inca possde de nombreux pieges : il faudra trouvez 7 clefs qui serons cacher dans la ville ":PRINT +44 PRINT " Dans cette lettre vous trouverez un billet d'avion pour 9h00 ORLY dpchez-vous !!! ":PRINT +45 PRINT " AH ,j'oubliait nous n'avons pas pu se procurer un plan ,et vous disposer de 2000 frs":PRINT :PRINT " C O N S E I L S" +46 PRINT :PRINT " I pour inventre " +47 PRINT " S pour somme d'argent possede " +48 S=2000:PRINT :PRINT "APP sur une Touche ... ":GOSUB 9000 +50 COLOR ,0:PALETTE 1,6:PALETTE 2,5:PALETTE 3,14 +51 CLS :PRINT +52 PRINT " Comme la lettre vous la conseill vous vous dpechez pour sauter dans l'avion 9h00 pour Tilka . ":PLAY "p4":PRINT +53 PRINT " Vous tes maintenant dans le taxi , votre coeur bat de plus en plus fort car cela faisait longtemps que vous n'avier pas fais de mission de ce genre ":PLAY "p4":PRINT +54 PRINT " Voila vous tes Orly ,vous courez le plus possible parce qu il est 8h40 ":PLAY "p4":PRINT :PRINT " Enfin dans l'avion quel soulagement Vous ne l'avez pas ratter ... " +55 PRINT:PRINT :PLAY "p2":PRINT " 10 h sont passes ,vous tes Tilka ,vous descendez de l'avion puis puis vous apercevez une voiture qui vous attend . Personne au alentour !?. Le pillote de l'avion dit << Cette voiture je l'ai amm" +56 PRINT " ici car dans ce coin il y a personne 200 KM la ronde ...>> ,puis il parti ":PRINT " vous pntrez dans la voiture ... une lettre blanche attir vos yeux , vous la prenez puis vous la lisez ...." +57 COLOR 3:PRINT :PRINT " app sur une touche ....":GOSUB 9000 +58 CLS:COLOR 1,15:PALETTE 1,0:PRINT :PRINT " B O N S O I R ! ! ! ":PRINT +59 PRINT " M E R C I d'avoir accept cette mission . Cette voiture contient de la nouriture pour un moi,4 bidons d'essence,5 bouteilles de gaz pour rechaud, des ustensiles pour la cuisine ,une radio qui se connect sur satelite,sa frequence" +60 PRINT " est de 50 Mhz .Dans le coffre arrire il a y une tente et deux duvets ":PRINT :PRINT " signer l ' X +61 LINE (1,90)-(640,200),1,BF +62 PLAY "p1p1p1p1p1p1p1p1":COLOR 2,0:LOCATE 12:PRINT " Vous repliez la lettre et vous commencez vous instaler prs d'un abre Puis aprs avoir lu le compliqu mode d'emplois vous instalez la radio ":PLAY "p2" +63 PRINT " Apres avoir cuisin un bon petit plat ,vous le mangez car vous avez enormment faim .En suite vous vous couchez tranquillemant ....":PLAY "p1p2":PRINT " app sur une touche pour vous reveillez !!!! ":GOSUB 9000 +64 CLS:PALETTE 1,6:PALETTE 2,14:PALETTE 3,2 +65 PRINT :PRINT " Le landemain matin vous vous reveiller trs tt car vous savez que vous avez du pain la planche,vous djeunez trs vite et vous contempler le paysage pour savoir par o vous allez commencer : " +66 PRINT "choisissez le numero correspondant a ce que vous voulez voir : " +67 LINE (1,50)-(639,199),1,B +68 LINE (1,100)-(200,100),1:LINE -(300,150),1:LINE -(639,150),1:PAINT (320,175),3,1 +69 PUT (50,70),T1:PUT (400,130),T2:PUT (520,120),T3:PUT (400,170),T4 +70 LOCATE 14,7:PRINT "1":LOCATE 20,52:PRINT "2":LOCATE 20,66:PRINT "3":LOCATE 24,52:PRINT "4";:LOCATE 5 +71 GOSUB 9000 +72 IF A$="1" OR A$="&" THEN 80 +73 'IF A$="2" OR A$="" OR A$="`" THEN '"???" +74 'IF A$="3" THEN '"???" +75 'IF A$="'" OR A$="|" OR A$="4" THEN '"???" +76 GOTO 71 +80 CLS::PALETTE 3,6:PALETTE 1,13:COLOR 1:PRINT :PRINT +81 PRINT " Apres un bon bout de marche vous arrivez avotre but.Vous contemplez le temple avec stuppeur .Il est gigantesque ... Vous avez face a vous un grand escalier sur les deux cots il y a rien : Qu'allez-vous faire ?" +82 PRINT " ( 1 pour monter les esc. 2 pour rebrousser le chemin ) " +83 LINE (1,50)-(639,199),1,B:LINE (120,150)-(540,199),3,BF:LINE (170,100)-(470,150),2,BF:LINE (220,50)-(420,100),1,BF:LINE (270,70)-(370,100),0,BF:LINE (270,100)-(170,199),1:LINE -(470,199),1:LINE -(370,100),1:LINE -(270,100),1:PAINT (275,120),1 +84 GOSUB 9000 +85 IF A$="1" OR A$="&" THEN 90 +86 IF A$="2" OR A$="" OR A$="`" THEN 88 +87 GOTO 84 +88 CLS:PALETTE 1,6:PALETTE 2,14:PALETTE 3,2 +89 PRINT " Reflexion faite ce lieu vous parrait banal alors vous partez vers le camp ":GOTO 66 +90 CLS:PALETTE 1,8:PALETTE 3,4:COLOR 3 +91 PRINT " Vous tes dans une piece sombre . 1 pour analyser les murs 2 pour retourner au camp";:IF C(4)=0 THEN PRINT "3 pour prendre la clef " +92 LINE (1,50)-(639,199),1,B:LINE (70,80)-(560,169),1,BF:LINE (1,50)-(70,80),1:LINE (639,199)-(560,169),1:LINE (70,169)-(1,199),1:LINE (560,80)-(639,50),1:PAINT (25,70),1:PAINT (600,80),1:LINE (290,110)-(330,169),0,B,15:LINE (70,80)-(560,169),0,B +93 GOSUB 9000 +94 IF A$="2" OR A$="`" OR A$="" THEN 88 +95 IF A$="&" OR A$="1" THEN 98 +96 'IF A$="3" AND C(4)=0 THEN '"???" +98 CLS:PRINT " VOUS analysez les murs minussiosement quand soudin vous declanchez un systeme qui ouvre une porte. 1 pour y entrer 2 pour la refermer " +99 LINE (215,20)-(435,199),1,B:LINE (290,80)-(360,139),1,B:LINE (215,20)-(290,80),1:LINE(435,199)-(360,139),1:LINE (215,199)-(290,139),1:LINE (435,20)-(360,80),1:LINE (1,20)-(215,199),1,BF:LINE (435,20)-(639,199),1,BF +100 GOSUB 9000 +101 IF A$= "&" OR A$= "1" THEN goto 105 +102 IF A$= "`" OR A$= "" OR A$="2" THEN goto 98 +103 GOTO 100 +104 ' *** *** +105 ' +9000 REM |||||||||||||||||||| I T E R S E C T I O N |||||||||||||||||||||||||||| +9001 A$=INKEY$ ':IF A$="" THEN 9001 ELSE IF A$="0" OR A$="" THEN 'SAVE "voyage":SYSTEM +9002 'IF A$="i" OR A$="I" THEN +9003 IF A$="s" OR A$="S" THEN PRINT " Somme d'argent = ";S:PLAY "p2":PRINT "votre choix ":GOTO 9001 +9090 RETURN +60000 CLS:LOCATE 10 +60010 LINE (1,15)-(1,20),1:LINE -(20,20),1:LINE -(20,14),1:LINE (2,12)-(2,15),1:LINE (3,12)-(3,5),1:LINE (4,5)-(4,2),1:LINE -(9,2),1:LINE -(9,5),1:LINE (10,5)-(10,8),1:LINE -(12,8),1:LINE (6,10)-(14,10),1:LINE (14,9)-(17,9),1:LINE (19,10)-(19,14),1 +60011 LINE (5,11)-(5,15),1:LINE -(14,15),1:LINE -(14,10),1:PSET (6,2),1:PSET(7,2),1:PSET (17,8),1:PSET(11,9),1:PSET (18,10),1:PSET (9,11),1:PSET (10,11),1:PSET(13,11),1:PSET (20,11),1:PSET (4,11),1:PSET (2,13),1:PSET (6,13),1:PSET (13,13),1:PSET(9,14) +60020 PAINT (7,7),1:PAINT (13,17),1:PAINT (9,13),0 +60030 GET (1,1)-(20,20),T2 +60040 CLS:LOCATE 10:LINE (24,5)-(27,13),3,BF:LINE (7,9)-(10,12),3,BF:LINE(6,12)-(11,19),2,BF:LINE (3,19)-(14,24),2,BF:LINE (1,24)-(16,30),1,BF:LINE (22,13)-(29,24),2,BF :LINE (19,24)-(30,30),1,BF +60050 GET (1,1)-(30,30),T3 +60060 CLS:LOCATE 10:LINE (7,9)-(10,12),2,BF:LINE(6,12)-(11,19),2,BF:LINE (3,19)-(14,24),2,BF:LINE (1,24)-(16,30),2,BF:LINE (16,25)-(30,30),2:LINE -(16,30),2:PAINT (20,28),1,2 +60070 GET (1,1)-(30,30),T1 +60074 CLS:LOCATE 10:LINE (3,19)-(14,24),2,BF:LINE (1,24)-(16,30),2,BF +60075 GET (1,19)-(16,30),T4 +60080 RETURN diff --git a/Y.BAS b/Y.BAS new file mode 100644 index 0000000..920c9a0 --- /dev/null +++ b/Y.BAS @@ -0,0 +1,4 @@ +screen 1 +paint (160,100),"@"+chr$(16)+chr$(68)+chr$(17) +end + \ No newline at end of file diff --git "a/\302\261MEG\302\261\302\261\302\261" "b/\302\261MEG\302\261\302\261\302\261" new file mode 100644 index 0000000..84cf842 --- /dev/null +++ "b/\302\261MEG\302\261\302\261\302\261" @@ -0,0 +1 @@ + 1 ZORK SYSTEM & LOGIQUE Vous flicite d'avoir choisie samessagerie faites en part aux AUTRES Merci beaucoup BONJOUR 4 BONJOUR 4 BONJOUR Tout va bien et meme tres bien SALUT LES P'TIT NUL COMMENT a roule les cours ! Haha pas trible ce que je vois !!! Bye ZORK SYSTEME & LOGIQUE \ No newline at end of file