Another update from ingydotnet^djgoku
This commit is contained in:
Ingy döt Net
parent
91df62d461
commit
948b86eafa
7604 changed files with 108452 additions and 22726 deletions
|
|
@ -1,19 +1,7 @@
|
|||
SCREEN 13 ' enter high-color graphic mode
|
||||
|
||||
' sets palette colors B/N
|
||||
FOR i = 0 TO 255
|
||||
PALETTE 255 - i, INT(i / 4) + INT(i / 4) * 256 + INT(i / 4) * 65536
|
||||
NEXT i
|
||||
PALETTE 0, 0
|
||||
|
||||
' draw the sphere
|
||||
FOR i = 255 TO 0 STEP -1
|
||||
x = 50 + i / 3
|
||||
y = 99
|
||||
CIRCLE (x, y), i / 3, i
|
||||
PAINT (x, y), i
|
||||
NEXT i
|
||||
|
||||
' wait until keypress
|
||||
DO: LOOP WHILE INKEY$ = ""
|
||||
END
|
||||
clg
|
||||
color white
|
||||
rect 0,0,graphwidth, graphheight
|
||||
For n = 1 to 100
|
||||
color rgb(2*n,2*n,2*n)
|
||||
circle 150-2*n/3,150-n/2,150-n
|
||||
next n
|
||||
|
|
|
|||
5
Task/Draw-a-sphere/BASIC/draw-a-sphere-10.basic
Normal file
5
Task/Draw-a-sphere/BASIC/draw-a-sphere-10.basic
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
'This is a simple Circle
|
||||
graphic #g, 300, 300 'create a graphic object
|
||||
#g place(100,100) 'place the drawing pen at 100,100
|
||||
#g circle(75) 'make a circle with radius 75
|
||||
render #g 'show it
|
||||
|
|
@ -1 +1,117 @@
|
|||
MAKE OBJECT SPHERE 1,1
|
||||
MODE 8
|
||||
INSTALL @lib$+"D3DLIB"
|
||||
D3DTS_VIEW = 2
|
||||
D3DTS_PROJECTION = 3
|
||||
D3DRS_SPECULARENABLE = 29
|
||||
|
||||
SYS "LoadLibrary", @lib$+"D3DX8BBC.DLL" TO d3dx%
|
||||
IF d3dx%=0 ERROR 100, "Couldn't load D3DX8BBC.DLL"
|
||||
SYS "GetProcAddress", d3dx%, "D3DXCreateSphere" TO `D3DXCreateSphere`
|
||||
SYS "GetProcAddress", d3dx%, "D3DXMatrixLookAtLH" TO `D3DXMatrixLookAtLH`
|
||||
SYS "GetProcAddress", d3dx%, "D3DXMatrixPerspectiveFovLH" TO `D3DXMatrixPerspectiveFovLH`
|
||||
|
||||
DIM eyepos%(2), lookat%(2), up%(2), mat%(3,3)
|
||||
|
||||
DIM D3Dlight8{Type%, Diffuse{r%,g%,b%,a%}, Specular{r%,g%,b%,a%}, \
|
||||
\ Ambient{r%,g%,b%,a%}, Position{x%,y%,z%}, Direction{x%,y%,z%}, \
|
||||
\ Range%, Falloff%, Attenuation0%, Attenuation1%, Attenuation2%, \
|
||||
\ Theta%, Phi%}
|
||||
|
||||
DIM D3Dmaterial8{Diffuse{r%,g%,b%,a%}, Ambient{r%,g%,b%,a%}, \
|
||||
\ Specular{r%,g%,b%,a%}, Emissive{r%,g%,b%,a%}, Power%}
|
||||
|
||||
DIM D3Dbasemesh8{QueryInterface%, Addref%, Release%, \
|
||||
\ DrawSubset%, GetNumFaces%, GetNumVertices%, GetFVF%, \
|
||||
\ GetDeclaration%, GetOptions%, GetDevice%, \
|
||||
\ CloneMeshFVF%, CloneMesh%, GetVertexBuffer%, GetIndexBuffer%, \
|
||||
\ LockVertexBuffer%, UnlockVertexBuffer%, LockIndexBuffer%, \
|
||||
\ UnlockIndexBuffer%, GetAttributeTable%}
|
||||
|
||||
DIM D3Ddevice8{QueryInterface%, AddRef%, Release%, TestCooperativeLevel%, \
|
||||
\ GetAvailableTextureMem%, ResourceManagerDiscardBytes%, GetDirect3D%, \
|
||||
\ GetDeviceCaps%, GetDisplayMode%, GetCreationParameters%, SetCursorProperties%, \
|
||||
\ SetCursorPosition%, ShowCursor%, CreateAdditionalSwapChain%, Reset%, \
|
||||
\ Present%, GetBackBuffer%, GetRasterStatus%, SetGammaRamp%, GetGammaRamp%, \
|
||||
\ CreateTexture%, CreateVolumeTexture%, CreateCubeTexture%, CreateVertexBuffer%, \
|
||||
\ CreateIndexBuffer%, CreateRenderTarget%, CreateDepthStencilSurface%, \
|
||||
\ CreateImageSurface%, CopyRects%, UpdateTexture%, GetFrontBuffer%, \
|
||||
\ SetRenderTarget%, GetRenderTarget%, GetDepthStencilSurface%, BeginScene%, \
|
||||
\ EndScene%, Clear%, SetTransform%, GetTransform%, MultiplyTransform%, \
|
||||
\ SetViewport%, GetViewport%, SetMaterial%, GetMaterial%, SetLight%, GetLight%, \
|
||||
\ LightEnable%, GetLightEnable%, SetClipPlane%, GetClipPlane%, SetRenderState%, \
|
||||
\ GetRenderState%, BeginStateBlock%, EndStateBlock%, ApplyStateBlock%, \
|
||||
\ CaptureStateBlock%, DeleteStateBlock%, CreateStateBlock%, SetClipStatus%, \
|
||||
\ GetClipStatus%, GetTexture%, SetTexture%, GetTextureStageState%, \
|
||||
\ SetTextureStageState%, ValidateDevice%, GetInfo%, SetPaletteEntries%, \
|
||||
\ GetPaletteEntries%, SetCurrentTexturePalette%, GetCurrentTexturePalette%, \
|
||||
\ DrawPrimitive%, DrawIndexedPrimitive%, DrawPrimitiveUP%, \
|
||||
\ DrawIndexedPrimitiveUP%, ProcessVertices%, CreateVertexShader%, \
|
||||
\ SetVertexShader%, GetVertexShader%, DeleteVertexShader%, \
|
||||
\ SetVertexShaderConstant%, GetVertexShaderConstant%, GetVertexShaderDeclaration%, \
|
||||
\ GetVertexShaderFunction%, SetStreamSource%, GetStreamSource%, SetIndices%, \
|
||||
\ GetIndices%, CreatePixelShader%, SetPixelShader%, GetPixelShader%, \
|
||||
\ DeletePixelShader%, SetPixelShaderConstant%, GetPixelShaderConstant%, \
|
||||
\ GetPixelShaderFunction%, DrawRectPatch%, DrawTriPatch%, DeletePatch%}
|
||||
|
||||
pDevice%=FN_initd3d(@hwnd%, 1, 1)
|
||||
IF pDevice%=0 ERROR 100, "Couldn't create Direct3D8 device"
|
||||
!(^D3Ddevice8{}+4) = !pDevice%
|
||||
|
||||
SYS `D3DXCreateSphere`, pDevice%, FN_f4(1), 50, 50, ^meshSphere%, 0
|
||||
IF meshSphere% = 0 ERROR 100, "D3DXCreateSphere failed"
|
||||
!(^D3Dbasemesh8{}+4) = !meshSphere%
|
||||
|
||||
REM. Point-source light:
|
||||
D3Dlight8.Type%=1 : REM. point source
|
||||
D3Dlight8.Diffuse.r% = FN_f4(1)
|
||||
D3Dlight8.Diffuse.g% = FN_f4(1)
|
||||
D3Dlight8.Diffuse.b% = FN_f4(1)
|
||||
D3Dlight8.Specular.r% = FN_f4(1)
|
||||
D3Dlight8.Specular.g% = FN_f4(1)
|
||||
D3Dlight8.Specular.b% = FN_f4(1)
|
||||
D3Dlight8.Position.x% = FN_f4(2)
|
||||
D3Dlight8.Position.y% = FN_f4(1)
|
||||
D3Dlight8.Position.z% = FN_f4(4)
|
||||
D3Dlight8.Range% = FN_f4(10)
|
||||
D3Dlight8.Attenuation0% = FN_f4(1)
|
||||
|
||||
REM. Material:
|
||||
D3Dmaterial8.Diffuse.r% = FN_f4(0.2)
|
||||
D3Dmaterial8.Diffuse.g% = FN_f4(0.6)
|
||||
D3Dmaterial8.Diffuse.b% = FN_f4(1.0)
|
||||
D3Dmaterial8.Specular.r% = FN_f4(0.4)
|
||||
D3Dmaterial8.Specular.g% = FN_f4(0.4)
|
||||
D3Dmaterial8.Specular.b% = FN_f4(0.4)
|
||||
D3Dmaterial8.Power% = FN_f4(100)
|
||||
|
||||
fovy = RAD(30)
|
||||
aspect = 5/4
|
||||
znear = 1
|
||||
zfar = 1000
|
||||
bkgnd% = &7F7F7F
|
||||
eyepos%() = 0, 0, FN_f4(6)
|
||||
lookat%() = 0, 0, 0
|
||||
up%() = 0, FN_f4(1), 0
|
||||
|
||||
SYS D3Ddevice8.Clear%, pDevice%, 0, 0, 3, bkgnd%, FN_f4(1), 0
|
||||
SYS D3Ddevice8.BeginScene%, pDevice%
|
||||
SYS D3Ddevice8.SetLight%, pDevice%, 0, D3Dlight8{}
|
||||
SYS D3Ddevice8.LightEnable%, pDevice%, 0, 1
|
||||
SYS D3Ddevice8.SetMaterial%, pDevice%, D3Dmaterial8{}
|
||||
SYS D3Ddevice8.SetRenderState%, pDevice%, D3DRS_SPECULARENABLE, 1
|
||||
|
||||
SYS `D3DXMatrixLookAtLH`, ^mat%(0,0), ^eyepos%(0), ^lookat%(0), ^up%(0)
|
||||
SYS D3Ddevice8.SetTransform%, pDevice%, D3DTS_VIEW, ^mat%(0,0)
|
||||
|
||||
SYS `D3DXMatrixPerspectiveFovLH`, ^mat%(0,0), FN_f4(fovy), \
|
||||
\ FN_f4(aspect), FN_f4(znear), FN_f4(zfar)
|
||||
SYS D3Ddevice8.SetTransform%, pDevice%, D3DTS_PROJECTION, ^mat%(0,0)
|
||||
|
||||
SYS D3Dbasemesh8.DrawSubset%, meshSphere%, 0
|
||||
SYS D3Ddevice8.EndScene%, pDevice%
|
||||
SYS D3Ddevice8.Present%, pDevice%, 0, 0, 0, 0
|
||||
|
||||
SYS D3Ddevice8.Release%, pDevice%
|
||||
SYS D3Dbasemesh8.Release%, meshSphere%
|
||||
SYS "FreeLibrary", d3dx%
|
||||
END
|
||||
|
|
|
|||
1
Task/Draw-a-sphere/BASIC/draw-a-sphere-3.basic
Normal file
1
Task/Draw-a-sphere/BASIC/draw-a-sphere-3.basic
Normal file
|
|
@ -0,0 +1 @@
|
|||
MAKE OBJECT SPHERE 1,1
|
||||
48
Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic
Normal file
48
Task/Draw-a-sphere/BASIC/draw-a-sphere-4.basic
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
' "\" = a integer division (CPU)
|
||||
' "/" = a floating point division (FPU)
|
||||
' the compiler takes care of the conversion between floating point and integer
|
||||
' compile with: FBC -s console "filename.bas" or FBC -s GUI "filename.bas"
|
||||
' filename is whatever name you give it, .bas is mandatory
|
||||
|
||||
' Sphere using XPL0 code from rosetacode sphere page
|
||||
' Altered freebasic version to compile in default mode
|
||||
' version 17-06-2015
|
||||
' compile with: fbc -s console or fbc -s gui
|
||||
#Define W 640
|
||||
#Define H 480
|
||||
|
||||
ScreenRes W, H, 32 ' set 640x480x32 graphics mode, 32 bits color mode
|
||||
WindowTitle "32 bpp Cyan Sphere FreeBASIC"
|
||||
|
||||
' wait until keypress
|
||||
' Color(RGB(255,255,255),RGB(0,0,0)) ' default white foreground, black background
|
||||
Locate 50,2
|
||||
Print "Enter any key to start"
|
||||
Sleep
|
||||
|
||||
Dim As UInteger R = 100, R2 = R * R ' radius, in pixels; radius squared
|
||||
Dim As UInteger X0 = W \ 2, Y0 = H \ 2 ' coordinates of center of screen
|
||||
Dim As Integer X, Y, C, D2 ' coords, color, distance from center squared
|
||||
|
||||
For Y = -R To R ' for all the coordinates near the circle
|
||||
For X = -R To R ' which is under the sphere
|
||||
D2 = X * X + Y * Y
|
||||
If D2 <= R2 Then ' coordinate is inside circle under sphere
|
||||
' height of point on surface of sphere above X,Y
|
||||
C = Sqr(R2 - D2) - ( X + Y) / 2 + 130 ' color is proportional; offset X and Y, and
|
||||
|
||||
Color C Shl 8 + C ' = color RGB(0, C, C)
|
||||
' green + blue = cyan
|
||||
PSet(X + X0, Y + Y0)
|
||||
End If
|
||||
Next
|
||||
Next
|
||||
|
||||
' wait until keypress
|
||||
Locate 50,2
|
||||
Color(RGB(255,255,255),RGB(0,0,0)) ' foreground color is changed
|
||||
' empty keyboard buffer
|
||||
While InKey <> "" : Var _key_ = InKey : Wend
|
||||
Print : Print "hit any key to end program"
|
||||
Sleep
|
||||
End
|
||||
36
Task/Draw-a-sphere/BASIC/draw-a-sphere-5.basic
Normal file
36
Task/Draw-a-sphere/BASIC/draw-a-sphere-5.basic
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
'Sphere for FreeBASIC May 2015
|
||||
'spherefb4.bas
|
||||
'Sphere using XPL0 code from rosetacode sphere page
|
||||
'
|
||||
screenres 640,480,32 '\set 640x480x32 graphics mode
|
||||
windowtitle "32 bpp Blue Sphere FreeBASIC"
|
||||
'
|
||||
' wait until keypress
|
||||
locate 50,2
|
||||
color(rgb(255,255,255),rgb(0,0,0))
|
||||
Print "Enter any key to start"
|
||||
sleep
|
||||
R=100 : R2=R*R '\radius, in pixels; radius squared
|
||||
X0=640/2 : Y0=480/2 '\coordinates of center of screen
|
||||
dim as integer X, Y, Z, C, D2 '\coords, color, distance from center squared
|
||||
'
|
||||
for Y= -R to +R '\for all the coordinates near the circle
|
||||
for X = -R to +R '\ which is under the sphere
|
||||
D2 = X*X + Y*Y '
|
||||
C = 0 '\default color is black
|
||||
if D2 <= R2 then '\coordinate is inside circle under sphere
|
||||
Z = sqr(R2-D2) '\height of point on surface of sphere above X,Y
|
||||
C = Z-(X+Y)/2+130 ' \color is proportional; offset X and Y, and
|
||||
endif
|
||||
color c ' \ shift color to upper limit of its range
|
||||
'\green + blue = cyan orginal line don't understand
|
||||
Pset(X+X0, Y+Y0)
|
||||
next x
|
||||
next y
|
||||
'
|
||||
' wait until keypress
|
||||
locate 50,2
|
||||
color(rgb(255,255,255),rgb(0,0,0))
|
||||
Print "Enter any key to exit "
|
||||
sleep
|
||||
END
|
||||
26
Task/Draw-a-sphere/BASIC/draw-a-sphere-6.basic
Normal file
26
Task/Draw-a-sphere/BASIC/draw-a-sphere-6.basic
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
WindowWidth =420
|
||||
WindowHeight =460
|
||||
|
||||
nomainwin
|
||||
|
||||
open "Sphere" for graphics_nsb_nf as #w
|
||||
|
||||
#w "down ; fill lightgray"
|
||||
|
||||
xS =200
|
||||
yS =200
|
||||
for radius =150 to 0 step -1
|
||||
level$ =str$( int( 256 -256 *radius /150))
|
||||
c$ =level$ +" " +level$ +" " +level$
|
||||
#w "color "; c$
|
||||
#w "backcolor "; c$
|
||||
#w "place "; xS; " "; yS
|
||||
xS =xS -0.5
|
||||
yS =yS -0.2
|
||||
#w "circlefilled "; radius
|
||||
next radius
|
||||
|
||||
#w "flush"
|
||||
wait
|
||||
close #w
|
||||
end
|
||||
251
Task/Draw-a-sphere/BASIC/draw-a-sphere-7.basic
Normal file
251
Task/Draw-a-sphere/BASIC/draw-a-sphere-7.basic
Normal file
|
|
@ -0,0 +1,251 @@
|
|||
; Original by Comtois @ 28/03/06
|
||||
;
|
||||
; Updated/Formated by Fluid Byte @ March.24,2009
|
||||
;
|
||||
; http://www.purebasic.fr/english/viewtopic.php?p=281258#p281258
|
||||
|
||||
Declare CreateSphere(M,P)
|
||||
Declare UpdateMesh()
|
||||
|
||||
#_SIZEVERT = 36
|
||||
#_SIZETRIS = 6
|
||||
#FULLSCREEN = 0
|
||||
|
||||
Structure VECTOR
|
||||
X.f
|
||||
Y.f
|
||||
Z.f
|
||||
EndStructure
|
||||
|
||||
Structure VERTEX
|
||||
X.f
|
||||
Y.f
|
||||
Z.f
|
||||
NX.f
|
||||
NY.f
|
||||
NZ.f
|
||||
Color.l
|
||||
U.f
|
||||
V.f
|
||||
EndStructure
|
||||
|
||||
Structure TRIANGLE
|
||||
V1.w
|
||||
V2.w
|
||||
V3.w
|
||||
EndStructure
|
||||
|
||||
Macro CALC_NORMALS
|
||||
*PtrV\NX = *PtrV\X
|
||||
*PtrV\NY = *PtrV\Y
|
||||
*PtrV\NZ = *PtrV\Z
|
||||
EndMacro
|
||||
|
||||
Global *VBuffer, *IBuffer
|
||||
Global Meridian = 50, Parallele = 50, PasLength = 4, Length
|
||||
|
||||
Define EventID, i, NbSommet, CameraMode, Angle.f, Pas.f = 0.5
|
||||
|
||||
InitEngine3D() : InitSprite() : InitKeyboard()
|
||||
|
||||
Add3DArchive(GetTemporaryDirectory(),#PB_3DArchive_FileSystem)
|
||||
Add3DArchive(#PB_Compiler_Home + "Examples\Sources\Data\",#PB_3DArchive_FileSystem)
|
||||
|
||||
If #FULLSCREEN
|
||||
OpenScreen(800,600,32,"Sphere 3D")
|
||||
Else
|
||||
OpenWindow(0,0,0,800,600,"Sphere 3D",#PB_Window_SystemMenu | 1)
|
||||
OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)
|
||||
EndIf
|
||||
|
||||
;-Texture
|
||||
CreateImage(0,128,128)
|
||||
StartDrawing(ImageOutput(0))
|
||||
For i = 0 To 127 Step 4
|
||||
Box(0,i,ImageWidth(0),2,RGB(255,255,255))
|
||||
Box(0,i + 2,ImageWidth(0),2,RGB(0,0,155))
|
||||
Next i
|
||||
StopDrawing()
|
||||
SaveImage(0,GetTemporaryDirectory() + "temp.bmp") : FreeImage(0)
|
||||
|
||||
;-Material
|
||||
CreateMaterial(0,LoadTexture(0,"temp.bmp"))
|
||||
RotateMaterial(0,0.1,#PB_Material_Animated)
|
||||
|
||||
;-Mesh
|
||||
CreateSphere(Meridian,Parallele)
|
||||
|
||||
;-Entity
|
||||
CreateEntity(0,MeshID(0),MaterialID(0))
|
||||
ScaleEntity(0,60,60,60)
|
||||
|
||||
;-Camera
|
||||
CreateCamera(0,0,0,100,100)
|
||||
MoveCamera(0,0,0,-200)
|
||||
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
|
||||
|
||||
;-Light
|
||||
AmbientColor(RGB(105, 105, 105))
|
||||
CreateLight(0, RGB(255, 255, 55), EntityX(0) + 150, EntityY(0) , EntityZ(0))
|
||||
CreateLight(1, RGB( 55, 255, 255), EntityX(0) - 150, EntityY(0) , EntityZ(0))
|
||||
CreateLight(2, RGB( 55, 55, 255), EntityX(0) , EntityY(0) + 150, EntityZ(0))
|
||||
CreateLight(3, RGB(255, 55, 255), EntityX(0) , EntityY(0) - 150, EntityZ(0))
|
||||
|
||||
; ----------------------------------------------------------------------------------------------------
|
||||
; MAINLOOP
|
||||
; ----------------------------------------------------------------------------------------------------
|
||||
|
||||
Repeat
|
||||
If #FULLSCREEN = 0
|
||||
Repeat
|
||||
EventID = WindowEvent()
|
||||
|
||||
Select EventID
|
||||
Case #PB_Event_CloseWindow : End
|
||||
EndSelect
|
||||
Until EventID = 0
|
||||
EndIf
|
||||
|
||||
Angle + Pas
|
||||
RotateEntity(0, Angle, Angle,Angle)
|
||||
|
||||
If PasLength > 0 : UpdateMesh() : EndIf
|
||||
|
||||
If ExamineKeyboard()
|
||||
If KeyboardReleased(#PB_Key_F1)
|
||||
CameraMode = 1 - CameraMode
|
||||
CameraRenderMode(0, CameraMode)
|
||||
EndIf
|
||||
EndIf
|
||||
|
||||
RenderWorld()
|
||||
FlipBuffers()
|
||||
Until KeyboardPushed(#PB_Key_Escape)
|
||||
|
||||
; ----------------------------------------------------------------------------------------------------
|
||||
; FUNCTIONS
|
||||
; ----------------------------------------------------------------------------------------------------
|
||||
|
||||
Procedure CreateSphere(M,P)
|
||||
; M = Meridian
|
||||
; P = Parallele
|
||||
; The radius is 1. Front to remove it later, it's just for the demo.
|
||||
|
||||
If M < 3 Or P < 2 : ProcedureReturn 0 : EndIf
|
||||
|
||||
Protected Normale.VECTOR, NbSommet, i, j, Theta.f, cTheta.f, sTheta.f
|
||||
Protected Alpha.f, cAlpha.f, sAlpha.f, *PtrV.VERTEX, *PtrF.TRIANGLE, NbTriangle
|
||||
|
||||
NbSommet = 2 + ((M + 1) * P)
|
||||
*VBuffer = AllocateMemory(#_SIZEVERT * Nbsommet)
|
||||
|
||||
For i = 0 To M
|
||||
Theta = i * #PI * 2.0 / M
|
||||
cTheta = Cos(theta)
|
||||
sTheta = Sin(theta)
|
||||
|
||||
For j = 1 To P
|
||||
Alpha = j * #PI / (P + 1)
|
||||
cAlpha = Cos(Alpha)
|
||||
sAlpha = Sin(Alpha)
|
||||
*PtrV = *VBuffer + #_SIZEVERT * ((i * P) + (j - 1))
|
||||
*PtrV\X = sAlpha * cTheta
|
||||
*PtrV\Y = sAlpha * sTheta
|
||||
*PtrV\Z = cAlpha
|
||||
*PtrV\U = Theta / (2.0 * #PI)
|
||||
*PtrV\V = Alpha / #PI
|
||||
CALC_NORMALS
|
||||
Next j
|
||||
Next i
|
||||
|
||||
; Southpole
|
||||
*PtrV = *VBuffer + #_SIZEVERT * ((M + 1) * P)
|
||||
*PtrV\X = 0
|
||||
*PtrV\Y = 0
|
||||
*PtrV\Z = -1
|
||||
*PtrV\U = 0
|
||||
*PtrV\V = 0
|
||||
CALC_NORMALS
|
||||
|
||||
; Northpole
|
||||
*PtrV + #_SIZEVERT
|
||||
*PtrV\X = 0
|
||||
*PtrV\Y = 0
|
||||
*PtrV\Z = 1
|
||||
*PtrV\U = 0
|
||||
*PtrV\V = 0
|
||||
CALC_NORMALS
|
||||
|
||||
; Les facettes
|
||||
NbTriangle = 4 * M * P
|
||||
*IBuffer = AllocateMemory(#_SIZETRIS * NbTriangle)
|
||||
*PtrF = *IBuffer
|
||||
|
||||
For i = 0 To M - 1
|
||||
For j = 1 To P - 1
|
||||
*PtrF\V1 = ((i + 1) * P) + j
|
||||
*PtrF\V2 = ((i + 1) * P) + (j - 1)
|
||||
*PtrF\V3 = (i * P) + (j - 1)
|
||||
*PtrF + #_SIZETRIS
|
||||
*PtrF\V3 = ((i + 1) * P) + j ;Recto
|
||||
*PtrF\V2 = ((i + 1) * P) + (j - 1) ;Recto
|
||||
*PtrF\V1 = (i * P) + (j - 1) ;Recto
|
||||
*PtrF + #_SIZETRIS
|
||||
*PtrF\V1 = i * P + j
|
||||
*PtrF\V2 = ((i + 1) * P) + j
|
||||
*PtrF\V3 = (i * P) + (j - 1)
|
||||
*PtrF + #_SIZETRIS
|
||||
*PtrF\V3 = i * P + j ;Recto
|
||||
*PtrF\V2 = ((i + 1) * P) + j ;Recto
|
||||
*PtrF\V1 = (i * P) + (j - 1) ;Recto
|
||||
*PtrF + #_SIZETRIS
|
||||
Next j
|
||||
Next i
|
||||
|
||||
; The Poles
|
||||
For i = 0 To M - 1
|
||||
*PtrF\V3 = (M + 1) * P + 1
|
||||
*PtrF\V2 = (i + 1) * P
|
||||
*PtrF\V1 = i * P
|
||||
*PtrF + #_SIZETRIS
|
||||
*PtrF\V1 = (M + 1) * P + 1 ;Recto
|
||||
*PtrF\V2 = (i + 1) * P ;Recto
|
||||
*PtrF\V3 = i * P ;Recto
|
||||
*PtrF + #_SIZETRIS
|
||||
Next i
|
||||
|
||||
For i = 0 To M - 1
|
||||
*PtrF\V3 = (M + 1) * P
|
||||
*PtrF\V2 = i * P + (P - 1)
|
||||
*PtrF\V1 = (i + 1) * P + (P - 1)
|
||||
*PtrF + #_SIZETRIS
|
||||
*PtrF\V1 = (M + 1) * P ;Recto
|
||||
*PtrF\V2 = i * P + (P - 1) ;Recto
|
||||
*PtrF\V3 = (i + 1) * P + (P - 1) ;Recto
|
||||
*PtrF + #_SIZETRIS
|
||||
Next i
|
||||
|
||||
If CreateMesh(0,100)
|
||||
Protected Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
|
||||
SetMeshData(0,Flag,*VBuffer,NbSommet)
|
||||
SetMeshData(0,#PB_Mesh_Face,*IBuffer,NbTriangle)
|
||||
ProcedureReturn 1
|
||||
EndIf
|
||||
|
||||
ProcedureReturn 0
|
||||
EndProcedure
|
||||
|
||||
; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
|
||||
Procedure UpdateMesh()
|
||||
Protected NbTriangle = 4 * Meridian * Parallele
|
||||
|
||||
Length + PasLength
|
||||
|
||||
If Length >= NbTriangle
|
||||
PasLength = 0
|
||||
Length = Nbtriangle
|
||||
EndIf
|
||||
|
||||
SetMeshData(0,#PB_Mesh_Face,*IBuffer,Length)
|
||||
EndProcedure
|
||||
19
Task/Draw-a-sphere/BASIC/draw-a-sphere-8.basic
Normal file
19
Task/Draw-a-sphere/BASIC/draw-a-sphere-8.basic
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
SCREEN 13 ' enter high-color graphic mode
|
||||
|
||||
' sets palette colors B/N
|
||||
FOR i = 0 TO 255
|
||||
PALETTE 255 - i, INT(i / 4) + INT(i / 4) * 256 + INT(i / 4) * 65536
|
||||
NEXT i
|
||||
PALETTE 0, 0
|
||||
|
||||
' draw the sphere
|
||||
FOR i = 255 TO 0 STEP -1
|
||||
x = 50 + i / 3
|
||||
y = 99
|
||||
CIRCLE (x, y), i / 3, i
|
||||
PAINT (x, y), i
|
||||
NEXT i
|
||||
|
||||
' wait until keypress
|
||||
DO: LOOP WHILE INKEY$ = ""
|
||||
END
|
||||
18
Task/Draw-a-sphere/BASIC/draw-a-sphere-9.basic
Normal file
18
Task/Draw-a-sphere/BASIC/draw-a-sphere-9.basic
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
'Run BASIC White Sphere, Black background
|
||||
'runbasic.com
|
||||
graphic #win, 300, 300
|
||||
#win size(1)
|
||||
R=100
|
||||
R2=R*R
|
||||
X0=300/2
|
||||
Y0=300/2
|
||||
for Y = -150 to 150
|
||||
for X = -150 to 150
|
||||
D2 = X*X + Y*Y
|
||||
C = 0
|
||||
if D2 <= R2 then Z = sqr(R2-D2) : C = int(Z-(X+Y)/2+130)
|
||||
#win color(C,C,C)
|
||||
#win set(X+X0, Y+Y0)
|
||||
next X
|
||||
next Y
|
||||
render #win
|
||||
8
Task/Draw-a-sphere/Befunge/draw-a-sphere.bf
Normal file
8
Task/Draw-a-sphere/Befunge/draw-a-sphere.bf
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
45*65*65*"2"30p20p10p::00p2*40p4*5vv<
|
||||
>60p140g->:::*00g50g*60g40g-:*-\-v0>1
|
||||
^_@#`\g0<|`\g04:+1, <*84$$_v#`\0:<>p^
|
||||
>v>g2+:5^$>g:*++*/7g^>*:9$#<"~"/:"~"v
|
||||
g:^06,+55<^03*<v09p07%"~"p09/"~"p08%<
|
||||
^>#0 *#12#<0g:^>+::"~~"90g*80g+*70gv|
|
||||
g-10g*+:9**00gv|!*`\2\`-20::/2-\/\+<>
|
||||
%#&eo*!:..^g05<>$030g-*9/\20g*+60g40^
|
||||
|
|
@ -4,5 +4,5 @@ pts =. (0&*^:(0={:))@:(,,(0>.(*:R)-+)&.*:)"0/~ i:15j200
|
|||
luminosity =. (>:ambient) %~ (ambient * * +/&.:*:"1 pts) + k^~ 0>. R%~ pts +/@:*"1 -light
|
||||
|
||||
load 'viewmat'
|
||||
togreyscale =. 256 #. [: <. 255 255 255 *"1 0 ]
|
||||
'rgb' viewmat togreyscale luminosity
|
||||
torgb =. 256 #. [: <. 255 255 255 *"1 0 ]
|
||||
'rgb' viewmat torgb luminosity
|
||||
|
|
|
|||
|
|
@ -12,15 +12,15 @@ sub MAIN ($outfile = 'sphere-perl6.pgm') {
|
|||
$out.close;
|
||||
}
|
||||
|
||||
sub normalize (@vec) { return @vec »/» ([+] @vec Z* @vec).sqrt }
|
||||
sub normalize (@vec) { return @vec »/» ([+] @vec »*« @vec).sqrt }
|
||||
|
||||
sub dot (@x, @y) { return -([+] @x Z* @y) max 0 }
|
||||
sub dot (@x, @y) { return -([+] @x »*« @y) max 0 }
|
||||
|
||||
sub draw_sphere ( $rad, $k, $ambient ) {
|
||||
my @pixels;
|
||||
my $r2 = $rad * $rad;
|
||||
my @range = -$rad .. $rad;
|
||||
for @range X @range -> $x, $y {
|
||||
for flat @range X @range -> $x, $y {
|
||||
if (my $x2 = $x * $x) + (my $y2 = $y * $y) < $r2 {
|
||||
my @vector = normalize([$x, $y, ($r2 - $x2 - $y2).sqrt]);
|
||||
my $intensity = dot(@light, @vector) ** $k + $ambient;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,3 @@
|
|||
from visual import *
|
||||
scene.title = "VPython: Draw a sphere"
|
||||
sphere() # using defaults, see http://www.vpython.org/contents/docs/defaults.html defaults]
|
||||
sphere() # using defaults, see http://www.vpython.org/contents/docs/defaults.html
|
||||
|
|
|
|||
|
|
@ -1,38 +1,39 @@
|
|||
/*REXX program expresses a lighted sphere with simple chars for shading.*/
|
||||
call drawSphere 19, 4, 2/10 /*draw a sphere with radius 19. */
|
||||
call drawSphere 10, 2, 4/10 /*draw a sphere with radius ten. */
|
||||
exit /*stick a fork in it, we're done.*/
|
||||
/*──────────────────────────────────DRAWSPHERE subroutine───────────────*/
|
||||
drawSphere: procedure; parse arg r, k, ambient /*get the arguments*/
|
||||
if 1=='f1'x then shading='.:!*oe&#%@' /*EBCDIC dithering.*/
|
||||
else shading='·:!°oe@░▒▓' /*ASCII " */
|
||||
lightSource = '30 30 -50' /*the light source.*/
|
||||
parse value norm(lightSource) with s1 s2 s3 /*normalize light S*/
|
||||
sLen=length(shading); sLen1=sLen-1; rr=r*r /*handy-dandy vars.*/
|
||||
/*REXX program expresses a lighted sphere with simple characters for shading.*/
|
||||
call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */
|
||||
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*─────────────────────────────────────one─liner subroutines──────────────────*/
|
||||
ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) *(x\=_)
|
||||
floor: procedure; parse arg x; _=trunc(x); return _ - (x<0) *(x\=_)
|
||||
norm: parse arg _1 _2 _3; _=sqrt(_1**2+_2**2+_3**2); return _1/_ _2/_ _3/_
|
||||
/*──────────────────────────────────DRAWSPHERE subroutine─────────────────────*/
|
||||
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
|
||||
if 1=='f1'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */
|
||||
else shading= "·:!°oe@░▒▓" /* ASCII " " */
|
||||
lightSource = '30 30 -50' /*position of light source.*/
|
||||
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
|
||||
sLen=length(shading)-1; rr=r*r /*handy─dandy variables. */
|
||||
|
||||
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; aLine=
|
||||
do j=floor(-2*r) to ceil(2*r); y=j/2+.5; yy=y**2
|
||||
if xx+yy<=rr then do /*within the phere?*/
|
||||
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
|
||||
dot=s1*v1 + s2*v2 + s3*v3 /*dot product of Vs*/
|
||||
if dot>0 then dot=0 /*if pos, make it 0*/
|
||||
b=abs(dot)**k + ambient /*calc. brightness.*/
|
||||
if b<=0 then brite=sLenm1
|
||||
else brite=trunc( max( (1-b) * sLen1, 0) )
|
||||
aLine=aLine || substr(shading,brite+1,1) /*build.*/
|
||||
end
|
||||
else aLine=aLine' ' /*append a blank. */
|
||||
do i=floor(-r) to ceil(r) ; x= i+.5; xx=x**2; $=
|
||||
do j=floor(-2*r) to ceil(r+r); y=j/2+.5; yy=y**2
|
||||
if xx+yy<=rr then do /*is point within sphere ? */
|
||||
parse value norm(x y sqrt(rr-xx-yy)) with v1 v2 v3
|
||||
dot=s1*v1 + s2*v2 + s3*v3 /*the dot product of the Vs*/
|
||||
if dot>0 then dot=0 /*if positive, make it zero*/
|
||||
b=abs(dot)**k + ambient /*calculate the brightness.*/
|
||||
if b<=0 then brite=sLen
|
||||
else brite=trunc( max( (1-b) * sLen, 0) )
|
||||
$=($)substr(shading,brite+1,1) /*build a display line.*/
|
||||
end
|
||||
else $=$' ' /*append a blank to line. */
|
||||
end /*j*/
|
||||
say strip(aLine,'trailing') /*show a line of it*/
|
||||
end /*i*/ /* [↑] show sphere*/
|
||||
say strip($,'trailing') /*show a line of the sphere*/
|
||||
end /*i*/ /* [↑] display the sphere.*/
|
||||
return
|
||||
/*─────────────────────────────────────subroutines────────────────────────────*/
|
||||
ceil: procedure; parse arg x; _=trunc(x); return _ + (x>0) * (x\=_)
|
||||
floor: procedure; parse arg x; _=trunc(x); return _ - (x<0) * (x\=_)
|
||||
norm: parse arg _1 _2 _3; _=sqrt(_1**2+_2**2+_3**2); return _1/_ _2/_ _3/_
|
||||
/*─────────────────────────────────────SQRT subroutine────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); p=d+d%4+2; m.=11
|
||||
numeric digits m.;numeric form;parse value format(x,2,1,,0) 'E0' with g 'E' _ .
|
||||
g=g*.5'E'_%2; do j=0 while p>9; m.j=p; p=p%2+1; end
|
||||
do k=j+5 to 0 by -1; if m.k>11 then numeric digits m.k; g=.5*(g+x/g); end
|
||||
numeric digits d; return g/1
|
||||
/*──────────────────────────────────SQRT subroutine───────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); i=; m.=9
|
||||
numeric digits 9; numeric form; h=d+6; if x<0 then do; x=-x; i='i'; end
|
||||
parse value format(x,2,1,,0) 'E0' with g 'E' _ .; g=g*.5'e'_%2
|
||||
do j=0 while h>9; m.j=h; h=h%2+1; end /*j*/
|
||||
do k=j+5 to 0 by -1; numeric digits m.k; g=(g+x/g)*.5; end /*k*/
|
||||
numeric digits d; return (g/1)i /*make complex if X < 0.*/
|
||||
|
|
|
|||
|
|
@ -5,5 +5,5 @@ pack [canvas .c -height 400 -width 640 -background white]
|
|||
for {set i 0} {$i < 255} {incr i} {
|
||||
set h [grey $i]
|
||||
.c create arc [expr {100+$i/5}] [expr {50+$i/5}] [expr {400-$i/1.5}] [expr {350-$i/1.5}] \
|
||||
-start 0 -extent 359 -fill $h -outline $h}
|
||||
-start 0 -extent 359 -fill $h -outline $h
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue