!
!  Fractals program for Vax and the Fred machines.
!  Comment out the appropriate bits when using the program.
!  Vax prog connects in a file into virtual memory, because of
!  problems with record boundaries. The APM uses Printsymbols.
!
%begin
      %system %string (255) %fn %spec ItoS (%integer v,p)

%string (255) aa,bb, OutFile

%integer Key, OffX, OffY, MaxCol, Infinity, i, j, k, Nxp, Nyq
%short PixelX, PixelY
%const %byte True = 1, False = 0
%byte KeyLook, B, Mon, Col, Type
%longreal xpMin, xpMax, yqMin, yqMax, 
          dxp, dyq, OldX, NewX, OldY, NewY, Xs, Ys,
          p, q, r, Xr, Yr, XYRatio


      %half %integer %array CM (0:255)
      %half %integer %name CMp

%routine PrintShort (%short P)
         PrintSymbol ((P >> 8) & 16_FF)
         PrintSymbol (P & 16_FF)
%end

%integer %function Fun(%integer x)
   x = 31-x&31
   x = x*x
   x = (x//45)&31
   %result = 31-x
%end

%routine Init
%integer i

%on %event 3,9 %start
   %if Keylook = True %start
    %if Event_Event = 9 %then PrintString ("Key not found") %c
                        %else PrintString ("Bad Key found")
   %finish %else PrintString ("File Error")
   Newline
   KeyLook = True
   -> Close
%finish

   Open Input (3,"Frac.Dat"); selectinput(0)
   Keylook = True
   PrintString ("Opened FRAC.DAT");Newline
   Prompt ("Which Picture (give key symbol) : "); Read (Key)
   Select Input (3)
   %cycle
      Read Symbol (b) %until b = '#'
      Skip Symbol %while Next Symbol = ' ' %or Next Symbol = '#'
      Read (i)
      %exit %if i = Key 
   %repeat
   Keylook = False
   Read (Type)
   Read (Infinity)
   Read (MaxCol)
   Read (xpMin)
   Read (xpMax)
   Xr = xpMax - xpMin
   Read (yqMin)
   Read (yqMax)
   Yr = yqMax - yqMin
   XYRatio = Xr/Yr
   %if Type = 1 %start
      Read (p)
      Read (q)
   %finish
   Keylook = False
Close:
   Close Input
   Select Input (0)
%end

!!%label cycle, exit, noexit1, noexit2
Init
%stop %if Keylook = True
OutFile = "O".ItoS(Key,0).".Pic"
Printstring("Writing to ".Outfile); newline

Newline
PrintString ("X:Y Ratio is "); Print (XYRatio,4,4);Newlines(2)
Prompt ("Scale by X or Y or both? (X/Y/B) : ")
Readsymbol (B) %and B = B & 95 %until B = 'Y' %or B = 'X' %or B = 'B'
%if B = 'X' %start
   Prompt ("Picture Width : "); Read (PixelX)
   PixelY = Int(PixelX / XYRatio)
   Newline; PrintString ("The file will be ");Write(PixelX,0)
   Printstring(" by ");Write(PixelY,0);PrintString(" pixels.");Newlines(2)
%elseif B = 'Y'
   Prompt ("Picture Height : "); Read (PixelY)
   PixelX = Int(PixelY * XYRatio)
   Newline; PrintString ("The file will be ");Write(PixelX,0)
   Printstring(" by ");Write(PixelY,0);PrintString(" pixels.");Newlines(2)
%else
   Prompt ("Picture Width : "); Read (PixelX)
   Prompt ("Picture Height : "); Read (PixelY)
%finish

dxp = Xr / (PixelX - 1)
dyq = Yr / (PixelY - 1)

Newline; Prompt ("Monitor ? (Y/N) : ")
Readsymbol (Mon) %and Mon = Mon & 95 %until Mon = 'Y' %or Mon = 'N'

      Open Output (3,OutFile)
      Select Output (3)


PrintShort (PixelX)
PrintShort (PixelY)
PrintShort (CM(i)) %for i = 0,1,255

      OffX = 0
      OffX = (688-PixelX)>>1 %if PixelX < 688
      OffY = 0
      OffY = (512-PixelY)>>1 %if PixelY < 512

%for Nxp = 0, 1, PixelX-1 %cycle
   %for Nyq = 0, 1, PixelY-1 %cycle

      %if Type = 1 %start
         OldX = xpMin + Nxp * dxp
         OldY = yqMin + Nyq * dyq
      %finishelsestart
         p = xpMin + Nxp * dxp
         q = yqMin + Nyq * dyq
         OldX = 0; OldY = 0
      %finish

      k = 0

      %cycle
         Xs = OldX*OldX
         Ys = OldY*OldY
         OldY = (OldX+OldX)*OldY + q
         OldX = Xs-Ys + p
         k = k + 1
         r = Xs + Ys
         Col = k&255 %and %exit %if r > Infinity
         Col = 0 %and %exit %if k = MaxCol
      %repeat

!!! %cycle
!!cycle:
!!! Xs = OldX*OldX
!!    *MOVE.L  oldx,D0
!!    *MOVE.L  D0,D1
!!    *JSR     FMUL
!!    *MOVE.L  D0,xs
!!! Ys = OldY*OldY
!!    *MOVE.L  oldy,D0
!!    *MOVE.L  D0,D1
!!    *JSR     FMUL
!!    *MOVE.L  D0,ys
!!! OldY = (OldX+OldX)*OldY + q
!!    *MOVE.L  oldx,D0
!!    *MOVE.L  D0,D1
!!    *JSR     FADD
!!    *MOVE.L  oldy,D1
!!    *JSR     FMUL
!!    *MOVE.L  q,D1
!!    *JSR     FADD
!!    *MOVE.L  D0,oldy
!!! OldX = Xs-Ys + p
!!    *MOVE.L  xs,D0
!!    *MOVE.L  ys,D1
!!    *JSR     FSUB
!!    *MOVE.L  p,D1
!!    *JSR     FADD
!!    *MOVE.L  D0,oldx
!!! k = k + 1
!!    *ADDQ.L  #1,k
!!! r = Xs + Ys
!!    *MOVE.L  xs,D0
!!    *MOVE.L  ys,D1
!!    *JSR     FADD
!!    *MOVE.L  D0,r
!!! Co*l = k&255 %and %exit %if r > Infinity
!!    *MOVE.L  infinity,D0
!!    *JSR     float
!!    *MOVE.L  r,D1
!!    *JSR     FSUB
!!    *BGE     noexit1
!!    *MOVE.L  k,D0
!!    *ANDI.L  #$00FF,D0
!!    *MOVE.B  D0,col
!!    *BRA     exit
!!noexit1:
!!! Col = 0 %and %exit %if k = MaxCol
!!    *MOVE.L  k,D0
!!    *CMP.L   maxcol,D0
!!    *BNE     noexit2
!!    *CLR.B   col
!!    *BRA     exit
!!noexit2:
!!! %repeat
!!    *BRA     cycle
!!exit:
      PrintSymbol (Col)


   %repeat

   %if Mon = 'Y' %start
      Select Output (0)
      Write (Nxp,3); Newline
      Select Output (3)
   %finish

%repeat

      Close Output
      Select Output (0)

%endofprogram