ASCII torch on a land of dark letters

[TempodiBasic]

Hi guys

going on with the little demo of a torch made by ASCII in graphic 32 bit
here the result (I have brougth up the SUB version that is my way to code, I am not so able with GOSUB):

Code: QB64: [Select]

1. DIM SHARED A AS LONG, whites(1 TO 50) AS LONG, Black AS LONG, Black2 AS LONG
2. DIM SHARED r AS INTEGER, g AS INTEGER, b AS INTEGER, counter AS INTEGER
3. DIM SHARED area(1 TO 25, 1 TO 62) AS STRING * 1, Lamp AS INTEGER
4. DIM row AS INTEGER, col AS INTEGER
5. DIM min AS INTEGER, max AS INTEGER, up AS INTEGER, down AS INTEGER
6.  
7.  
8. Setup
9. 'CalculateRows
10. '30 rows and 62 columns
11. col = 1
12. row = 1
13. min = 1
14. max = 47
15. up = 1
16. down = 23
17. Lamp = 1
18.  
19.  
20. DO
21.     IF _KEYDOWN(19200) THEN
22.         LOCATE 27, 1: COLOR whites(1): PRINT "Left" + SPACE$(20)
23.         IF col > min THEN col = col - 1
24.     END IF
25.     IF _KEYDOWN(19712) THEN
26.         LOCATE 27, 1: COLOR whites(1): PRINT "Right" + SPACE$(20)
27.         IF col < max THEN col = col + 1
28.     END IF
29.     IF _KEYDOWN(18432) THEN
30.         LOCATE 27, 1: COLOR whites(1): PRINT "Up " + SPACE$(20)
31.         IF row > up THEN row = row - 1
32.     END IF
33.     IF _KEYDOWN(20480) THEN
34.         LOCATE 27, 1: COLOR whites(1): PRINT "Down" + SPACE$(20)
35.         IF row < down THEN row = row + 1
36.     END IF
37.     IF _KEYDOWN(13) THEN
38.         Lamp = Lamp + 1
39.         IF Lamp > 3 THEN Lamp = 1
40.         IF Lamp = 1 THEN
41.             max = 47: down = 23
42.         ELSEIF Lamp = 2 THEN
43.             max = 62: down = 25
44.         ELSEIF Lamp = 3 THEN
45.             max = 58: down = 22
46.         END IF
47.         IF row > down THEN row = down
48.         IF col > max THEN col = max
49.         LOCATE 27, 1: COLOR whites(1): PRINT "Enter change shape of lamp     "
50.     END IF
51.     Arena
52.     MoveLight row, col, 1, 16
53.     LOCATE 26, 1: COLOR _RGB(255, 255, 55), Black: PRINT " press arrows to move light, enter change lamp, space to quit "
54.     _LIMIT 12
55.     CLS
56. LOOP UNTIL _KEYDOWN(32) = -1
57. END
58.  
59. FUNCTION MinMax (Min AS INTEGER, Max AS INTEGER)
60.     IF Min > Max THEN SWAP Min, Max
61.     MinMax = INT(RND * (Max - Min + 1)) + Min
62. END FUNCTION
63.  
64. SUB Arena
65.     DIM x AS INTEGER, y AS INTEGER
66.     LOCATE 1, 1
67.     COLOR Black2, Black
68.     FOR x = 1 TO 25 STEP 1
69.         FOR y = 1 TO 62 STEP 1
70.             PRINT area(x, y);
71.         NEXT y
72.     NEXT x
73. END SUB
74.  
75. SUB MoveLight (row AS INTEGER, col AS INTEGER, min AS INTEGER, max AS INTEGER)
76.     DIM t AS INTEGER, r AS INTEGER, c AS INTEGER
77.  
78.     LOCATE row, col
79.     IF Lamp = 1 THEN
80.         'rectangular light
81.         FOR t = 1 TO 3 STEP 1
82.             c = 9 'flag and color index
83.             FOR r = min TO max
84.                 IF (c > 1 AND Lamp = 1) THEN
85.                     c = c - 1
86.                 ELSEIF c = 1 THEN
87.                     Lamp = 99
88.                 ELSEIF (c > 0 AND c < 9 AND Lamp = 99) THEN
89.                     c = c + 1
90.                 END IF
91.                 COLOR Black, whites(c)
92.                 LOCATE row + t - 1, col + r - 1
93.                 PRINT area(row + t - 1, col + r - 1)
94.             NEXT r
95.             Lamp = 1
96.         NEXT t
97.     ELSEIF Lamp = 2 THEN
98.         'one square
99.         COLOR Black, whites(1)
100.         LOCATE row, col
101.         PRINT area(row, col)
102.     ELSEIF Lamp = 3 THEN
103.         'crux
104.         LOCATE row, col + 1
105.         COLOR Black, whites(4)
106.         PRINT area(row, col + 1); area(row, col + 2)
107.         LOCATE row + 3, col + 1
108.         PRINT area(row + 3, col + 1); area(row + 3, col + 2)
109.         COLOR Black, whites(2)
110.         LOCATE row + 1, col
111.         FOR r = 1 TO 2
112.             FOR t = 1 TO 4
113.                 LOCATE row + r, col + t - 1
114.                 PRINT area(row + r, col + t - 1)
115.             NEXT t
116.         NEXT r
117.     END IF
118.  
119. END SUB
120.  
121.  
122. SUB Setup
123.     DIM counter AS INTEGER, x AS INTEGER
124.     RANDOMIZE TIMER
125.     A = _NEWIMAGE(500, 500, 32)
126.     IF A THEN SCREEN A ELSE PRINT "Error create SCREEN"
127.     Black = _RGB(0, 0, 0)
128.     Black2 = _RGB(0, 0, 50)
129.     whites(1) = _RGB(255, 255, 255)
130.     r = 255
131.     b = 255
132.     g = 255
133.     counter = 1
134.     FOR counter = 2 TO 10
135.         r = r - INT(255 / 10)
136.         b = b - INT(255 / 10)
137.         g = g - INT(255 / 10)
138.         whites(counter) = _RGB(r, g, b)
139.     NEXT counter
140.     FOR y = 1 TO 62 STEP 1
141.         FOR x = 1 TO 25 STEP 1
142.             c = MinMax(65, 90)
143.             area(x, y) = CHR$(c)
144.         NEXT x
145.     NEXT y
146. END SUB
147.  
148. SUB CalculateRows
149.     LOCATE 1, 1: COLOR _RGB(0, 127, 127)
150.     FOR x = 1 TO 80 STEP 1
151.         IF x > -1 THEN PRINT LTRIM$(STR$(x MOD 10));
152.     NEXT x
153.     PRINT
154.     FOR x = 1 TO 30 STEP 1
155.         IF x > -1 THEN PRINT LTRIM$(STR$(x MOD 10))
156.     NEXT x
157.  
158.     SLEEP
159. END SUB
160.  

Thanks to take a look

LOL:
PS I have loose just an hour fighting with SCREEN function because in a wrong way I was remembering that it has been fixed for 32 graphic mode! And the wiki say the same! Gasp... but further search in this forum brings to me the truth!
So frustated I have made an array of string and I have used it to store screen informations...

[FellippeHeitor]

Looks good, Tempodi!

[bplus]

Could use _Display in main loop, but inspired me to give it a try :)

Code: QB64: [Select]

1. _TITLE "text over search light, move mouse wheel" 'started 2019-04-21 B+
2.  
3. CONST xmax = 800
4. CONST ymax = 600
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE _MIDDLE
7. DIM txt(1 TO 37) AS STRING, v(1 TO 37)
8. FOR i = 1 TO 37
9.     b$ = ""
10.     FOR j = 1 TO 100
11.         b$ = b$ + CHR$(INT(RND * 96) + 32)
12.     NEXT
13.     txt(i) = b$: v(i) = INT(RND * 3) + 1
14. NEXT
15. r = 100
16. COLOR _RGB32(40, 20, 10), _RGBA32(0, 0, 0, 40)
17. WHILE _KEYDOWN(27) = 0
18.     CLS
19.     DO WHILE _MOUSEINPUT
20.         r = r + _MOUSEWHEEL
21.     LOOP
22.     mx = _MOUSEX: my = _MOUSEY
23.     FOR i = r TO 0 STEP -1
24.         fcirc mx, my, i, _RGB((r - i) ^ 1.2 / r * 255, (r - i) / r * 255, (r - i) / r * 255)
25.     NEXT
26.     FOR i = 1 TO 37
27.         txt(i) = MID$(txt(i), v(i)) + MID$(txt(i), 1, v(i) - 1)
28.         LOCATE i, 1: PRINT MID$(txt(i), 1, 100);
29.     NEXT
30.     _DISPLAY
31.     _LIMIT 5
32. WEND
33.  
34. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
35.     DIM Radius AS INTEGER, RadiusError AS INTEGER
36.     DIM X AS INTEGER, Y AS INTEGER
37.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
38.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
39.     LINE (CX - X, CY)-(CX + X, CY), C, BF
40.     WHILE X > Y
41.         RadiusError = RadiusError + Y * 2 + 1
42.         IF RadiusError >= 0 THEN
43.             IF X <> Y + 1 THEN
44.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
45.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
46.             END IF
47.             X = X - 1
48.             RadiusError = RadiusError - X * 2
49.         END IF
50.         Y = Y + 1
51.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
52.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
53.     WEND
54. END SUB
55.  
56.  

[TempodiBasic]

Thanks for feedback

Hey Bplus wonderful math underlayer!

[Pete]

Argh, that's just annoying.

DO BETTER!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Pete

[TempodiBasic]

@Pete
ok I need to imagine what and to have some time to write code... after I can show you something better!!!

@Bplus
your characters' background let me think to Matrix  :-)

[OldMoses]

This approach could make a decent game map highlighter, I'm thinking. You guys are cool.

[Jack002]

TempodiBasic, I'm following all your torch on letters posts. Very cool effect. I'd use it if I needed it. Well done.

[Petr]

Nice work, TempodiBasic.