Pentagram of DOOM

[James D Jarvis]

A brief Halloween themed demo.   

Code: (Select All)

'Spooky pentagram of doom for Halloween
'juts a little halloween season fun
Screen _NewImage(800, 500, 32)
_Define K As _UNSIGNED LONG
_FullScreen
'good music here
Play "MB O0 L4  cdccdcecdccdccdccdcecdccababcddcddcdde O2 L2  e  e  e  e  e"
'well not really
For d = 0 To 360
    _Limit 20
    Cls
    circleBF 400, 250, (d * 1.1) / 2, _RGB32(250, 250, 0)
    circleBF 400, 250, ((d * 1) / 2) - 2, _RGB32(0, 0, 0)
    bumpypoly 400, 250, d / 2, 72, 180 + d, 1 + Int(d / 120), _RGB32(0, 250, 10)

    bumpypentagram 400, 250, d / 2, 72, 180 + d, 1 + Int(d / 90), _RGB32(250, 2, 5)
    _Display
Next d
_AutoDisplay
For n = 1 To 900
    _Limit 400
    sx = Int(Rnd * 800)
    sy = Int(Rnd * 500)
    klr = _RGB32(240 + Int(Rnd * 16), Int(Rnd * 10), Int(Rnd * 10))
    rd = Int(Rnd * 12)
    circleBF sx, sy, 8 + rd, klr
    circleBF sx + Int(Rnd * (rd / 2)), sy + Int(Rnd * (rd / 2)), 4 + rd, klr
    circleBF sx + Int(Rnd * (rd / 2)), sy + Int(Rnd * (rd / 2)), 2 + rd, klr
Next
Line (0, 0)-(800, 500), klr, BF
klr2 = _RGB32(250, 250, 0)
For t = 1 To 360
    _Limit 180
    pp = 1 + Int(Rnd * 3)
    For reps = 1 To pp
        sx = Int(Rnd * 800)
        sy = Int(Rnd * 500)
        rd = 3 + Int(Rnd * 24)

        pentagram sx, sy, rd, 72, Int(Rnd * 360), .5 + Rnd * 2.5, klr2
    Next reps
    bumpypentagram 400, 250, 180, 72, 360, 1 + Int(t / 90), _RGB32(75 + t / 2, 75 + t / 2, 5)
Next t
For n = 0 To 255
    _Limit 180
    Line (0, 0)-(800, 500), _RGB32(0, 0, 0, n), BF
    bumpypentagram 400, 250, 180, 72, 360, 5, _RGB32(255, 255, 5)
Next n
For n = 0 To 255
    _Limit 180
    bumpypentagram 400, 250, 180, 72, 360, 5, _RGB32(255, 255, 5)
    Line (0, 0)-(800, 500), _RGB32(0, 0, 0, n), BF

Next n
_Delay 3
Cls
System



Sub bumpypentagram (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
    Dim p(6, 2)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    'Line (cx + x, cy + y)-(cx + x, cy + y), klr
    lx = cx + x: ly = cy + y
    n = 0
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        ' tv = (Rnd * 6 + Rnd * 6 + 3) / 10
        ' bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
        lx = cx + x2: ly = cy + y2
        n = n + 1
        p(n, 1) = cx + x2
        p(n, 2) = cy + y2
    Next
    tv = (Rnd * 6 + Rnd * 6 + 3) / 10
    bumpyline p(1, 1), p(1, 2), p(3, 1), p(3, 2), thk * tv, klr
    tv = (Rnd * 6 + Rnd * 6 + 3) / 10
    bumpyline p(3, 1), p(3, 2), p(5, 1), p(5, 2), thk * tv, klr
    tv = (Rnd * 6 + Rnd * 6 + 3) / 10
    bumpyline p(5, 1), p(5, 2), p(2, 1), p(2, 2), thk * tv, klr
    tv = (Rnd * 6 + Rnd * 6 + 3) / 10
    bumpyline p(2, 1), p(2, 2), p(4, 1), p(4, 2), thk * tv, klr
    tv = (Rnd * 6 + Rnd * 6 + 3) / 10
    bumpyline p(4, 1), p(4, 2), p(6, 1), p(6, 2), thk * tv, klr
End Sub

Sub pentagram (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
    Dim p(6, 2)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    'Line (cx + x, cy + y)-(cx + x, cy + y), klr
    lx = cx + x: ly = cy + y
    n = 0
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        ' tv = (Rnd * 6 + Rnd * 6 + 3) / 10
        ' bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
        lx = cx + x2: ly = cy + y2
        n = n + 1
        p(n, 1) = cx + x2
        p(n, 2) = cy + y2
    Next
    Line (p(1, 1), p(1, 2))-(p(3, 1), p(3, 2)), klr
    Line (p(3, 1), p(3, 2))-(p(5, 1), p(5, 2)), klr
    Line (p(5, 1), p(5, 2))-(p(2, 1), p(2, 2)), klr
    Line (p(2, 1), p(2, 2))-(p(4, 1), p(4, 2)), klr
    Line (p(4, 1), p(4, 2))-(p(6, 1), p(6, 2)), klr
End Sub


Sub bumpypoly (cx, cy, rr, shapedeg, turn, thk, klr As _Unsigned Long)
    x = rr * Sin(0.01745329 * turn)
    y = rr * Cos(0.01745329 * turn)
    'Line (cx + x, cy + y)-(cx + x, cy + y), klr
    lx = cx + x: ly = cy + y
    For deg = turn To turn + 360 Step shapedeg
        x2 = rr * Sin(0.01745329 * deg)
        y2 = rr * Cos(0.01745329 * deg)
        tv = (Rnd * 6 + Rnd * 6 + 3) / 10
        bumpyline lx, ly, cx + x2, cy + y2, thk * tv, klr
        lx = cx + x2: ly = cy + y2
    Next
End Sub
Sub bumpylineLow (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    yi = 1
    If dy < 0 Then
        yi = -1
        dy = -dy
    End If
    'D = (2 * dy) - dx
    d = (dy + dy) - dx
    y = y0
    For x = x0 To x1
        tv = (Rnd * 12 + Rnd * 6 + 3) / 10
        circleBF x, y, r * tv, klr

        If d > 0 Then
            y = y + yi
            ' D = D + (2 * (dy - dx))
            d = d + ((dy - dx) + (dy - dx))
        Else
            ' D = D + 2 * dy
            d = d + dy + dy
        End If
    Next x
End Sub

Sub bumpylineHigh (x0, y0, x1, y1, r, klr As _Unsigned Long)
    dx = x1 - x0
    dy = y1 - y0
    xi = 1
    If dx < 0 Then
        xi = -1
        dx = -dx
    End If
    ' D = (2 * dx) - dy
    D = (dx + dx) - dy
    x = x0
    For y = y0 To y1
        tv = (Rnd * 12 + Rnd * 6 + 3) / 10
        circleBF x, y, r * tv, klr

        If D > 0 Then
            x = x + xi
            ' D = D + (2 * (dx - dy))
            D = D + ((dx - dy) + (dx - dy))
        Else
            ' D = D + 2 * dx
            D = D + dx + dx
        End If
    Next y
End Sub
Sub bumpyline (x0, y0, x1, y1, r, klr As _Unsigned Long)
    If Abs(y1 - y0) < Abs(x1 - x0) Then
        If x0 > x1 Then
            bumpylineLow x1, y1, x0, y0, r, klr

        Else
            bumpylineLow x0, y0, x1, y1, r, klr
        End If
    Else
        If y0 > y1 Then
            bumpylineHigh x1, y1, x0, y0, r, klr
        Else
            bumpylineHigh x0, y0, x1, y1, r, klr
        End If
    End If
End Sub

Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub

[bplus]

Nice, we should have a Halloween Themed thing this year.

[TerryRitchie]

Nice, we should have a Halloween Themed thing this year.

I agree. Here is something I worked on a while back. Maybe someone could use it for their spooky program? An animated lava cave with layers to place creatures in. Remove the remarks from the circle statements in the main loop to see what I mean.

[TerryRitchie]

A brief Halloween themed demo.   

Ok, that was creepy. Cool.

[bplus]

Nice, we should have a Halloween Themed thing this year.

I agree. Here is something I worked on a while back. Maybe someone could use it for their spooky program? An animated lava cave with layers to place creatures in. Remove the remarks from the circle statements in the main loop to see what I mean.

Oh ha! Just found this in my Downloads Folder, very nice with background in constant activity and panning.

[Pete]

I have only one thing to say...

The power of Christ "compiles" you!

Pete

[Pete]

On a side note, shouldn't it be spelled Christe? I mean how do you get a long "i" sound without a silent "e" at the end?

I wonder what possessed me to write this. Oh well...

Pete

- My 2nd favorite actor is Captain Kirk. These are the things I think about at work...

[James D Jarvis]

Nice, we should have a Halloween Themed thing this year.

I agree. Here is something I worked on a while back. Maybe someone could use it for their spooky program? An animated lava cave with layers to place creatures in. Remove the remarks from the circle statements in the main loop to see what I mean.

I slapped the pentagram of doom inside your scrolling cave. (in code of course) Makes me want to improve my generated graphics:   

[Pete]

I tried to use it to make a hex editor, but I got pea soup all over my monitor.

Pete

[James D Jarvis]

I tried to use it to make a hex editor, but I got pea soup all over my monitor.

Pete

That's deserving of a pun-ishmnet.