Es parte de la publicación: | Next Fractal Explorer |
Tamaño del archivo: | 11773 |
md5: | 1c7eb0dd556ddd5fa095dd796c5affd0 |
#program nfe
2 REM Author: Matt Thompson, Copyright 2024
3 REM Except for the Mandlebrot plotting code which came from from https:/rosettacode.org/wiki/Mandelbrot_set#BASIC256
6 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.
7 REM
8 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.
9 REM
10 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/
11 REM
12 REM Thanks go to the developers of Nextbuild - https://github.com/em00k/NextBuild
13 REM Nextbuild allows the Mandelbrot plotting code to be compiled into Z80 assembly, giving a massive speedup!
14 REM
16 REM Begin ...
60 RUN AT 1: CLEAR 40959
65 v$="V0.6" : REM version number
70 ON ERROR PROC ErrorHandler()
80 REM reserve some banks for banked code
90 BANK NEW uibnk: BANK NEW iobnk: BANK NEW zmbnk: BANK NEW plotbnk: BANK NEW l2palbnk
105 zmchcol=64 : REM palette color used by zoom mode crosshairs
109 REM load banked code, the default palette, setup zoom mode sprites etc.
110 PROC StartUp(): LAYER OVER 1
130 xmin=-2.1: xmax=0.6: ymin=-1.35: ymax = 1.35 : REM these are the default values that produce the plot loaded on startup
150 REM define the available plot sizes
160 DIM plotsizes(2,2): REM each row is xsize,ysize
170 plotsizes(1,1)=256:plotsizes(1,2)=192
180 plotsizes(2,1)=320:plotsizes(2,2)=256
190 plotsize=1 : REM the default on startup is therefore 256x192
200 maxiter = 255: REM this allows the use of all 256 (0-255) layer 2 colours
220 REM General note: layer 1 is used for text window interface
230 REM General note: Layer 2 layer2 used for graphics
240 REM General note: LAYER OVER and clipping used to mix the two
310 PROC MainLoop()
315 REM exit NFE
320 LAYER 1,1: LAYER CLEAR : LAYER OVER 5: PAPER 7: CLS : PROC ReleaseBanks(): PAPER 6 : INK 4: PRINT AT 11,12;"Cheerio!" : GO TO %9999
330 DEFPROC ErrorHandler(): LAYER 1,1: LAYER OVER 5: LAYER CLEAR : myerror= ERROR : PAPER 0: CLS : PRINT AT 2,10; INK 7;"Error code = ": PRINT AT 4,0: FOR i=1 TO 7: PRINT INK i; myerror: NEXT i
340 ENDPROC
350 GO TO %9999
540 REM --------------------
550 DEFPROC Float2Str (fpn)
555 REM used to poke floating point strings into memory for the plotting routine
560 f$= STR$ (fpn)
570 WHILE LEN (f$)<12
580 f$=f$+" "
590 PRINT f$;" "; LEN (f$)
600 ENDPROC = f$
610 REM --------------------
620 DEFPROC PokeStr (f$,addr)
625 REM used to poke strings into memory for the plotting routine
630 FOR i=1 TO LEN (f$)
640 POKE addr+(i-1), CODE f$(i)
650 NEXT i
660 ENDPROC
670 REM *********************
680 DEFPROC RunCode()
685 REM runs the plotting code
690 start$= TIME $
700 RANDOMIZE USR 40960
710 end$= TIME $
715 REM start$ and end$ might be used in the future, but ae not at the moment
720 ENDPROC
730 REM *********************
740 DEFPROC LoadBankedCode (fn$,bnk)
750 REM bnk must have been initialised first ...
770 LOAD fn$ BANK bnk
790 ENDPROC
800 REM ********************
810 DEFPROC MainLoop()
820 LOCAL redrawmenu = 1
830 menuvis=1 : REM menu visibility
840 REPEAT
850 IF redrawmenu = 1:
860 LAYER OVER 1 : LAYER 1,1 : BANK 5 ERASE 0,6912,255: REM hide the redrawing
870 redrawmenu=0: BANK uibnk PROC NewTextWin (6,8,10,10,13,5,1,14,14,6)
880 PRINT #6; AT 0,5; INK 15;"* Menu *";
890 PRINT #6; INK 6; AT 2,1;"L - Load Plot"; AT 3,1;"P - Load Palette"; AT 4,1;"Z - Zoom mode"; AT 5,1;"M - Migraine mode"; AT 6,1;"T - Show/Hide menu"; AT 7,1;"A - About"; AT 8,1;"Q - Quit"
900 LAYER OVER 5
910 ENDIF
920 REPEAT : k$= INKEY$ : REPEAT UNTIL k$<>""
930 REM process key presses ...
940 IF k$<>"z" AND k$<>"Z" THEN GO TO @checkmkey
950 REPEAT : REPEAT UNTIL INKEY$ ="": REM wait for key release
960 LAYER OVER 0
965 REM enter zoom mode
970 BANK zmbnk PROC SelectionLoop (48,32,4,plotsize) TO selx,sely,selsize
980 msg$="x="+ STR$ (selx)+" y="+ STR$ (sely) + " size="+ STR$ (selsize): REM debug info
990 LAYER OVER 5
1000 BANK uibnk PROC SetL1Clip(0)
1010 REM Now calculate new xmin,xmax,ymin,ymax
1020 xstep= (xmax - xmin)/plotsizes(plotsize,1)
1030 ystep= (ymax - ymin)/plotsizes(plotsize,2)
1040 newxmin = xmin+(selx*xstep): newxmax = newxmin+32*(selsize)*xstep
1050 newymin = ymin+(sely*ystep): newymax = newymin+24*(selsize)*ystep
1060 REM get confirmation before beginning the plot ...
1070 BANK zmbnk PROC ConfirmPlot (newxmin,newxmax,newymin,newymax,plotsize,255,"zoom.mnd") TO dozoom,newxmin,newxmax,newymin,newymax,newplotsize,newiters,newsavefn$
1080 xmin=newxmin: xmax=newxmax:ymin=newymin:ymax=newymax:maxiters=newiters:plotsize=newplotsize
1090 BANK uibnk PROC SetL1Clip(0)
1095 REM if confirmed, plot the new values
1100 IF dozoom=1 THEN PROC Mandel(xmin,xmax,ymin,ymax,maxiters,plotsize,newsavefn$)
1110 redrawmenu=1
1120 k$="f"
1130 @checkmkey
1140 IF k$<>"m" AND k$<>"M" THEN GO TO @checklkey
1145 REM migraine mode
1150 PROC MMInfo(): REM show warning if necessary
1160 v=60000: LAYER 1,1: CLS : LAYER 2,1: LAYER OVER 3: RANDOMIZE USR v:
1170 LAYER 1,1: LAYER OVER 5: redrawmenu=1: BANK uibnk PROC SetPalette()
1180 @checklkey:
1190 IF k$<>"l" AND k$<>"L" THEN GO TO @checkpkey
1192 REM Load plot
1195 CD "Plots"
1200 BANK uibnk PROC SetL1Clip(0): .browse -t "mnd" -f -p "Select plot" fn$
1210 BANK iobnk PROC LoadPlot(fn$) TO p : CD "..": REM back to main dir
1212 plotsize=p(1):xmin=p(2):xmax=p(3)
1214 ymin=p(4):ymax=p(5):
1220 BANK uibnk PROC SetL1Clip(2)
1230 redrawmenu=1
1240 @checkpkey:
1250 IF k$<>"p" AND k$<>"P" THEN GO TO @checktkey
1252 REM Load palette
1255 CD "palettes"
1260 BANK uibnk PROC SetL1Clip(0): .browse -t "pal" -f -p "Select Palette file:" pf$
1265 LAYER OVER 1: REM hide layer 1 while the palette is loading
1280 BANK uibnk PROC LoadL2Pal(l2palbnk,pf$) TO colors
1281 REM BANK uibnk PROC SetL1Clip(2)
1285 CD ".."
1290 redrawmenu=1:
1300 LAYER 1,1: BANK uibnk PROC SetPalette(): LAYER OVER 5
1320 @checktkey:
1330 IF k$<>"t" AND k$<>"T" THEN GO TO @checkakey
1335 REM show/hide menu
1340 menuvis = 1 - menuvis
1350 IF menuvis=1:
1360 LAYER OVER 5
1370 ELSE
1380 LAYER OVER 0
1390 ENDIF
1400 REPEAT : REPEAT UNTIL INKEY$ =""
1402 @checkakey:
1404 IF k$<>"a" AND k$<>"A" THEN GO TO @checkqkey
1406 PROC ShowAbout()
1408 redrawmenu=1
1410 @checkqkey:
1420 REPEAT UNTIL k$="q" OR k$="Q"
1430 ENDPROC
1470 DEFPROC mandel (xmin, xmax, ymin, ymax, maxiter, ps, sfn$)
1480 REM first, convert min/max values to strings and poke them into memory
1490 PROC Float2Str(xmin) TO xmin$
1500 PROC Float2Str (xmax) TO xmax$
1510 PROC Float2Str (ymin) TO ymin$
1520 PROC Float2Str(ymax) TO ymax$
1530 PROC PokeStr(xmin$,43387)
1531 REM was PROC PokeStr(xmin$,44886)
1540 PROC PokeStr(xmax$,43399)
1541 REM wasPROC PokeStr(xmax$,44898)
1550 PROC PokeStr(ymin$,43411)
1551 REM wasPROC PokeStr(ymin$,44910)
1560 PROC PokeStr(ymax$,43423)
1561 REM was PROC PokeStr(ymax$,44922)
1570 BANK uibnk PROC SetL2Res(ps): BANK uibnk PROC CLSL2(ps,-1,maxiter)
1580 POKE 43435,255: REM maxiter
1581 REM was POKE 44935,ps-1: REM plotsize when plotting = 256x192, 1 = 320x256
1590 POKE 43436,ps-1: REM plotsize when plotting = 256x192, 1 = 320x256
1610 LAYER 2,1: LAYER OVER 0
1620 PROC RunCode(): REM let rip...
1630 BANK iobnk PROC saveplot (ps,xmin,xmax,ymin,ymax,maxiter,ps,"plots/"+sfn$)
1640 ENDPROC
1650 REM *********************
1660 DEFPROC StartUp()
1670 REM show the splash screen and load the banked BASIC libraries
1680 REM load ui procs first ..,
1685 LAYER OVER 5: LAYER 2,1: PAPER 4: CLS : LAYER 1,1: CLS : : LOAD "uibanked.bas" BANK uibnk
1691 RUN AT 3: LAYER 2,1: BANK uibnk PROC LoadL2Pal (l2palbnk,"palettes/default256.pal")
1692 LAYER OVER 5: BANK uibnk PROC SetL1Clip(0): BANK uibnk PROC SetPalette(): REM load Layer 1 palette
1694 BANK uibnk PROC NewTextWin (6,9,4,5,24,5,16,1,7,2)
1695 PRINT #6; INK 5; AT 2,2;"NEXT Fractal Explorer is Loading..."
1699 REM load default palette and the splash screen
1730 REM now load the rest of the code and show a message in a text window
1740 REM temporarily slow down. Antcipation is part of the fun...
1750 RUN AT 1
1800 PROC LoadbankedCode ("iobanked.bas", iobnk)
1820 PROC LoadBankedCode ("zmbanked.bas", zmbnk)
1840 PROC LoadBankedCode ("plotbanked.bas", plotbnk)
1845 REM load migraine mode machine code
1850 f$="rotate_pal.bin": LOAD f$ CODE 60000
1870 LOAD "mandelv3.bin" CODE 40960 : REM load the Mandelbrot assembly code..
1890 REM now setup sprites used in zoom mode
1900 RUN AT 3: SPRITE CLEAR : BANK NEW spritebnk: BANK zmbnk PROC SetupSprites(spritebnk,zmchcol): SPRITE PRINT 1: RUN AT 1
1905 LAYER 2,1: BANK uibnk PROC SetL2Res(1): LOAD "newfull.sl2" LAYER : LAYER 1,1: LAYER OVER 5: PAUSE 100
1910 PRINT #6 ; INK 4; AT 2,2;" Done! "
1920 PAUSE 75
1930 CLOSE # 6
1950 ENDPROC
1960 DEFPROC ReleaseBanks()
1970 REM Free the banks that we,ve used
1980 BANK uibnk CLEAR : BANK iobnk CLEAR : BANK zmbnk CLEAR : BANK spritebnk CLEAR
1990 BANK l2palbnk CLEAR
2000 ENDPROC
2050 DEFPROC MMInfo()
2060 REM show keys and photosensitivity warning for Migraine Mode
2061 REM but only if a file named "showMMInfo" is found
2063 DIM d(1)
2065 ON ERROR ENDPROC
2067 LOAD "showMMInfo" DATA d()
2070 BANK uibnk PROC NewTextWin (6,1,2,22,28,5,1,2,8,12)
2080 PRINT #6; AT 0,13; INK 4; "* Migraine Mode *"
2090 PRINT #6; AT 2,9; INK 2; "PHOTOSENSITIVITY WARNING"
2100 PRINT #6; AT 4,2; INK 2; "Migraine Mode contains rapidly flashing"
2110 PRINT #6; AT 5,2; INK 2; "colours that may make it unsuitable for "
2120 PRINT #6; AT 6,2; INK 2; "people with photosensitive conditions."
2130 PRINT #6; AT 8,6; INK 2; " User discretion is advised."
2140 PRINT #6; AT 10,7; INK 12;"Keys used in Migraine Mode"
2150 PRINT #6; AT 12,3;
2160 PRINT #6; AT 12,3; INK 12;" J - reduce colour cyling speed"
2170 PRINT #6; AT 13,3; INK 12;" K - increase color cycling speed"
2180 PRINT #6; AT 14,3; INK 12;" D - reverse colour cycling direction"
2190 PRINT #6; AT 15,3; INK 12;" R - exit Migraine Mode"
2200 PRINT #6; AT 17,3; INK 4; " Press M to start Migraine Mode now"
2210 PRINT #6; AT 18,3; INK 4; " Press Q to stop this panel being shown"
2220 PRINT #6; AT 19,3; INK 4; " again and to start Migraine Mode now."
2230 @mminfoloop:
2240 REPEAT : REPEAT UNTIL INKEY$ =""
2250 REPEAT :kp$= INKEY$ : REPEAT UNTIL kp$<>""
2260 IF kp$="Q" OR kp$="q"
2270 .rm "showMMInfo"
2280 ENDPROC
2290 ELSE IF kp$="m" OR kp$="M"
2300 ENDPROC
2310 ENDIF
2320 GO TO @mminfoloop
2400 DEFPROC CreateShowMMInfo()
2410 DIM d(1) : SAVE "showMMInfo" DATA d()
2420 ENDPROC
2500 DEFPROC ShowAbout()
2510 REM show info about NFE
2520 BANK uibnk PROC NewTextWin (6,5,4,14,24,5,1,2,8,12)
2530 PRINT #6; AT 0,4; INK 4;"* Next Fractal Explorer ";v$;" *"
2531 PRINT #6; AT 2,3; INK 12;"NFE is open source software, is "
2532 PRINT #6; AT 3,3; INK 12;"copyright 2024, and is released "
2533 PRINT #6; AT 4,3; INK 12;"under the GNU General Purpose "
2534 PRINT #6; AT 5,3; INK 12;"License 3."
2535 PRINT #6; AT 7,2; INK 14;" Home Page:"
2536 PRINT #6; AT 9,2; INK 2;" www.github.com/matt-thompson-uk/"
2537 PRINT #6; AT 10,2; INK 2;" Next-Fractal-Explorer"
2538 PRINT #6; AT 12,2; INK 10;"Press A again to close this message"
2600 @aboutloop:
2610 REPEAT : REPEAT UNTIL INKEY$ <>""
2620 k$= INKEY$
2630 REPEAT : REPEAT UNTIL INKEY$ =""
2640 IF k$<>"a" AND k$<>"A" THEN GO TO @aboutloop
2650 ENDPROC
9998 SAVE "nfe.bas"