Next Fractal Explorer: ui.txt

Es parte de la publicación: Next Fractal Explorer
Tamaño del archivo: 6258
md5: 0d628d9fd5487e65ec7bcd18407d836b
#program ui
   1 REM This file - ui.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 ui.bas and then
   9 REM BANK NEW tmpbnk: BANK tmpbnk LINE 1,9999: SAVE "uibanked.bas" BANK tmpbnk: BANK tmpbnk CLEAR
  10 DEFPROC ErrorMessage(msg$,y,x,h,w)
  20 REM Show an error message in a text window
  30 numcols=w*1.59
  40 PROC NewTextWin(6,y,x,h,w,5,1,14,14,12)
  50 PRINT #6; AT 0,((numcols/2)-4);"* Error *"
  60 PRINT #6; AT 2,(numcols/2)-(( LEN msg$)/2);Msg$
  70 PRINT #6; AT 4,(numcols/2)-14;"Press any key to continue..."
  80 REPEAT : REPEAT UNTIL INKEY$ <>""
  90 ENDPROC 
 100 DEFPROC ShowMessage(msg$,y,x,h,w)
 110 REM show a message in a text window
 120 numcols=w*1.59
 130 PROC NewTextWin(6,y,x,h,w,5,1,7,7,10)
 140 PRINT #6; AT 0,((numcols/2)-5);"* Message *"
 150 PRINT #6; AT 2,(numcols/2)-(( LEN Msg$)/2);Msg$
 160 PRINT #6; AT 4,(numcols/2)-14;"Press any key to continue..."
 170 REPEAT : REPEAT UNTIL INKEY$ <>""
 180 ENDPROC 
 190 DEFPROC ShowMessageCountdown (msg$,y,x,h,w,delay)
 200 REM show a message and a countdown to 0, in seconds..
 210 numcols=w*1.59
 220 PROC NewTextWin(6,y,x,h,w,5,1,9,9,3)
 230 PRINT #6; AT 0,((numcols/2)-5);"* Message *"
 240 FOR i=delay TO 0 STEP -1
 250 PRINT #6; AT 2,(numcols/2)-(( LEN Msg$)/2);Msg$;" ";i;"s ": PAUSE 50
 260 NEXT i
 270 ENDPROC 
 280 DEFPROC DebugMessage (msg$)
 290 PROC NewTextWin(6,8,2,5,28,5,14,2,2)
 300 PRINT #6; AT 2,2,msg$
 310 OPEN # 5, "debug.txt": PRINT #5;msg$: CLOSE # 5
 320 REPEAT : REPEAT UNTIL INKEY$ <>""
 330 ENDPROC 
 340 DEFPROC LoadL2Pal (pb,pf$)
 350 REM load a layer 2 palette (pf$) into bank pb
 360 LOAD pf$ BANK pb
 370 colors= BANK pb DPEEK 0
 380 LAYER 2,1: LAYER PALETTE 0: PALETTE DIM 9: PALETTE FORMAT colors-1
 390 LAYER PALETTE 0 BANK pb,2
 400 FOR i=0 TO colors-1: lsb= BANK pb PEEK (2+i*2): msb= BANK pb PEEK (3+i*2)
 410 REG 64,i: REG 68,lsb: REG 68,msb: NEXT i
 420 POKE 59990,colors-1: REM let mingraine mode know how many colors are in the palette 
 430 REM LAYER PALETTE 0 BANK pb,2 : REM layer palette 0 bank pb,2 only works the first time
 440 REM using reg to set colors works every time EXCEPT the first time
 450 REM so use both methods!
 460 ENDPROC = colors
 470 DEFPROC ClearL1 (attrcol)
 480 REM clear the contents of the layer 1 screen. attrcol = value to write to attribute area
 490 BANK 5 ERASE 0,6144,0: BANK 5 ERASE 6144,768,attrcol
 500 ENDPROC 
 510 REM 
 520 DEFPROC ClearL2 (bcol,clearval)
 530 REM clear layer2 256x192 screen. bcol = border color, clearval = value to be written to layer 2 memory
 540 BORDER bcol
 550 FOR %b=9 TO 11: BANK %b ERASE 0,16384, clearval: NEXT %b
 560 ENDPROC 
 570 DEFPROC ClearL2320 (clearval)
 580 FOR %b=9 TO 14: BANK %b ERASE 0,16384, clearval: NEXT %b
 590 ENDPROC 
 600 DEFPROC ClsL2 (res, clearval, numcolors)
 610 REM wrapper for two clear L2 procs.
 620 REM res = screen resolution, 1 for 256x192, 2 for 320x256
 630 REM clear val =value to be written to layer 2 memory. If -1 a random color is used..
 640 REM numcolors = the number of colours to select from
 650 REM assumes that the screen resolution has already been set....
 660 IF clearval=-1:
 670 RANDOMIZE : newclearval = 1 + INT ( RND * numcolors)
 680 ELSE 
 690 newclearval = clearval
 700 ENDIF 
 710 IF res = 1:
 720 PROC ClearL2 (0,newclearval)
 730 ELSE 
 740 PROC ClearL2320 (newclearval)
 750 ENDIF 
 760 ENDPROC 
 770 DEFPROC SetL1Clip(action,cx=0,cy=0,cw=0,ch=0)
 780 REM set the layer 1 clipping area
 790 REM action=1 -set the clip region using the values in cx,cy etc
 800 REM action=0 - reset the clip region so that all of layer 1 is shown
 810 REM action=2 - restore and set the last used clip region
 820 PRIVATE oldcx,oldcy,oldcw,oldch
 830 LAYER 1,1
 840 IF action=1:
 850 LAYER DIM cx,cy,cw,ch
 860 oldcx=cx: oldcy=cy: oldcw=cw: oldch=ch
 870 ELSE IF action= 0:
 880 LAYER DIM 0,0,255,191
 890 ELSE IF action=2:
 900 LAYER DIM oldcx,oldcy,oldcw,oldch
 910 ENDIF 
 920 ENDPROC 
 930 DEFPROC NewTextWin(chan,y,x,h,w,tw,clip,bc,pc,ic)
 940 REM create a new text window
 950 REM chan is the channel to use
 960 REM y,x,h,w,tw are the poisition, size, and text size of the window
 970 CLOSE # chan: REM in case the channel is already open
 980 REM for debug purposes PRINT INK 1; PAPER 8;wstr$
 990 wstr$ = "w>" + STR$ (y)+","+ STR$ (x)+","+ STR$ (h)+","+ STR$ (w) +","+ STR$ (tw)
1000 OPEN # chan,wstr$
1010 REM if clip>0 then the clipping region will be set to match the size and poisition of the window, with a one pixel border around it
1020 IF clip>0:
1030 PROC SetL1Clip(0):cx= (x*8)-1: cy=(y*8)-1:cw=cx+(w*8)+1: ch=cy+(h*8)+1: PAPER bc: PROC SetL1Clip(1,cx,cy,cw,ch)
1040 PRINT #chan; CHR$ 16; CHR$ ic; CHR$ 17; CHR$ pc; CHR$ 14
1050 ENDIF 
1060 ENDPROC 
1070 REM 
1080 DEFPROC SetPalette()
1090 REM sets the layer 1 palette - L1 must be active!
1100 LAYER PALETTE 0
1110 PALETTE DIM 8
1120 PALETTE FORMAT 15
1130 RESTORE %1160
1140 FOR %a=0 TO 15: READ p: LAYER PALETTE 0,%a,p: LAYER PALETTE 0,%a+128,p
1150 NEXT %a
1160 DATA @00101001,@01001001,@01001001,@01001101
1170 DATA @11111111,@11111111,@10110110,@10011011
1180 DATA @10010110,@01110010,@10101110,@11010001
1190 DATA @11111001,@10111001,@11001010,@11000111
1200 ENDPROC 
1210 DEFPROC SetL2Res(res)
1220 REM set Layer 2 screen res. Layer 2 must be active..
1230 REM res is 1 for 256x192, 2 for 320x256
1240 IF res = 1:
1250 REG 112,0: REG 28,1: REG 24,0: REG 24,255: REG 24,0: REG 24,191: REM switch to 256x192
1260 ELSE 
1270 REG 112,16: REG 28,1: REG 24,0: REG 24,159: REG 24,0: REG 24,255: REM switch to 320x256
1280 ENDIF 
1290 ENDPROC