'===========================================================================
' Subject: MANDELBROT VIEWING PROGRAM         Date: 06-03-96 (20:04)       
'  Author: Douglas H. Lusher                  Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: EGAVGA.ABC
'===========================================================================
'>     By now you should know that I have managed to do repeated zoom
'>     using my own method in the MODEX version. But I would love to
'>     see what you come up in this regard.

'Well, it's still somewhat rough, but here it is.
'You will have to begin by entering values and computing a
'starting screen. When you save a screen, the values are saved
'along with it. Then you can load the file, move the cursor
'around the image, change the size of the cursor, etc. When
'you decide what you want to magnify, just press ENTER. Once
'that image is made, you can save it, reload it in the left
'window and magnify part of it, etc. It would certainly be
'possible - it would be pretty easy, in fact - to make it so
'that you could press a key and see the cursor on the new
'image without having to reload it, but I just haven't gotten
'that far yet. I'm not sure I will, either, I need to start
'giving some time to other projects, I'm afraid.

 CONST PgUpKey = -73, PgDnKey = -81
 CONST UpArrow = -72, DnArrow = -80
 CONST LArrow = -75, RArrow = -77
 CONST ENTER = 13, ESC = 27
 DEFSNG A-Z
 Abort% = 0: Disp$ = "##.#######"
 NumColors% = 16: Maxdwell! = 150

 Beginning:
 SCREEN 0: WIDTH 80
 COLOR 7, 1: CLS
 PRINT "Mandlebrot Viewing Program"
 PRINT
 DO
   PRINT "Begin with a [F]ile or by entering [V]alues? (F/V) ";
   LOCATE , , 1
   A$ = UCASE$(INPUT$(1))
   SELECT CASE A$
     CASE "F": PRINT A$
       INPUT "Enter file name: ", FileName$
       IF LEN(FileName$) THEN EXIT DO
     CASE "V": PRINT A$
       GOSUB GetCoords: IF Range! <> 0 THEN EXIT DO
     CASE CHR$(27): PRINT
       END
     CASE ELSE
       BEEP
   END SELECT
 LOOP

 SCREEN 12
 Size% = 304
 CursSize% = Size% \ 4
 TopMarg% = 12
 LeftMarg% = 332
 LINE (LeftMarg% - 1, TopMarg% - 1)-STEP(Size% + 1, Size% + 1), 8, B
 LeftMarg% = 4
 LINE (LeftMarg% - 1, TopMarg% - 1)-STEP(Size% + 1, Size% + 1), 8, B

 SELECT CASE A$
   CASE "F": GOSUB GetImageFromFile
   CASE "V": GOSUB GetImageFromValues
 END SELECT

 CursX% = LeftMarg%: CursY% = TopMarg% + Size% - 1
 GOSUB ResizeCursorArray
 GOSUB DrawCursor

 LOCATE 25, 2: PRINT "Use the arrow keys to move the cursor around";
 LOCATE 26, 2: PRINT "Use the PageUp & PageDn keys to resize the cursor";
 LOCATE 27, 2: PRINT "Press Enter to magnify the area within the cursor";

 DO
   DO WHILE LEN(INKEY$): LOOP
   CALL GetKeypress(Keycode%)
   SELECT CASE Keycode%
     CASE UpArrow
       Temp% = CursY% - 1
       IF Temp% - CursSize% >= TopMarg% THEN
         GOSUB EraseCursor: CursY% = Temp%: GOSUB DrawCursor
       ELSE BEEP
       END IF
     CASE DnArrow
       Temp% = CursY% + 1
       IF Temp% < TopMarg% + Size% THEN
         GOSUB EraseCursor: CursY% = Temp%: GOSUB DrawCursor
       ELSE BEEP
       END IF
     CASE LArrow
       Temp% = CursX% - 1
       IF Temp% >= LeftMarg% THEN
         GOSUB EraseCursor: CursX% = Temp%: GOSUB DrawCursor
       ELSE BEEP
       END IF
     CASE RArrow
       Temp% = CursX% + 1
       IF Temp% + CursSize% < LeftMarg% + Size% THEN
         GOSUB EraseCursor: CursX% = Temp%: GOSUB DrawCursor
       ELSE BEEP
       END IF
     CASE PgUpKey
       IF CursSize% < Size% \ 2 THEN
         GOSUB EraseCursor
         CursSize% = CursSize% + 1
         GOSUB ResizeCursorArray
         GOSUB DrawCursor
       END IF
     CASE PgDnKey
       IF CursSize% > 5 THEN
         GOSUB EraseCursor
         CursSize% = CursSize% - 1
         GOSUB ResizeCursorArray
         GOSUB DrawCursor
       END IF
     CASE ENTER
       Real! = Range! * ((CursX% - LeftMarg%) / Size%) + Real!
       Imag! = Range! * ((Size% - (CursY% - TopMarg%)) / Size%) + Imag!
       Range! = Range! * (CursSize% / Size%)
       LeftMarg% = 332
       GOSUB GetImageFromValues
       GOTO Beginning
     CASE ESC
       EXIT DO
   END SELECT
 LOOP
 SCREEN 0: WIDTH 80
 END

 GetImageFromFile:
 File% = FREEFILE
 OPEN FileName$ FOR BINARY AS #File%
   SEEK #File%, LOF(File%) - 11
   GET #File%, , Real!
   GET #File%, , Imag!
   GET #File%, , Range!
 CLOSE #File%
 GOSUB ShowCoords
 CALL BLOADnPUT(LeftMarg%, TopMarg%, FileName$)
 RETURN
 GetImageFromValues:
 GOSUB ShowCoords
 LOCATE 25, 1: PRINT SPC(79); " ";
 LOCATE 26, 1: PRINT SPC(79); " ";
 LOCATE 27, 1: PRINT SPC(79); " ";
 LOCATE 26, 22: PRINT "Please wait while image is created...";
 GOSUB CreateImage
 LOCATE 26, 1: PRINT SPC(79); " ";
 IF NOT Abort% THEN
   LOCATE 28, 1: INPUT "Enter file name: ", FileName$
   IF LEN(FileName$) THEN
     LOCATE 28, 1: PRINT SPC(79); " ";
     X1% = LeftMarg%: Y1% = TopMarg%
     X2% = LeftMarg% + Size% - 1: Y2% = TopMarg% + Size% - 1
     CALL GETnBSAVE(X1%, Y1%, X2%, Y2%, 12, FileName$)
     File% = FREEFILE
     OPEN FileName$ FOR BINARY AS #File%
       SEEK #File%, LOF(File%) + 1
       PUT #File%, , Real!
       PUT #File%, , Imag!
       PUT #File%, , Range!
     CLOSE #File%
   END IF
 END IF
 RETURN

 GetCoords:
 DO
   PRINT "The value of Real! must be between -2 and +2."
   INPUT "Enter a value for Real!: ", Real!
 LOOP UNTIL Real! >= -2 AND Real! <= 2
 DO
   PRINT "The value of Imag! must be between -2 and +2."
   INPUT "Enter a value for Imag!: ", Imag!
 LOOP UNTIL Imag! >= -2 AND Imag! <= 2
 DO
   PRINT "The value of Range! must be between 0 and 4."
   INPUT "Enter a value for Range!: ", Range!
 LOOP UNTIL Range! >= 0 AND Range! <= 4
RETURN

 ResizeCursorArray:
 Bytes% = ((CursSize% \ 8) + 1) * (CursSize% + 1) * 4 + 4
 REDIM CursArray%(Bytes% \ 2)
 RETURN

 DrawCursor:
 GET (CursX%, CursY% - CursSize%)-STEP(CursSize%, CursSize%), CursArray%
 LINE (CursX%, CursY%)-STEP(CursSize%, -CursSize%), 15, B
 Rl! = Range! * ((CursX% - LeftMarg%) / Size%) + Real!
 Ig! = Range! * ((Size% - (CursY% - TopMarg%)) / Size%) + Imag!
 Rg! = Range! * (CursSize% / Size%)
 R% = (TopMarg% + Size%) \ 16 + 2
 LOCATE R%, 43: PRINT "FracX = "; USING Disp$; Rl!;
 LOCATE R% + 1, 43: PRINT "FracY = "; USING Disp$; Ig!;
 LOCATE R% + 2, 43: PRINT "Range = "; USING Disp$; Rg!;
 RETURN

 EraseCursor:
 PUT (CursX%, CursY% - CursSize%), CursArray%, PSET
 RETURN

 ShowCoords:
 R% = (TopMarg% + Size%) \ 16 + 2
 C% = LeftMarg% \ 8 + 2
 LOCATE R%, C%: PRINT "FracX = "; USING Disp$; Real!;
 LOCATE R% + 1, C%: PRINT "FracY = "; USING Disp$; Imag!;
 LOCATE R% + 2, C%: PRINT "Range = "; USING Disp$; Range!;
 RETURN

 CreateImage:
 highdwell = 0
 Gap = Range / Size%
 AC = Real
 FOR X% = LeftMarg% TO LeftMarg% + Size% - 1
   AC = AC + Gap
   BC = Imag
   FOR Y% = TopMarg% + Size% - 1 TO TopMarg% STEP -1
     IF INKEY$ = CHR$(27) THEN Abort% = -1: EXIT FOR
     BC = BC + Gap
     AZ = 0
     BZ = 0
     Count% = 0
     Size! = 0
     WHILE (Size! < 4) AND (Count% < Maxdwell)
       Temp = AZ * AZ - BZ * BZ + AC
       BZ = 2 * AZ * BZ + BC
       AZ = Temp
       Size! = AZ * AZ + BZ * BZ
       Count% = Count% + 1
     WEND
     IF (Count% < Maxdwell) AND (Count% > highdwell) THEN highdwell = Count%
     IF Count% <> Maxdwell THEN
       Culler% = Count% MOD (NumColors% - 1) + 1
       PSET (X%, Y%), Culler%
     END IF
   NEXT
   IF Abort% THEN EXIT FOR
 NEXT
 RETURN

 SUB BLOADnPUT (X1%, Y1%, FileName$)
 Temp% = 0
 File% = FREEFILE
 OPEN FileName$ FOR BINARY AS File%
   GET #File%, 6, Temp%
 CLOSE File%
 Bytes& = Temp% AND &HFFFF&
 REDIM Image%(Bytes& \ 2)
 DEF SEG = VARSEG(Image%(0))
 BLOAD FileName$, VARPTR(Image%(0))
 PUT (X1%, Y1%), Image%
 DEF SEG
 END SUB

 SUB GetKeypress (Keycode%) STATIC
 DO: Ky$ = INKEY$: LOOP UNTIL LEN(Ky$)
 Keycode% = ASC(Ky$): IF Keycode% = 0 THEN Keycode% = -ASC(MID$(Ky$, 2))
 END SUB

 DEFSNG A-Z
 SUB GETnBSAVE (X1%, Y1%, X2%, Y2%, Mode%, FileName$)
 SELECT CASE Mode%
   CASE 1: BitsPerPixel% = 2: BitPlanes% = 1
   CASE 2: BitsPerPixel% = 1: BitPlanes% = 1
   CASE 7: BitsPerPixel% = 1: BitPlanes% = 4
   CASE 8: BitsPerPixel% = 1: BitPlanes% = 4
   CASE 9: BitsPerPixel% = 1: BitPlanes% = 4
     'in SCREEN 9, if EGA memory < 64K then BitPlanes% = 2
   CASE 11: BitsPerPixel% = 1: BitPlanes% = 1
   CASE 12: BitsPerPixel% = 1: BitPlanes% = 4
   CASE 13: BitsPerPixel% = 8: BitPlanes% = 1
   CASE ELSE: ERROR 5
 END SELECT
 X% = ABS(X2% - X1%) + 1    'number of pixel columns
 Y% = ABS(Y2% - Y1%) + 1    'number of pixel rows
 Bytes& = CLNG(((X% * BitsPerPixel%) + 7) \ 8) * Y% * BitPlanes% + 4
 IF Bytes& > 65535 THEN ERROR 5
 REDIM Image%(Bytes& \ 2)
 GET (X1%, Y1%)-(X2%, Y2%), Image%
 DEF SEG = VARSEG(Image%(0))
 BSAVE FileName$, VARPTR(Image%(0)), Bytes&
 DEF SEG
 END SUB