| Es parte de la publicación: | Next Fractal Explorer |
| Tamaño del archivo: | 10980 |
| md5: | 6c795ecabec0270685e7370670a7abf8 |
#program zm
1 REM This file - zm.bas - is part of Next Fractal Explorer
2 REM Next Fractal Explorer is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
3 REM
4 REM This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
5 REM
6 REM You should have received a copy of the GNU General Public License along with this program. If not, see https://www.gnu.org/licenses/
7 REM
8 REM to convert this to banked code LOAD zm.bas and then
9 REM BANK NEW tmpbnk: BANK tmpbnk LINE 1,9999: SAVE "zmbanked.bas" BANK tmpbnk: BANK tmpbnk CLEAR
10 DEFPROC ConfirmPlot(cpxmin,cpxmax,cpymin,cpymax,cpps,cpiters,cpsavefn$)
20 REM Use a text window to confirm the details of a new plot
30 REM and also allows the user to set the the plot size, number of iterations and filename
40 BANK uibnk PROC NewTextWin(6,2,3,20,26,5,1,1,1,6)
50 PRINT #6; AT 1,12; INK 7;"* Plot Details *"
60 PROC FormatFloat$(cpxmin,8) TO xmin$: PROC FormatFloat$(cpxmax,8) TO xmax$: PROC FormatFloat$(cpymin,8) TO ymin$: PROC FormatFloat$(cpymax,8) TO ymax$
70 PRINT #6; AT 3,1; INK 6; " Left : "; xmin$
80 PRINT #6; AT 4,1; INK 6; " Right : "; xmax$
90 PRINT #6; AT 5,1; INK 6; " Top : "; ymin$
100 PRINT #6; AT 6,1; INK 6; " Bottom : "; ymax$
110 @cploop:
120 PRINT #6; AT 8,1; INK 10; " Plot size : "; plotsizes(cpps,1);" x ";plotsizes(cpps,2);" "
130 PRINT #6; AT 9,1; INK 10; " Iterations : "; cpiters;" "
140 PRINT #6; AT 10,1; INK 10; " Filename : ";cpsavefn$;" "
150 newfn$=cpsavefn$
160 PRINT #6; AT 12,0; INK 7; " ----------------------------------------"
170 PRINT #6; AT 14,1; INK 4; " E : Set min/max values by hand"
180 PRINT #6; AT 15,1; INK 4; " p : Set plot size"
190 PRINT #6; AT 16,1; INK 4; " F : Set Filename"
200 PRINT #6; AT 17,1; INK 4; " S : Save values & begin plot"
210 PRINT #6; AT 18,1; INK 4; " C : Cancel changes"
220 REPEAT : REPEAT UNTIL INKEY$ <>""
230 kp$= INKEY$ : REPEAT : REPEAT UNTIL INKEY$ =""
240 IF kp$ ="p" OR kp$ ="P":
250 ON cpps: cpps=cpps: cpps=2: cpps=1
260 ENDIF
270 IF kp$ ="e" OR kp$ = "E":
280 REPEAT
290 PRINT #6; INK 6; AT 3,15;" "; AT 3,15;: INPUT #6; cpxmin
300 PRINT #6; INK 6; AT 4,15;" "; AT 4,15;: INPUT #6; cpxmax
310 WHILE cpxmin>=cpxmax
320 BANK iobnk PROC ErrorBeep()
330 REPEAT UNTIL cpxmin<cpxmax
340 REPEAT
350 PRINT #6; INK 6; AT 5,15;" "; AT 5,15;: INPUT #6; cpymin
360 PRINT #6; INK 6; AT 6,15;" "; AT 6,15;: INPUT #6; cpymax
370 WHILE cpymin>=cpymax
380 BANK iobnk PROC ErrorBeep()
390 REPEAT UNTIL cpymin<cpymax
400 ENDIF
410 IF kp$="F" OR kp$="f"
420 REPEAT
430 PRINT #6; AT 10,15;" "
440 PRINT #6; AT 10,15;: INPUT #6; newfn$
450 IF newfn$="" THEN BANK iobnk PROC ErrorBeep()
460 REPEAT UNTIL newfn$<>""
470 cpsavefn$=newfn$
480 ENDIF
490 IF kp$="s" OR kp$="S":
500 SPRITE PRINT 0
510 BANK uibnk PROC ClearL2(0,32)
520 ENDPROC = 1,cpxmin,cpxmax,cpymin,cpymax,cpps,cpiters,cpsavefn$
530 ENDIF
540 IF kp$="c" OR kp$="C":
550 SPRITE PRINT 0
560 ENDPROC = 0,0,0,0,0,0,0,"cancelled"
570 ENDIF
580 GO TO @cploop
590 ENDPROC
600 DEFPROC FormatFloat$(fnum,decimals)
610 REM convert a floating point number to a string with the required number of decimal places, but prepend a "+" to postive numbers.
620 fn$ = STR$ (fnum,10,decimals)
630 IF fnum>=0 THEN fn$="+"+fn$
640 ENDPROC =fn$
650 REM How to setup and use selection mode
660 REM SPRITE CLEAR
670 REM BANK NEW spritebank
680 REM PROC setupsprites(spritebank)
690 REM SPRITE PRINT 1
700 REM x=0:y=0:s=0
710 REM PROC SelectionLoop(8,6,1) TO x,y,s
720 REM
730 DEFPROC SetupSprites(sb,clr)
740 REM clr is the colour of the crosshairs
750 RESTORE
760 FOR f=0 TO 511
770 READ n: BANK sb POKE f,n
780 NEXT f
790 SPRITE BANK sb
800 REM sprite data
810 DATA clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr
820 DATA clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr,clr
830 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
840 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
850 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
860 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
870 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
880 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
890 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
900 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
910 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
920 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
930 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
940 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
950 DATA clr,clr,227,227,227,227,227,227,227,227,227,227,227,227,227,227
960 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
970 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
980 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
990 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1000 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1010 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1020 DATA 227,227,227,227,227,227,227,clr,clr,227,227,227,227,227,227,227
1030 DATA 227,227,227,227,227,227,227,clr,clr,227,227,227,227,227,227,227
1040 DATA 227,227,227,227,227,clr,clr,227,227,clr,clr,227,227,227,227,227
1050 DATA 227,227,227,227,227,clr,clr,227,227,clr,clr,227,227,227,227,227
1060 DATA 227,227,227,227,227,227,227,clr,clr,227,227,227,227,227,227,227
1070 DATA 227,227,227,227,227,227,227,clr,clr,227,227,227,227,227,227,227
1080 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1090 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1100 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1110 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1120 DATA 227,227,227,227,227,227,227,227,227,227,227,227,227,227,227,227
1130 ENDPROC
1140 DEFPROC DrawSelection(x,y,size,ps)
1150 REM draw the zoom selection area.
1160 REM x & y are the coordinates of the top left of the area and are in layer 2 coordinates, not sprite layer coordinates
1170 REM adjust coordinates for 256x192 plots
1180 IF ps=1 THEN x+=32:y+=32
1190 SPRITE 0,x,y,0,1
1200 SPRITE 1,x+size*32-16,y,0,9
1210 SPRITE 2,x+size*32/2-8,y+size*24/2-8,1,1 : REM middle one
1220 SPRITE 3,x,y+size*24-16,0,%@101
1230 SPRITE 4,x+size*32-16,y+size*24-16,0,%@1101
1240 ENDPROC
1250 REM
1260 DEFPROC SelectionLoop(tlx,tly,ssize,ps)
1270 LAYER 1,1
1280 PROC FirstRun() TO helpvis
1290 helpshown=helpvis
1310 SPRITE PRINT 1
1320 IF helpshown=0 THEN PROC DrawSelection (tlx,tly,ssize,ps)
1330 REPEAT
1340 REPEAT : REPEAT UNTIL INKEY$ <>""
1350 k$= INKEY$
1360 IF k$= "h" OR k$="H"
1370 helpvis= 1 - helpvis
1380 IF helpvis=1
1390 IF helpshown=0 THEN PROC ZoomHelp(): helpshown=1
1400 LAYER OVER 5
1410 ELSE
1420 LAYER OVER 0
1430 ENDIF
1440 ENDIF
1450 IF k$ = "-":
1460 IF ssize<>1:
1470 ssize-=1
1480 ELSE
1490 BANK iobnk PROC ErrorBeep()
1500 ENDIF
1510 ENDIF
1520 IF k$ ="+" AND ssize<>5:
1530 IF tlx+32*(ssize+1)<=plotsizes(ps,1) AND tly+24*(ssize+1)<=plotsizes(ps,2):
1540 ssize+=1
1550 ELSE
1560 BANK iobnk PROC ErrorBeep()
1570 ENDIF
1580 ENDIF
1590 IF k$ = CHR$ (9):
1600 IF tlx+(32*ssize)<plotsizes(ps,1)-8:
1610 tlx+=8
1620 ELSE
1630 BANK iobnk PROC ErrorBeep()
1640 ENDIF
1650 ENDIF
1660 IF k$= CHR$ (8):
1670 IF tlx >7:
1680 tlx-=8
1690 ELSE
1700 BANK iobnk PROC ErrorBeep()
1710 ENDIF
1720 ENDIF
1730 IF k$ = CHR$ (10):
1740 IF tly+(ssize*24)<plotsizes(ps,2)-6
1750 tly+=6
1760 ELSE
1770 BANK iobnk PROC ErrorBeep()
1780 ENDIF
1790 ENDIF
1800 IF k$= CHR$ (11):
1810 IF tly>5
1820 tly-=6
1830 ELSE
1840 BANK iobnk PROC ErrorBeep()
1850 ENDIF
1860 ENDIF
1870 IF k$="5":
1880 IF tlx<>0
1890 tlx-=1
1900 ELSE
1910 BANK iobnk PROC ErrorBeep()
1920 ENDIF
1930 ENDIF
1940 IF k$="8":
1950 IF tlx+(32*ssize)<plotsizes(ps,1)
1960 tlx+=1
1970 ELSE
1980 BANK iobnk PROC ErrorBeep()
1990 ENDIF
2000 ENDIF
2010 IF k$="6":
2020 IF tly+(24*ssize)<plotsizes(ps,2)
2030 tly+=1
2040 ELSE
2050 BANK iobnk PROC ErrorBeep()
2060 ENDIF
2070 ENDIF
2080 IF k$="7":
2090 IF tly>0
2100 tly-=1
2110 ELSE
2120 BANK iobnk PROC ErrorBeep()
2130 ENDIF
2140 ENDIF
2150 IF k$=" "
2160 REM change colour used by crosshair to random rgb3 value
2170 REG 67, %@0100001: REG 64,zmchcol: REG 68,% RND 255: REG 68,% RND 1
2180 BANK uibnk PROC SetPalette() : REM reload layer 1 palette
2190 ENDIF
2200 PROC DrawSelection(tlx,tly,ssize,ps)
2210 SPRITE MOVE INT
2220 REPEAT UNTIL k$="z"
2230 SPRITE PRINT 0
2240 ENDPROC = tlx,tly,ssize
2250 DEFPROC ZoomHelp()
2260 BANK uibnk PROC NewTextWin(6,1,2,22,28,5,1,1,10,1)
2270 PRINT #6; INK 3; AT 0,13;"* Zoom Mode Help *"
2280 PRINT #6; AT 2,1; INK 14; " Cursor keys : Move zoom area (big jump)"
2290 PRINT #6; AT 3,1; INK 14; " 5,6,7,8 : Move zoom area (small jump)"
2300 PRINT #6; AT 4,1; INK 14; " Space : Change crosshair colour"
2310 PRINT #6; AT 5,1; INK 14; " + : Increase zoom area"
2320 PRINT #6; AT 6,1; INK 14; " - : Decrease zoom area"
2330 PRINT #6; AT 7,1; INK 14; " H : Show/Hide this help"
2340 PRINT #6; AT 8,1; INK 14; " Z : Exit zoom mode and"
2350 PRINT #6; AT 9,1; INK 14; " confirm new plot"
2360 PRINT #6; AT 11,1; INK 1; " Handy tip: On the confirmation screen you"
2370 PRINT #6; AT 12,1; INK 1; " can manually input the plot coordinates"
2380 PRINT #6; AT 13,1; INK 1; " by pressing E."
2390 PRINT #6; AT 15,1; INK 1; " So, you can use an online plotter such as"
2400 PRINT #6; AT 16,1; INK 3; " sciencedemos.org.uk/mandelbrot.php"
2410 PRINT #6; AT 17,1; INK 1; " on a 'modern' computing device to quickly"
2420 PRINT #6; AT 18,1; INK 1; " find an interesting area, and then enter"
2430 PRINT #6; AT 19,1; INK 1; " the coordinates of it in NFE to see it"
2440 PRINT #6; AT 20,1; INK 1; " plotted in magnificent 8-bit glory!"
2450 ENDPROC
2460 DEFPROC FirstRun()
2470 REM if this is the first time using zoom mode, show zoom help
2480 REM returns 1 is zoomhelp is being shown, 0 otherwise
2490 ON ERROR PROC ZoomHelp(): LAYER OVER 5: DIM p(1): SAVE "zh" DATA p(): ENDPROC =1
2500 DIM p(1): LOAD "zh" DATA p()
2510 ENDPROC =0
