!* * * * * * * * * *
!*   Starstruck    *
!* * * * * * * * * *
!by Michael South and Joyce Jones
!
!(original concept by michael south)
! innovative and creative changes by Joyce Jones

option nolet
plotsmall$="yes"

xfac=.975437
yfac=.967832 
!xfac=1
!yfac=1

library "pictlib*"
dim rainbow$(6)
call rbow(rainbow$())
!randomize
!plot 0,0;
!for eks=1 to 6
!print rainbow$(eks)
!set color rainbow$(eks)
!plot rnd,rnd;
!pause 2
!next eks


public coords(4,1),picname$(1),en,wholesetnum
open #13: name "starstruck.coords",org text
do while more #13
   line input #13:line$
   if line$<>"" then  en=en+1
loop
reset #13:begin
mat redim coords(en,4)
mat redim picname$(en)
for lupe=1 to en
    input #13:coords(lupe,1),coords(lupe,2),coords(lupe,3),coords(lupe,4),picname$(lupe)
    if picname$(lupe)="wholeset.pict" then wholesetnum=lupe
next lupe
reset #13:begin
close #13
!for lupe=1 to en
!picname$(lupe)="bigpicts:"&picname$(lupe)
!next lupe
set background color "black"
set color "white"
ask pixels xpix,ypix
 public left,right,top,bot,nboxes,filter$

 menu=1
 filter$="off"
maxit=300
filterlevel=200
 whichpic=wholesetnum


 nboxes= 8
public winxmin,winxmax,winymin,winymax,winheight,winwidth
open #2: screen ypix/xpix,1,0,.3
window #2
ask pixels xpix2,ypix2
set window -2,.75,-.5*(2.75)*(ypix2/xpix2),.5*(2.75)*(ypix2/xpix2)
set background color "black"

call cls(wholesetnum)
!call labels(menu)

open #1: screen .78,.99,.3,.57       !text window
set background color "black"
ask screen a,b,c,d
 x=o
set color rainbow$(mod(x,6)+1)
window #0

do
   call mouse_input(xmouse,ymouse)
   if left<xmouse and xmouse<right and bot<ymouse and ymouse<top then
      select case (ymouse-winymin)/winheight


      case .948830 to .995927     !clear 
           if menu=1 or menu=2 then
              call cls(whichpic)
              call labels(menu)
               skip=1
           end if
           if menu=3 then         !clear
              !clear and replot box options
           end if

      case .901733 to .948830
           if menu=1 or menu=2 then
              call cls(whichpic)  !
              call labels(menu)   !   clears screen and replots last
              !         set color x                             !   orbit
              window #1           !
              set color rainbow$(mod(x,6)+1)    !
              print "r=";ri       !
              print "i=";ii       !
           end if
      case .854636 to .901733
           if menu=1 then         !
              set color "white"   !show axes
              plot lines: 0,winymin;0,winymax     !
              plot lines: winxmin,0;winxmax,0     !
              for i=winxmin to winxmax step .1
                  if i-int(i)<.00001 and abs(i)>.05 then
                     plot lines: i,-.05;i,.05
                     plot lines: .05,i;-.05,i
                  else  if abs(abs (i-int(i))-.5)<.05 then
                     plot lines: i,-.03;i,.03
                     plot lines: .03,i;-.03,i

                  else  if abs(i)>.05 then
                     plot lines: i,-.01;i,.01
                     plot lines: .01,i;-.01,i

                  end if
              next i

              for n= -3 to 3
                  if n<>0 then
                     plot text, at n,-.1: str$(n)
                     plot text, at -.02, n: str$(n)
                     ask color now$
                     set color "white"
                     plot text, at .5,-.1: "0.5"
                     set color now$
                     plot text, at -.45,-.1: "-0.5"
                     plot text, at -1.5,-.1: "-1.5"
                     plot text, at -.02,-.5: "-0.5"
                     plot text, at -.02,.5: "0.5"
                  end if
              next n
               skip = 1
           end if
           if menu=2 then
              if filter$="on" then     !
                  filter$="off"     !    toggles filter
              else                !
                  filter$="on"      !
                  skip=1       !
              end if              !
              call labels(menu)   !
              window#1            !
              print "r=";ri       !
              print "i=";ii       !
           end if

      case .807539 to .854636
            selection= 4
           if menu=1 then         !grid (small)
              ask color now$
              set color "white"
              plot lines: 0,winymin;0,winymax     !
              plot lines: winxmin,0;.5,0
              set color mix(50) .2,.2,.2
              set color 50        !show axes

              for n=-20 to 2.75
                  if n<>0 then
                     plot lines: .2*n,winymin;.2*n,winymax
                  end if
              next n
              for i=-10 to 10
                  if i<>0 then
                     plot lines:  winxmin,.2*i;.5,.2*i
                  end if
              next i
              set color now$
               skip=1
           end if
           if menu = 2 then       !numerical input
              window#1            !
              set color rainbow$(mod(x,6)+1)    !
              input prompt "r= ":ri    !   puts in points directly
              input prompt "i= ":ii    !
           end if
      case .760442 to .807539
           if menu=1 then         !grid (large)
              ask color now$
              set color "white"
              plot lines: 0,winymin;0,winymax     !
              plot lines: winxmin,0;.5,0
              set color mix(50) .2,.2,.2
              set color 50        !show axes

              for n=-20 to 3
                  if n<>0 then
                     plot lines: .1*n,winymin;.1*n,winymax
                  end if
              next n
              for i=-15 to 15
                  if i<>0 then
                     plot lines:  winxmin,.1*i;.5,.1*i
                  end if
              next i
              set color now$
               skip=1
           end if
           if menu=2 then
              window #1           !   puts angle into equation of 
              set color rainbow$(mod(x,6)+1)    !   cardioid and plots orbit
              input prompt "angle (deg) ":a      !
               ri=.5*cos(a*2*pi/360)-.25*cos(2*a*2*pi/360)
               ii=.5*sin(a*2*pi/360)-.25*sin(2*a*2*pi/360)
           end if

      case .713345 to .760442
           if menu=1 then         !switch menus
               menu=2
              call labels(menu)
               skip=1
              exit select
           end if
           if menu=2 then
               menu=1
              call labels(menu)
               skip=1
           end if
      case .666248 to .713345
           if menu=1 then
           call cls(whichpic)
           call picture_pick(whichpic)      !other pictures
           call cls (whichpic)
              end if
           if menu=2 then 
              call calibrate(xfac,yfac)
              call cls(whichpic)
           end if 
           skip=1
      case .619145 to .666248
           if menu=1 then stop    !quit
           if menu=2 then         !change # of iter.
           ask color now$
           set color "white"
!             window #1           !
!              print "sorry--no help available."
!              print "(try the yellow pages)"
               clear
               print "Current number of iterations is ";maxit
               print "Current filter level is ";filterlevel
               print
               do 
               input prompt "Do you wish to change these? (y/n) ":yn$
               if lcase$(yn$)<>"y" and  lcase$(yn$)<>"n" then print "Please enter a ""y"" or ""n""." else exit do
               loop
               if lcase$(yn$)="y" then
                  do
                  input prompt "Please input the new number of interations: ":maxit
                  do
                  input prompt "Please input the new filter level (must be less than "&str$(maxit)&" ) ":filterlevel
                  loop until filterlevel<maxit
          
               print "Current number of iterations is ";maxit
               print "Current filter level is ";filterlevel

               do 
               input prompt "Is this okay? (y/n) ":yn$
               if lcase$(yn$)<>"y" and  lcase$(yn$)<>"n" then print "Please enter a ""y"" or ""n""." else exit do
               loop
               loop until lcase$(yn$)="y"
               end if 
                   
                  call cls(whichpic)
               skip=1
            set color now$
           end if
      case else
           print "yes, it does happen"
      end select




   else
       ri=xmouse
       ii=ymouse
      window #1
      set color rainbow$(mod(x,6)+1)

   end if

   window #0                      !graphics window
   set color rainbow$(mod(x,6)+1)
   if skip <> 1 then      plot points:ri,ii

    ro=ri
    io=ii
window #2
               set color rainbow$(mod(x,6)+1)
window #0

if skip<>1 then
   for l=1 to maxit

        rn=ro^2-io^2+ri
        in=2*ro*io+ii
       if filter$="off" or l>filterlevel then
          if int(l)=filterlevel then
             
             set color rainbow$(mod(x+1,6)+1)
          end if

!if skip<>1
             plot lines: ro,io;rn,in
             if whichpic<>wholesetnum then
               window #2
               plot lines: ro,io;rn,in
               window #0
             end if
!          end if
       end if
       if rn^2+in^2>4 then
           l=maxit+1           !quit if outside set
          if filter$="on" then
             window #1
             !                      set color "white"
             print "(blew up)"
          end if
       end if


        ro=rn
        io=in
   next l

    x=x+1
   set color rainbow$(mod(x,6)+1)
   window#1

      print "r=";ri
      print "i=";ii
end if

    skip=0
   set color rainbow$(mod(x,6)+1)
   window #0



loop

sub cls(whichpic)
   ask color now$ 
    window #0
    clear
    ask pixels xpix,ypix
     xminpict=coords(whichpic,1)
     xmaxpict=coords(whichpic,2)
     yminpict=coords(whichpic,3)
     ymaxpict=coords(whichpic,4)
    if picname$(whichpic)="wholeset.pict" then
       call set_frame(0,1,0,1)
!xpictbigedge=xminpict+1.02039*(xmaxpict-xminpict)
!ypictsmalledge=ymaxpict-1.0295*(ymaxpict-yminpict)
       set window xminpict,xminpict+(1/xfac)*(xmaxpict-xminpict),ymaxpict-(1/yfac)*(ymaxpict-yminpict),ymaxpict

    else
       call set_frame(0,(ypix/xpix),0,1)
      set window xminpict,xminpict+(xpix/ypix)*(xmaxpict-xminpict)*(1/xfac),ymaxpict-(1/yfac)*(ymaxpict-yminpict),ymaxpict
    end if
    call draw_pictfile(picname$(whichpic),1)
    set color "blue"
if picname$(whichpic)="wholeset.pict" then
   box lines xminpict,.5,yminpict,ymaxpict
   else
    box lines xminpict,xmaxpict,yminpict,ymaxpict
    end if
    call labels(menu)
if picname$(whichpic)<>"wholeset.pict" then
    ask color now$ 
  window #2

     set color "red"
           for t=0 to pi/3 step .02                      !cardioid
              let x=.5*cos(2*pi*t)-.25*cos(4*pi*t)
              let y=.5*sin(2*pi*t)-.25*sin(4*pi*t)
              plot lines: x,y;
           next t
           plot lines
                    box ellipse -1.25,-.75,-.25,.25      !period 2 lobe
    set color "blue"
    box lines xminpict,xmaxpict,yminpict,ymaxpict
  window #0
    set color now$
end if
set color now$
end sub

end
sub labels(menu)
    ask color colornow
    declare public left,right,top,bot,nboxes,filter$
    declare public winxmin,winxmax,winymin,winymax,winheight,winwidth
ask window winxmin,winxmax,winymin,winymax

 winwidth=winxmax-winxmin
 winheight=winymax-winymin

 left=winxmin+winwidth* .802276
 right=winxmin+winwidth* .992888
 bot=winymin+winheight* .619145
 top=winymin+winheight* .995927

!print left,right,top,bot,nboxes,filter$

    dim label$(8,2)
    set text justify "center","half"
     label$(1,1)="clear"
     label$(1,2)="clear"
     label$(2,1)="replot last"
     label$(2,2)="replot last"
     label$(3,1)="show axes"
    if filter$="on" then  notfilter$="off" else  notfilter$="on"
     label$(3,2)="turn filter "&notfilter$
     label$(4,1)="grid (large)"
     label$(4,2)="numerical input"
     label$(5,1)="grid (small)"
     label$(5,2)="angle input"
     label$(6,1)="other options"
     label$(6,2)="other options"
     label$(7,1)="other pictures"
     label$(7,2)="calibrate"
     label$(8,1)="quit"
     label$(8,2)="change # of iter."
    set color "white"



    box clear left,right,top-(top-bot)*(nboxes+1)/nboxes,top

    for eye=1 to nboxes
        box lines left,right,bot+(top-bot)*(eye-1)/nboxes,bot+(top-bot)*(eye)/nboxes
        plot text,at left+(right-left)/2,top-(eye-1/2)*(top-bot)/nboxes:label$(eye,menu)
    next eye
      plot text,at left+(right-left)/2,top-(eye-1/2)*(top-bot)/nboxes:"filter is "&filter$   
    set color colornow
end sub

sub mouse_input(xmouse,ymouse)
    do
       get mouse xmouse,ymouse,statmouse
       !             ! if xmouse<>oldxmouse or ymouse<>oldymouse then box clear winxmax-(winxmax-winxmin)/3.5,winxmax,winymin,winymin+(winymax-winymin)/20 
       !             plot text, at winxmax,winymin :"r= "&str$(xmouse)&" "&"i= "&str$(ymouse)
       !             oldxmouse=xmouse
       !             oldymouse=ymouse
       if statmouse=2 then exit do
    loop

end sub

! a not too quickly converging orbit
!.24872453826=ri
!.5013524130029=ii
!.14957
!.547232

sub rbow(rainbow$())
    mat read rainbow$
    data red,yellow,green,cyan,magenta,blue



    !data 215,17,11,4,77,185,183,180,162,174,140
    !for i=1 to 11
    !rainbow1(i)=mod(i-1,9)+1
    !print "anything";rainbow1(i)
    !next i
end sub
sub picture_pick(whichpic)
    whichpictemp=whichpic
    declare public en,coords(,),picname$(),wholesetnum
     picmenu=1
     call piccls
    call piclabels(picmenu)
    do
       call mouse_input(xmouse,ymouse)
       if left<xmouse and xmouse<right then
          select case (ymouse-winymin)/winheight

          case .917312 to .989817      !="clear"
               call piccls        !"clear"
               !piclabel$(2,1)="clear"
          case .844807 to .917312      !="show names"
               if picmenu=1 then
                  whichpic=whichpictemp
                  exit sub  !!piclabel$(2,2)="select"
                  
               end if
               if picmenu=2 then
                   for lupe=1 to en
                   plot text, at coords(lupe,1),coords(lupe,3):picname$(lupe)
                   next lupe
               end if
             case .772301 to .844807   !label$="more options"
                  if picmenu=1 then  picmenu=2 else  picmenu=1
                  call piclabels(picmenu)   !piclabel$="more options"
             case .699796 to .772301   
                  if picmenu=1 then    !="back to start"
!                      xminpict=-2
!                      xmaxpict=4/3
!                      yminpict=(xmaxpict-xminpict)*(ypix/xpix)/(-2)
!                      ymaxpict=-yminpict
                      whichpic=wholesetnum
                     exit sub
                  end if
                  if picmenu=2 then !="add my own pict"
                  ask color now$
                  set color "white"
                   print "You must edit the ""Starstruck.coords"" file--"
                   print "email msouth@ncsa.uiuc.edu for instructions"
                   set color now$
                   end if
             case .627291 to .699796   
                  if picmenu=1 then exit sub  !="no change"
                               
                            
                  if picmenu=2 then            !="name input"
                  do
                     input prompt "Enter the name of the PICT file":picchoice$
                       for lupe=1 to en
                       if picname$(lupe)=picchoice$ then
                          whichpic=lupe
                          exit sub
                       end if
                       next lupe
                     print "That name ("&picchoice$&") didn't match anything I had on file--"
                     input prompt "Want to try again? (y/n)":choice$
                  loop until lcase$(choice$)="n"
!next en

               end if
          case else
                missed=1
          end select
       end if

      for lieup=whichpic+1 to en
 !         print "checking"

          if coords(lieup,1)<xmouse and xmouse < coords(lieup,2) and coords(lieup,3)<ymouse and ymouse <coords(lieup,4) and lieup<>whichpictemp then
             ask color now$
             set color "blue"
             box lines xminlast,xmaxlast,yminlast,ymaxlast
             set color "white"
             box lines coords(lieup,1),coords(lieup,2),coords(lieup,3),coords(lieup,4)
             xminlast=coords(lieup,1)
             xmaxlast=coords(lieup,2)
             yminlast=coords(lieup,3)
             ymaxlast=coords(lieup,4)
             set color now$
             whichpictemp=lieup
             exit for
           end if
       next lieup
    loop

    sub piclabels(picmenu)
        dim piclabel$(2,5)
        ask color now$
        set color "white"
    ask window winxmin,winxmax,winymin,winymax
     winwidth=winxmax-winxmin
     winheight=winymax-winymin
     left=winxmin+winwidth* .802276
     right=winxmin+winwidth* .992888
     bot=winymin+winheight* .619145
     top=winymin+winheight* .995927

     nboxes= 5
        box clear left,right,bot-(top-bot)/nboxes,top
    for i=1 to nboxes
        box lines left,right,bot+(top-bot)*(i-1)/nboxes,bot+(top-bot)*(i)/nboxes
    next i

        set text justify "center","half"
         piclabel$(1,1)="clear"
         piclabel$(1,2)="select"
         piclabel$(1,3)="other options"
         piclabel$(1,4)="back to start"
         piclabel$(1,5)="keep same picture"

         piclabel$(2,1)="clear"
         piclabel$(2,2)="show names"
         piclabel$(2,3)="other options"
         piclabel$(2,4)="add my own to list"
         piclabel$(2,5)="name input"
!mat read piclabel$
!data clear,show names,other options,add my own to list,other menu
!data clear,select,other options,whole set,leave unchanged
        for eye=1 to nboxes
            plot text,at left+(right-left)/2,top-(eye-1/2)*(top-bot)/nboxes:piclabel$(picmenu,eye)
        next eye
        set color now$
    end sub
   sub piccls

!   call cls(whichpic)
    ask color now$
    set color "blue"
    for lalala=1 to en
     box lines coords(lalala,1),coords(lalala,2),coords(lalala,3),coords(lalala,4)
    next lalala
    set color now$
   end sub

end sub

sub calibrate(xfac,yfac)
!declare public whichpic
clear
ask color now$

ask back backcolor
set back "white"
ask pixels xpix,ypix
open #2: screen ypix/xpix+.01,1,.1,.89
window #0
set window 0,1,0,1

do until lcase$(done$)="y"
!call set_frame(0,ypix/(2*xpix),1/2,1)
!call draw_pictfile("redgrid.pict",1)
!set color "blue"
!box lines 0,ypix/(2*xpix),1/2,1
set color "red"
!for x=0 to ypix/(2*xpix) step ypix/(40*xpix)
!plot lines: x,1/2;x,1
!next x
!for y=1/2 to 1 step 1/40
!plot lines: 0,y;ypix/(2*xpix),y
!next y
!do until lcase$(done$)="y"

call set_frame(0,ypix/(xpix),0,1)
call draw_pictfile("redgrid.pict",1)
set color "blue"
box lines 0,xfac*ypix/(2*xpix),1-yfac,1
!set color "red"
for x=0 to xfac*ypix/(xpix) step xfac*ypix/(20*xpix)
plot lines: x,1-yfac;x,1
next x
for y=1-yfac to 1 step yfac*1/20
plot lines: 0,y;xfac*ypix/(xpix),y
next y
pause 1


box lines .9,1,.9,1
plot text, at .95,.95:"okay"

window #2
print"Two grids have just been"
print"plotted on the screen--a"
print"red grid and a blue grid."
print"If you only see one grid,"
print" then your computer is "
print"calibrated.  Click the "
print"""okay"" box in the top "
print"right corner."
print 
print"If you see two grids, "
print"click on the bottom "
print"right hand corner of "
print"the RED grid, then click"
print" okay."

window #0

          do
          call mouse_input(xmouse,ymouse)
          if xmouse<.9 or ymouse<.9  then
          set color backcolor
          plot oldx,oldy
          oldx=xmouse
          oldy=ymouse
          set color "green"
          plot oldx,oldy
          else 
          exit do
          end if
          loop
    if oldx=0 and oldy=0 then
      set back "black"
!      xfac,yfac=1
      exit sub
        end if

    clear
    call draw_pictfile("redgrid.pict",1)
    set color "blue"
    xfac=oldx/(ypix/(xpix))
    yfac=1-oldy

    for x=0 to xfac*ypix/(xpix) step xfac*ypix/(20*xpix)
    plot lines: x,1-yfac;x,1
    next x
    for y=1 to 1-yfac step -yfac*1/20
    plot lines: 0,y;xfac*ypix/(xpix),y
    next y
    window #2
    print "Is it calibrated well"
    input prompt "enough now? (y/n)":done$
    if done$="save" then
       open #7:name "calibration",org "text",create newold
       erase #7
       reset #7 :begin
       print #7:xfac,yfac
       close #7
       done$="y"
    end if
    window #0
    
loop


clear
set color now$
set back "black"
end sub