Next Fractal Explorer: nfe.txt

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"