Wormhole

[SierraKen]

Hi all. I don't know if any of you remember this program from the 90's. But someone made this and posted it, I believe, to the newsgroup comp.lang.basic.misc back then. It shows a wormhole effect and 3D text. After I post the original, the next post on this thread will be what I did with it last night to make text like this in other programs. I think this was made by someone named Travis Schultz. I added the _FULLSCREEN at the top to see it better.

Code: QB64: [Select]

1. _FULLSCREEN
2. SCREEN 13
3. LOCATE 24, 5
4. COLOR 255
5. PALETTE 255, 63 * 65536 + 63 * 256 + 63
6. PRINT " PLEASE WAIT - INITIALIZING ";
7. VIEW SCREEN(0, 0)-(319, 179)
8. READ scr$
9. linen = 1
10. linep = 1
11.  
12. 'OUT 968, 0
13. 'FOR i = 1 TO 765
14. 'OUT 969, 0
15. 'NEXT i
16.  
17. OUT 968, 12
18. OUT 969, 63
19. OUT 969, 0
20. OUT 969, 0
21. OUT 968, 9
22. OUT 969, 0
23. OUT 969, 0
24. OUT 969, 63
25. FOR a = 1 TO 62
26.     FOR c = 0 TO 255
27.         OUT &H3C7, c: r = INP(&H3C9): g = INP(&H3C9): b = INP(&H3C9)
28.         IF r > 0 THEN r = r - 1
29.         IF g > 0 THEN g = g - 1
30.         IF b > 0 THEN b = b - 1
31.         OUT &H3C8, c: OUT &H3C9, r: OUT &H3C9, g: OUT &H3C9, b
32.     NEXT c
33.     WAIT &H3DA, 8
34. NEXT a
35. n = 0
36. x = 5
37. FOR I = 200 TO 40 STEP -1
38.     n = n + 1
39.     IF n = 6 THEN n = 1
40.     x = x / 1.003
41.     FOR j = 1 TO 10
42.         CIRCLE (160, I), x, n, , , .5
43.         x = x * 1.003
44.     NEXT j
45. NEXT I
46.  
47. VIEW SCREEN(0, 0)-(319, 199)
48.  
49. DIM c(265)
50. FOR I = 1 TO 6
51.     c(I) = I * (63 / 6)
52. NEXT I
53. FOR I = 7 TO 256
54.     c(I) = 0
55. NEXT I
56.  
57. FOR I = 1 TO 49
58. NEXT I
59.  
60. LINE (0, 0)-(320, 10), 0, BF
61.  
62. LOCATE 1, 32
63. COLOR 1
64. PRINT "SCHULTZ"
65. FOR I = 248 TO 320
66.     FOR j = 0 TO 10
67.         IF POINT(I, j) > 0 THEN LINE ((I - 196) * 2, j * 2 + 50)-((I - 196) * 2 + 2, j * 2 + 52), 15, BF
68.     NEXT j
69. NEXT I
70.  
71. FOR I = 100 TO 220
72.     FOR j = 49 TO 75
73.         IF POINT(I, j) = 15 THEN GOTO skip2j
74.         IF POINT(I + 1, j + 1) = 15 THEN PSET (I, j), 50
75.         IF POINT(I, j + 1) = 15 OR POINT(I + 1, j) = 15 THEN PSET (I, j), 49
76.         IF POINT(I - 1, j + 1) = 15 OR POINT(I + 1, j - 1) = 15 THEN PSET (I, j), 48
77.         IF POINT(I, j - 1) = 15 OR POINT(I - 1, j) = 15 THEN PSET (I, j), 47
78.         IF POINT(I - 1, j - 1) = 15 THEN PSET (I, j), 46
79.         skip2j:
80.     NEXT j
81. NEXT I
82. FOR I = 100 TO 220
83.     FOR j = 49 TO 75
84.         IF POINT(I, j) = 15 THEN PSET (I, j), 32 - (j - 49)
85.     NEXT j
86. NEXT I
87.  
88. FOR I = 1 TO 5
89.     n = I * 12
90.     c = n * 65536 + n * 256 + n
91.     PALETTE I + 45, c
92. NEXT I
93.  
94. LINE (0, 0)-(320, 10), 0, BF
95.  
96. FOR I = 1 TO 50
97.     r = I + 13
98.     g = I - 1
99.     c = g * 256 + r
100.     PALETTE I + 150, c
101. NEXT I
102.  
103. FOR I = 0 TO 15
104.     c = I * 4
105.     n = c * 65536 + c * 256 + c
106.     PALETTE I + 16, n
107. NEXT I
108.  
109. LOCATE 1, 12
110. COLOR 9
111. PRINT "TRAVIS"
112. DIM ass(200, 8)
113. GET (50, 0)-(250, 8), ass()
114. LINE (50, 0)-(250, 8), 0, BF
115. ax = 0
116. av = 0
117.  
118. DIM text(312 * 8)
119.  
120. DO
121.     OUT 968, 1
122.     FOR j = 1 TO 5
123.         OUT 969, c(j)
124.         OUT 969, 0
125.         OUT 969, 0
126.     NEXT j
127.  
128.     PUT (ax, 0), ass(), PSET
129.     ax = ax + av
130.     IF ax < 50 THEN av = av + 1 ELSE av = av - 1
131.  
132.     b = c(5)
133.     FOR j = 5 TO 2 STEP -1
134.         c(j) = c(j - 1)
135.     NEXT j
136.     c(1) = b
137.  
138.     z = TIMER * 100
139.     DO
140.     LOOP WHILE TIMER * 100 - z < 1
141.  
142.     tm = tm + 1
143.     IF tm < 3 THEN GOTO skip2l
144.     GET (16, 180)-(311, 199), text()
145.     PUT (8, 180), text(), PSET
146.     LOCATE 24, 39
147.     DO
148.         at$ = MID$(scr$, linep, 1)
149.         linep = linep + 1
150.         IF linep > LEN(scr$) THEN
151.             linep = 1
152.             linen = linen + 1
153.             IF linen > 16 THEN: linen = 1: RESTORE
154.  
155.         END IF
156.         IF sl > ln THEN sl = 1
157.         IF at$ = "*" THEN clr = 1
158.         IF at$ = "@" THEN clr = 2
159.         IF at$ = "#" THEN clr = 3
160.         IF at$ = "$" THEN clr = 4
161.         IF at$ = "%" THEN clr = 12
162.         IF at$ = "^" THEN clr = 9
163.         IF at$ = "&" THEN clr = 255
164.     LOOP WHILE INSTR("*@#$%^&", at$) > 0
165.     COLOR clr
166.     PRINT at$;
167.     tm = 1
168.     skip2l:
169. LOOP WHILE INKEY$ = ""
170. CLS
171.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      
172. 'If you are reading this, we told you about it!!!
173.  
174. DATA "  *P@R#O$G*R@A#M$E*D@ *B$Y* $M*Y"
175.  
176.  

[SierraKen]

Here is what I did with it last night. You type 1 word or 2 small words and it forms them into 3D text.  I might play around with this more and change colors, etc. if I can.

Edit: Here is a little bit better than what I first posted in the length of the word(s).

Code: QB64: [Select]

1. 'Code from an old 1990's Internet Newsgroup post.
2. SCREEN 13
3. _FULLSCREEN
4. INPUT "1 word here:", a$
5. CLS
6. LOCATE 1, 32
7. COLOR 1
8. PRINT a$
9. FOR I = 248 TO 420
10.     FOR j = 0 TO 10
11.         IF POINT(I, j) > 0 THEN LINE ((I - 196) * 2, j * 2 + 50)-((I - 196) * 2 + 2, j * 2 + 52), 15, BF
12.     NEXT j
13. NEXT I
14.  
15. FOR I = 100 TO 420
16.     FOR j = 49 TO 75
17.         IF POINT(I, j) = 15 THEN GOTO skip2j
18.         IF POINT(I + 1, j + 1) = 15 THEN PSET (I, j), 50
19.         IF POINT(I, j + 1) = 15 OR POINT(I + 1, j) = 15 THEN PSET (I, j), 49
20.         IF POINT(I - 1, j + 1) = 15 OR POINT(I + 1, j - 1) = 15 THEN PSET (I, j), 48
21.         IF POINT(I, j - 1) = 15 OR POINT(I - 1, j) = 15 THEN PSET (I, j), 47
22.         IF POINT(I - 1, j - 1) = 15 THEN PSET (I, j), 46
23.         skip2j:
24.     NEXT j
25. NEXT I
26. FOR I = 100 TO 420
27.     FOR j = 49 TO 75
28.         IF POINT(I, j) = 15 THEN PSET (I, j), 32 - (j - 49)
29.     NEXT j
30. NEXT I
31.  
32. FOR I = 1 TO 5
33.     n = I * 12
34.     c = n * 65536 + n * 256 + n
35.     PALETTE I + 45, c
36. NEXT I
37.  
38. LINE (0, 0)-(320, 10), 0, BF
39.  
40.