'******************************************************************
'* 
'*   Fractal 
'* 
'******************************************************************

'   This little program opens a screen and draws a fractal on it (at the 
'speed of a decomposing snail, but it does). 

'   Here we demonstrate the asl screen mode requester, and a backdrop
'window. It isnecessary to use a backdrop window for various reasons:
'Firstly, we need a window to attach the menus to, and give us an IDCMP
'port, and secondly, grphics drawn straight on a screen get trashed by 
'things lile menus.
'   The other note worthy point is the waythat IDCMP messages are checked
'while drawing the fractal, so the user can quit half way through. 

'******************************************************************

Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
Global PATH$,OSVER
Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH
Dim SCOLS(17)
Global SCOLS()
Global _MYSCREEN
Dim _FRACGADS(0)
Global _FRACGADS()
Global _FRACMENU,_FRACMENADD
Dim _FRACZOOM(1)
Global _FRACZOOM()
Global _FRACWIND

'** SMTAGS is the taglist created by the screen mode requester 
'   MYASLSM is the screen mode requester.
Global SMTAGS
Global MYASLSM

On Error Proc _CLEANUP

_INITIALIZE

'Create and call the screen mode requester 
J Tag SCRAPTAGS,1,Equ("ASLSM_TitleText"),J Make String("Select a screen mode to work on")
J Tag Equ("ASLSM_DoWidth"),True
J Tag Equ("ASLSM_DoHeight"),True
J Tag Equ("ASLSM_DoDepth"),True
J Tag Equ("ASLSM_MinDepth"),5
J Tag 0,0
MYASLSM=J Create Asl Requester(Equ("ASL_ScreenModeRequest"),SCRAPTAGS)

SMTAGS=J Screen Request(MYASLSM,SCRAPTAGS)
'remember to check the taglist in case the requester was cancelled.
If SMTAGS=0 Then _CLEANUP
'once called, we can free the requester since we don't need it again 
MYASLSM=J Free Asl Requester(MYASLSM)

_GUIDATA
_SETUPALL
_SETPORTS

'set up the palette and then draw the fractal
_CREATE_PALETTE
_DRAW_FRACTAL

Do 
   K=J Wait Message
   While K
      C=J Tag Data(_MESSLIST,1)
      If C=Equ("IDCMP_MENUPICK")
         _CLEANUP
      Else If C=Equ("IDCMP_REFRESHWINDOW")
         _DOREFRESH
      End If 
      K=J Next Message
   Wend 
Loop 

Procedure _CREATE_PALETTE
'This is straight from Palette.amos, it's explained there
Procedure _DO_SPREAD[FIRST,LAST]
   On Error Proc _CLEANUP
   
   'If the two colours are the same, or adjacent then quit the procedure. 
   If Abs(FIRST-LAST)<=1
      Pop Proc
   End If 
   
   'If FIRST is greater than LAST then swap them. This malkes sure the loop 
   'runs the right way. 
   If FIRST>LAST
      Swap FIRST,LAST
   End If 
   
   'First, get the colour values of the first and last colours. Also obtain 
   'the number of colours the spread will take place across (NC#).
   'Then take the difference in each colour component across the range to 
   'be spread, divided by the number of colours to spread across. 
   'Then, colour X in the spread is calculated by (for each component) the
   'value of the FIRST, plus X times the difference.
   If OSVER=>39
      CF=J Get Aga Colour(_MYSCREEN,FIRST)
      CL=J Get Aga Colour(_MYSCREEN,LAST)
      NC#=LAST-FIRST
      
      DR#=(J Aga Red(CL)-J Aga Red(CF))/NC#
      DG#=(J Aga Green(CL)-J Aga Green(CF))/NC#
      DB#=(J Aga Blue(CL)-J Aga Blue(CF))/NC#
      
      For N=1 To LAST-FIRST
         R=J Aga Red(CF)+DR#*N
         G=J Aga Green(CF)+DG#*N
         B=J Aga Blue(CF)+DB#*N
         L=J Make Aga Colour(R,G,B)
         J Aga Colour _MYSCREEN,FIRST+N,L
      Next N
   Else 
      CF=J Get Colour(_MYSCREEN,FIRST)
      CL=J Get Colour(_MYSCREEN,LAST)
      NC#=LAST-FIRST
      
      DR#=(J Red(CL)-J Red(CF))/NC#
      DG#=(J Green(CL)-J Green(CF))/NC#
      DB#=(J Blue(CL)-J Blue(CF))/NC#
      
      For N=1 To LAST-FIRST
         R=J Red(CF)+DR#*N
         G=J Green(CF)+DG#*N
         B=J Blue(CF)+DB#*N
         L=J Make Colour(R,G,B)
         J Colour _MYSCREEN,FIRST+N,L
      Next N
   End If 
   
End Proc

Procedure _DRAW_FRACTAL
   On Error Proc _CLEANUP
   
   'This routine was dredged up from some old code, and I haven't got 
   'the faintest idea what it does. Sorry. It does seem to work.
   J This Screen _MYSCREEN
   
   XSTP=8192/(SW/4) : YSTP=8192/(SH/4) : ITT=2^J Screen Depth-1
   SW=J Screen Width : SH=J Screen Height
   OX=SW/2 : OY=SH/2
   
   J This Window _FRACWIND
   
   For PY=0 To SH-1
      For PX=0 To SW-1
         X=(PX-OX)*XSTP
         Y=(PY-OY)*YSTP
         XX=X
         YY=Y
         For I=4 To ITT
            XXX=X
            X=(X^2-Y^2)/8192+XX
            Y=(2*XXX*Y)/8192+YY
            If(X^2)+(Y^2)>268435456
               Plot PX,PY,I
               Goto _QUITIT
            End If 
         Next I
         Plot PX,PY,4
         _QUITIT:
         K=J Next Message
         If K
            C=J Tag Data(_MESSLIST,1)
            If C=Equ("IDCMP_MENUPICK")
               _CLEANUP
            End If 
         End If 
      Next PX
   Next PY
   
End Proc


'proces created by Gadstools 

Procedure _INITIALIZE
Procedure _SETUPALL
Procedure _GUIDATA
'this routine has been changed to open the screen the user requested 
Procedure _MAKESCREEN[SC]
   On Error Proc _CLEANUP
   
   J Tag _SCRAPTAGS,1,Equ("SA_Overscan"),Equ("OSCAN_TEXT")
   J Tag Equ("SA_Font"),Leek(SC+Equ("sc_Font"))
   J Tag Equ("SA_Pens"),J Default Pens
   J Tag Equ("SA_Colors"),Varptr(SCOLS(0))
   J Tag Equ("SA_ShowTitle"),False
   J Tag Equ("TAG_MORE"),SMTAGS
   
   _MYSCREEN=J Open Screen(_SCRAPTAGS)
   
End Proc
Procedure _MAKEFRACGADS
Procedure _MAKEFRACWIND[SC]
Procedure _DOREFRESH
Procedure _SETPORTS
Procedure _FREEWIND[W,G,M,A,C]
Procedure _CLEANUP