home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprogs / chernoff.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  170 lines
  1. ############################################################################
  2. #
  3. #    File:     chernoff.icn
  4. #
  5. #    Subject:  Program to imitate a Chernoff face
  6. #
  7. #    Author:   Jon Lipp
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  This program displays a Chernoff face.
  18. #
  19. ############################################################################
  20. #
  21. #  Links:  options, vidgets, vscroll, vbuttons, wopen, xcompat
  22. #
  23. ############################################################################
  24.  
  25. link options
  26. link vidgets, vscroll, vbuttons
  27. link wopen
  28. link xcompat
  29.  
  30. global FH
  31.  
  32. procedure main(args)
  33. local opts, font, wid, h
  34. local root, win, s1, s2, s3, s4, s5
  35.  
  36.    opts := options(args, "f:wh")
  37.    font := \opts["f"]
  38.    wid := \opts["w"]
  39.    h := \opts["h"]
  40.  
  41.    win := WOpen("label=popup dialogs demo",
  42.       "size="  ||  (\wid | 425)  ||  "," || (\h | 325)) |
  43.       stop("*** can't open window")
  44.  
  45.    root := Vroot_frame(win)
  46.  
  47.    FH := WAttrib(win, "fheight")
  48.  
  49.    s1 := Vhoriz_scrollbar(root, 0, 50, win, eyes, 1, 90, , 10, 99, 1)
  50.    s2 := Vhoriz_scrollbar(root, 0, 100, win, pupils, 2, 90, , 10, 99, 1)
  51.    s3 := Vhoriz_scrollbar(root, 0, 150, win, nose, 2, 90, , 0, 25, 1)
  52.    s4 := Vhoriz_scrollbar(root, 0, 200, win, smile, 2, 90, , 47, 32, 1)
  53.    s5 := Vhoriz_scrollbar(root, 0, 250, win, face, 2, 90, , 250, 300, 1)
  54.  
  55. #   Vpane(root, 100, 10, win, , , 200, 200)
  56.  
  57.    VResize(root)
  58.    put_label(root, s1, "eyes")
  59.    put_label(root, s2, "pupils")
  60.    put_label(root, s3, "nose")
  61.    put_label(root, s4, "smile")
  62.    put_label(root, s5, "face")
  63.    eyes(s1.thumb, s1.callback.value)
  64.    pupils(s2.thumb, s2.callback.value)
  65.    nose(s3.thumb, s3.callback.value)
  66.    smile(s4.thumb, s4.callback.value)
  67.    face(s5.thumb, s5.callback.value)
  68.  
  69.    GetEvents(root, quit)
  70. end
  71.  
  72.  
  73. procedure quit(e)
  74.    if e === "q" then stop()
  75. end
  76.  
  77. procedure write_val(vid, val)
  78.    GotoXY(vid.win, vid.ax-10, vid.ay-5)
  79.    writes(vid.win, val||"  ")
  80. end
  81.  
  82. procedure put_label(root, sc, str)
  83.    local x, l
  84.  
  85.    l := TextWidth(root.win, str)
  86.    x := sc.ax+sc.aw-l
  87.    VDraw(Vmessage(root, x, sc.ay-5-FH, root.win, str))
  88. end
  89.  
  90. procedure face(vid, val)
  91.    local x1, y, x
  92.    static faceval, ox1, oy
  93.  
  94.    write_val(vid, val)
  95.    x1 := 250 - val/2
  96.    y := 150 - val/2
  97.    rev_on(vid.win)
  98.    XDrawArc(vid.win, \ox1, \oy, \faceval, \faceval)
  99.    rev_off(vid.win)
  100.    XDrawArc(vid.win, x1, y, val, val)
  101.    faceval := val
  102.    ox1 := x1; oy := y
  103. end
  104.  
  105. procedure eyes(vid, val)
  106.    local x1, x2, y
  107.    static eyeval, ox1, ox2, oy
  108.  
  109.    write_val(vid, val)
  110.    x1 := 200 - val/2
  111.    x2 := 300 - val/2
  112.    y := 100 - val/2
  113.    rev_on(vid.win)
  114.    XDrawArc(vid.win, \ox1, \oy, \eyeval, \eyeval)
  115.    XDrawArc(vid.win, \ox2, \oy, \eyeval, \eyeval)
  116.    rev_off(vid.win)
  117.    XDrawArc(vid.win, x1, y, val, val)
  118.    XDrawArc(vid.win, x2, y, val, val)
  119.    eyeval := val
  120.    ox1 := x1; ox2 := x2; oy := y
  121. end
  122.  
  123. procedure pupils(vid, val)
  124.    local x1, x2, y
  125.    static pupilval, ox1, ox2, oy
  126.  
  127.    write_val(vid, val)
  128.    x1 := 200 - val/2
  129.    x2 := 300 - val/2
  130.    y := 100 - val/2
  131.    rev_on(vid.win)
  132.    XFillArc(vid.win, \ox1, \oy, \pupilval, \pupilval)
  133.    XFillArc(vid.win, \ox2, \oy, \pupilval, \pupilval)
  134.    rev_off(vid.win)
  135.    XFillArc(vid.win, x1, y, val, val)
  136.    XFillArc(vid.win, x2, y, val, val)
  137.    pupilval := val
  138.    ox1 := x1; ox2 := x2; oy := y
  139. end
  140.  
  141. procedure smile(vid, val)
  142.    static oldsmile
  143.  
  144.    write_val(vid, val)
  145.    rev_on(vid.win)
  146.    XDrawArc(vid.win, 185, 190, 130, 40, \oldsmile*360, (48-\oldsmile)*2*360)
  147.    rev_off(vid.win)
  148.    XDrawArc(vid.win, 185, 190, 130, 40, val*360, (48-val)*2*360)
  149.    oldsmile := val
  150. end
  151.  
  152. procedure nose(vid, val)
  153.    static oldnose
  154.  
  155.    write_val(vid, val)
  156.    rev_on(vid.win)
  157.    DrawLine(vid.win, 250, 140, 275, 180+\oldnose, 250, 190)
  158.    rev_off(vid.win)
  159.    DrawLine(vid.win, 250, 140, 275, 180+val, 250, 190)
  160.    oldnose := val
  161.  
  162. end
  163.  
  164. procedure rev_on(win)
  165.    WAttrib(win, "reverse=on", "linewidth=3")
  166. end
  167. procedure rev_off(win)
  168.    WAttrib(win, "reverse=off", "linewidth=1")
  169. end
  170.