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 / colrname.icn < prev    next >
Text File  |  2000-08-03  |  3KB  |  126 lines
  1. ############################################################################
  2. # 
  3. #    File:     colrname.icn
  4. # 
  5. #    Subject:  Program to browse color names
  6. # 
  7. #    Author:   Clinton L. Jeffery
  8. #
  9. #    Date:     August 3, 2000
  10. # 
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.1
  18. #
  19. #    Extension to output color specification added by Ralph E. Griswold
  20. #
  21. ############################################################################
  22. #
  23. #     An X color name browser.
  24. #
  25. #     Click on a colorname to change the window's background color.
  26. # Not very interesting on a monochrome server.
  27. #
  28. ############################################################################
  29. #
  30. # Requires:  Version 9 graphics with mutable colors and X.
  31. #
  32. ############################################################################
  33. #
  34. #  Links: sort, wopen
  35. #
  36. ############################################################################
  37.  
  38. link sort
  39. link wopen
  40.  
  41. global w, L, startcols, rows, theBackGround
  42.  
  43. procedure drawit()
  44.    local curcol, i, maxcol
  45.    curcol := 1
  46.    i := 0
  47.    startcols := [1]
  48.    maxcol := 0
  49.    every name := !L do {
  50.       maxcol <:= *name
  51.       GotoRC(i % rows + 1,curcol)
  52.       writes(&window,name)
  53.       i +:= 1
  54.       if (i>0) & (i % rows = 0) then {
  55.      curcol +:= maxcol + 2
  56.      maxcol := 0
  57.      put(startcols,curcol)
  58.      }
  59.       }
  60. end
  61.  
  62.  
  63. procedure doevents()
  64.    local e, varcol, lastvarcol, lastrow
  65.    repeat {
  66.       Active()
  67.       while Pending()[1] do {
  68.      e := Event()
  69.      case e of {
  70.             "o":      write(ColorValue(\name))
  71.         "q"|"\e": exit(0)
  72.         &lpress|&mpress|&rpress|&ldrag|&mdrag|&rdrag: {
  73.            varcol := 0
  74.            every &col >= !startcols do varcol +:= 1
  75.            if varcol === lastvarcol & &row===lastrow then next
  76.            lastvarcol := varcol
  77.            lastrow := &row
  78.            name := L[(varcol-1)*rows+&row]
  79.            Color(theBackGround,name)
  80.            WAttrib("label=Color Names: " || name)
  81.         }
  82.      }
  83.       }
  84.    }
  85. end
  86.  
  87. procedure main(av)
  88.    local filename, f, i, t, max, line, t2, r, g, b, rgb
  89.  
  90.    filename := av[1] | "/usr/lib/X11/rgb.txt"
  91.    WOpen("label=Color Names","x","cursor=on","lines=50","columns=175") |
  92.       stop("no window")
  93.    rows := WAttrib("lines")
  94.    f := open(filename) | stop("no rgb.txt")
  95.  
  96.    theBackGround := NewColor("white")
  97.    Bg(theBackGround)
  98.    EraseArea()
  99.  
  100.    i := 1
  101.    t := set()
  102.    t2 := table() # skip redundant colors by storing their rgb
  103.    max := 0
  104.    every line := !f do {
  105.       line ? {
  106.      tab(upto(&digits))
  107.      r := tab(many(&digits))
  108.      tab(upto(&digits))
  109.      g := tab(many(&digits))
  110.      tab(upto(&digits))
  111.      b := tab(many(&digits))
  112.      rgb := ishift(r,16)+ishift(g,8)+b
  113.      name := (tab(upto(&letters)) & tab(0))
  114.      if /t2[rgb] := name then {
  115.         insert(t,name)
  116.         max <:= *name
  117.         i +:= 1
  118.         }
  119.      }
  120.       }
  121.    L := isort(t)
  122.  
  123.    drawit()
  124.    doevents()
  125. end
  126.