Halloween Reoccurence
#1
Code:
_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  The Reoccurence
       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

Confused
B += x
Reply
#2
I like Steve's better. It's called. "A Country Bumpkin Carved a Pumpkin." Rhymes and everything. Your Jack just looks too scary for this modern PC culture. It might make some Snowflakes feel unsafe.

Nice job!!!

Pete Big Grin
Reply
#3
Thanks Pete! I will have to find Steve's program. TempodiBasic has a load of Chess homework I have to catch up on, plus possibly some interesting math at .net, so no chatting with Rio tonight.
B += x
Reply