Author Topic: Re: the MATHEMATICAL ANALOG CLOCK  (Read 4173 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: the MATHEMATICAL ANALOG CLOCK
« Reply #45 on: February 27, 2019, 10:19:47 pm »
Many are posting all these clocks with numbers, here is a break from that, plus! my smoothest clock yet.
Code: QB64: [Select]
  1. _TITLE "Smooth clock modern 7" 'B+ 2019-02-28 Series tries to get all hands moving across clockface smoothly
  2. ' Modified arcRing to draw complete arc around but starting opacity max at one angle to
  3. ' 360 degree CCW is completely transparent.
  4. ' Now with a red theme for night mode
  5.  
  6. CONST sq = 700 '<<<<<<<<<<<<<< everything is scaled to this
  7. CONST xy0 = sq / 2
  8. CONST fr = .95 * xy0
  9. CONST dr = .9 * xy0
  10. CONST br = 0 * xy0
  11. CONST hh = .5 * xy0
  12. CONST mh = .7 * xy0
  13. CONST sh = .8 * xy0
  14. CONST smc = .007 * xy0
  15.  
  16. 'pi
  17. CONST pi = 3.141592653589793
  18. CONST pm2 = 2 * pi
  19. CONST pm3d2 = 3 * pi / 2
  20. CONST pd2 = pi / 2
  21. CONST pm2d12 = 2 * pi / 12
  22. CONST pm2d60 = 2 * pi / 60
  23. CONST pd96 = pi / 96
  24.  
  25. 'color
  26. CONST nsc = &HFF330000
  27. CONST ncf = &HFFBB0000
  28. CONST nhh = &HFF990000
  29. CONST nmh = &HFF770000
  30. CONST nsh = &HFF550000
  31.  
  32. CONST dsc = &HFF440044
  33. CONST dcf = &HFF00AAAA
  34. CONST dhh = &HFF00BB00
  35. CONST dmh = &HFF990000
  36. CONST dsh = &HFF000066
  37.  
  38. SCREEN _NEWIMAGE(sq, sq, 32)
  39. _SCREENMOVE (1200 - sq) / 2, 10
  40.     t# = TIMER(.001)
  41.     't# = t# + 12 * 3600 'test opposite colors
  42.     hour% = INT(t# / 3600)
  43.     IF hour% >= 7 AND hour% <= 23 THEN 'day mode between 7 AM to 11 PM
  44.         csc = dsc: ccf = dcf: chh = dhh: cmh = dmh: csh = dsh
  45.     ELSE
  46.         csc = nsc: ccf = ncf: chh = nhh: cmh = nmh: csh = nsh
  47.     END IF
  48.     IF hour% > 12 THEN showHr# = t# / 3600 - 12 ELSE showHr# = t# / 3600
  49.     min# = t# / 60 - hour% * 60
  50.     sec# = t# - hour% * 3600 - INT(min#) * 60
  51.     fcirc xy0, xy0, fr, csc
  52.     FOR i = 0 TO 59
  53.         IF i = 45 THEN
  54.             r = 7 * smc
  55.         ELSEIF i MOD 5 = 0 THEN
  56.             r = 4 * smc
  57.         ELSE
  58.             r = smc
  59.         END IF
  60.         fcirc xy0 + dr * COS(i * pm2d60), xy0 + dr * SIN(i * pm2d60), r, ccf
  61.     NEXT
  62.     arcRingRotateColor xy0, xy0, hh, br, showHr# * pm2d12 - pd2, chh
  63.     arcRingRotateColor xy0, xy0, mh, hh, min# * pm2d60 - pd2, cmh
  64.     arcRingRotateColor xy0, xy0, sh, mh, sec# * pm2d60 - pd2, csh
  65.     _DISPLAY
  66.     _LIMIT 30
  67.  
  68. 'going around in a circle draw a disk max opacity at angle a and around to complete transparencey just on other side
  69. SUB arcRingRotateColor (x0, y0, outerR, innerR, raStart, colr AS _UNSIGNED LONG)
  70.     DIM x AS INTEGER, y AS INTEGER
  71.     r = _RED32(colr): g = _GREEN32(colr): b = _BLUE32(colr)
  72.  
  73.     raS = raStart
  74.     WHILE raS >= pm2
  75.         raS = raS - pm2
  76.     WEND
  77.     WHILE raS < 0
  78.         raS = raS + pm2
  79.     WEND
  80.     raE = raS - .001
  81.     IF raE < 0 THEN raE = raE + pm2
  82.     IF raE > raS THEN ck1 = -1
  83.     FOR y = y0 - outerR TO y0 + outerR
  84.         FOR x = x0 - outerR TO x0 + outerR
  85.             dist = SQR((x - x0) * (x - x0) + (y - y0) * (y - y0))
  86.             IF dist >= innerR AND dist <= outerR THEN 'within 2 radii
  87.                 'angle of x, y to x0, y0
  88.                 IF x - x0 <> 0 AND y - y0 <> 0 THEN
  89.                     ra = _ATAN2(y - y0, x - x0)
  90.                     IF ra < 0 THEN ra = ra + pm2
  91.                 ELSEIF x - x0 = 0 THEN
  92.                     IF y >= y0 THEN ra = pd2 ELSE ra = pm3d2
  93.                 ELSEIF y - y0 = 0 THEN
  94.                     IF x >= x0 THEN ra = 0 ELSE ra = pi
  95.                 END IF
  96.                 IF ck1 THEN 'raEnd > raStart
  97.                     IF ra >= raS AND ra <= raE THEN
  98.                         PSET (x, y), _RGBA32(r, g, b, ABS(ra - raS) / pm2 * 255)
  99.                     END IF
  100.                 ELSE 'raEnd < raStart, raEnd is falls before raStart clockwise so fill through 2 * PI
  101.                     IF ra >= raS AND ra < pm2 THEN
  102.                         PSET (x, y), _RGBA32(r, g, b, ABS(ra - raS) / pm2 * 255)
  103.                     ELSE
  104.                         IF ra >= 0 AND ra <= raE THEN
  105.                             PSET (x, y), _RGBA32(r, g, b, ABS(pm2 + ra - raS) / pm2 * 255)
  106.                         END IF
  107.                     END IF
  108.                 END IF
  109.             END IF
  110.         NEXT
  111.     NEXT
  112.  
  113. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  114.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  115.     DIM X AS INTEGER, Y AS INTEGER
  116.  
  117.     Radius = ABS(R)
  118.     RadiusError = -Radius
  119.     X = Radius
  120.     Y = 0
  121.  
  122.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  123.  
  124.     ' Draw the middle span here so we don't draw it twice in the main loop,
  125.     ' which would be a problem with blending turned on.
  126.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  127.  
  128.     WHILE X > Y
  129.         RadiusError = RadiusError + Y * 2 + 1
  130.         IF RadiusError >= 0 THEN
  131.             IF X <> Y + 1 THEN
  132.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  133.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  134.             END IF
  135.             X = X - 1
  136.             RadiusError = RadiusError - X * 2
  137.         END IF
  138.         Y = Y + 1
  139.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  140.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  141.     WEND
  142.  
  143.  
smooth clock modern 7.PNG
* smooth clock modern 7.PNG (Filesize: 125.24 KB, Dimensions: 1281x727, Views: 104)
« Last Edit: February 27, 2019, 10:37:45 pm by bplus »

Offline petoro

  • Newbie
  • Posts: 27
    • View Profile
Re: the MATHEMATICAL ANALOG CLOCK
« Reply #46 on: August 18, 2019, 04:59:11 pm »
A very original and beautiful sphere in such a short portion of code... Congratulations.