ubi44
Junior Member
Posts: 51
|
Post by ubi44 on Jan 14, 2024 1:00:04 GMT
I didn't want to overload the presentation and thought it would be intuitive. However, it only is for me... I was wrong! So here are all the instructions and hiden features: On the start screen, hovering over the title 'Dark Battle', options should appear and clicking on it will take you to a (somewhat dark) menu where there are two clickable flags to change the language: Molière or Shakespeare  From top to bottom the options are: 1) AI not always easy / or hard... this when 'not always hard' is selected, shows the type of boat that is sunk, including for the AI, which changes things up a bit 2) Just below brightness and alpha are indicated but not clickable you have to use the arrows on the keyboard to change them: up/down for brightness and right left for alpha this option works at any time in the program (I used the ontimer function for this) 3) Then there is the resolution which goes from 320/240 (for fun) to 1440/1080, the smaller the resolution, the smoother the game is at the expense of quality... 4) GRID SIZE defaults to 10 but you can choose from 6 to 26, this is the size of the game grid. 5) Underneath there are Small, Classic and Great these are parts with a predefined number of boats and grid size: Small: Grid Size 6 with 3 ships, Classic: Grid 10 with 5 Ships and Great: Grid 15 with 15 Ships 6) Below that there are 8 shots per turn it's default but you can decrease to 1 or increase but never higher than the size of the grid minus 2 for a grid of 10, 8 is the maximum... 7) Next there is the list of boats that can be modified at will limited by the size of the grid (which can increase on its own if necessary)! 8) Finally, there's the start button that returns to the start screen On the start screen, at the top left, there is an option to switch to full screen or window (alt+enter too)! At the very top center there is Start arcade. hovering over it appears 'infinite laser' and 'limited laser' (with a Z.. fault?) These two buttons start a game with the possibility to shoot at the incoming missiles (more chance to win...) At the top right are displayed the fps. By hovering over the fps with the mouse, Exit will appear with a small red cross, it's to exit the game and return to the desktop. At the very bottom, in the center, Start Classic starts a game without the possibility of shooting at enemy missiles! There's still a menu hidden under the QB64 flag... These are graphical options When hovering over the QB64 flag, a big BENCH appears just below it, there is 30fps or 20 fps. There, by clicking, the program will automatically adjust the graphic quality of the grid to reach (approximately) the chosen framerate. Underneath, from left to right there is grid which changes the quality of the grid in game (you have to click on the <= or => ) this can improve the fluidity in some cases then there is smoke on/off it is to add smoke when your boat is hit (anecdotal and very greedy by the way the choice of fps goes to 15 or 20 when the smoke option is on) well everything at Right there is sun on/off to have the halo of the "sun" or not. just below there is water quality which will adjust the water quality manually without worrying about FPS! It's up to you. Also in this menu, by right-clicking, a menu appears to choose the number of particles in space (from 30 to 600), a right click and you will return to the previous menu. When you have chosen a game mode (start arcade or start classic), you get to where you have to position your boats, a left click will rotate the boat, a right click will put it on the grid, there is also an AUTO button that flashes red at the top center (but it doesn't work very well when there is only one boat... it must be insisted). When one or more boats are placed, a reset button on the right (not quite at the top!) will appear, it allows you to remove everything at once! Once a boat is placed, you can select it with a left click to move it to another and put it down with a right click. Starting from the top left corner of the screen, a back button appears to return to the start screen. When all the boats are placed, an ok button appears at the top right, it allows you to move on. So it's a coin toss! Move the mouse to the bottom right to choose Head or to the bottom left to choose Tail. By clicking the wheel will slow down until it stops. You or AI starts click to start the game! In-game, right-clicking when it's your turn to play will rotate the grids to see where the AI to hit. By pressing ESC, you will have the option to return to the home screen (confirmation needed). Pressing the space bar would show you the contract (the number of ships to be sunk with the number of squares they occupy in parentheses) When the game is over, savor your victory (or not!) and by clicking you will return to the splash screen. |
|
ubi44
Junior Member
Posts: 51
|
Post by ubi44 on Jan 14, 2024 14:50:20 GMT
Here's the (commented) code for the in-game text... Edited..01/18/2024 ...and now it work !!!
Type lettr
t As Integer ' if t=0 first it's point of the letter| if t=1 its point of the letter| if t=2 its last point of the letter
x As _Float ' x
y As _Float ' y
End Type
Type vec2
x As _Float
y As _Float
End Type
WidthOfCharacter = 85 ''' Width of a letter ...Sets the space between letters.
Dim Shared Lett(256, 500) As lettr ' Stores letters Lett(letter, point of letter)
Dim Shared LettStart(256) As vec2 ' Stores first point of letters x,y
Screen _NewImage(800, 600, 32)
Scanlet
Cls
CUT = 15 ' . the cut of a letter( each 5 a cut) ...25 MAX , ... 5 MIN
VD = -5 ' increment of a 'auto'cut line 24 & 25
grouch = Timer + .5
taille = Abs(Cos(Timer))
r$ = ".TYPE TEXT." '''' the key input!
M$ = Chr$(2) + " hello world " + Chr$(2)
Do
If grouch < Timer Then
If Int(taille * 10000) <= Int(0.1 * 10000) Then ' change the cut if taille = Pretty much = 0
CUT = CUT + VD
If CUT >= 30 Or CUT <= 0 Then VD = -VD: CUT = CUT + VD * 2 ' allright with limit
grouch = Timer + .5 ' wait a bit...the pretty much..
End If
End If
taille = Abs(Cos(Timer * .8)) ' size of text must be between 0 & 1
graa = 5 '5 + 2 * Abs(Cos(Timer * 5.7*2)) ' bold of r$ text colouring
For y = 1 To _Height ' cls with color gradient!
Line (0, y)-(_Width, y), _RGBA(25 + Cos(Timer) * 10 - (y / _Height) * 45, 10 + Cos(Timer / 8) * 10 - (y / _Height) * 20, 37 - Cos(Timer / 2) * 16 - (y / _Height) * 53, 125)
Next y
' xx is To place text$. to place centered i start from the center of screen minus half of the (len(text$) + 2) * the size of text * (WidthOfCharacter)
text$ = "step to draw letters:" + Str$(CUT)
xx = _Width / 2 - .2 * ((Len(text$) + 2) / 2) * (WidthOfCharacter)
Text2D text$, .2, 15, -1, xx, 1, 10, 178, 120, 24, 150 ' 2d text
Text2D text$, .2, 0, 1, xx, 1, 10, 17, 17, 17, 255 ' 2d text
text$ = "type some text or hit enter to reset, esc to quit"
xx = _Width / 2 - .185 * ((Len(text$) + 2) / 2) * (WidthOfCharacter)
Text2D text$, .185, 15, 1, xx, _Height - WidthOfCharacter * 3 * .185, 5, 178, 120, 24, 150
Text2D text$, .185, 0, -1, xx, _Height - WidthOfCharacter * 3 * .185, 5, 17, 17, 17, 255
text$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
xx = _Width / 2 - taille * (.5 + (1 - taille) * .5) * ((Len(text$) + 2) / 2) * (WidthOfCharacter)
Text2D text$, taille * (.5 + (1 - taille) * .5), 15, 1, xx, 100 * taille * (.5 + (1 - taille) * .5), CUT, 178, 120, 24, 25 + 100 * taille ' 2d text
Text2D text$, taille * (.5 + (1 - taille) * .5), .5, 1, xx, 100 * taille * (.5 + (1 - taille) * .5), CUT, 175, 175, 175, 12 * taille * 4 ' 2d text
text$ = " | Hit F1 and see ....current bold:" + Str$(bolding) + " . ..,\_o')--/ |"
xx = repose
If xx < -(.2 * ((Len(text$) + 2)) * (WidthOfCharacter)) Then repose = _Width + 5
Text2D text$, .2, 15, -1, xx, _Height * .87, 5, 178, 120, 24, 150 ' 2d text
Text2D text$, .2, 0, 1, xx, _Height * .87, 5, 17, 17, 17, 255 ' 2d text
repose = repose - 5
text$ = r$ '
xx = _Width / 2 - (5 + go) * ((Len(text$) + 2) / 2) * (WidthOfCharacter)
bout = Len(r$)
If bout > 55 Then bout = 55
If bolding = 0 Then
Text2D r$, 5 + go, 1.5 * (1 + (graa - bout * .005)), -1, xx, 180 + bout, CUT, 255, 120 + bout * .14, 24 - bout / 4, 155 - Len(r$) * 1.7 ' 2d text
Text2D r$, 5 + go, (1 + (graa - bout * .01)), -1, xx, 180 + bout, CUT, 127 - bout, bout * 1.4, 4 + bout * .4, 255 ' 2d text
End If
If bolding = 1 Then
Text2D r$, 5 + go, 3 * (1 + (graa - bout * .005)), 1, xx, 180 + bout, CUT, 255, 120 + bout * .14, 24 - bout / 4, 155 - Len(r$) * 1.7 ' 2d text
Text2D r$, 5 + go, (1 + (graa - bout * .01)), -1, xx, 180 + bout, CUT, 127 - bout, bout * 1.4, 4 + bout * .4, 255 ' 2d text
End If
If bolding = 2 Then
Text2D r$, 5 + go, 1.5 * (1 + (graa - bout * .005)), -1, xx, 180 + bout, CUT, 255, 120 + bout * .14, 24 - bout / 4, 155 - Len(r$) * 1.7 ' 2d text
Text2D r$, 5 + go, (1 + (graa - bout * .01)), 1, xx, 180 + bout, CUT, 127 - bout, bout * 1.4, 4 + bout * .4, 255 ' 2d text
End If
If bolding = 3 Then
Text2D r$, 5 + go, 3 * (1 + (graa - bout * .005)), 1, xx, 180 + bout, 5, 55, 75 + bout * .4, 24 - bout / 4, 155 - Len(r$) * 1.7 ' 2d text
Text2D r$, 5 + go, (1 + (graa - bout * .01)), -1, xx, 180 + bout, 5, 75, 87 + bout * .4, 44 - bout / 4, 255 ' 2d text
End If
If r$ <> "" Then ' adjust the size with var __'go'(min-3,max 0).. to set the good size of r$_Text2d to fit the screen ! (used as (3 + go))
If xx < 0 Then go = go - .07: If go < -5 Then go = -5
If xx > _Width / 8 Then go = go + .01: If go > 0 Then go = 0
End If
x = _KeyHit ' input key presed or not!
If x Then
If x < 0 Then '
' Released negative value means key released
x = -x
If add = 1 Then add = 2 ' if key pressed and key released then key confirm!
Else
add = 1 ' key pressed
' Pressed positive value means key pressed
End If
If x < 256 Then 'ASCII code values
'
If add = 2 Then If x >= 32 And x <= 200 Then r$ = r$ + Chr$(x): add = 0 ' if key confirm add keypress to r$ and set add to 0
End If
If go <> 0 Then If x = 13 Then M$ = r$: r$ = "": go = 0 ' if hit enter reset and save to M$ for Text3D
If x = 15104 And add = 2 Then
Select Case bolding
Case 0
bolding = 1
Case 1
bolding = 2
Case 2
bolding = 3
Case 3
bolding = 0
End Select
add = 0
End If
End If
'''
bol = (Len(M$) + 1) ' set angle rotation in text3d
tim = (Timer * .3)
tim = Cos(tim) * .9 '''''' xz angx
tto = Timer '''''''''''''' yz angy
tth = -tim * .5 '''''''''' xy angz
''''''''''''''''
text$ = M$
For i = 1 To 15 Step 2
Text3D text$, .5, .5 * -((Len(text$) + 2) / 2) * WidthOfCharacter, 15 + (1 + tth) * 55 + (taille) * 150, 250 - i * 2 + taille * 1250, tim, Cos(tto * .5), tth, CUT, 55 + i * 20, 160, 144, 175 - taille * 186 ' 3d text
Next i
_Display
_Limit 60
Loop Until _KeyDown(27)
End
Sub Scanlet 'Scans all 255 characters
Dim x As Integer, y As Integer
lettre = 1
debut:
Cls
_Display 'no show!
PTT = 0 'Number of points to make a letter
_PrintString (400, 200), (Chr$(lettre))
' Redraw the letter in reverse video and in large size, to show the holes in the letters!
For x = 400 To 407
For y = 200 To 215
If _Red32(Point(x, y)) = 255 Then
Line (5 + (-400 + x) * 10, 5 + (y - 200) * 10)-((-400 + x) * 10 + 15, (y - 200) * 10 + 15), _RGB(0, 0, 0), BF
Else
Line (5 + (-400 + x) * 10, 5 + (y - 200) * 10)-((-400 + x) * 10 + 15, (y - 200) * 10 + 15), _RGB(255, 255, 255), BF
End If
Next y, x
' Erase the letter and leave only the holes
For yy = 1 To 200
Paint (5, yy), _RGB(0, 0, 0)
Next yy
'Scans holes
For hy = 0 To 200
For hx = 0 To 200
If Point(hx, hy) = _RGB(255, 255, 255) Then
x = hx: y = hy
GoSub SCANLEttRE
PTT = PTT + 1
Paint (hx + 1, hy + 1), _RGB(0, 0, 0) ' erase hole
End If
Next hx
Next hy
'redraw the letter
For x = 400 To 407
For y = 200 To 215
If _Red32(Point(x, y)) = 255 Then Line (5 + (-400 + x) * 10, 5 + (y - 200) * 10)-((-400 + x) * 10 + 15, (y - 200) * 10 + 15), _RGB(255, 255, 255), BF
Next y
Next x
'scan letter
For hy = 0 To 200
For hx = 0 To 200
If Point(hx, hy) = _RGB(255, 255, 255) Then
x = hx: y = hy
GoSub SCANLEttRE
PTT = PTT + 1
Paint (hx + 1, hy + 1), _RGB(0, 0, 0) 'erase letter
End If
Next hx
Next hy
Lett(lettre, PTT).t = 2 'end of letter
lettre = lettre + 1
If lettre > 255 Then Exit Sub
GoTo debut
SCANLEttRE: 'follows the contour of the letter or hole and creates a dot with each change of direction! in text3d and text2d the cut consist in jump in all dot
STARTX = x
STARTY = y
dirx = 1: diry = 0
olddirx = 1: olddiry = 0
If PTT > 0 Then
Lett(lettre, PTT).x = STARTX - oldSTARTx
Lett(lettre, PTT).y = STARTY - oldSTARTy
Lett(lettre, PTT).t = 0
Else
LettStart(lettre).x = (x / 3)
LettStart(lettre).y = (y / 3)
End If
totx = x: toty = y
Do
dbb:
lon = lon + 1
If dirx = 1 Then
If _Red32(Point(x + dirx, y)) = 0 Then
If _Red32(Point(x, y + 1)) = 255 Then
dirx = 0: diry = 1
GoTo 7
End If
If _Red32(Point(x, y - 1)) = 255 Then dirx = 0: diry = -1: GoTo 7
End If
If _Red32(Point(x + dirx, y)) = 255 And _Red32(Point(x + dirx, y - 1)) = 0 And _Red32(Point(x + dirx, y + 1)) = 255 Then
dirx = 1: diry = 0: GoTo 7
End If
If _Red32(Point(x + dirx, y)) = 255 And _Red32(Point(x + dirx, y - 1)) = 255 Then dirx = 0: diry = -1: GoTo 7
End If
If dirx = -1 Then
If _Red32(Point(x + dirx, y)) = 0 Then
If _Red32(Point(x, y - 1)) = 255 Then dirx = 0: diry = -1: GoTo 7
If _Red32(Point(x, y + 1)) = 255 Then dirx = 0: diry = 1: GoTo 7
End If
If _Red32(Point(x + dirx, y)) = 255 And _Red32(Point(x + dirx, y + 1)) = 0 Then dirx = -1: diry = 0: GoTo 7
If _Red32(Point(x + dirx, y)) = 255 And _Red32(Point(x + dirx, y - 1)) = 255 Then dirx = 0: diry = 1: GoTo 7
End If
If diry = 1 Then
If _Red32(Point(x, y + diry)) = 0 Then
If _Red32(Point(x - 1, y)) = 255 Then dirx = -1: diry = 0: GoTo 7
If _Red32(Point(x + 1, y)) = 255 Then dirx = 1: diry = 0: GoTo 7
End If
If _Red32(Point(x, y + diry)) = 255 And _Red32(Point(x + 1, y + diry)) = 0 Then diry = 1: dirx = 0: GoTo 7
If _Red32(Point(x, y + diry)) = 255 And _Red32(Point(x + 1, y + diry)) = 255 Then dirx = 1: diry = 0: GoTo 7
End If
If diry = -1 Then
If _Red32(Point(x, y + diry)) = 0 Then
If _Red32(Point(x - 1, y)) = 255 Then dirx = -1: diry = 0: GoTo 7
If _Red32(Point(x + 1, y)) = 255 Then dirx = 1: diry = 0: GoTo 7
End If
If _Red32(Point(x, y + diry)) = 255 And _Red32(Point(x - 1, y + diry)) = 0 Then diry = -1: dirx = 0: GoTo 7
If _Red32(Point(x, y + diry)) = 255 And _Red32(Point(x - 1, y + diry)) = 255 Then dirx = -1: diry = 0: GoTo 7
End If
GoTo dbb
7 If olddirx <> dirx And lon > 1 Then
vecx = vecx + olddirx * lon
vecy = vecy + olddiry * lon
If Sqr(vecx * vecx + vecy * vecy) > 1 Then
PTT = PTT + 1
Lett(lettre, PTT).x = vecx
Lett(lettre, PTT).y = vecy
Lett(lettre, PTT).t = 1
totx = totx + vecx
toty = toty + vecy
vecx = 0: vecy = 0
End If
lon = 0
End If
x = x + dirx: y = y + diry
If x = STARTX And y = STARTY Then
Exit Do 'The round is over!
End If
olddirx = dirx: olddiry = diry
Loop
PTT = PTT + 1
Lett(lettre, PTT).x = STARTX - totx
Lett(lettre, PTT).y = STARTY - toty
Lett(lettre, PTT).t = 1
lon = 0
oldSTARTx = STARTX
oldSTARTy = STARTY
Return
End Sub
Sub Text2D (phrase$, T As _Float, GRa, ORDre, Vx, Vy, Dcoupe, r, g, b, a)
Shared WidthOfCharacter 'Width of a letter
If T * .6 > 2 Then Toff = 2 Else Toff = T * .6
DDcoupe = Dcoupe
If T < .1 Then GRa = 1
'T for size
If T < 0 Then T = 0
'Gra to make bold
'ORDre to bold in or out
'vx vy starting position of the phrase/word
'Dcoupe to define a cutout of the letter
If DDcoupe < 5 Then DDcoupe = 5
If DDcoupe > 30 Then DDcoupe = 30
'r g b a _RGBA()
sDcoupe = DDcoupe
For Lete = 1 To Len(phrase$)
I = Asc(phrase$, Lete)
QQ = .7
stx = (LettStart(I).x * 3) * T + Vx + Lete * WidthOfCharacter * T
sty = (LettStart(I).y * 3) * T + Vy
If I = 7 Or (I >= 9 And I <= 13) Or I > 255 Then Exit Sub
If I = 32 Then GoTo 3117 'space...
Select Case I 'if some limit cause unreadable!!!!
Case 74, 187, 90
If DDcoupe > 25 Then DDcoupe = 25
Case 120, 88, 107, 54, 116
If DDcoupe > 15 Then DDcoupe = 15
Case 83, 71, 87, 119, 132, 122, 106, 50, 77
If DDcoupe > 20 Then DDcoupe = 20
Case 118, 86
If DDcoupe > 10 Then DDcoupe = 10
Case 78, 109, 110
If DDcoupe > 25 Then DDcoupe = 25
Case 115
If DDcoupe > 10 Then DDcoupe = 10
Case 75
If DDcoupe > 15 Then DDcoupe = 25
Case Else
DDcoupe = sDcoupe
End Select
If ((I > 47 And I < 58)) Or ((I > 64 And I < 123)) Then
'is not special characters.
Else
'if it's special charctere
If DDcoupe > 20 Then DDcoupe = 20 'over get point!
End If
oldi = I
Do
uP: tpx = Lett(I, pt).x: tpy = Lett(I, pt).y
If Lett(I, pt).t = 1 Or pt = 0 Or Lett(I, pt).t = 2 Then
L1 = Sqr(tpx * tpx + tpy * tpy)
coupe:
If L1 < DDcoupe Then
upx = Lett(I, pt + 1).x: upy = Lett(I, pt + 1).y
tpx = tpx + upx: tpy = tpy + upy
If Lett(I, pt).t <> 2 Then pt = pt + 1
If Lett(I, pt).t = 1 Then
upx = Lett(I, pt).x: upy = Lett(I, pt).y
L1 = Sqr(upx * upx + upy * upy)
GoTo coupe
End If
End If
End If
tpp = tpp + 1
If Lett(I, pt).t = 1 Or Lett(I, pt).t = 2 Then
bfx = stx + tpx * T
bfy = sty + tpy * T
dist = Sqr(tpx * tpx + tpy * tpy)
dix = (-tpy / dist) * (T)
diy = (tpx / dist) * (T)
For gras = 1 To GRa Step 4 - Toff
If ORDre = -1 Then
ax = stx - dix * gras: ay = sty - diy * gras
bx = bfx - dix * gras: by = bfy - diy * gras
Else
ax = stx + dix * gras: ay = sty + diy * gras
bx = bfx + dix * gras: by = bfy + diy * gras
End If
If ax > 0 And ay > 0 And bx > 0 And by > 0 And ax < _Width And bx < _Width And ay < _Height And by < _Height Then Line (ax, ay)-(bx, by), _RGBA(r, g, b, ((a + a) - gras * 12))
Next gras
If stx > 0 And sty > 0 And bfx > 0 And bfy > 0 And stx < _Width And bfx < _Width And sty < _Height And bfy < _Height Then
Line (stx, sty)-(bfx, bfy), _RGBA(r, g, b, (a + a))
End If
End If
stx = stx + tpx * T
sty = sty + tpy * T
If Lett(I, pt).t <> 2 Then pt = pt + 1: GoTo uP
Loop Until Lett(I, pt).t = 2
3117 pt = 0: tpp = 0
Next Lete
End Sub
Sub Text3D (phrase$, T, Vx, Vy, Vz, angx, angy, angz, Dcoupe, r, g, b, a)
DDcoupe = Dcoupe
'T for size
'Gra to make bold
'vx vy vz starting position of the phrase$ in a 3D coordinate system where 0,0,0 is in the center of the screen
'angx,angy,angz rotations on axis
'Dcoupe to define a cutout of the letter
If DDcoupe < 5 Then DDcoupe = 5
If DDcoupe > 30 Then DDcoupe = 30
'r g b a _RGBA()
Shared WidthOfCharacter
QQ = .01 * Vz / (Rnd * .3 + 1.9)
cosX = Cos(angx): sinX = Sin(angx)
cosY = Cos(angy): sinY = Sin(angy)
cosZ = Cos(angz): sinZ = Sin(angz)
sDcoupe = Dcoupe
mm = Len(phrase$) / 2
For Lete = 1 To Len(phrase$)
I = Asc(phrase$, Lete)
stx = (LettStart(I).x * 3) * T + Vx + Lete * WidthOfCharacter * T
sty = (LettStart(I).y * 3) * T + Vy
stz = 0
If I = 7 Or (I >= 9 And I <= 13) Or I > 255 Then Exit Sub
If I = 32 Then GoTo 3065 'space...
Select Case I
Case 74, 75, 187, 90, 122
If DDcoupe > 25 Then DDcoupe = 25
Case 120, 88, 107, 54
If DDcoupe > 15 Then DDcoupe = 15
Case 83, 71, 87, 119, 132, 122, 106, 50
If DDcoupe > 20 Then DDcoupe = 20
Case 118, 86
If DDcoupe > 10 Then DDcoupe = 10
Case 77, 78, 109, 110
If DDcoupe > 25 Then DDcoupe = 25
Case 115
If DDcoupe > 10 Then DDcoupe = 10
Case Else
DDcoupe = sDcoupe
End Select
If ((I > 47 And I < 58)) Or ((I > 64 And I < 123)) Then
Else
If DDcoupe > 20 Then DDcoupe = 20
End If
Do
uP: tpx = Lett(I, pt).x: tpy = Lett(I, pt).y
If Lett(I, pt).t = 1 Or pt = 0 Or Lett(I, pt).t = 2 Then
L1 = Sqr(tpx * tpx + tpy * tpy)
coupe:
If L1 < DDcoupe Then
upx = Lett(I, pt + 1).x: upy = Lett(I, pt + 1).y
tpx = tpx + upx: tpy = tpy + upy
If Lett(I, pt).t <> 2 Then pt = pt + 1
If Lett(I, pt).t = 1 Then
upx = Lett(I, pt).x: upy = Lett(I, pt).y
L1 = Sqr(upx * upx + upy * upy)
GoTo coupe
End If
End If
End If
tpp = tpp + 1
If Lett(I, pt).t = 1 Or Lett(I, pt).t = 2 Then
atx = stx: aty = sty: atz = stz
btx = stx + tpx * T: bty = sty + tpy * T: btz = stz
'rotations 'xz angx yz angy xy angz
tatx = atx * cosX - atz * sinX
atz = atx * sinX + atz * cosX
atx = tatx
taty = aty * cosY - atz * sinY
atz = aty * sinY + atz * cosY + Vz
aty = taty
tbtx = btx * cosX - btz * sinX
btz = btx * sinX + btz * cosX
btx = tbtx
tbty = bty * cosY - btz * sinY
btz = bty * sinY + btz * cosY + Vz
bty = tbty
taty = aty * cosZ - atx * sinZ
atx = aty * sinZ + atx * cosZ
aty = taty
tbty = bty * cosZ - btx * sinZ
btx = bty * sinZ + btx * cosZ
bty = tbty
afx = _Width / 2 + 40 * (atx) / (atz) * 15
afy = _Height / 2 + 40 * (aty) / (atz) * 20
bfx = _Width / 2 + 40 * (btx) / (btz) * 15
bfy = _Height / 2 + 40 * (bty) / (btz) * 20
If buit = 0 Then affx = afx: affy = afy: buit = 1
If afx > -5 And afy > -5 And bfx > -5 And bfy > -5 And afx < _Width + 5 And afy < _Height + 5 And bfx < _Width + 5 And bfy < _Height + 5 Then
Line (afx, afy)-(bfx, bfy), _RGBA(r, g, b, (a))
End If
End If
stx = stx + tpx * T
sty = sty + tpy * T
If Lett(I, pt).t <> 2 Then pt = pt + 1: GoTo uP
Loop Until Lett(I, pt).t = 2
3065 pt = 0: tpp = 0
Next Lete
End Sub
|
|
