Author Topic: My Best Analog Chiming Clock (Read 8693 times)

SierraKen · « **Reply #15 on:** November 18, 2020, 08:12:14 pm »

Here is a MUCH better clock. I completely remade the clock hands and added a new graphical seconds clock hand as well. It took me a few minutes to make a smoothly animated seconds hand but it's incredibly easier than it seems. All you need to do to find the degrees for RotoZoom of the seconds hand is this: angle = 6 * TIMER. TIMER is how many milliseconds since midnight. I also softened the hand graphics to add dark shade around them to look more authentic. I used B+'s idea to make circles around the hours, minutes, and seconds. Tell me what you think everyone. I also changed the colors around, I like these better. I'll update the original zip file and picture above and remove the last one. Here it is also below. By the way, it feels really good to be able to draw these clock hands when I've never been an artist hardly before.

bplus · « **Reply #16 on:** November 18, 2020, 09:10:31 pm »

Nice @SierraKen

The hands are picking up a nice style to them and I really like the blue hour dots more in the middle!

SierraKen · « **Reply #17 on:** November 18, 2020, 09:29:23 pm »

Thanks B+, I really like it too. I'll be using this often. :)

_vince · « **Reply #18 on:** November 19, 2020, 02:27:05 am »

why not

Code: [Select]

pi = 4*atn(1)
sw = 800
sh = 600

s$ = "33111121131112121222132114211123113231"

screen _newimage(sw, sh, 32)
screen ,,1,0

pset (sw/2, sh/2),_rgb(100,100,100)
for a=0 to 2*pi step 0.01
        x = 100*cos(a) + 100*cos(14*a)
        y = 100*sin(a) + 100*sin(14*a)
        line -(sw/2 + x, sh/2 + y),_rgb(35,35,35)
next

circle (sw/2, sh/2), 8
circle (sw/2, sh/2), 12
circle (sw/2, sh/2), 210 - 5,_rgb(100,100,100)
circle (sw/2, sh/2), 280 + 5,_rgb(100,100,100)
circle (sw/2, sh/2), 280 + 10,_rgb(100,100,100)

a = -pi/2

do while i < len(s$)-1
        i = i + 1
        c$ = mid$(s$, i, 1)
        b = a - 0.05*(val(c$))*0.5
        for k=0 to val(c$) - 1
                i = i + 1
                select case mid$(s$, i, 1)
                case "1"
                        line (sw/2 + 210*cos(b), sh/2 + 210*sin(b))-step(70*cos(b), 70*sin(b))
                case "2"
                        if val(c$) > 1 then c = b + 0.05*0.5*((k = 0) - (k <> 0)) else c = b
                        line (sw/2 + 210*cos(c), sh/2 + 210*sin(c))-step(70*cos(c - 0.05*3), 70*sin(c - 0.05*3))
                        line (sw/2 + 210*cos(c), sh/2 + 210*sin(c))-step(70*cos(c + 0.05*3), 70*sin(c + 0.05*3))
                case "3"
                        if val(c$) > 1 then c = b + 0.05*0.5*((k = 0) - (k <> 0)) else c = b
                        line (sw/2 + 210*cos(c - 0.05*0.8), sh/2 + 210*sin(c - 0.05*0.8))-(sw/2 + 280*cos(c + 0.05*0.8), sh/2 + 280*sin(c + 0.05*0.8))
                        line (sw/2 + 210*cos(c + 0.05*0.8), sh/2 + 210*sin(c + 0.05*0.8))-(sw/2 + 280*cos(c - 0.05*0.8), sh/2 + 280*sin(c - 0.05*0.8))
                end select
                b = b + 0.05
        next
        a = a + pi/6
loop

screen ,,0,0

do
        t = 100*timer
        pcopy 1,0

        b = 2*pi*(t/36 mod 1200)/1200- pi/2
        pset (sw/2, sh/2)
        for a=0 to pi step 0.01
                x = 140*(0.8*cos(a))^5*abs(3*cos(8*a)^2)*sin(a)*cos(b) - 180*sin(a)*sin(b)
                y = 140*(0.8*cos(a))^5*abs(3*cos(8*a)^2)*sin(a)*sin(b) + 180*sin(a)*cos(b)
                line -(sw/2 + x, sh/2 + y)
        next

        b = 2*pi*(t*100 mod 360000)/360000 - pi/2
        pset (sw/2, sh/2)
        for a=0 to pi step 0.01
                x = 55*(cos(a))^5*abs(2*(cos(4*a))^2 - 0.5)*sin(a)*cos(b) - 280*sin(a)*sin(b)
                y = 55*(cos(a))^5*abs(2*(cos(4*a))^2 - 0.5)*sin(a)*sin(b) + 280*sin(a)*cos(b)
                line -(sw/2 + x, sh/2 + y)
        next

        _display
        _limit 100
loop until _keyhit=27
sleep
system

bplus · « **Reply #19 on:** November 19, 2020, 11:52:59 am »

Holy cow! that's nice @_vince

SierraKen · « **Reply #20 on:** November 19, 2020, 01:35:53 pm »

That makes nothing on my computer. Was it supposed to go with something? Was it to make something transparent?

bplus · « **Reply #21 on:** November 19, 2020, 01:43:44 pm »

Hi @SierraKen

It's all drawing from bas code (the minutes hand is moving as if a seconds hand)

BTW @_vince this fixes line at 3 0'clock:

Code: QB64: [Select]

'PSET (sw / 2, sh / 2), _RGB(100, 100, 100)
FOR a = 0 TO 2 * pi STEP 0.01
    x = 100 * COS(a) + 100 * COS(14 * a)
    y = 100 * SIN(a) + 100 * SIN(14 * a)
    IF a = 0 THEN PSET (sw / 2 + x, sh / 2 + y) ELSE LINE -(sw / 2 + x, sh / 2 + y), _RGB(35, 35, 35) '<<< pset here
NEXT
 

SierraKen · « **Reply #22 on:** November 19, 2020, 04:30:42 pm »

LOL I can't believe I did that. I only copy/pasted the code that I saw, I didn't scroll down on the rest of his code. lol

Vince this is awesome! Very nice design. It just needs to be added the real time to it. I looked briefly at the code and can't really figure it out yet, but I'll look a bit more.

bplus · « **Reply #23 on:** November 19, 2020, 07:55:09 pm »

Tried a mod of _vince clock with solid hands, kinda fuzzy :(

Code: QB64: [Select]

CONST g = &HFF000088 'hnd5s and numbers
pi = _PI
sw = 800
sh = 600
s$ = "33111121131112121222132114211123113231"
 
SCREEN _NEWIMAGE(sw, sh, 32)
hhand& = _NEWIMAGE(360, 80, 32) ' make hour hand image and save
b = -pi / 2
PSET (sw / 2, sh / 2)
FOR a = 0 TO pi STEP 0.01
    x = 140 * (0.8 * COS(a)) ^ 5 * ABS(3 * COS(8 * a) ^ 2) * SIN(a) * COS(b) - 176 * SIN(a) * SIN(b)
    y = 140 * (0.8 * COS(a)) ^ 5 * ABS(3 * COS(8 * a) ^ 2) * SIN(a) * SIN(b) + 176 * SIN(a) * COS(b)
    LINE -(sw / 2 + x, sh / 2 + y), g
NEXT
PAINT (sw / 2 + 10, sh / 2), g, g
PAINT (sw / 2 + 60, sh / 2), g, g
PAINT (sw / 2 + 120, sh / 2), g, g
PAINT (sw / 2 + 160, sh / 2), g, g
_PUTIMAGE , 0, hhand&, (sw / 2 - 180, sh / 2 - 39)-STEP(359, 79)
'check
'CLS
'RotoZoom sw / 2, sh / 2, hhand&, 1, 0
'CIRCLE (sw / 2, sh / 2), 6, &HFFFFFF00
 
SCREEN _NEWIMAGE(sw, sh, 32) ' cls screen without cls keep back transparent
mhand& = _NEWIMAGE(560, 80, 32) 'make  minute hand
b = -pi / 2
FOR a = 0 TO pi STEP 0.01
    x = 55 * (COS(a)) ^ 5 * ABS(2 * (COS(4 * a)) ^ 2 - 0.5) * SIN(a) * COS(b) - 270 * SIN(a) * SIN(b)
    y = 55 * (COS(a)) ^ 5 * ABS(2 * (COS(4 * a)) ^ 2 - 0.5) * SIN(a) * SIN(b) + 270 * SIN(a) * COS(b)
    LINE -(sw / 2 + x, sh / 2 + y), g
NEXT
PAINT (sw / 2 + 20, sh / 2), g, g
PAINT (sw / 2 + 120, sh / 2), g, g
PAINT (sw / 2 + 160, sh / 2), g, g
_PUTIMAGE , 0, mhand&, (sw / 2 - 280, sh / 2 - 39)-STEP(559, 79)
'check
'CLS
'RotoZoom sw / 2, sh / 2, mhand&, 1, 36
'RotoZoom sw / 2, sh / 2, hhand&, 1, 150
'CIRCLE (sw / 2, sh / 2), 6, &HFFFFFF00
 
CLS
face& = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
fcirc sw / 2, sh / 2, 280 + 10, &HFFFF0000
fcirc sw / 2, sh / 2, 280 + 5, &HFFFFFFFF
fcirc sw / 2, sh / 2, 205, &HFFDDDDFF
FOR a = 0 TO 2 * pi STEP 0.01
    x = 100 * COS(a) + 100 * COS(14 * a)
    y = 100 * SIN(a) + 100 * SIN(14 * a)
    IF a = 0 THEN PSET (sw / 2 + x, sh / 2 + y) ELSE LINE -(sw / 2 + x, sh / 2 + y), _RGB(0, 255, 128)
NEXT
 
fcirc sw / 2, sh / 2, 12, &HFFFFFF00
fcirc sw / 2, sh / 2, 6, &HFF000000
CIRCLE (sw / 2, sh / 2), 210 - 5, &HFF000000
CIRCLE (sw / 2, sh / 2), 280 + 5, &HFF000000
CIRCLE (sw / 2, sh / 2), 280 + 10, &HFF000000
a = -pi / 2
COLOR g
DO WHILE i < LEN(s$) - 1
    i = i + 1
    c$ = MID$(s$, i, 1)
    b = a - 0.05 * (VAL(c$)) * 0.5
    FOR k = 0 TO VAL(c$) - 1
        i = i + 1
        SELECT CASE MID$(s$, i, 1)
            CASE "1"
                LINE (sw / 2 + 210 * COS(b), sh / 2 + 210 * SIN(b))-STEP(70 * COS(b), 70 * SIN(b))
            CASE "2"
                IF VAL(c$) > 1 THEN c = b + 0.05 * 0.5 * ((k = 0) - (k <> 0)) ELSE c = b
                LINE (sw / 2 + 210 * COS(c), sh / 2 + 210 * SIN(c))-STEP(70 * COS(c - 0.05 * 3), 70 * SIN(c - 0.05 * 3))
                LINE (sw / 2 + 210 * COS(c), sh / 2 + 210 * SIN(c))-STEP(70 * COS(c + 0.05 * 3), 70 * SIN(c + 0.05 * 3))
            CASE "3"
                IF VAL(c$) > 1 THEN c = b + 0.05 * 0.5 * ((k = 0) - (k <> 0)) ELSE c = b
                LINE (sw / 2 + 210 * COS(c - 0.05 * 0.8), sh / 2 + 210 * SIN(c - 0.05 * 0.8))-(sw / 2 + 280 * COS(c + 0.05 * 0.8), sh / 2 + 280 * SIN(c + 0.05 * 0.8))
                LINE (sw / 2 + 210 * COS(c + 0.05 * 0.8), sh / 2 + 210 * SIN(c + 0.05 * 0.8))-(sw / 2 + 280 * COS(c - 0.05 * 0.8), sh / 2 + 280 * SIN(c - 0.05 * 0.8))
        END SELECT
        b = b + 0.05
    NEXT
    a = a + pi / 6
LOOP
_PUTIMAGE , 0, face&
DO
    _PUTIMAGE , face&, 0
    m = VAL(MID$(TIME$, 4, 2)) / 60
    h = VAL(LEFT$(TIME$, 2))
    IF h > 12 THEN h = h - 12
    h = (h / 12 + m / 12) * 360
    RotoZoom sw / 2, sh / 2, hhand&, 1, h - 90
    RotoZoom sw / 2, sh / 2, mhand&, 1, m * 360 - 90
    _DISPLAY
    _LIMIT 100
LOOP UNTIL _KEYHIT = 27
SLEEP
SYSTEM
 
SUB RotoZoom (X AS LONG, Y AS LONG, hdl AS LONG, Scale AS SINGLE, Rotation AS SINGLE)
    DIM px(3) AS SINGLE: DIM py(3) AS SINGLE
    W& = _WIDTH(hdl): H& = _HEIGHT(hdl)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = SIN(-Rotation / 57.2957795131): cosr! = COS(-Rotation / 57.2957795131)
    FOR I& = 0 TO 3
        x2& = (px(I&) * cosr! + sinr! * py(I&)) * Scale + X: y2& = (py(I&) * cosr! - px(I&) * sinr!) * Scale + Y
        px(I&) = x2&: py(I&) = y2&
    NEXT
    _MAPTRIANGLE (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), hdl TO(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MAPTRIANGLE (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), hdl TO(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
END SUB
 
'from Steve Gold standard
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 

I also found out Ken modified a perfectly fine rotozoom feeling need to change parameter name ;)
(I had copied the version he had in his code. I changed it back to hdl.)

_vince · « **Reply #24 on:** November 19, 2020, 09:03:24 pm »

Nice, I was definitely inspired by Ken's clock hands and wanted to see how hard it would be to render those vintage style 'calligraphy' hands in a short tight curve parametrization. It turns out it is beyond me. I had my sights on something like this:
(https://image.shutterstock.com/image-vector/vintage-clock-dial-set-hands-600w-496516774.jpg)

I have no idea how you'd parametrize those spade like curves with all the loops and cusps. I am aware that there's an algorithm that can fit a sum of sinusoids expression to any arbitrary curve but it would not be as tight and elegant as the stuff here: https://mathworld.wolfram.com/HeartCurve.html - that math is beyond me. I'd be impressed if anyone can pull off a fancy spade clock hand curve with a similar expression. My hands are a sloppy few minutes of trial and error.

I am also aware that the program is a bit rough with mistakes and misalignment but had I polished all of that it would no longer be the cute 70-liner -- I would then be better off hand coding each roman numeral and so on. I would be down to code up the ultimate QB vintage clock some time, all the flourishings, calligraphy, fancy spirographs, true 3D shadows on hands, etc and no external images!

SierraKen · « **Reply #25 on:** November 19, 2020, 09:16:17 pm »

Thanks Vince. RotoZoom takes care of most of the math by just rotating the picture. I tried to add the real time to your clock this afternoon but no luck. Your math is beyond me there is why.

SierraKen · « **Reply #26 on:** November 19, 2020, 09:32:04 pm »

I see what you mean B+, "hdl AS LONG". Yeah hdl confused me so I just named it clock. lol I'll change it back and put the new version up in the zips above.

bplus · « **Reply #27 on:** November 19, 2020, 09:43:01 pm »

Quote from: SierraKen on November 19, 2020, 09:32:04 pm

I see what you mean B+, "hdl AS LONG". Yeah hdl confused me so I just named it clock. lol I'll change it back and put the new version up in the zips above.

Don't worry about it Ken, I was proud to see you using a SUB! BTW hdl means rotozoom was looking for any image handle to scale and rotate.

@_vince maybe we could work something up from this?

Code: QB64: [Select]

_TITLE "Beating Cardiod" 'B+ 2019-02-16
'2019-02-28 random magnify and beat, redder heart
 
 
CONST xmax = 800
CONST ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE (1280 - xmax) / 2 + 30, (760 - ymax) / 2
 
'center of screen
CX = xmax / 2
CY = ymax / 2 - 50
 
WHILE _KEYDOWN(27) = 0
    CLS
    loopCount = (loopCount + 1) MOD 2
    IF loopCount THEN magnify = 10 ELSE magnify = RND * 10 + 12
    FOR a = -_PI TO _PI STEP _PI(1 / 360)
        x = CX + magnify * xCard(a)
        y = CY - magnify * yCard(a)
        IF a <> -_PI THEN
            LINE (x, y)-(lastx, lasty), _RGB(140, 0, 0)
        END IF
        lastx = x: lasty = y
    NEXT
    PAINT (CX, CY), _RGB(180, 0, 0), _RGB(140, 0, 0)
    _DISPLAY
    IF loopCount THEN _DELAY 40 / 60 ELSE _DELAY (30 + RND * 15) / 65
WEND
 
'Reference and thanks to:
' http://mathworld.wolfram.com/HeartCurve.html
' find the 6th heart curve equations #7, 8
FUNCTION xCard (t)
    xCard = 16 * SIN(t) ^ 3
END FUNCTION
 
FUNCTION yCard (t)
    yCard = 13 * COS(t) - 5 * COS(2 * t) - 2 * COS(3 * t) - COS(4 * t)
END FUNCTION
 

SierraKen · « **Reply #28 on:** November 19, 2020, 09:48:01 pm »

B+ your white clock is amazing! Yeah, the brighter colors shows up the rough edges for some reason, not sure why. That is why I smoothed out my hand files using my graphics program.

STxAxTIC · « **Reply #29 on:** November 20, 2020, 03:47:26 am »

12-hour H:M:S clock with ~~fading graphics and~~ celtic-like overlay. The hands connect on-end, not on center:

Thanks @Fellippe for anti-aliased lines.

EDIT: Got rid of fading colors and other busy things, it looked bad after a while:

Code: QB64: [Select]

OPTION _EXPLICIT
 
DIM MainScreen AS LONG
DIM BackScreen AS LONG
MainScreen = _NEWIMAGE(600, 600, 32)
BackScreen = _NEWIMAGE(600, 600, 32)
SCREEN MainScreen
 
DIM SHARED pi
DIM SHARED phi
pi = 4 * ATN(1)
phi = (1 + SQR(5)) / 2
 
TYPE TimeValue
    Hour AS DOUBLE
    Minute AS DOUBLE
    Second AS DOUBLE
END TYPE
 
TYPE Vector
    x AS DOUBLE
    y AS DOUBLE
END TYPE
 
TYPE ClockHand
    Center AS Vector
    HandPosition AS Vector
    Length AS DOUBLE
    Angle AS DOUBLE
    Shade AS _UNSIGNED LONG
END TYPE
 
DIM SHARED TheTime AS TimeValue
DIM SHARED HourHand AS ClockHand
DIM SHARED MinuteHand AS ClockHand
DIM SHARED SecondHand AS ClockHand
 
HourHand.Center.x = 0
HourHand.Center.y = 0
HourHand.Length = 140
HourHand.Shade = _RGBA(255, 0, 0, 255)
MinuteHand.Length = HourHand.Length / phi
MinuteHand.Shade = _RGBA(0, 255, 0, 255)
SecondHand.Length = HourHand.Length / (phi ^ 2)
SecondHand.Shade = _RGBA(255, 0, 255, 255)
 
_DEST BackScreen
DIM k AS LONG
FOR k = 0 TO 12 * 3600 - (3600) STEP (3600)
    CALL UpdateTime(k)
    CALL UpdateClock
    CALL ccircle(HourHand.HandPosition.x, HourHand.HandPosition.y, 5, _RGBA(_RED32(HourHand.Shade), _GREEN32(HourHand.Shade), _BLUE32(HourHand.Shade), 200))
NEXT
FOR k = 0 TO 12 * 3600 - (12 * 3) STEP (12 * 3)
    CALL UpdateTime(k)
    CALL UpdateClock
    CALL ccircle(MinuteHand.HandPosition.x, MinuteHand.HandPosition.y, 3, _RGBA(_RED32(MinuteHand.Shade), _GREEN32(MinuteHand.Shade), _BLUE32(HourHand.Shade), 100))
NEXT
 
_DEST MainScreen
_PUTIMAGE (0, 0)-(_WIDTH, _HEIGHT), BackScreen, MainScreen, (0, 0)-(_WIDTH, _HEIGHT)
DO
    CALL UpdateTime(TIMER)
    CALL UpdateClock
 
    CLS
    _PUTIMAGE (0, 0)-(_WIDTH, _HEIGHT), BackScreen, MainScreen, (0, 0)-(_WIDTH, _HEIGHT)
    CALL DrawClockHands
 
    _DISPLAY
    _LIMIT 60
LOOP
 
SUB UpdateClock
    HourHand.Angle = -((TheTime.Hour + (TheTime.Minute / 60)) / 12) * 2 * pi + pi / 2
    MinuteHand.Angle = -((TheTime.Minute + (TheTime.Second / 60)) / 60) * 2 * pi + pi / 2
    SecondHand.Angle = -(TheTime.Second / 60) * 2 * pi + pi / 2
    HourHand.HandPosition.x = HourHand.Center.x + HourHand.Length * COS(HourHand.Angle)
    HourHand.HandPosition.y = HourHand.Center.y + HourHand.Length * SIN(HourHand.Angle)
    MinuteHand.Center.x = HourHand.HandPosition.x
    MinuteHand.Center.y = HourHand.HandPosition.y
    MinuteHand.HandPosition.x = MinuteHand.Center.x + MinuteHand.Length * COS(MinuteHand.Angle)
    MinuteHand.HandPosition.y = MinuteHand.Center.y + MinuteHand.Length * SIN(MinuteHand.Angle)
    SecondHand.Center.x = MinuteHand.HandPosition.x
    SecondHand.Center.y = MinuteHand.HandPosition.y
    SecondHand.HandPosition.x = SecondHand.Center.x + SecondHand.Length * COS(SecondHand.Angle)
    SecondHand.HandPosition.y = SecondHand.Center.y + SecondHand.Length * SIN(SecondHand.Angle)
END SUB
 
SUB DrawClockHands
    CALL ccircle(SecondHand.HandPosition.x, SecondHand.HandPosition.y, 3, SecondHand.Shade)
    CALL lineSmooth(SecondHand.Center.x, SecondHand.Center.y, SecondHand.HandPosition.x, SecondHand.HandPosition.y, SecondHand.Shade)
    CALL ccircle(MinuteHand.HandPosition.x, MinuteHand.HandPosition.y, 3, MinuteHand.Shade)
    CALL lineSmooth(MinuteHand.Center.x, MinuteHand.Center.y, MinuteHand.HandPosition.x, MinuteHand.HandPosition.y, MinuteHand.Shade)
    CALL ccircle(HourHand.HandPosition.x, HourHand.HandPosition.y, 3, HourHand.Shade)
    CALL lineSmooth(HourHand.Center.x, HourHand.Center.y, HourHand.HandPosition.x, HourHand.HandPosition.y, HourHand.Shade)
END SUB
 
SUB UpdateTime (t AS DOUBLE)
    TheTime.Hour = t \ 3600
    t = t - TheTime.Hour * 3600
    IF (TheTime.Hour > 12) THEN TheTime.Hour = TheTime.Hour - 12
    TheTime.Minute = t \ 60
    t = t - TheTime.Minute * 60
    TheTime.Second = t
END SUB
 
SUB cpset (x1, y1, col AS _UNSIGNED LONG)
    PSET (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), col
END SUB
 
SUB cline (x1 AS DOUBLE, y1 AS DOUBLE, x2 AS DOUBLE, y2 AS DOUBLE, col AS _UNSIGNED LONG)
    LINE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2)-(_WIDTH / 2 + x2, -y2 + _HEIGHT / 2), col
END SUB
 
SUB ccircle (x1 AS DOUBLE, y1 AS DOUBLE, rad AS DOUBLE, col AS _UNSIGNED LONG)
    CIRCLE (_WIDTH / 2 + x1, -y1 + _HEIGHT / 2), rad, col
END SUB
 
SUB lineSmooth (x0, y0, x1, y1, c AS _UNSIGNED LONG)
    'translated from
    'https://en.wikipedia.org/w/index.php?title=Xiaolin_Wu%27s_line_algorithm&oldid=852445548
 
    DIM plX AS INTEGER, plY AS INTEGER, plI
 
    DIM steep AS _BYTE
    steep = ABS(y1 - y0) > ABS(x1 - x0)
 
    IF steep THEN
        SWAP x0, y0
        SWAP x1, y1
    END IF
 
    IF x0 > x1 THEN
        SWAP x0, x1
        SWAP y0, y1
    END IF
 
    DIM dx, dy, gradient
    dx = x1 - x0
    dy = y1 - y0
    gradient = dy / dx
 
    IF dx = 0 THEN
        gradient = 1
    END IF
 
    'handle first endpoint
    DIM xend, yend, xgap, xpxl1, ypxl1
    xend = _ROUND(x0)
    yend = y0 + gradient * (xend - x0)
    xgap = (1 - ((x0 + .5) - INT(x0 + .5)))
    xpxl1 = xend 'this will be used in the main loop
    ypxl1 = INT(yend)
    IF steep THEN
        plX = ypxl1
        plY = xpxl1
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = ypxl1 + 1
        plY = xpxl1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    ELSE
        plX = xpxl1
        plY = ypxl1
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = xpxl1
        plY = ypxl1 + 1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    END IF
 
    DIM intery
    intery = yend + gradient 'first y-intersection for the main loop
 
    'handle second endpoint
    DIM xpxl2, ypxl2
    xend = _ROUND(x1)
    yend = y1 + gradient * (xend - x1)
    xgap = ((x1 + .5) - INT(x1 + .5))
    xpxl2 = xend 'this will be used in the main loop
    ypxl2 = INT(yend)
    IF steep THEN
        plX = ypxl2
        plY = xpxl2
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = ypxl2 + 1
        plY = xpxl2
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    ELSE
        plX = xpxl2
        plY = ypxl2
        plI = (1 - (yend - INT(yend))) * xgap
        GOSUB plot
 
        plX = xpxl2
        plY = ypxl2 + 1
        plI = (yend - INT(yend)) * xgap
        GOSUB plot
    END IF
 
    'main loop
    DIM x
    IF steep THEN
        FOR x = xpxl1 + 1 TO xpxl2 - 1
            plX = INT(intery)
            plY = x
            plI = (1 - (intery - INT(intery)))
            GOSUB plot
 
            plX = INT(intery) + 1
            plY = x
            plI = (intery - INT(intery))
            GOSUB plot
 
            intery = intery + gradient
        NEXT
    ELSE
        FOR x = xpxl1 + 1 TO xpxl2 - 1
            plX = x
            plY = INT(intery)
            plI = (1 - (intery - INT(intery)))
            GOSUB plot
 
            plX = x
            plY = INT(intery) + 1
            plI = (intery - INT(intery))
            GOSUB plot
 
            intery = intery + gradient
        NEXT
    END IF
 
    EXIT SUB
 
    plot:
    ' Change to regular PSET for standard coordinate orientation.
    CALL cpset(plX, plY, _RGB32(_RED32(c), _GREEN32(c), _BLUE32(c), plI * 255))
    RETURN
END SUB
 

News:

Author Topic: My Best Analog Chiming Clock (Read 8693 times)

SierraKen

Re: My Best Analog Chiming Clock

bplus

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

_vince

Re: My Best Analog Chiming Clock

bplus

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

bplus

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

bplus

Re: My Best Analog Chiming Clock

_vince

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

bplus

Re: My Best Analog Chiming Clock

SierraKen

Re: My Best Analog Chiming Clock

STxAxTIC

Re: My Best Analog Chiming Clock