QB64.org Forum

Active Forums => Programs => Topic started by: bplus on March 04, 2018, 02:18:04 am

Title: Outline Letters
Post by: bplus on March 04, 2018, 02:18:04 am

Well we've rotated letters every which way, how about outling them?

Code: QB64: [Select]

1. _TITLE "Outline Letter bplus 2018-03-03"
2. RANDOMIZE TIMER
3. CONST xmax = 1260
4. CONST ymax = 600
5.  
6.  
7. COMMON SHARED cN, pR!, pG!, pB!
8.  
9. SCREEN _NEWIMAGE(xmax, ymax, 32)
10. _SCREENMOVE 100, 20
11. mess$ = "Bplus strikes again!"
12. PRINT mess$
13.  
14. w = 8 * LEN(mess$): h = 16
15. DIM p(8 * w, 8 * h)
16. black&& = POINT(0, 0)
17. FOR y = 0 TO h - 1
18.     FOR x = 0 TO w - 1
19.         IF POINT(x, y) <> black&& THEN
20.             FOR yy = 0 TO 7
21.                 FOR xx = 0 TO 7
22.                     p(8 * x + xx, 8 * y + yy) = 1
23.                 NEXT
24.             NEXT
25.         END IF
26.     NEXT
27. NEXT
28.  
29. 'now hollow out letter
30. DIM newP(8 * w, 8 * h)
31. FOR y = 0 TO 8 * h
32.     FOR x = 0 TO 8 * w
33.         IF x > 0 AND x < 8 * w THEN
34.             IF y > 0 AND y < 8 * h THEN
35.                 IF p(x, y) THEN
36.                     IF p(x - 1, y) AND p(x + 1, y) AND p(x, y - 1) AND p(x, y + 1) THEN
37.                         newP(x, y) = 0
38.                     ELSE
39.                         newP(x, y) = 1
40.                     END IF
41.                 ELSE
42.                     newP(x, y) = 0
43.                 END IF
44.             ELSE
45.                 newP(x, y) = p(x, y)
46.             END IF
47.         ELSE
48.             newP(x, y) = p(x, y)
49.         END IF
50.     NEXT
51. NEXT
52.  
53. CLS
54. xo = 5: yo = 235: m = 4
55. resetPlasma
56. WHILE 1
57.     CLS
58.     FOR y = 0 TO 8 * h
59.         FOR x = 0 TO 8 * w
60.             IF newP(x, y) THEN
61.                 IF cycle MOD 4 = 0 THEN
62.                     changePlasma
63.                     LINE (x, y)-STEP(0, 4), , BF
64.                 ELSE
65.                     LINE (x, y)-STEP(0, 4), _RGB(lc, lc, lc), BF
66.                 END IF
67.                 x1 = x + 20 * COS(A)
68.                 y1 = y + 40 * COS(A) * SIN(A)
69.                 PSET (x1, y1 + lc + 200), _RGB(255, 255, 0)
70.             ELSEIF p(x, y) THEN
71.                 LINE (x, y)-STEP(0, 4), _RGB32(100, 0, 0), BF
72.             END IF
73.         NEXT
74.     NEXT
75.     _DISPLAY
76.     _LIMIT 30
77.     A = A + _PI(1 / 12)
78.     lc = lc + 1
79.     lc = lc MOD 255
80.     IF lc MOD 255 = 0 THEN cycle = cycle + 1: resetPlasma
81. WEND
82.  
83. SUB changePlasma ()
84.     cN = cN + 1
85.     COLOR _RGB(127 + 127 * SIN(pR! * .1 * cN), 127 + 127 * SIN(pG! * .1 * cN), 127 + 127 * SIN(pB! * .1 * cN))
86. END SUB
87.  
88. SUB resetPlasma ()
89.     pR! = RND ^ 2: pG! = RND ^ 2: pB! = RND ^ 2
90. END SUB
91.  
92.  

Text Only | Text with Attachments