Publié par diemaker form le 17/03/2008
Modif du programme de réorganisation de SFLPMEA par DMF non complet
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
CLS : DEFSTR A-Z: SCREEN 12
GOSUB GS01.OPEN: CLOSE 1: KILL "CNC.DMK"
GOSUB GS01.OPEN
OPEN "CNC.TXT" FOR INPUT AS 10
'Masque = " A = #####.### B = #####.### C = #####.### D = #####.###"
Masque = "####.###,####.###,####.###,####.###"
Vecteurs% = 0
DO
INPUT #10, XD!, YD!, XF!, YF!
Vecteurs% = Vecteurs% + 1: E% = Vecteurs%
GOSUB GS02.ECRITURE
LOOP UNTIL EOF(10)
' ***** Controle Fichier initial
PRINT
PRINT "***** Fichier initial non tri‚": PRINT
FOR E% = 1 TO Vecteurs%
PRINT E%; : GOSUB GS03.LECTURE
PRINT USING Masque; XD!; YD!; XF!; YF!
NEXT E%
GOSUB GS04.REORGANISATION
' ***** Affichage Controle resultat
PRINT : COLOR 11: PRINT "***** Fichier reorganis‚": PRINT
FOR E% = 1 TO Vecteurs%
GOSUB GS03.LECTURE: COLOR 15: PRINT E%; crayon1$; : COLOR 14
XF.Pr! = XF!: YF.Pr! = YF!
IF (XF.Pr! <> XD! OR YF.Pr! <> YD!) THEN COLOR 14 ELSE COLOR 11
PRINT USING Masque; XD!; YD!; XF!; YF!;
COLOR 15: PRINT crayon2$
NEXT E%
SLEEP
END
GS01.OPEN: OPEN "CNC.DMK" FOR RANDOM AS #1 LEN = 24
FIELD #1, 4 AS F.XD, 4 AS F.YD, 4 AS F.XF, 4 AS F.YF, 4 AS crayon1$, 4 AS crayon2$
RETURN
GS02.ECRITURE:
LSET F.XD = MKS$(XD!): LSET F.YD = MKS$(YD!)
LSET F.XF = MKS$(XF!): LSET F.YF = MKS$(YF!)
crayon1$ = cray1$: crayon2$ = cray2$
PUT #1, E%
RETURN
GS03.LECTURE: GET #1, E%
XD! = CVS(F.XD): YD! = CVS(F.YD): XF! = CVS(F.XF): YF! = CVS(F.YF)
RETURN
GS04.REORGANISATION:
Actuel% = 0
GS04A: Actuel% = Actuel% + 1: Suivant% = Actuel%
' ***** Lecture de l'enregistrement actuel
E% = Actuel%
'cray1$ = "bass": cray2$ = "haut"
GOSUB GS03.LECTURE
IF Actuel% = Vecteurs% THEN GOTO GS04F' ***** Fin du fichier
XF.Actuel! = XF!: YF.Actuel! = YF!
GS04B: ' ***** Lecture de l'Enregistrement suivant
Suivant% = Suivant% + 1
IF Suivant% > Vecteurs% THEN ' ***** Pas de suivant correct
PRINT : COLOR 15: PRINT USING "Suivant introuvable #####"; Actuel%
cray1$ = "haut": cray2$ = "haut"
GOTO GS04A
END IF
E% = Suivant%: GOSUB GS03.LECTURE
IF XD! = XF.Actuel! AND YD! = YF.Actuel! AND Suivant% = Actuel% + 1 THEN
' ***** L'enregistrement suivant est bien place
cray1$ = "haut": cray2$ = "bass"
GOTO GS04A ' ***** pour examiner le suivant "Actuel% + 1"
END IF
IF XD! <> XF.Actuel! AND YD! <> YF.Actuel% THEN
' ***** L'enregistrement suivant n'est pas le bon
' Il faut aller voir plus loin
GOTO GS04B
END IF
IF XD! = XF.Actuel! AND YD! = YF.Actuel! THEN
' ***** il faut permuter les enregistrements
' (Actuel% + 1) et Suivant% (qui vient d'etre lu)
' Sauvegarde des valeurs suivantes
XDS! = XD!: YDS! = YD!: XFS! = XF!: YFS! = YF!
E% = Actuel% + 1: GOSUB GS03.LECTURE:
' Sauvegarde des valeur actuelles
XDA! = XD!: YDA! = YD!: XFA! = XF!: YFA! = YF!
' remplacement par les suivantes
XD! = XDS!: YD! = YDS!: XF! = XFS!: YF! = YFS!
GOSUB GS02.ECRITURE
E% = Suivant%
XD! = XDA!: YD! = YDA!: XF! = XFA!: YF! = YFA!
GOSUB GS02.ECRITURE
GOTO GS04A
END IF
GOTO GS04A
GS04F:
cray1$ = "haut": cray2$ = "haut"
'fin du bloc reorganisation
RETURN