Welcome, Guest |
You have to register before you can post on our site.
|
Latest Threads |
Who wants to PLAY?
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
1 hour ago
» Replies: 0
» Views: 7
|
Fun with Ray Casting
Forum: a740g
Last Post: MasterGy
5 hours ago
» Replies: 9
» Views: 163
|
QBJS - ANSI Draw
Forum: QBJS, BAM, and Other BASICs
Last Post: dbox
7 hours ago
» Replies: 3
» Views: 87
|
Cautionary tale of open, ...
Forum: General Discussion
Last Post: doppler
Today, 10:23 AM
» Replies: 3
» Views: 91
|
Extended KotD #23 and #24...
Forum: Keyword of the Day!
Last Post: SMcNeill
Today, 09:51 AM
» Replies: 0
» Views: 35
|
Big problem for me.
Forum: General Discussion
Last Post: JRace
Today, 05:11 AM
» Replies: 11
» Views: 188
|
Virtual Arrays
Forum: Site Suggestions
Last Post: hsiangch_ong
Today, 12:35 AM
» Replies: 8
» Views: 298
|
QBJS v0.9.0 - Release
Forum: QBJS, BAM, and Other BASICs
Last Post: hsiangch_ong
Today, 12:25 AM
» Replies: 17
» Views: 315
|
Very basic key mapping de...
Forum: SMcNeill
Last Post: SMcNeill
Yesterday, 11:18 PM
» Replies: 0
» Views: 35
|
1990's 3D Doom-Like Walls...
Forum: Programs
Last Post: a740g
Yesterday, 06:12 PM
» Replies: 10
» Views: 332
|
|
|
I love the jaggies! |
Posted by: mnrvovrfc - 10-26-2022, 03:17 PM - Forum: Utilities
- Replies (10)
|
|
I created a sub that has too many parameters but could fake the block graphic characters drawn by ancient computers such as the TRS-80 Model III. I have found a bug while composing this on Linux.
Code: (Select All) option _explicit
dim as integer i, x, y, re, be, ge, scw, sch, saiz
scw = 1152
sch = 672
screen _newimage(scw, sch, 32)
saiz = 48
re = 96
ge = re
be = re
'for i = 128 to 191
' block i - 128, saiz, 2, 3, x, y, _rgb(255, 255, 255)
' x = x + saiz
' if x >= 800 then
' x = 0
' y = y + saiz
' end if
'next
'goto pend
saiz = 12
for i = 0 to 4095
block i, saiz, 3, 4, x, y, _rgb(re, ge, be)
x = x + saiz
if x >= scw then
x = 0
y = y + saiz
if y >= sch then exit for
ge = ge + 32
if ge > 255 then ge = 96: be = be + 12
end if
next
pend:
sleep
system
''num = fake character code (bits will be checked)
''siz = point size of the whole "rectangle"
''wd = number of pixels across
''ht = number of pixels vertically
''xx, yy = coordinates of top-left corner (desired to avoid this and "co")
''co = 32-bit color value
''eg. TRS-80 monochrome graphics, wd = 2 and ht = 3, graphics 128 x 48
''for Tandy Coco as well "num" must start at zero but graphics chars started at CHR$(128)
sub block (num as _unsigned integer, siz as integer, wd as integer, ht as integer, xx as single, yy as single, co as long)
static as integer x, y, k
static as _byte p
static as long m
static as single w, h
w = siz / wd
h = siz / ht
p = 0
for y = 0 to ht - 1
for x = 0 to wd - 1
m = 2 ^ p
if num and m then
line(xx + x * w, yy + y * h)-step(w, h), co, bf
end if
p = p + 1
next
next
end sub
The colors are a vain attempt to see the influence of the pixel rows more clearly. This should have range checking. This wasn't tested under "VIEW" and "WINDOW" setting.
Composed this on Fedora 36 MATE. (Yeah got stuck yesterday waiting for 37 to discover they postponed it for another week!)
This is the bug:
On a laptop or other screen with 768 pixels vertically, try changing "sch" to a value higher than 672, compile and run. The top part of the picture is scrolled off as if "PRINT" were used without semicolon near the bottom of the screen. This is seen more obviously if the commented parts were the demonstration, which draws much-larger pixel blocks. This drove me crazy for about half an hour and while I was getting the 3x4-pixel thing straightened out.
My laptop has only 768 pixels vertically. With "task bar" enabled the area is reduced to 720 or less, however that "task bar" has no influence on the user program's window. Maybe somebody with a larger viewport hardware could handle a larger size, but this bug should happen when the vertical dimension is quite near the maximum.
|
|
|
Curious. Do we still have a way to change the date and time? |
Posted by: Pete - 10-25-2022, 01:29 AM - Forum: General Discussion
- Replies (4)
|
|
In QuickBASIC we could manipulate the time and date of the computer.
TIME$ = "06:30:00"
DATE$ = "10/20/2020"
I see QB64 currently supports only using those two statements to get the computer time and date, and no longer to set the time and date. Do we have a Windows API call that can manipulate the computer clocks available?
Pete
|
|
|
TCP/IP Example Demo for LOCAL HOST/CLIENT Applications |
Posted by: Pete - 10-24-2022, 07:30 PM - Forum: Works in Progress
- Replies (20)
|
|
We had a discussion about using _CLIPBOARD to deliver info from one running QB64 app to another. Spriggsy brought up the point that method is frowned upon by M$, which recommends using a TCP/IP routine to pass the info.
So I decided to post a way to communicate back and forth between two QB64 programs.
Notes: You will probably need to tell Windows Defender to okay running these apps, as Defender checks for exe files of this nature.
How to use...
1) Copy/Paste the first program to your QB64 IDE.
2) Open a second IDE and copy/paste the second program.
3) Name and save the second program as; Pete2.bas.
4) Compile Pete2.bas or just run Pete2.bas and close it.
5) Go back to the first IDE, and select "Run" (You don't need to name this app. Untitled works just fine.)
What next? Well, the first program will SHELL open Pete.exe. Now you will have two windows opened. Click the first window, and INPUT 1, 2, or 3 at the prompt. After you hit Enter, you will see your choice appear in the second window as either A, B, C, or if you goofed up it will tell you. The second window sends a message back that it completed the task so the first window can loop back to the INPUT statement. Just close them out with the mouse when you are finished.
Code: (Select All) _SCREENMOVE 0, 0 ' Set up this host window to the left of your desktop.
WIDTH 60, 25
DO
CLS
DO UNTIL x ' Stay in loop until window determines if it is the host or client window.
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
IF x = 0 THEN
x = _OPENHOST("TCP/IP:1234") ' Note the host and clinet must have the same 1234 I.D. number.
a$ = "Opening as host." ' x channel is now open and this window becomes the host.
ELSE
a$ = "Opening as client." ' Should not go here for this demo.
END IF
PRINT a$
LOOP
IF initiate = 0 THEN ' This only needs to be performed once, to open the client window.
SHELL _HIDE "start pete2.exe" ' Open the client window.
initiate = -1 ' Switches this block statement off for all subsequent loops.
END IF
IF z = 0 THEN ' Initiates an open channel number when zero.
DO
z = _OPENCONNECTION(x) ' Checks if host is available to transfer data.
LOOP UNTIL z
PRINT "Connection established."
END IF
LOCATE 3, 1 ' Okay, time to input something on the host that will be communicated to the client.
INPUT "Input a number for letter of the alphabet 1, 2, or 3: "; choice
_KEYCLEAR
PUT #z, , choice ' Input is now entered into TCP/IP routine.
DO
GET #z, , a
LOOP UNTIL a = -1 ' -1 is the return code from the client we set as: task_complete = -1
PUT #z, , a ' Now put our -1 value back into the routine. Failure to do so would result in the client not waiting in the GET #x DO/LOOP.
CLS
LOOP
Save this one as: Pete2.bas and compile it to Pete2.exe.
Code: (Select All) _SCREENMOVE 600, 0 ' Set up this client window next to your host window.
WIDTH 50, 25
x = _OPENCLIENT("TCP/IP:1234:localhost") ' Used to establish a TCP/IP routine.
PRINT "Opened as client.": PRINT
DO UNTIL x = 0 ' Prevents running if this app is opened without using host.
DO
_LIMIT 30
GET #x, , receive ' Waits until it receives data input from the host.
LOOP UNTIL receive > 0
PRINT "You chose the letter: ";
SELECT CASE receive
CASE 1
PRINT "A"
CASE 2
PRINT "B"
CASE 3
PRINT "C"
CASE ELSE
PRINT "Wrong input!"
END SELECT
PRINT
task_complete = -1 ' Send back a task completed message to the host.
PUT #x, , task_complete
LOOP
@Spriggsy
Please have a look. I'd like to see if there is anything you would like to comment on, add or optimize. What I'm shooting for is making another example entry in our wiki to expand on the use of these QB64 available communication functions.
Pete
|
|
|
like Alice in wonderland |
Posted by: MasterGy - 10-23-2022, 06:51 PM - Forum: MasterGy
- Replies (6)
|
|
What does a mouse see? What does an elephant see? Perhaps the larger the animal, the higher it sees the world. The horizon increases with increasing altitude. What is huge for a small animal is small for a large animal. The small animal is slow compared to the ground, but normal speed compared to its own world. Although this is what the big animal feels, only the other way around. I wanted to convey the transition between the two perspectives.
Find an image with a size of about 2000x2000 pixels and try it! Depth data comes from grayscale.
download with sourcecode
https://drive.google.com/file/d/1r3UZ3gp...sp=sharing
|
|
|
Skipping within a For Loop |
Posted by: Dimster - 10-23-2022, 03:38 PM - Forum: Help Me!
- Replies (26)
|
|
Logically the answer to my question here is NO but embarrassment from asking stupid coding questions is my Forte.
When you have a loop control range, can you skip a specific step within the range? So for example the For Loop is
For x = 50 to -50
if x = 0 then next
Next
or if there may be a couple within the controlled range is there a way to
For x = 50 to -50
if x = 10 or x = 0 or x = -10 then Next
Next
Thanks
|
|
|
ASCII scrollable list with mouse |
Posted by: TempodiBasic - 10-23-2022, 07:35 AM - Forum: Programs
- Replies (4)
|
|
Hi QB64 Fan Community
here a perfectable demo of a Vertical Scrolling List in ASCII mode
Code: (Select All) 'ASCII scrollbar output Demo
Dim Num(1 To 100), First As Integer, Last As Integer, Selected As Integer
Dim Stopp, MB1, MB2, Max, MY, MX
Max = 100
For a = 1 To Max
Num(a) = a * 10
Next
_MouseMove 10, 10
First = 1: Last = 15: Selected = First + 4
While Stopp = 0
While _MouseInput: Wend
MB1 = _MouseButton(1)
MB2 = _MouseButton(2)
MY = _MouseX 'column
MX = _MouseY 'row
If MB1 Then
If Chr$(Screen(MX, MY, 0)) = "Ý" Then ' if leftmousebuttonclick is on the scrollingbar
If MX > (Selected Mod 16) Then ' if mouseclick below selected item it scrolls down
Selected = Selected + 5
If Selected > Last Then ' if scrolling Selected goes below LastitemShown it adjourns pointers of listToShow
First = Selected
Last = First + 15
If Last > Max Then Last = Max - Selected + 1 ' if lastItemShown is more than LastItemList it adjourns pointer of listToShow
End If
Else 'if mouseclick over selected item it scrolls up
Selected = Selected - 5
If Selected < First Then
First = Selected
Last = First + 15
If Selected < 1 Then ' if scrolling up selected goes over FirstItemShown it adjourns pointer of ListToShow
First = 1
Selected = 1
Last = First + 15
End If
End If
End If
End If
If Chr$(Screen(MX, MY, 0)) = "Û" Then ' if leftMouseClick is on ruler of scrollingBar
Do While _MouseInput: Loop ' it waits that MouseInput stops
If MX > _MouseY Then
' if actual vertical position of mouse is less than previous the ruler has been brought up
Selected = Selected - 1
If Selected < 1 Then
First = 1
Selected = 1
Last = First + 15
End If
Else ' if actual vertical position of mouse is more than previous ther ruler has been brought down
Selected = Selected + 1
If Selected > Last Then
First = Selected
Last = Selected + 15
If Last > Max Then Last = Max - Selected
End If
End If
End If
End If
If MB2 Then Stopp = 1
Do While _MouseInput: Loop ' it waits that MouseInput stops
Cls
For a = First To Last
If a = Selected Then Color 14, 1
Print Num(a); Space$(5 - Len(LTrim$(Str$(a))));
If a = Selected Then Print "Û" Else Print "Ý"
Color 7, 0
Next
_Limit 5
Wend
End
It's a start and can be expanded to support mouse Drag & Drop, Keyboard shortcuts, and moreover the customizable setting (i.e. how many rows to show on screen, position on the screen, colors for text and background).
Moreover it can become a function that return the selected item.
|
|
|
Program Real Line Counter. Anyone want to jump in? |
Posted by: Pete - 10-22-2022, 08:10 PM - Forum: Works in Progress
- Replies (35)
|
|
Mark asked about this, so I thought I whip up a little something to find out how many real line numbers are in a program. By real line numbers I'm talking about excluding spaces, but adding a line number count for the proper use of colons to separate statements on a single line.
I haven't goof proofed this yet, but I was hoping before going any further I could get some feedback or if anyone would like to modify it, etc. that's fine too. It might be fun for contests, etc. to have an "OFFICIAL" (ha ha) QB64 program line counter.
So basically it roots out trailing colons, REM statements with colons, both ' and REM, and any colons enclosed in quotes like PRINT statements. Did I miss anything? For instance, this routine counts...
CASE 1: PRINT "foo"
That colon is counted as an extra line.
CASE 1
PRINT "foo"
If you think more conditions apply, it might be easy to add in the select case portion.
To try, just copy a forum post program or IDE program to the clipboard and run this code.
Code: (Select All) PRINT "Line count analysis...": PRINT
x$ = _CLIPBOARD$
DO
' parse clipboard
statement$ = UCASE$(MID$(x$, 1, INSTR(x$, CHR$(13)) - 1))
x$ = MID$(x$, INSTR(x$, CHR$(10)) + 1)
IF LEN(_TRIM$(statement$)) THEN
program_ide_lines = program_ide_lines + 1
FOR i = 1 TO 3
SELECT CASE i
CASE 1: mychr$ = CHR$(34)
CASE 2: mychr$ = "'"
CASE 3: mychr$ = "REM"
END SELECT
SELECT CASE i
CASE 1 ' Double polling for enclosed quotes.
DO UNTIL INSTR(statement$, mychr$) = 0
IF INSTR(statement$, mychr$) THEN
statement$ = MID$(statement$, 1, INSTR(statement$, mychr$) - 1) + MID$(statement$, INSTR(INSTR(statement$, mychr$) + 1, statement$, mychr$) + 1)
END IF
LOOP
CASE ELSE
DO UNTIL INSTR(statement$, mychr$) = 0
IF INSTR(statement$, mychr$) THEN
statement$ = MID$(statement$, 1, INSTR(statement$, mychr$) - 1)
END IF
LOOP
END SELECT
NEXT
IF RIGHT$(RTRIM$(statement$), 1) = ":" THEN statement$ = MID$(RTRIM$(statement$), 1, LEN(RTRIM$(statement$)) - 1)
REM PRINT statement$,
' count colons
seed% = 0: linecnt = linecnt + 1: real_line_cnt = real_line_cnt + 1
DO UNTIL INSTR(seed%, statement$, ":") = 0
seed% = INSTR(seed%, statement$, ":") + 1
real_line_cnt = real_line_cnt + 1
LOOP
ELSE
program_ide_lines = program_ide_lines + 1
END IF
IF INSTR(x$, CHR$(10)) = 0 THEN myexit = myexit + 1
LOOP UNTIL myexit = 2
PRINT "Program IDE lines ="; program_ide_lines; " Line count ="; linecnt; " Real line count ="; real_line_cnt
Pete
|
|
|
using the clipboard for communicatign between programs |
Posted by: James D Jarvis - 10-22-2022, 03:05 AM - Forum: Programs
- Replies (13)
|
|
a simple example of using the clipboard to communicate between programs.
This example requires three programs Clipmaster ,cliptalk1, and cliptalk2.
Compile all three and save them in the same directory to see how this works.
I almost certainly lifted the idea from somewhere else but I can't recall where, sorry if I'm failing to give proper credit.
Clipmaster
Code: (Select All) 'Clipmaster
'clipboard communication sample
'
'CTA talk to all the cliptalk programs
'CT1 talk to cliptalk1
'CT2 talk to cliptalk2
'QUITALL ends all the programs
_Title "CLIPMaster"
Shell _DontWait "cliptalk1.exe /RUN"
Shell _DontWait "cliptalk2.exe /RUN"
Do
Line Input "Enter some text to send to other program: ", text$
If text$ = "QUITALL" Then Exit Do
If UCase$(text$) = "CLEAR" Then _Clipboard$ = ""
_Clipboard$ = text$
Loop
_Clipboard$ = "CTAQUITALL"
System
Cliptalk1
Code: (Select All) 'cliptalk1
Screen _NewImage(40, 20, 0)
_Title "CLIPTALK1"
Print "Reading text from clipboard."
Print " Esc key quits!"
MYID$ = "CT1"
Do: _Limit 100
text$ = _Clipboard$ 'function returns clipboard contents
If Len(text$) And text$ <> lasttext$ Then
If text$ = "CTAQUITALL" Then GoTo QEXIT
If Left$(UCase$(text$), 3) = "CTA" Then lasttext$ = text$
If Left$(UCase$(text$), 3) = MYID$ Or Left$(UCase$(text$), 3) = "CTA" Then
tt$ = Left$(UCase$(text$), 3)
text$ = Right$(text$, Len(text$) - 3)
Print text$
If tt$ = MYID$ Then _Clipboard$ = "" 'clear clipboard after a read
End If
End If
Loop Until InKey$ = Chr$(27)
QEXIT:
System
End
cliptalk2
Code: (Select All) 'cliptalk2
Screen _NewImage(40, 20, 0)
_Title "CLIPTALK2"
Color 0, 15
Cls
Print "Reading text from clipboard."
Print " Esc key quits!"
MYID$ = "CT2"
Do: _Limit 100
text$ = _Clipboard$ 'function returns clipboard contents
If Len(text$) And text$ <> lasttext$ Then
If Left$(UCase$(text$), 3) = "CTA" Then lasttext$ = text$
If text$ = "CTAQUITALL" Then GoTo QEXIT
If Left$(UCase$(text$), 3) = MYID$ Or Left$(UCase$(text$), 3) = "CTA" Then
tt$ = Left$(UCase$(text$), 3)
text$ = Right$(text$, Len(text$) - 3)
Print text$
If tt$ = MYID$ Then _Clipboard$ = "" 'clear clipboard after a read
End If
End If
Loop Until InKey$ = Chr$(27)
QEXIT:
System
End
|
|
|
Shadowing |
Posted by: MasterGy - 10-21-2022, 06:31 PM - Forum: MasterGy
- Replies (15)
|
|
Back when I made the "tree house" game, a few years ago. It's 3D and you can only walk around. At that time, I remember Galleon rewrote the program and added something to the display part to shade the textures. Everything got darker in proportion to the distance. I didn't understand then. I looked for the code, but I couldn't find it, and the old forum is not available. Since then, I have solved the distance-proportional darkening of games by generating lots of textures. That's a lot of memory, and it doesn't work on a large surface, because if one vertex of a triangle is close to you and another vertex is far away, then what shade should it get? So it's only good for displaying small textures.
In the past few days, I've been thinking about how Galleon solved the problem of placing a texture of any size on the screen in any way. Then he told me that a black mask with an alpha distance proportional to the texture should be drawn. That's when I understood that by switching _depthbuffer on and off, it can be solved by dragging the alpha texture after each texture. And I understood why I didn't use it then. Very good, fast, practical, only switching the z-buffer on and off slows down the program significantly.
I was wondering how it could be solved without switching on the z-buffer.
Suppose _maptriangle gets a 3d point. be x,y,z. it should be 20,10,30. This point in the plane will be where, for example, 200,100,300 or 2,1,3 or 40,20,60. This simple realization helped. Simply, after drawing the texture, x,y,z must be multiplied by 0.999999, and then the mask can be drawn on it. That way, you don't have to switch on the z-buffer.
I thank Galleon several times already! If it doesn't show it then, I won't think about how it could be operated faster.
Code: (Select All) picture$ = "" '<-------- enter an image or leave the field blank
'texture
If _FileExists(picture$) Then
text = _LoadImage(picture$, 33)
Else
temp = _NewImage(1, 1, 32): _Dest temp: Cls , _RGB32(255, 255, 255): text = _CopyImage(temp, 33): _FreeImage temp
End If
'window
monx = 800: mony = Int(monx / _DesktopWidth * _DesktopHeight): monm = monx * .008: mon = _NewImage(monx, mony, 32): Screen mon: _FullScreen: _DisplayOrder _Hardware , _Software
Const pip180 = 3.141592 / 180
Dim Shared me(9), cosrotz, sinrotz, cosrotx, sinrotx, sinrot_cs, cosrot_cs
'cube locations, sizes
Randomize Timer
cube_res = 1000: cube_deep = 1000
temp = _NewImage(cube_res - 1, cube_deep - 1, 32): _Dest temp: For t = 0 To cube_res - 1: For t2 = 0 To cube_deep - 1
PSet (t, t2), _RGBA32(0, 0, 0, Int(255 / (cube_deep - 1) * t2) - 3)
Next t2, t: cube_text = _CopyImage(temp, 33): _FreeImage temp
'mask distance behind texture
Dim shdw_m(15000): For t = 0 To 15000: shdw_m(t) = Interpolate(.999, .97, 1 / 15000 * t): Next t
mapdim = 1000
'make cubes
obj_c = 200
Dim obj(obj_c - 1, 9): _Source deep_text: For t = 0 To obj_c - 2: For t2 = 0 To 2: obj(t, t2) = mapdim * Rnd: obj(t, t2 + 3) = 10 + 40 * Rnd: Next t2, t
For t = 0 To 2: obj(obj_c - 1, 3 + t) = mapdim / 2: obj(obj_c - 1, t) = mapdim / 2: Next t
For t = 0 To 2: me(t) = mapdim / 2: Next t: light = .2: me(4) = -.2: ut_me4 = -.2: ylook_limit = 80 'radian
_Dest mon
Locate 1, 1: Print "moving:WASD looking:mouse light adjust : mousewheel"
Dim p(3, 2), p2(3, 2), pc(7, 9)
Do: _Limit 30
'control
mouse_sens_xy = .01: mouse_sens_z = .01
mousex = 0: mousey = 0: mousew = 0: While _MouseInput: mousex = mousex + _MouseMovementX: mousey = mousey + _MouseMovementY: mousew = mousew + _MouseWheel: Wend
me(3) = me(3) + mousex * mouse_sens_xy: me(4) = me(4) + mousey * mouse_sens_z
ylook_deg = ((me(4) / pip180) + 90): If Abs(ylook_deg) > ylook_limit Then me(4) = ut_me4 Else ut_me4 = me(4)
rot_cs = (rot_cs + mousex * .001 * Abs(Sin(me(4)))) * .9
light = light - mousew * 0.005: If light < 0 Then light = 0 Else If light > 1 Then light = 1
Locate 2, 1: Print "light:"; Int(light * 100); "% "
position_speed = 5
kw = _KeyDown(119): ks = _KeyDown(115): ka = _KeyDown(97): kd = _KeyDown(100): new_direction = (Abs(ka Or kd Or kw) Or -Abs(ks)) * position_speed
deg_XY = -90 * Abs(ka) + 90 * Abs(kd): szog_xy = me(3) + deg_XY * pip180: szog_z = me(4)
me(0) = me(0) - Sin(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(1) = me(1) - Cos(szog_xy) * (1 - Cos(szog_z)) * new_direction
me(2) = me(2) - Cos(szog_z + _Pi) * new_direction
cosrotz = Cos(me(3)): sinrotz = Sin(me(3)): cosrotx = Cos(me(4)): sinrotx = Sin(me(4)): cosrot_cs = Cos(rot_cs): sinrot_cs = Sin(rot_cs) 'to rotating angles
'draw cubes
px1 = cube_res / 2: px2 = cube_res - 2
dl = cube_deep - 3: c_dis = Interpolate(50, 2500, light): temp = cube_deep / c_dis
For a_obj = 0 To obj_c - 1: For t = 0 To 7
For t2 = 0 To 2: pc(t, t2) = (obj(a_obj, 3 + t2) * (Sgn(t And 2 ^ t2) * 2 - 1) + (obj(a_obj, t2) - me(t2))): Next t2
rotate pc(t, 0), pc(t, 1), pc(t, 2)
pc(t, 3) = Sqr(pc(t, 0) * pc(t, 0) + pc(t, 1) * pc(t, 1) + pc(t, 2) * pc(t, 2))
sm = shdw_m(Abs(Int(pc(t, 2))))
For t2 = 0 To 2: pc(t, 4 + t2) = pc(t, t2) * sm: Next t2
Next t
For t = 0 To 5: For t2 = 0 To 3: side(t2) = Val(Mid$("024623673175105445670123", 1 + t * 4 + t2, 1)): For t3 = 0 To 2: p(t2, t3) = pc(side(t2), t3): p2(t2, t3) = pc(side(t2), t3 + 4): Next t3, t2
'texture
_MapTriangle (0, 0)-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(0, 0), p(0, 1), p(0, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
_MapTriangle (_Width(text), _Height(text))-(_Width(text) - 1, 0)-(0, _Height(text)), text To(p(3, 0), p(3, 1), p(3, 2))-(p(1, 0), p(1, 1), p(1, 2))-(p(2, 0), p(2, 1), p(2, 2)), , _Smooth
'shadow mask
For t2 = 0 To 3: py(t2) = Int(temp * pc(side(t2), 3)): If py(t2) > dl Then py(t2) = dl
Next t2
_MapTriangle (1, py(0))-(px1, py(1))-(px2, py(2)), cube_text To(p2(0, 0), p2(0, 1), p2(0, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
_MapTriangle (1, py(3))-(px1, py(1))-(px2, py(2)), cube_text To(p2(3, 0), p2(3, 1), p2(3, 2))-(p2(1, 0), p2(1, 1), p2(1, 2))-(p2(2, 0), p2(2, 1), p2(2, 2)), , _Smooth
Next t, a_obj
_Display
Loop
Function Interpolate (a, b, x): Interpolate = a + (b - a) * x: End Function
Sub rotate (px, py, pz2): px3 = px * cosrotz - py * sinrotz: py2 = px * sinrotz + py * cosrotz: py3 = py2 * cosrotx - pz2 * sinrotx: pz3 = py2 * sinrotx + pz2 * cosrotx
px4 = px3 * cosrot_cs - py3 * sinrot_cs: py4 = px3 * sinrot_cs + py3 * cosrot_cs: px = -px4: py = -py4: pz2 = -pz3: End Sub
|
|
|
|