MODE 8 xres=@vdu%!208 yres=@vdu%!212 minx=-2.0 maxx=2.0 xrange=maxx-minx xstep=xrange/xres miny=-1.25 maxy=1.25 yrange=maxy-miny ystep=yrange/yres REM Reserve space for the assembly routine itself, making sure it's in its own 2K block to avoid cache thrashing. size% = 2048 DIM code% NOTEND AND 2047, code% size%-1 REM These are just dummy variables, while setting up the assembler nr=3.5 ni=1.5 cr=0.29 ci=0.01 mag%=0 temp=0.0 col%=TRUE fixed%=FALSE PROCAssJulia REM Set up a DIBsection for screen output, so we can write data to it directly DIM BITMAPINFOHEADER{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \ \ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \ \ ClrUsed%, ClrImportant%} DIM bmi{Header{} = BITMAPINFOHEADER{}, Palette%(255)} bmi.Header.Size% = DIM(BITMAPINFOHEADER{}) bmi.Header.Width% = @vdu%!208 bmi.Header.Height% = @vdu%!212 bmi.Header.Planes.l& = 1 bmi.Header.BitCount.l& = 8 REM We've made an 8 bit per pixel bitmap definition: define a palette to go with it SYS "CreateDIBSection", @memhdc%, bmi{}, 0, ^bits%, 0, 0 TO hbitmap% IF hbitmap% = 0 ERROR 100, "Couldn't create DIBSection" SYS "SelectObject", @memhdc%, hbitmap% TO oldhbm% SYS "DeleteObject", oldhbm% PROCSetColour(col%) CLS bytesperpixel% = bmi.Header.BitCount.l& DIV 8 bytesperline% = ((bmi.Header.Width% * bytesperpixel%) + 3) AND -4 REPEAT MOUSE x%,y%,z% IF NOT fixed% THEN cr=minx+x%*xstep/2 ci=miny+y%*ystep/2 PRINT TAB(0,0);cr,ci ELSE IF z%>0 THEN tx%=x% ty%=y% REPEAT MOUSE x%,y%,z% UNTIL z%=0 minx+=(tx%-x%)*xstep/2 maxx+=(tx%-x%)*xstep/2 miny+=(ty%-y%)*ystep/2 maxy+=(ty%-y%)*ystep/2 ENDIF ENDIF CALL code% SYS "InvalidateRect", @hwnd%, 0, 0 q$=INKEY$(0) CASE q$ OF WHEN "c","C":col%=NOT col%:PROCSetColour(col%) WHEN "f","F": fixed%=NOT fixed% WHEN CHR$(140): fixed%=TRUE minx+=xrange/4 maxx-=xrange/4 xrange=maxx-minx xstep=xrange/xres miny+=yrange/4 maxy-=yrange/4 yrange=maxy-miny ystep=yrange/yres WHEN CHR$(141): fixed%=TRUE minx-=xrange/4 maxx+=xrange/4 xrange=maxx-minx xstep=xrange/xres miny-=yrange/4 maxy+=yrange/4 yrange=maxy-miny ystep=yrange/yres ENDCASE UNTIL q$="q" OR q$="Q" QUIT : DEFPROCSetColour(col%) LOCAL i%,r%,g%,b% IF col% THEN FOR i% = 0 TO 255 r% = (i% MOD 16)*16 g% = (i% MOD 64)*4 b% = 255-i%/2 bmi.Palette%(i%) = b% + (g% << 8) + (r% << 16) NEXT ELSE FOR i% = 0 TO 255 bmi.Palette%(i%) = i% + (i% << 8) + (i% << 16) NEXT ENDIF SYS "SetDIBColorTable", @memhdc%, 0, 256, ^bmi.Palette%(0) ENDPROC : DEFPROCAssJulia LOCAL opt% FOR opt%=0 TO 2 STEP 2 P%=code% [ OPT opt% mov esi,[^yres] mov edx,[^bits%] fld tbyte [^miny] fstp tbyte [^ni] .yloop mov ecx,[^xres] fld tbyte [^minx] fstp tbyte [^nr] .xloop mov eax,0 fld tbyte [^ci] fld tbyte [^cr] fld tbyte [^nr] fst st3 fmul st0,st0 fstp st4 ;After this we have cr,ci,nr and nr2 in ST0-3, and 2 pushes fld tbyte [^ni] fst st5 fmul st0,st0 fstp st6 ;After this we have cr,ci,nr, nr2,ni and ni2 in ST0-5, and 2 pushes .lpt ;OK now we should be able to calculate the new values of nr, ni fld st2 fadd st0,st0 fmul st0,st5 fadd st0,st2 fstp st5 ;we should be in the same place, but with the new value of ni fld st3 fsub st0,st6 fadd st0,st1 fstp st3 ;After this we now have cr,ci, the new nr, the old nr2, the new ni, and the old ni2 in ST0-5, and 2 pushes fld st2 fmul st0,st0 fstp st4 ;now with new nr2, still 2 pushes fld st4 fmul st0,st0 fst st6 ;now with new ni2, now 3 pushes fadd st0,st4 ;gives magnitude squared fistp dword [^mag%] ;store it as an integer, so it can be read into a standard register and compared, Back to 2 pushes inc eax mov ebx,[^mag%] cmp ebx,4 ja esc cmp eax,255 jb lpt .esc ;Now we have the problem of popping the stack twice fstp tbyte [^temp] ;should pop cr into temp fstp tbyte [^temp] ;should pop ci into temp mov byte [edx],al add edx,[^bytesperpixel%] fld tbyte [^nr] fld tbyte [^xstep] faddp st1,st0 fstp tbyte [^nr] dec ecx jnz near xloop fld tbyte [^ni] fld tbyte [^ystep] faddp st1,st0 fstp tbyte [^ni] dec esi jnz near yloop ret ] NEXT opt% ENDPROC
MODE 8 xres=@vdu%!208 yres=@vdu%!212 julia%=1:PROCSetfieldJ REM Reserve space for the assembly routine itself, making sure it's in its own 2K block to avoid cache thrashing. size% = 2048 DIM code% NOTEND AND 2047, code% size%-1 REM These are just dummy variables, while setting up the assembler nr=3.5 ni=1.5 cr=0.29 ci=0.01 mag%=0 temp=0.0 col%=TRUE fixed%=FALSE PROCAssJulia REM Set up a DIBsection for screen output, so we can write data to it directly DIM BITMAPINFOHEADER{Size%, Width%, Height%, Planes{l&,h&}, BitCount{l&,h&}, \ \ Compression%, SizeImage%, XPelsPerMeter%, YPelsPerMeter%, \ \ ClrUsed%, ClrImportant%} DIM bmi{Header{} = BITMAPINFOHEADER{}, Palette%(255)} bmi.Header.Size% = DIM(BITMAPINFOHEADER{}) bmi.Header.Width% = @vdu%!208 bmi.Header.Height% = @vdu%!212 bmi.Header.Planes.l& = 1 bmi.Header.BitCount.l& = 8 REM We've made an 8 bit per pixel bitmap definition: define a palette to go with it SYS "CreateDIBSection", @memhdc%, bmi{}, 0, ^bits%, 0, 0 TO hbitmap% IF hbitmap% = 0 ERROR 100, "Couldn't create DIBSection" SYS "SelectObject", @memhdc%, hbitmap% TO oldhbm% SYS "DeleteObject", oldhbm% PROCSetColour(col%) CLS OFF bytesperpixel% = bmi.Header.BitCount.l& DIV 8 bytesperline% = ((bmi.Header.Width% * bytesperpixel%) + 3) AND -4 tcr=-5 tci=-5 REPEAT WAIT 0 MOUSE x%,y%,z% IF (NOT fixed%) AND julia% THEN cr=minx+x%*xstep/2 ci=miny+y%*ystep/2 IF cr<>tcr OR ci<>tci THEN changed%=TRUE PRINT TAB(0,0);cr,ci ELSE IF z%>0 THEN tx%=x% ty%=y% REPEAT MOUSE x%,y%,z% UNTIL z%=0 minx+=(tx%-x%)*xstep/2 maxx+=(tx%-x%)*xstep/2 miny+=(ty%-y%)*ystep/2 maxy+=(ty%-y%)*ystep/2 changed%=TRUE ENDIF ENDIF IF changed% THEN CALL code% changed%=FALSE tcr=cr tci=ci SYS "InvalidateRect", @hwnd%, 0, 0 ENDIF q$=INKEY$(0) CASE q$ OF WHEN "c","C":col%=NOT col%:PROCSetColour(col%):changed%=TRUE WHEN "f","F": fixed%=NOT fixed% WHEN "j","J": julia%=1:PROCSetfieldJ WHEN "m","M": julia%=0:PROCSetfieldM WHEN CHR$(140): fixed%=TRUE minx+=xrange/4 maxx-=xrange/4 xrange=maxx-minx xstep=xrange/xres miny+=yrange/4 maxy-=yrange/4 yrange=maxy-miny ystep=yrange/yres changed%=TRUE WHEN CHR$(141): fixed%=TRUE minx-=xrange/4 maxx+=xrange/4 xrange=maxx-minx xstep=xrange/xres miny-=yrange/4 maxy+=yrange/4 yrange=maxy-miny ystep=yrange/yres changed%=TRUE ENDCASE UNTIL q$="q" OR q$="Q" QUIT : DEFPROCSetColour(col%) LOCAL i%,r%,g%,b% IF col% THEN FOR i% = 0 TO 255 r% = (i% MOD 16)*16 g% = (i% MOD 64)*4 b% = 255-i%/2 bmi.Palette%(i%) = b% + (g% << 8) + (r% << 16) NEXT ELSE FOR i% = 0 TO 255 bmi.Palette%(i%) = i% + (i% << 8) + (i% << 16) NEXT ENDIF SYS "SetDIBColorTable", @memhdc%, 0, 256, ^bmi.Palette%(0) ENDPROC : DEFPROCSetfieldJ minx=-2.0 maxx=2.0 xrange=maxx-minx xstep=xrange/xres miny=-1.25 maxy=1.25 yrange=maxy-miny ystep=yrange/yres changed%=TRUE fixed%=FALSE ENDPROC : DEFPROCSetfieldM minx=-2.0 maxx=0.5 xrange=maxx-minx xstep=xrange/xres miny=-1.25 maxy=1.25 yrange=maxy-miny ystep=yrange/yres changed%=TRUE fixed%=FALSE ENDPROC : DEFPROCAssJulia LOCAL opt% FOR opt%=0 TO 2 STEP 2 P%=code% [ OPT opt% mov esi,[^yres] mov edx,[^bits%] fld tbyte [^miny] fstp tbyte [^ni] .yloop mov ecx,[^xres] fld tbyte [^minx] fstp tbyte [^nr] .xloop mov eax,[^julia%] cmp eax,0 jz mand fld tbyte [^ci] fld tbyte [^cr] jmp inloop .mand fld tbyte [^ni] fld tbyte [^nr] .inloop mov eax,0 fld tbyte [^nr] fst st3 fmul st0,st0 fstp st4 ;After this we have cr,ci,nr and nr2 in ST0-3, and 2 pushes fld tbyte [^ni] fst st5 fmul st0,st0 fstp st6 ;After this we have cr,ci,nr, nr2,ni and ni2 in ST0-5, and 2 pushes .lpt ;OK now we should be able to calculate the new values of nr, ni fld st2 fadd st0,st0 fmul st0,st5 fadd st0,st2 fstp st5 ;we should be in the same place, but with the new value of ni fld st3 fsub st0,st6 fadd st0,st1 fstp st3 ;After this we now have cr,ci, the new nr, the old nr2, the new ni, and the old ni2 in ST0-5, and 2 pushes fld st2 fmul st0,st0 fstp st4 ;now with new nr2, still 2 pushes fld st4 fmul st0,st0 fst st6 ;now with new ni2, now 3 pushes fadd st0,st4 ;gives magnitude squared fistp dword [^mag%] ;store it as an integer, so it can be read into a standard register and compared, Back to 2 pushes inc eax mov ebx,[^mag%] cmp ebx,4 ja esc cmp eax,255 jb lpt .esc ;Now we have the problem of popping the stack twice fstp tbyte [^temp] ;should pop cr into temp fstp tbyte [^temp] ;should pop ci into temp mov byte [edx],al add edx,[^bytesperpixel%] fld tbyte [^nr] fld tbyte [^xstep] faddp st1,st0 fstp tbyte [^nr] dec ecx jnz near xloop fld tbyte [^ni] fld tbyte [^ystep] faddp st1,st0 fstp tbyte [^ni] dec esi jnz near yloop ret ] NEXT opt% ENDPROC