!
!  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.
!
%control 0 ;!jhb
%begin
!{VAX} %include "Imp_Include:Connect.Inc"
{APM} %include "ng"
{APM} %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

!{VAX} %integer FileAddr,Count,Pages
!{VAX} %short %integer %array CM (0:255)
!{VAX} %short %integer %name CMp

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

%routine PrintShort (%short P)
{APM}    PrintSymbol ((P >> 8) & 16_FF)
{APM}    PrintSymbol (P & 16_FF)
!{VAX}    Byte Integer (Count) = (P>>8)&16_FF
!{VAX}    Byte Integer (Count+1) = P&16_FF
!{VAX}    Count = Count + 2
%end

%routine Mix CM (%integer C, %integer R, G, B)
   CM (C)=(R+G<<5+B<<10) & 16_FFFF
%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

   CM(0) = 0
   Mix CM (i,Fun(31-i&31),Fun(i&31),0) %for i = 1,1,31
   Mix CM (i,0,Fun(31-i&31),Fun(i&31)) %for i = 32,1,63
   Mix CM (i,Fun(i&31),0,Fun(31-i&31)) %for i = 64,1,95

   Mix CM (i,Fun(31-i&31),Fun(i&31),0) %for i = 96,1,127
   Mix CM (i,0,Fun(31-i&31),Fun(i&31)) %for i = 128,1,159
   Mix CM (i,Fun(i&31),0,Fun(31-i&31)) %for i = 160,1,191

   Mix CM (i,Fun(31-i&31),Fun(i&31),0) %for i = 192,1,223
   Mix CM (i,0,Fun(31-i&31),Fun(i&31)) %for i = 224,1,255

{APM} CMp == CM(0)
{APM} Update Colour Map (CMp)

   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

!OutFile = CliParam; OutFile = aa.bb %while OutFile -> aa.(" ").bb
!Prompt ("Output File : ") %and Read (OutFile) %if OutFile = ""
!
!%if OutFile -> aa.(".").bb %then OutFile = aa.".".bb %c
!                           %else OutFile = OutFile.".pic"

{APM} Setup
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)
%finish %elsec
%if B = 'Y' %start
   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)
%finish %else %start
   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'

{APM} Open Output (3,OutFile)
{APM} Select Output (3)

!{VAX} i = PixelX * PixelY + 516
!{VAX} Pages = i >> 9
!{VAX} Pages = Pages + 1 %if i & 512 # 0
!{VAX} Make File (OutFile,Pages,FileAddr)
!{VAX} Count = FileAddr

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

{APM} OffX = 0
{APM} OffX = (688-PixelX)>>1 %if PixelX < 688
{APM} OffY = 0
{APM} 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
         NewX = Xs-Ys + p
         NewY = 2*OldX*OldY + q
         k = k + 1
         r = Xs + Ys
         Col = k&255 %and %exit %if r > Infinity
         Col = 0 %and %exit %if k = MaxCol
         OldX = NewX; OldY = NewY
      %repeat

{APM} PrintSymbol (Col)
{APM} Colour (Col)
{APM} Plot (Nxp+OffX,Nyq+OffY)

!{VAX} Byte Integer (Count) = Col
!{VAX} Count = Count + 1

   %repeat

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

%repeat

{APM} Close Output
{APM} Select Output (0)

%endofprogram