💾 Archived View for gmi.noulin.net › MANDEL3.PAS.gmi captured on 2024-08-18 at 17:23:09. Gemini links have been rewritten to link to archived content
⬅️ Previous capture (2023-09-28)
-=-=-=-=-=-=-
Program Mandel; Uses CRT,DOS; var X1,X2,Y1,Y2 :real; IncX,incY :real; Limite :byte; coul : array [1..64522] of byte; nom : string; reg : Registers; handle : word; Const BaseEcran = 320; HautEcran = 200; IncLigne = 1; IncColonne = 1; Pointeur:word = 1; PROCEDURE Initialisation; BEGIN CLRSCR; Writeln(' ':10,'ZOOM SUR L''ENSEMBLE DE MANDELBROT'); Writeln(' ':10,'=================================='); Gotoxy(1,10); writeln('Entrez une fenêtre carrée:'); Gotoxy(1,12); write('Intervalle sur l''axe réel ...... [X1 , X2] ? '); readln (X1,X2); write('Intervalle sur l''axe imaginaire [Y1 , Y2] ? '); readln (Y1,Y2); write('Nombre limite d''iteration ...... Limite ? '); readln (Limite); WriteLn; write('Nom du Fichier (5 Lettres Max) : ');READ(NOM); IncX :=(X2-X1)/BaseEcran; incY :=(Y2-Y1)/HautEcran; END; PROCEDURE MandelBrot; Var Ligne,Colonne,Compt :integer; P0,Q0,Module,X,Y,Aux :real; r:byte; BEGIN Colonne:=0; while Colonne<= BaseEcran do Begin P0:= X1+Colonne*IncX; Ligne:=0; while Ligne<=HautEcran do begin Q0:= Y1+Ligne*IncY; X:=0; Y:=0; Compt:=1; Module:=0; while (compt<= Limite) and (Module<4) do begin Aux:=X; X:=sqr(X)-sqr(Y)+P0; Y:=2*Y*Aux+Q0; Module:=sqr(X)+sqr(Y); Inc(compt); end; if Module>4 then begin r := Compt mod 256; coul[Pointeur]:=r; end else coul[Pointeur]:=0; inc(Pointeur); GotoXY(1,22);Write(Pointeur); Ligne:=Ligne+IncLigne; end; Colonne:=Colonne+IncColonne; end; END; PROCEDURE SauveTableau(dds,ssi : word); BEGIN reg.ax:=$3c00; reg.cx:= 0; reg.ds:=seg (nom); reg.dx:=ofs (nom)+1; intr($21,reg); handle:=reg.ax; reg.ds:=seg (nom); reg.dx:=ofs (nom)+1; reg.ax:=$3d42; intr($21,reg); handle:=reg.ax; reg.ax:=$4000; reg.ds:= dds; reg.dx:= ssi; { offset mém } reg.cx:= Pointeur; reg.bx:= handle; intr($21,reg); reg.ax:=$3e00; reg.bx:=handle; intr($21,reg); END; BEGIN Initialisation; Mandelbrot; nom := NOM +'.clr'+Chr(0); SauveTableau(seg (coul),ofs(coul)); END.