Σάββατο 12 Ιανουαρίου 2019

Color Wheel

Need last (27 rev, Version 9.6). Because Sqrt(0) now return 0 (before we get error, no zero allowed). For older versions/revisions need to make a new function: Def Sqr1(x)=if(x=0->0, sqrt(x))




Module Check {
      \\ we use an internal object for Math functions (here for Atan2)
      Declare Math Math
      Const tau=2*Pi, Center=2
      \\ change console size,  and center it ( using ;) to current monitor    
      Window 12, 800*twipsX,600*twipsY;
      \\ actual size maybe less (so can fit text exactly)
      Double ' Double height characters
      Report Center, "Color wheel"
      Normal ' restore to normal
      Atan2=Lambda Math (a, b) ->{
            Method Math, "Atan2", a, b As ret
            =ret
      }
      \\ brightness=1 for this program
      hsb2rgb=Lambda (hue, sat) ->{
            If sat == 0 Then {
                = 255, 255, 255
           } Else {
                  h=frac(hue+1)*6
                  f = frac(h)
                  p = Int((1-sat)*255 + 0.5)
                  q = Int((1-sat*f)*255 + 0.5)
                  t = Int((1-sat*(1-f))*255 + 0.5)
                  Select Case Int(h)
                  Case 1
                      = q, 255, p
                  Case 2
                      = p, 255, t
                  Case 3
                     = p, q, 255
                  Case 4
                      = t, p, 255
                  Case 5
                      = 255, p, q
                  Else Case
                      = 255, t, p
                  End Select
          }
      }
      Let OffsetX=X.twips/2-128*TwipsX, OffsetY=Y.twips/2-128*TwipsY
      \\ a pixel has a size of TwipsX x TwipsY
      OffsetX=(OffsetX div TwipsX)*TwipsX
      OffsetY=(OffsetY div TwipsY)*TwipsY
      \\ We set hsb2rgb, OffsetX, OffsetY as closures to PrintPixel
      \\ We send to stack the R G B values using Stack ! array
      \\ hsb2rgb() return an array of values
      \\ we pop these values using Number
      PrintPixel = Lambda hsb2rgb, OffsetX, OffsetY (x,y, theta, sat) -> {
            Stack ! hsb2rgb(theta,sat)
            PSet Color(number, number, number), x*TwipsX+offsetX, y*TwipsY+offsetY
      }
      \\ set Atan2, tau as closures to HueCircle
      \\ we can rotate/flip the wheel by changing signs in Atan2() and
      \\ by changing order of arguments (dx,dy) or (dy,dx). 8 combinations
      HueCircle= Lambda Atan2, tau (PrintPixel) -> {
            Let c_width=256, c_height=256
            Let cx=c_width/2, cy=c_height/2
            Let radius=If(cx<=cy->cx, cy)
            c_width--
            c_height--
            dy=-cy
            For y=0 To c_height {
                  dy++ : dy2=dy*dy : dx=-cx
                  For x=0 To c_width {
                        dx++ : dist=Sqrt(dx^2+dy2)
                        If dist>radius Then continue
                        Call PrintPixel(x,y, Atan2(dx, -dy)/tau, dist/radius)
                  }
            }
      }
      Call HueCircle(PrintPixel)
      Scr$=""  ' we use this string  to load an image
      Move 0,0
      \\ scale.x, scale.y are twips height and width, of current layer
      Copy scale.x, scale.y to Scr$
      Clipboard Scr$ ' save window to clipboard
}
Check

Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου

You can feel free to write any suggestion, or idea on the subject.