11

« **on:** 31. October 2017, 04:28:10 »
Another occurrence of another variation, kind of scary how it wont go away...

QB64 so I had to make my own ellipse and fill triangle subs.

`_TITLE "Halloween Reoccurence 2017-10-29 bplus"`

CONST xmax = 1100

CONST ymax = 740

SCREEN _NEWIMAGE(xmax, ymax, 32)

_SCREENMOVE 160, 2

RANDOMIZE TIMER

COMMON SHARED sx

cx = xmax / 2: cy = ymax / 2: pr = .49 * xmax

d = 1: sx = 0

WHILE 1

pumpkin cx, cy, pr, 3

sx = sx + rand%(-4, 4)

IF sx > .7 * pr / 12 THEN d = -1 * d: sx = 0

IF sx < -.7 * pr / 12 THEN d = -1 * d: sx = 0

_DISPLAY

_LIMIT 6

WEND

FUNCTION rand% (lo%, hi%)

rand% = INT(RND * (hi% - lo% + 1)) + lo%

END FUNCTION

SUB pumpkin (cx, cy, pr, limit)

'carve this!

COLOR &HFFFF0000

fEllipse cx, cy, pr, 29 / 35 * pr

COLOR &HFF000000

lastr = 2 / 7 * pr

DO

ellipse cx, cy, lastr, 29 / 35 * pr

lastr = .5 * (pr - lastr) + lastr + 1 / 35 * pr

IF pr - lastr < 1 / 80 * pr THEN EXIT DO

LOOP

' 'flickering candle light

COLOR _RGB(RND * 55 + 200, RND * 55 + 200, 120)

' eye sockets

ftri cx - 9 * pr / 12, cy - 2 * pr / 12, cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12

ftri cx - 7 * pr / 12, cy - 6 * pr / 12, cx - 3 * pr / 12, cy - 0 * pr / 12, cx - 2 * pr / 12, cy - 3 * pr / 12

ftri cx + 9 * pr / 12, cy - 2 * pr / 12, cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12

ftri cx + 7 * pr / 12, cy - 6 * pr / 12, cx + 3 * pr / 12, cy - 0 * pr / 12, cx + 2 * pr / 12, cy - 3 * pr / 12

' nose

ftri cx, cy - rand%(2, 5) * pr / 12, cx - 2 * pr / 12, cy + 2 * pr / 12, cx + rand%(1, 2) * pr / 12, cy + 2 * pr / 12

' evil grin

ftri cx - 9 * pr / 12, cy + 1 * pr / 12, cx - 7 * pr / 12, cy + 7 * pr / 12, cx - 6 * pr / 12, cy + 5 * pr / 12

ftri cx + 9 * pr / 12, cy + 1 * pr / 12, cx + 7 * pr / 12, cy + 7 * pr / 12, cx + 6 * pr / 12, cy + 5 * pr / 12

' moving teeth/talk/grrrr..

u = rand%(4, 8)

dx = pr / u

FOR i = 1 TO u

tx1 = cx - 6 * pr / 12 + (i - 1) * dx

tx2 = tx1 + .5 * dx

tx3 = tx1 + dx

ty1 = cy + 5 * pr / 12

ty3 = cy + 5 * pr / 12

ty2 = cy + (4 - RND) * pr / 12

ty22 = cy + (6 + RND) * pr / 12

ftri tx1, ty1, tx2, ty2, tx3, ty3

ftri tx1 + .5 * dx, ty1, tx2 + .5 * dx, ty22, tx3 + .5 * dx, ty3

NEXT

IF limit THEN

'shifty eyes

IF limit = 3 THEN sxs = sx ELSE sxs = .1 * sx

pumpkin sxs + cx - 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)

pumpkin sxs + cx + 5 * pr / 12, cy - 2.5 * pr / 12, .15 * pr, INT(limit - 1)

END IF

END SUB

SUB fEllipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)

DIM scale AS SINGLE, x AS LONG, y AS LONG

scale = yRadius / xRadius

LINE (CX, CY - yRadius)-(CX, CY + yRadius), , BF

FOR x = 1 TO xRadius

y = scale * SQR(xRadius * xRadius - x * x)

LINE (CX + x, CY - y)-(CX + x, CY + y), , BF

LINE (CX - x, CY - y)-(CX - x, CY + y), , BF

NEXT

END SUB

SUB ellipse (CX AS LONG, CY AS LONG, xRadius AS LONG, yRadius AS LONG)

DIM scale AS SINGLE, xs AS LONG, x AS LONG, y AS LONG

DIM lastx AS LONG, lasty AS LONG

scale = yRadius / xRadius: xs = xRadius * xRadius

PSET (CX, CY - yRadius): PSET (CX, CY + yRadius)

lastx = 0: lasty = yRadius

FOR x = 1 TO xRadius

y = scale * SQR(xs - x * x)

LINE (CX + lastx, CY - lasty)-(CX + x, CY - y)

LINE (CX + lastx, CY + lasty)-(CX + x, CY + y)

LINE (CX - lastx, CY - lasty)-(CX - x, CY - y)

LINE (CX - lastx, CY + lasty)-(CX - x, CY + y)

lastx = x: lasty = y

NEXT

END SUB

SUB ftri (xx1, yy1, xx2, yy2, xx3, yy3)

'make copies before swapping

x1 = xx1: y1 = yy1: x2 = xx2: y2 = yy2: x3 = xx3: y3 = yy3

'thanks Andy Amaya!

'triangle coordinates must be ordered: where x1 < x2 < x3

IF x2 < x1 THEN SWAP x1, x2: SWAP y1, y2

IF x3 < x1 THEN SWAP x1, x3: SWAP y1, y3

IF x3 < x2 THEN SWAP x2, x3: SWAP y2, y3

IF x1 <> x3 THEN slope1 = (y3 - y1) / (x3 - x1)

'draw the first half of the triangle

length = x2 - x1

IF length <> 0 THEN

slope2 = (y2 - y1) / (x2 - x1)

FOR x = 0 TO length

LINE (INT(x + x1), INT(x * slope1 + y1))-(INT(x + x1), INT(x * slope2 + y1))

'lastx2% = lastx%

lastx% = INT(x + x1)

NEXT

END IF

'draw the second half of the triangle

y = length * slope1 + y1: length = x3 - x2

IF length <> 0 THEN

slope3 = (y3 - y2) / (x3 - x2)

FOR x = 0 TO length

'IF INT(x + x2) <> lastx% AND INT(x + x2) <> lastx2% THEN 'works! but need 2nd? check

IF INT(x + x2) <> lastx% THEN

LINE (INT(x + x2), INT(x * slope1 + y))-(INT(x + x2), INT(x * slope3 + y2))

END IF

NEXT

END IF

END SUB