Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on October 02, 2018, 10:04:20 am

Title: Analog clocks code
Post by: bplus on October 02, 2018, 10:04:20 am
But will the lines fit?
Code: QB64: [Select]
  1. _TITLE "49+ Analog Clocks in 38 Lines of Code for QB64 B+ 2018-10-02"
  2. SCREEN _NEWIMAGE(720, 720, 32)
  3. _SCREENMOVE 300, 10
  5.     CLS
  6.     FOR i = 0 TO 11
  7.         clock 360 + 258 * COS(_PI(2 * i / 12)), 360 + 258 * SIN(_PI(2 * i / 12)), 65
  8.         clock 360 + 149 * COS(_PI(2 * i / 12)), 360 + 149 * SIN(_PI(2 * i / 12)), 37
  9.         clock 360 + 86 * COS(_PI(2 * i / 12)), 360 + 86 * SIN(_PI(2 * i / 12)), 20
  10.         clock 360 + 50 * COS(_PI(2 * i / 12)), 360 + 50 * SIN(_PI(2 * i / 12)), 12
  11.     NEXT
  12.     clock 360, 360, 340
  13.     clock 700, 700, 865
  14.     _DISPLAY
  15.     _LIMIT 2
  17. SUB clock (x, y, r)
  18.     FOR a = 0 TO 359 STEP 6
  19.         IF a MOD 30 = 0 THEN r1 = 1 / 30 * r ELSE r1 = 1 / 75 * r
  20.         CIRCLE (x + r * COS(_D2R(a)), y + r * SIN(_D2R(a))), r1
  21.         PAINT (x + r * COS(_D2R(a)), y + r * SIN(_D2R(a))), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  22.     NEXT
  23.     IF VAL(LEFT$(TIME$, 2)) + (VAL(MID$(TIME$, 4, 2)) / 60) >= 12 THEN hrs = VAL(LEFT$(TIME$, 2)) + (VAL(MID$(TIME$, 4, 2)) / 60) - 12 ELSE hrs = VAL(LEFT$(TIME$, 2)) + (VAL(MID$(TIME$, 4, 2)) / 60)
  24.     ftri x + 1 / 15 * r * COS(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2) + _PI(1 / 2)), y + 1 / 15 * r * SIN(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2) + _PI(1 / 2)), x + 1 / 15 * r * COS(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2) - _PI(1 / 2)), y + 1 / 15 * r * SIN(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2) - _PI(1 / 2)), x + r * COS(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2)), y + r * SIN(VAL(MID$(TIME$, 4, 2)) * _PI(1 / 30) - _PI(1 / 2)), _RGB32(255, 0, 0)
  25.     ftri x + 1 / 10 * r * COS(hrs * _PI(1 / 6) - _PI(1 / 2) + _PI(1 / 2)), y + 1 / 10 * r * SIN(hrs * _PI(1 / 6) - _PI(1 / 2) + _PI(1 / 2)), x + 1 / 10 * r * COS(hrs * _PI(1 / 6) - _PI(1 / 2) - _PI(1 / 2)), y + 1 / 10 * r * SIN(hrs * _PI(1 / 6) - _PI(1 / 2) - _PI(1 / 2)), x + 2 / 3 * r * COS(hrs * _PI(1 / 6) - _PI(1 / 2)), y + 2 / 3 * r * SIN(hrs * _PI(1 / 6) - _PI(1 / 2)), _RGB32(0, 0, 255)
  26.     LINE (x, y)-(x + r * COS(VAL(RIGHT$(TIME$, 2)) * _PI(1 / 30) - _PI(1 / 2)), y + r * SIN(VAL(RIGHT$(TIME$, 2)) * _PI(1 / 30) - _PI(1 / 2))), _RGB32(255, 255, 0)
  27.     CIRCLE (x, y), 1 / 10 * r, _RGB32(255, 255, 255)
  28.     PAINT (x + 1 / 75 * r, y + 1 / 75 * r), _RGB32(100, 100, 100), _RGB32(255, 255, 255)
  29.     CIRCLE (x, y), 1 / 30 * r, _RGB32(0, 0, 0)
  31. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  32.     a& = _NEWIMAGE(1, 1, 32)
  33.     _DEST a&
  34.     PSET (0, 0), K
  35.     _DEST 0
  36.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  37.     _FREEIMAGE a& '<<< this is important!
  39.  

EDIT: Some paints were part off / part on screen.
Title: Re:Analog clocks code
Post by: bplus on October 02, 2018, 03:39:22 pm
Hated triangle arms plus wanted to change colors of face and hands but mainly wanted transparent clocks.

Here is all that:
Code: QB64: [Select]
  1. _TITLE "Clock code for QB64 B+ 2018-10-02"
  3. SCREEN _NEWIMAGE(720, 720, 32)
  4. _SCREENMOVE 300, 10
  5.  
  6. CONST PI = 3.141492653589793
  7. CONST PI2 = 1.570796326794897
  8.  
  9. 'check scaling
  10. _TITLE "Scale Test:  Press m for more, l for less clock size, esc for next test..."
  11. sz = 4
  12. WHILE _KEYDOWN(27) = 0
  13.     K$ = INKEY$
  14.     IF K$ = "m" AND INT(sz * 1.25) < 360 THEN sz = INT(sz * 1.25)
  15.     IF K$ = "l" AND INT(sz / 1.25) > 3 THEN sz = INT(sz / 1.25)
  16.     CLS
  17.     clock 360, 360, sz, _RGB32(0, 0, 80), _RGB32(200, 155, 255), _RGB32(60, 30, 45)
  18.     PRINT sz
  19.     _DISPLAY
  20.     _LIMIT 30
  25.  
  26. 'transparency tests, first some background picture
  27. bgrd& = _NEWIMAGE(720, 720, 32) 'draw background
  28. _DEST bgrd&
  29. FOR I = 1 TO 100 'draw background
  30.     LINE (RND * 720, RND * 720)-STEP(RND * 90, RND * 90), _RGB32(RND * 255, RND * 255, RND * 255), BF
  32. LINE (350, 350)-STEP(100, 50), _RGB32(255, 255, 0), BF
  34.  
  35. _TITLE "Transparency Test: press m for more opaqueness press l for less opaqueness, esc for next test..."
  36. sz = 200
  38. t = 15
  39. WHILE _KEYDOWN(27) = 0
  40.     CLS
  41.     K$ = INKEY$
  42.     IF K$ = "m" AND (t + 10 <= 255) THEN t = t + 10
  43.     IF K$ = "l" AND (t - 10 >= 15) THEN t = t - 10
  44.     _PUTIMAGE , bgrd&
  45.     clock 360, 360, sz, _RGBA32(60, 30, 10, t), _RGBA32(128, 196, 255, t), _RGBA32(60, 30, 10, t)
  46.     COLOR _RGB32(255, 255, 255)
  47.     PRINT t
  48.     _DISPLAY
  49.     _LIMIT 30
  51.  
  52. 'random tests
  53. DIM SHARED nClocks
  54. nClocks = 15
  55. DIM SHARED cx(nClocks), cy(nClocks), cr(nClocks), ccb(nClocks) AS _UNSIGNED LONG, ccf(nClocks) AS _UNSIGNED LONG, cch(nClocks) AS _UNSIGNED LONG
  56.  
  57. ON TIMER(4) newClocks
  59. newClocks
  60. _TITLE "Random clocks test,  press q to quit..."
  61. WHILE K$ <> "q"
  62.     CLS
  63.     K$ = INKEY$
  64.     _PUTIMAGE , bgrd&
  65.     FOR I = 1 TO 15
  66.         clock cx(I), cy(I), cr(I), ccf(I), ccb(I), cch(I)
  67.     NEXT
  68.     _DISPLAY
  69.     _LIMIT 30
  74.  
  75. SUB newClocks
  76.     FOR i = 1 TO nClocks
  77.         cr(i) = RND * 200 + 10
  78.         cx(i) = RND * 720 - .5 * cr(i)
  79.         cy(i) = RND * 720 - .5 * cr(i)
  80.         t = RND * 255
  81.         ccb(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
  82.         ccf(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
  83.         cch(i) = _RGBA32(RND * 255, RND * 255, RND * 255, t)
  84.     NEXT
  86.  
  87. SUB clock (x, y, rr, fc AS _UNSIGNED LONG, bc AS _UNSIGNED LONG, hc AS _UNSIGNED LONG)
  88.     clockFace x, y, rr, fc, bc
  89.     r = .9 * rr
  90.     hrs = VAL(LEFT$(TIME$, 2)) + (VAL(MID$(TIME$, 4, 2)) / 60)
  91.     IF hrs >= 12 THEN hrs = hrs - 12
  92.     hrs = hrs * _PI(1 / 6) - PI2
  93.     ms = VAL(MID$(TIME$, 4, 2)) * PI / 30 - PI2
  94.     ss = VAL(RIGHT$(TIME$, 2)) * PI / 30 - PI2
  95.     x3 = x + r * COS(ms): y3 = y + r * SIN(ms)
  96.     x4 = x + r / 10 * COS(ms - PI): y4 = y + r / 10 * SIN(ms - PI)
  97.     thic x3, y3, x4, y4, r / 15, hc
  98.     x3 = x + 3 / 4 * r * COS(hrs): y3 = y + 3 / 4 * r * SIN(hrs)
  99.     x4 = x + r / 10 * COS(hrs - PI): y4 = y + r / 10 * SIN(hrs - PI)
  100.     thic x3, y3, x4, y4, r / 15, hc
  101.     LINE (x, y)-(x + r * COS(ss), y + r * SIN(ss)), hc
  102.     fcirc x, y, r / 15, hc
  103.     CIRCLE (x, y), r / 30, bc
  105.  
  106. SUB ftri (x1, y1, x2, y2, x3, y3, K AS _UNSIGNED LONG)
  107.     a& = _NEWIMAGE(1, 1, 32)
  108.     _DEST a&
  109.     PSET (0, 0), K
  110.     _DEST 0
  111.     _MAPTRIANGLE _SEAMLESS(0, 0)-(0, 0)-(0, 0), a& TO(x1, y1)-(x2, y2)-(x3, y3)
  112.     _FREEIMAGE a&
  114.  
  115. SUB clockFace (x, y, r, fc AS _UNSIGNED LONG, bc AS _UNSIGNED LONG)
  116.     b& = _NEWIMAGE(2 * r + 1, 2 * r + 1, 32)
  117.     _DEST b&
  118.     fcirc r, r, r, bc
  119.     FOR a = 0 TO 359 STEP 6
  120.         IF a MOD 30 = 0 THEN
  121.             r1 = 1 / 30 * r
  122.         ELSE
  123.             IF r / 60 > 1 THEN r1 = r / 60 ELSE r1 = 0
  124.         END IF
  125.         IF r1 THEN fcirc r + .9 * r * COS(_D2R(a)), r + .9 * r * SIN(_D2R(a)), r1, fc
  126.     NEXT
  127.     _PUTIMAGE (x - r, y - r)-(x + r, y + r), b&, 0
  128.     _DEST 0
  129.     _FREEIMAGE b&
  131.  
  132. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  133. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, K AS _UNSIGNED LONG)
  134.     DIM subRadius AS LONG, RadiusError AS LONG
  135.     DIM X AS LONG, Y AS LONG
  136.  
  137.     subRadius = ABS(R)
  138.     RadiusError = -subRadius
  139.     X = subRadius
  140.     Y = 0
  141.  
  142.     IF subRadius = 0 THEN PSET (CX, CY), K: EXIT SUB
  143.  
  144.     ' Draw the middle span here so we don't draw it twice in the main loop,
  145.     ' which would be a problem with blending turned on.
  146.     LINE (CX - X, CY)-(CX + X, CY), K, BF
  147.  
  148.     WHILE X > Y
  149.         RadiusError = RadiusError + Y * 2 + 1
  150.         IF RadiusError >= 0 THEN
  151.             IF X <> Y + 1 THEN
  152.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), K, BF
  153.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), K, BF
  154.             END IF
  155.             X = X - 1
  156.             RadiusError = RadiusError - X * 2
  157.         END IF
  158.         Y = Y + 1
  159.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), K, BF
  160.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), K, BF
  161.     WEND
  163.  
  164. SUB thic (x1, y1, x2, y2, thick, K AS _UNSIGNED LONG)
  165.     t2 = thick / 2
  166.     IF t2 < 1 THEN t2 = 1
  167.     a = _ATAN2(y2 - y1, x2 - x1)
  168.     x3 = x1 + t2 * COS(a + PI2)
  169.     y3 = y1 + t2 * SIN(a + PI2)
  170.     x4 = x1 + t2 * COS(a - PI2)
  171.     y4 = y1 + t2 * SIN(a - PI2)
  172.     x5 = x2 + t2 * COS(a + PI2)
  173.     y5 = y2 + t2 * SIN(a + PI2)
  174.     x6 = x2 + t2 * COS(a - PI2)
  175.     y6 = y2 + t2 * SIN(a - PI2)
  176.     ftri x6, y6, x4, y4, x3, y3, K
  177.     ftri x3, y3, x5, y5, x6, y6, K
  179.  
  180.  
Title: Re: Analog clocks code
Post by: bplus on October 02, 2018, 08:57:19 pm
The above code was cleaned up and optimized (same day as original post) also used a ON TIMER for first time for testing Random clocks.
Text Only | Text with Attachments