home *** CD-ROM | disk | FTP | other *** search
- ############################################################################
- #
- # File: graphdem.icn
- #
- # Subject: Program to demonstrate simple bar graphics
- #
- # Author: Matthias Heesch
- #
- # Date: September 28, 1992
- #
- ###########################################################################
- #
- # graph.icn: simple bar graphics package with two demo applications:
- # 1. display the 4 most frequently used characters in a string.
- # 2. display the fibonacci numbers
- #
- ############################################################################
- #
- # Requires: ANSI terminal support
- #
- ############################################################################
-
- procedure main()
- local option
-
- write("graph: simple bar graphics package for icon")
- write("(b)yte frequency count or (f)ibonacci's numbers?")
- option := read()
- case option of {
- "b" : countdemo()
- "f" : fibodemo()
- default : write("erroneous option")
- }
- end
- #
- procedure countdemo()
- local numlist, line, a, ms, b
-
- numlist := list(0)
- write("type strings or quit using end-of-file")
- while line := read() do {
- a := frequ_count(line,4)
- ms := a
- a ? {
- while b := tab(upto(";")) do {
- b ? {
- tab(upto(","))
- move(1)
- b := tab(0)
- }
- move(1)
- put(numlist,b)
- }
- }
- graph(numlist,("the most frequently used characters: " || ms))
- }
- end
- #
- procedure frequ_count(lin,item_number)
- local result, n, byte_frequency_1, byte_frequency_2, byte, entry
-
- result := ""
- n := 1
- byte_frequency_1 := table(0)
- every byte := !lin do {
- byte_frequency_1[byte] +:= 1
- }
- byte_frequency_2 := sort(byte_frequency_1,2)
- while n <= item_number do {
- entry := pull(byte_frequency_2)
- result := result || pop(entry) || "," || pull(entry) || ";"
- n +:= 1
- }
- return result
- end
- #
- # fibodemo(): calls user defined function fibo(n,m): fibodemo() will
- # use an ansi escape code to clear the screen after every call to
- # graph. therefore when using ms/dr dos the config.sys file should
- # contain: device=ansi.sys. using other operating systems, the line
- # containing the esc-code should be deleted.
- procedure fibodemo()
- local a, l, b, fb
-
- while every a := fibo(0,1) & a < 10000 do {
- l := list(4,0)
- # delete the following line if you don't use ms/dr dos
- write(char(27),"[2J")
- l[1] := a
- graph(l,("fibo: " || a || ". <enter> to continue"))
- b := read()
- }
- end
- #
- procedure fibo(m,n)
- local fb
-
- while n < 30000 do {
- fb := m + n
- m := n
- n := fb
- suspend fb
- }
- end
- #
- # graph(numbers,comment): bar graphics function which accepts a list
- # of 4 integers 10000 and a commentary message. it will display 4
- # bar graphic diagrams which each contains a diagram of one of the
- # argument values. in the order of the decimal system, the left bar
- # shows the 1000s, the following the 100s etc. Therefore the values
- # have to be <10000. When the diagram has been displayed argument
- # comment will be written to the screen.
- procedure graph(numbers,comment)
- local item, itm, value, bar, graph_line, l, m, n, nn
-
- # item2 is a list which contains lists of each 4 strings. these strings
- # correspond to the numerical values in the lists contained in list
- # numbers. each of these strings contains repl(" ",(10-numerical_value))
- # || repl("▄",numerical_value).
- #
- # create item2 with its string contents
- item := list(0)
- while itm := pop(numbers) do {
- # write every place of itm if there are less then 4 places.
- if *itm < 4 then itm := repl("0",(4 - *itm)) || itm
- # convert every place of itm to a "▄ "-string and assign it
- # to list item
- while every value := !itm do {
- bar := repl(" ",(10 - value)) || repl("▄",value)
- put(item,bar)
- }
- }
- # display bar graphic
- graph_line := ""
- l := 1
- m := 1
- n := 1
- nn := 10
- while n <= 10 do {
- while m <= 16 do {
- while l <= 4 do {
- graph_line := graph_line || " " || !item[m]
- item[m][1] := ""
- l +:= 1
- m +:= 1
- }
- graph_line := graph_line || " ║ "
- l := 1
- }
- write(graph_line," ",nn)
- graph_line := ""
- l := 1
- m := 1
- n +:= 1
- nn -:= 1
- }
- write(" a b c d")
- write("a: 1000, b: 100, c: 10, d: 1")
- write(comment)
- end
-