unit MinSenGraphics; {$R-} INTERFACE uses DOSSTUFF, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, MinSenData; const lifespancolors:boolean=true; (* const hmax=1000; agehmax=100; type sextype=(marked,empty,none,M,F,H,C); {marked=marked for death; empty; H=hermaphrodite; C=clonal} genome=byte; site=object sex :sextype; b :double; {gene for birthrate} g :genome; {treated as 8, 16, 32, or 64 1-0 bits} end; grid=array[0..ymaxx,0..xmaxx] of site; runresult=record time :longint; winner :sextype; bmr,dr :double; {bitmutrate and deathrate} end; runningrec=record time :longint; occ :double; proportion :array[f..c] of double; end; *) type {TLogiVscForm = class(TForm)} TLogiVscForm = class(TForm) StaticText1 :TStaticText; Button1 :TButton; StaticText2: TStaticText; StaticText3: TStaticText; StaticText4: TStaticText; Button2: TButton; Button3: TButton; StaticText5: TStaticText; procedure Button1Click(Sender: TObject); procedure Abort(Sender: TObject); procedure ToggleColorScheme(Sender: TObject); procedure Paint; override; procedure OnePixel(y,x :word); end; var LogiVscForm :TLogiVscForm; BitMap :TBitMap; (* const ngenes:byte=8 {8*sizeof(genome)}; abbrev:array[f..c] of char=('F','H','C'); var t :double; {time, in units of maxx*maxx daily cycles} Temperatur :double; medianm :double; s :grid; hist :array[0..hmax] of word; tenmillions :byte; bavg :double; olderocc,oldocc, occ :longint; maturity :longint; totalbirths :longint; typesum :array[f..c] of longint; proportion :array[f..c] of double; diversum,divers2sum, diversity :double; diversN, diversK :word; done :boolean; *) IMPLEMENTATION {$R *.DFM} const sexwon=clLime; asexwon=clRed; sexwinning=clGreen; asexwinning=clMaroon; neutral=clgray; red=22; green=33; orange=111; {more names in Help under TColorType} function ChooseColor(y,x :word):byte; {unsigned longint} var index :byte; f :double; h,ih :integer; {0..15 are dim colors, 240..255 are bright colors} {1,2,4 is red, green blue 15 is bright red 00001111 71 is bright red 01000111 192 is bright blue 11100000 48 and 56 are bright green 00011100 254 is bright turquoise 11111110 0 is black 15 is gray 11000000 is blue 00110000 is green 00000110 is red} {192..198 is a good range for blue..magenta} {384..391 is similar, but darker} begin {result:=(x div 8) + ((y div 8) shl 4); good test} if (lifespancolors) then begin if (evolvinglifespan) then begin h:=g[y,x].ls; ih:=round(7*(h-lowls)/(highls-lowls)); result:=192+ih; (* if (h<7) then result:=192 {blue} else if (h<22) then result:=48 {green} else if (h<50) then result:=198 {magenta} else result:=71; {red} *) end else {not evolvinglifespan} begin if (g[y,x].ls=immortal) then result:=71 {Red} else result:=192; {blue} end; end {lifespancolors} else begin {fitness colors} f:=2*FitFunc(y,x,g[y,x])/(avgafit+avgnafit); if (f<0.85) then result:=192 {blue} else if (f<0.90) then result:=193 else if (f<0.95) then result:=194 else if (f<1.00) then result:=195 else if (f<1.05) then result:=196 else if (f<1.10) then result:=197 else if (f<1.15) then result:=198 else result:=199; {magenta} end; (* empty : result:=0; none : result:=15; {grey} marked: result:=254; m : result:=192; {bright blue} f : result:=71; {red} h : result:=198; {magenta} c : result:=48; {green} *) end; procedure TLogiVscForm.OnePixel(y,x :word); const yellow:longint=255+ (255 shl 8); begin if (maxx>512) then Canvas.pixels[6+x div 4,10+y div 4]:=yellow else if (maxx>256) then Canvas.pixels[6+x div 2,10+y div 2]:=yellow else Canvas.pixels[6+x,10+y]:=yellow; end; procedure TLogiVscForm.Paint; const lastnsdeath :longint=0; lastsendeath:longint=0; lastt:int64=-1000; lastfittest:longint=0; fitgrow:double=0; var totaldeaths :int64; x,y :integer; P,PP :PByteArray; ratio :double; begin if (maxx<=128) then for y := 1 to maxx do begin P := BitMap.ScanLine[2*y-2]; for x := 1 to maxx do begin p[2*x-2]:=ChooseColor(y,x); p[2*x-1]:=p[2*x-2]; end; PP:=BitMap.ScanLine[2*y-1]; for x:=0 to pred(2*maxx) do pp[x]:=p[x]; end else if (maxx>=1024) then for y := 1 to 256 do begin P := BitMap.ScanLine[pred(y)]; for x := 1 to 256 do begin p[pred(x)]:=ChooseColor(4*y,4*x); end; end else if (maxx>=512) then for y := 1 to 256 do begin P := BitMap.ScanLine[pred(y)]; for x := 1 to 256 do begin p[pred(x)]:=ChooseColor(2*y,2*x); end; end else for y := 1 to maxx do begin P := BitMap.ScanLine[pred(y)]; for x := 1 to maxx do begin p[pred(x)]:=ChooseColor(y,x); end; end; Canvas.draw(6,10,BitMap); if (fittest>lastfittest+10) then begin fitgrow:=(fittest-lastfittest); fitgrow:=fitgrow*lsunit/(tt-lastt); lastt:=tt; lastfittest:=fittest; end; StaticText4.caption:='Fittest org '+itoa(fittest)+' Fitness growth rate: '+ftoanoE(fitgrow,6,3)+' (Cumulative=' + ftoanoE(fittest*lsunit/succ(tt),6,3)+')'; if (nagercount=0) then ratio:=10000 else ratio:=agercount/nagercount; if (evolvinglifespan) then StaticText3.caption:='t='+itoa(tt div lsunit)+' Avg LS: '+ftoaNoE(avgls,5,3)+' +/- '+ftoaNoE(stdls,5,3) else StaticText3.caption:='t='+itoa(tt div lsunit)+' Agers:Non-agers = '+ftoaNoE(ratio,6,3); if (lastnsdeath