path: root/tests/examplefiles/example.icon

############################################################################
#
#       File:     kaleid.icn
#
#       Subject:  Program to produce kaleidoscope
#
#       Author:   Stephen B. Wampler
#
#       Date:     May 2, 2001
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#    Lots of options, most easily set by with the interface after
#    startup.  The only one that isn't set that way is -wn where 'n' is
#    the size of the kaleidoscope window (default is 600 square).
#
#    Terminology (and options):
#
#       Window_size (-wN): How big of a display window to use.
#           At the current time, this can only be set via a
#           command line argument.
#
#       Density (-dN): How many circles per octant to keep on display
#           at any one time.  There is NO LIMIT to the density.
#
#       Duration (-lN): How long to keep drawing circles (measured in
#           in circles) once the density is reached.  There is NO LIMIT
#           to the duration.
#
#       MaxRadius (-MN): Maximum radius of any circle.
#
#       MinRadius (-mN): Preferred minimum radius.  Circles with centers
#           near the edge have their radii forced down to fit entirely
#           on the display
#
#       MaxOffset (-XN): Maximum offset from center of display (may wrap).
#
#       MinOffset (-xN): Minimum offset
#
#       Skew (-sN): Shift probability of placing a circle at a 'typical'
#           offset.
#
#       Fill (-F): Turns off filling the circles.
#
#       Clear (-C): After the duration, reduces density back to 0 before
#           quitting.
#
#       Random Seed: (-rN): Sets the random number seed.
#
# Thanks to Jon Lipp for help on using vidgets, and to Mary Camaron
#   for her Interface Builder.
#
############################################################################
#
#  Requires:  Version 9 graphics
#
############################################################################
#
#  Links:  vidgets, vslider, vtext, vbuttons, vradio, wopen, xcompat
#
############################################################################

link vidgets
link vslider
link vtext
link vbuttons
link vradio
link wopen
link xcompat

global Clear, fill, duration, density, maxoff, minoff
global maxradius, minradius, r_seed, skew, win_size, mid_win
global root, check1, mainwin, use_dialog
global draw_circle

global du_v, de_v, rs_v, sk_v

procedure main (args)

   draw_circle := DrawCircle

   init_globs()
   process_args(args)

   if \use_dialog then {        # have vidgets, so use them for args.
      mainwin := WOpen("label=Kaleidoscope", "width=404", "height=313", 
                       "font=6x12") |
                 stop ("bad mainwin")
      root := ui (mainwin)
      GetEvents (root, quit)
      }
   else {                       # just rely on command line arguments
      kaleidoscope(r_seed)
      }

end

procedure init_globs()

   duration := 500                    # set default characteristics
   density := 30
   win_size := 600
   minoff := 1
   maxradius := 150
   minradius := 1
   skew := 1
   fill := "On"
   draw_circle := FillCircle
   Clear := "Off"
   r_seed := map("HhMmYy", "Hh:Mm:Yy", &clock)
   # See if the Vidget library is available or not
   if \VSet then use_dialog := "yes"
            else use_dialog := &null

end

procedure process_args(args)
   local arg

   # really only needed if you don't use the dialog box
   every arg := !args do case arg[1+:2] of {
      "-w" : win_size := integer(arg[3:0])       # window size
      "-d" : density := integer(arg[3:0])        # density of circles
      "-l" : duration := integer(arg[3:0])       # duration
      "-M" : maxradius := integer(arg[3:0])      # maximum radius
      "-m" : minradius := integer(arg[3:0])      # minimum radius
      "-X" : maxoff := integer(arg[3:0])         # maximum offset
      "-x" : minoff := integer(arg[3:0])         # minimum offset
      "-s" : skew := numeric(arg[3:0])           # set skewedness
      "-F" : fill := &null                       # turn off fill
      "-C" : Clear := "yes"                      # turn on clear mode
      "-r" : r_seed := integer(arg[3:0])         # random seed
      "-h" : stop("usage: kal [-wn] [-dn] [-ln] [-Mn] [-mn] [-Xn] [-xn] _
                     [-sn] [-F] [-C] [-rn]")
      }
   # adjust parameters that depend on the window size...
   mid_win := win_size/2
   maxoff := win_size-1
end

# Lorraine Callahan's kaleidoscope program, translated into icon.
#  (some of the things she did were too sophisticated for me
#   to spend time to figure out, so the output is square instead of
#   round), and I use 'xor' to draw instead of writing to separate
#   bit planes.

global putcircle, clrcircle

procedure kaleidoscope(r)
   local colors

   # What colors to use?  This can be changed to whatever!
   colors := ["red","green","blue","cyan","magenta","yellow"]

   &window := WOpen("label=Kaleidoscope: 'q' quits", "width="||win_size,
                                  "height="||win_size, "bg=black")
   WAttrib("drawop=xor")

   # Create two *indentical* sequences of circles, one to use when
   #   when drawing, one for erasing.  (Since 'xor' is used to
   #   place them, these both just draw the circles!)

   putcircle := create {                # draws sequence of circles
      &random :=: r
      |{
       Fg(?colors)
       outcircle()
       &random <-> r
       }
      }

   clrcircle := create {                # erases sequence of circles
      &random :=: r
      |{
       Fg(?colors)
       outcircle()
       &random <-> r
       }
      }

   every 1 to density do @putcircle     # fill screen to density

   every 1 to duration do {             # maintain steady state
      @putcircle
      @clrcircle
      if *Pending(&window) > 0 then break
      }

   every (Clear == "On") & 1 to density do @clrcircle

   close(&window)
end


procedure outcircle()                   # select a circle at random,
local radius, xoff, yoff                #  draw it in kaleidoscopic form

        # get a random center point and radius
   xoff := (?(maxoff - minoff) + minoff) % mid_win
   yoff := (?(maxoff - minoff) + minoff) % mid_win
   radius := ?0 ^ skew
        # force radius to 'fit'
   radius := ((maxradius-minradius) * radius + minradius) %
             (mid_win - ((xoff < yoff)|xoff))

        # put into all 8 octants
   draw_circle(mid_win+xoff, mid_win+yoff, radius)
   draw_circle(mid_win+xoff, mid_win-yoff, radius)
   draw_circle(mid_win-xoff, mid_win+yoff, radius)
   draw_circle(mid_win-xoff, mid_win-yoff, radius)

   draw_circle(mid_win+yoff, mid_win+xoff, radius)
   draw_circle(mid_win+yoff, mid_win-xoff, radius)
   draw_circle(mid_win-yoff, mid_win+xoff, radius)
   draw_circle(mid_win-yoff, mid_win-xoff, radius)

   return
end


############################################################################
#
#   Vidget-based user interface -- developed originally using Mary
#       Camaron's XIB program.  Don't expect this to be very readable -
#       you should have to play with it!
#
############################################################################
procedure ui (win)
   local cv1, cv2, cv3, cv4
   local 
         radio_button2, 
         radio_button1, 
         text_input6, 
         text_input5, 
         slider4, 
         slider3, 
         text_input4, 
         text_input3, 
         slider2, 
         slider1 

   /win := WOpen("label=ui", "width=404", "height=313", "font=6x12") | 
           stop ("bad win")
   root := Vroot_frame (win)

   VInsert (root, Vmessage(win, win_size/2), 168, 98)
   VInsert (root, Vmessage(win, "1"), 108, 97)

   VInsert (root, sk_v := Vtext(win,"Skew:\\=1",get_skew,,6), 280, 39)

   VInsert (root, du_v := Vtext(win, "Duration:\\="||duration, get_duration,,9),
                237, 15)

   VInsert (root, Vmessage(win, "Clear at end?"), 232, 145)
   VInsert (root, Vmessage(win, "Fill?"), 105, 142)
   VInsert (root, Vmessage(win,"Quit?"), 267, 259)
   VInsert (root, Vmessage(win,"Display it?"), 26, 260)

   VInsert (root, Vcheckbox(win, do_quit, "check2",20), 305, 255, 20, 20)

   VInsert (root, check1:=Vcheckbox(win, do_display, "check1",20),
                106, 258, 20, 20)

   radio_button2 := Vradio_buttons (win, ["On", "Off"], get_clear, , V_CIRCLE)
   VSet(radio_button2,Clear)
   VInsert (root, radio_button2, 253, 165)

   radio_button1 := Vradio_buttons (win, ["On", "Off"], get_fill, , V_CIRCLE)
   VSet(radio_button1,fill)
   VInsert (root, radio_button1, 99, 165)

   cv1 := Vcoupler()
   VAddClient(cv1, get_max_offset)
   text_input6 := Vtext (win, "Max Offset:\\="||(win_size-1), cv1, , 3)
   VAddClient(cv1, text_input6)
   slider4 := Vhoriz_slider (win, cv1, "slider4", 70, 12, 0,
                         win_size-1, win_size-1, )
   VAddClient(cv1, slider4)
   VInsert (root, text_input6, 196, 103)
   VInsert (root, slider4, 306, 106)

   cv2 := Vcoupler()
   VAddClient(cv2, get_min_offset)
   text_input5 := Vtext (win, "Min Offset\\=1", cv2, , 3)
   VAddClient(cv2, text_input5)
   slider3 := Vhoriz_slider (win, cv2, "slider3", 70, 12, 1, win_size-1, 1, )
   VAddClient(cv2, slider3)
   VInsert (root, text_input5, 201, 80)
   VInsert (root, slider3, 307, 82)

   cv3 := Vcoupler()
   VAddClient(cv3, get_max_radius)
   text_input4 := Vtext (win, "Max Radius\\="||(win_size/4), cv3, , 3)
   VAddClient(cv3, text_input4)
   slider2 := Vhoriz_slider (win, cv3, "slider2", 70, 12, 1, win_size/2,
         win_size/4, )
   VAddClient(cv3, slider2)
   VInsert (root, text_input4, 10, 104)
   VInsert (root, slider2, 110, 108)

   cv4 := Vcoupler()
   VAddClient(cv4, get_min_radius)
   text_input3 := Vtext (win, "Min Radius\\=1", cv4, , 3)
   VAddClient(cv4, text_input3)
   slider1 := Vhoriz_slider (win, cv4, "slider1", 70, 12, 1, win_size/2, 1, )
   VAddClient(cv4, slider1)
   VInsert (root, text_input3, 10, 81)
   VInsert (root, slider1, 110, 84)

   VInsert (root, rs_v := Vtext(win,"Random Seed:\\="||r_seed, get_random,, 11),
              30, 41)
   VInsert (root, de_v := Vtext(win,"Density:\\="||density, get_density,,8),
              71, 16)

   VResize (root)
   return root
end

procedure get_skew (wit, value)
   skew := value
end

procedure get_duration (wit, value)
   duration := value
end

procedure do_quit (wit, value)
   stop()
end

procedure do_display (wit, value)
   r_seed   := numeric(rs_v.data)
   duration := integer(du_v.data)
   density  := integer(de_v.data)
   skew     := integer(sk_v.data)
   kaleidoscope(r_seed)
   wit.callback.value := &null
   VDraw(check1)
end

procedure get_clear (wit, value)
   Clear := value
end

procedure get_fill (wit, value)
   fill := value
   if fill == "Off" then draw_circle := DrawCircle
   else draw_circle := FillCircle
end

procedure get_max_offset (wit, value)
   maxoff := value
end

procedure get_min_offset (wit, value)
   minoff := value
end

procedure get_max_radius (wit, value)
   maxradius := value
end

procedure get_min_radius (wit, value)
   minradius := value
end

procedure get_random (wit, value)
   r_seed := integer(value)
end

procedure get_density (wit, value)
   density := integer(value)
end

procedure quit(e)
   if e === "q" then stop ("Exiting Kaleidoscope")
end