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 / gprocs / putpixel.icn < prev    next >
Text File  |  2000-07-29  |  5KB  |  164 lines
  1. ############################################################################
  2. #
  3. #    File:     putpixel.icn
  4. #
  5. #    Subject:  Procedure to write quantized, processed pixel
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    These procedures assist pixel-by-pixel image construction.
  18. #
  19. #    PutPixel(W, x, y, k)    draws a single pixel after applying
  20. #                dithering, color quantization, and
  21. #                gamma correction.
  22. #
  23. #    PixInit(gamma, cquant, gquant, drandom)
  24. #                initializes parameters for PutPixel().
  25. #
  26. ############################################################################
  27. #
  28. #     PutPixel([win,] x, y, colr) sets the pixel at (x,y) to the given color
  29. #  after applying dithering, color quantization, and gamma correction.
  30. #  It is designed for constructing images a pixel at a time.  The window's
  31. #  foreground color is left set to the adjusted color.
  32. #
  33. #     Colr can be any value acceptable to Fg.  Mutable colors are not
  34. #  dithered, quantized, or gamma-corrected.
  35. #
  36. #     PixInit(gamma, cquant, gquant, drandom) may be called before PutPixel
  37. #  to establish non-default parameters.  The default gamma value is 1.0
  38. #  (that is, no correction beyond Icon's usual gamma correction).
  39. #  cquant and gquant specify the number of color and grayscale quantization
  40. #  steps; the defaults are 6 and 16 respectively.  If gquant + cquant ^ 3
  41. #  exceeds 256 there is a potential for running out of colors.  drandom
  42. #  is the fraction (0 to 1) of the dithering to be done randomly; the
  43. #  default is zero.
  44. #
  45. ############################################################################
  46. #
  47. #  Requires:  Version 9 graphics
  48. #
  49. ############################################################################
  50.  
  51. global XPP_qtab, XPP_gtab, XPP_dtab, XPP_rtab, XPP_gadjust
  52.  
  53. #  PixInit -- set parameters and build tables
  54.  
  55. procedure PixInit(gamma, cquant, gquant, drandom)  #: initialize pixel processing
  56.    local PIXRANGE, NRANDOM, cstep, gstep, indx, appx, gcor, i
  57.  
  58.    /gamma := 1.0            # gamma correction factor
  59.    /cquant := 6                # color quantization steps
  60.    /gquant := 16            # grayscale quantization
  61.    /drandom := 0.0            # fraction of dithering to do randomly
  62.  
  63.    NRANDOM := 500            # size of random number table
  64.    PIXRANGE := 255            # pixel value range 0..255
  65.  
  66.    if gamma < 0.01 then            # ensure legal values
  67.       gamma := 2.5
  68.    cquant <:= 2
  69.    gquant <:= 2
  70.    drandom <:= 0.0
  71.    drandom >:= 1.0
  72.  
  73.    cstep := (PIXRANGE / (cquant-1.0))    # color step size
  74.    gstep := (PIXRANGE / (gquant-1.0))    # grayscale step size
  75.  
  76.    # build 4 x 4 dither table (choose one)
  77.    # XPP_dtab := [0,8,2,10,12,4,14,6,3,11,1,9,15,7,13,5]  # ordered dither
  78.    XPP_dtab := [0,6,9,15,11,13,2,4,7,1,14,8,12,10,5,3]  # magic square dither
  79.    every i := 1 to 16 do    # normalize
  80.       XPP_dtab[i] := (XPP_dtab[i]/15.0 - 0.5) * (cstep - 3) * (1.0 - drandom)
  81.  
  82.    # build list of scaled random numbers for dithering
  83.    XPP_rtab := list(NRANDOM)
  84.    every !XPP_rtab := (?0 - 0.5) * 2 * (cstep - 3) * drandom
  85.  
  86.    # build table for combined quantization and gamma correction
  87.    XPP_qtab := list(PIXRANGE+1)
  88.    every i := 0 to PIXRANGE do {
  89.       indx := integer((i + cstep / 2) / cstep)
  90.       appx := cstep * indx
  91.       gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
  92.       XPP_qtab[i+1] := integer(gcor + 0.5)
  93.       }
  94.    # build similar table for grayscale
  95.    XPP_gtab := list(PIXRANGE+1)
  96.    every i := 0 to PIXRANGE do {
  97.       indx := integer((i + gstep / 2) / gstep)
  98.       appx := gstep * indx
  99.       gcor := PIXRANGE * ((real(appx) / real(PIXRANGE)) ^ (1.0 / gamma))
  100.       XPP_gtab[i+1] := integer(gcor + 0.5)
  101.       }
  102.    # grayscale adjustment for different quantization
  103.    XPP_gadjust := (gstep - 3) / (cstep - 3)
  104.    return
  105. end
  106.  
  107. #  PutPixel -- write a pixel
  108.  
  109. procedure PutPixel(win, x, y, color)           #: write pixel
  110.    local i, r, g, b
  111.  
  112.    initial if /XPP_qtab then PixInit()
  113.  
  114.    # default win to &window if omitted
  115.    if type(win) ~== "window" then {
  116.       win :=: x :=: y :=: color
  117.       win := &window
  118.       }
  119.  
  120.    # convert color to 8-bit r, g, b
  121.    if type(color) == "integer" then {
  122.       # mutable -- don't quantize
  123.       Fg(win, color)
  124.       DrawPoint(win, x, y)
  125.       return
  126.       }
  127.  
  128.    (color | ColorValue(color) | fail) ? (
  129.       (r := tab(many(&digits))) & move(1) &
  130.       (g := tab(many(&digits))) & move(1) &
  131.       (b := tab(many(&digits)))
  132.       )
  133.  
  134.    # convert three 0..65535 ints to 0..255
  135.    r := (r + 255) / 257
  136.    g := (g + 255) / 257
  137.    b := (b + 255) / 257
  138.  
  139.    # get dither table index based on coordinates
  140.    i := iand(x, 3) + 4 * iand(y, 3) + 1
  141.  
  142.    if r = g = b then {
  143.       g := integer(g + XPP_gadjust * (XPP_dtab[i] + ?XPP_rtab))
  144.       (g <:= 1) | (g >:= 256)
  145.       r := g := b := 257 * XPP_gtab[g]
  146.       }
  147.    else {
  148.       r := integer(r + XPP_dtab[i] + ?XPP_rtab + 1.5)
  149.       g := integer(g - XPP_dtab[i] + ?XPP_rtab + 1.5)
  150.       b := integer(b + XPP_dtab[i] + ?XPP_rtab + 1.5)
  151.       (r <:= 1) | (r >:= 256)
  152.       (g <:= 1) | (g >:= 256)
  153.       (b <:= 1) | (b >:= 256)
  154.       r := 257 * XPP_qtab[r]
  155.       g := 257 * XPP_qtab[g]
  156.       b := 257 * XPP_qtab[b]
  157.       }
  158.  
  159.    # finally, put the pixel on the screen
  160.    Fg(win, r || "," || g || "," || b)
  161.    DrawPoint(win, x, y)
  162.    return
  163. end
  164.