############################################################################ # # File: chernoff.icn # # Subject: Program to imitate a Chernoff face # # Author: Jon Lipp # # Date: August 14, 1996 # ############################################################################ # # This file is in the public domain. # ############################################################################ # # This program displays a Chernoff face. # ############################################################################ # # Links: options, vidgets, vscroll, vbuttons, wopen, xcompat # ############################################################################ link options link vidgets, vscroll, vbuttons link wopen link xcompat global FH procedure main(args) local opts, font, wid, h local root, win, s1, s2, s3, s4, s5 opts := options(args, "f:wh") font := \opts["f"] wid := \opts["w"] h := \opts["h"] win := WOpen("label=popup dialogs demo", "size=" || (\wid | 425) || "," || (\h | 325)) | stop("*** can't open window") root := Vroot_frame(win) FH := WAttrib(win, "fheight") s1 := Vhoriz_scrollbar(root, 0, 50, win, eyes, 1, 90, , 10, 99, 1) s2 := Vhoriz_scrollbar(root, 0, 100, win, pupils, 2, 90, , 10, 99, 1) s3 := Vhoriz_scrollbar(root, 0, 150, win, nose, 2, 90, , 0, 25, 1) s4 := Vhoriz_scrollbar(root, 0, 200, win, smile, 2, 90, , 47, 32, 1) s5 := Vhoriz_scrollbar(root, 0, 250, win, face, 2, 90, , 250, 300, 1) # Vpane(root, 100, 10, win, , , 200, 200) VResize(root) put_label(root, s1, "eyes") put_label(root, s2, "pupils") put_label(root, s3, "nose") put_label(root, s4, "smile") put_label(root, s5, "face") eyes(s1.thumb, s1.callback.value) pupils(s2.thumb, s2.callback.value) nose(s3.thumb, s3.callback.value) smile(s4.thumb, s4.callback.value) face(s5.thumb, s5.callback.value) GetEvents(root, quit) end procedure quit(e) if e === "q" then stop() end procedure write_val(vid, val) GotoXY(vid.win, vid.ax-10, vid.ay-5) writes(vid.win, val||" ") end procedure put_label(root, sc, str) local x, l l := TextWidth(root.win, str) x := sc.ax+sc.aw-l VDraw(Vmessage(root, x, sc.ay-5-FH, root.win, str)) end procedure face(vid, val) local x1, y, x static faceval, ox1, oy write_val(vid, val) x1 := 250 - val/2 y := 150 - val/2 rev_on(vid.win) XDrawArc(vid.win, \ox1, \oy, \faceval, \faceval) rev_off(vid.win) XDrawArc(vid.win, x1, y, val, val) faceval := val ox1 := x1; oy := y end procedure eyes(vid, val) local x1, x2, y static eyeval, ox1, ox2, oy write_val(vid, val) x1 := 200 - val/2 x2 := 300 - val/2 y := 100 - val/2 rev_on(vid.win) XDrawArc(vid.win, \ox1, \oy, \eyeval, \eyeval) XDrawArc(vid.win, \ox2, \oy, \eyeval, \eyeval) rev_off(vid.win) XDrawArc(vid.win, x1, y, val, val) XDrawArc(vid.win, x2, y, val, val) eyeval := val ox1 := x1; ox2 := x2; oy := y end procedure pupils(vid, val) local x1, x2, y static pupilval, ox1, ox2, oy write_val(vid, val) x1 := 200 - val/2 x2 := 300 - val/2 y := 100 - val/2 rev_on(vid.win) XFillArc(vid.win, \ox1, \oy, \pupilval, \pupilval) XFillArc(vid.win, \ox2, \oy, \pupilval, \pupilval) rev_off(vid.win) XFillArc(vid.win, x1, y, val, val) XFillArc(vid.win, x2, y, val, val) pupilval := val ox1 := x1; ox2 := x2; oy := y end procedure smile(vid, val) static oldsmile write_val(vid, val) rev_on(vid.win) XDrawArc(vid.win, 185, 190, 130, 40, \oldsmile*360, (48-\oldsmile)*2*360) rev_off(vid.win) XDrawArc(vid.win, 185, 190, 130, 40, val*360, (48-val)*2*360) oldsmile := val end procedure nose(vid, val) static oldnose write_val(vid, val) rev_on(vid.win) DrawLine(vid.win, 250, 140, 275, 180+\oldnose, 250, 190) rev_off(vid.win) DrawLine(vid.win, 250, 140, 275, 180+val, 250, 190) oldnose := val end procedure rev_on(win) WAttrib(win, "reverse=on", "linewidth=3") end procedure rev_off(win) WAttrib(win, "reverse=off", "linewidth=1") end