September Morn Update
This commit is contained in:
Ingy döt Net
parent
4e2d22a71d
commit
aac6731f2c
6856 changed files with 141342 additions and 21127 deletions
59
Task/Draw-a-sphere/AWK/draw-a-sphere.awk
Normal file
59
Task/Draw-a-sphere/AWK/draw-a-sphere.awk
Normal file
|
|
@ -0,0 +1,59 @@
|
|||
# syntax: GAWK -f DRAW_A_SPHERE.AWK
|
||||
# converted from VBSCRIPT
|
||||
BEGIN {
|
||||
draw_sphere(20,4,0.1)
|
||||
draw_sphere(10,2,0.4)
|
||||
exit(0)
|
||||
}
|
||||
function draw_sphere(radius,k,ambient, b,i,intensity,j,leng_shades,light,line,shades,vec,x,y) {
|
||||
leng_shades = split0(".:!*oe&#%@",shades,"")
|
||||
split("30,30,-50",light,",")
|
||||
normalize(light)
|
||||
for (i=int(-radius); i<=ceil(radius); i++) {
|
||||
x = i + 0.5
|
||||
line = ""
|
||||
for (j=int(-2*radius); j<=ceil(2*radius); j++) {
|
||||
y = j / 2 + 0.5
|
||||
if (x*x + y*y <= radius*radius) {
|
||||
vec[1] = x
|
||||
vec[2] = y
|
||||
vec[3] = sqrt(radius*radius - x*x - y*y)
|
||||
normalize(vec)
|
||||
b = dot(light,vec) ^ k + ambient
|
||||
intensity = int((1-b) * leng_shades)
|
||||
if (intensity < 0) {
|
||||
intensity = 0
|
||||
}
|
||||
if (intensity >= leng_shades) {
|
||||
intensity = leng_shades
|
||||
}
|
||||
line = line shades[intensity]
|
||||
}
|
||||
else {
|
||||
line = line " "
|
||||
}
|
||||
}
|
||||
printf("%s\n",line)
|
||||
}
|
||||
}
|
||||
function ceil(x, tmp) {
|
||||
tmp = int(x)
|
||||
return (tmp != x) ? tmp+1 : tmp
|
||||
}
|
||||
function dot(x,y, tmp) {
|
||||
tmp = x[1]*y[1] + x[2]*y[2] + x[3]*y[3]
|
||||
return (tmp < 0) ? -tmp : 0
|
||||
}
|
||||
function normalize(v, tmp) {
|
||||
tmp = sqrt(v[1]*v[1] + v[2]*v[2] + v[3]*v[3])
|
||||
v[1] /= tmp
|
||||
v[2] /= tmp
|
||||
v[3] /= tmp
|
||||
}
|
||||
function split0(str,array,fs, arr,i,n) { # same as split except indices start at zero
|
||||
n = split(str,arr,fs)
|
||||
for (i=1; i<=n; i++) {
|
||||
array[i-1] = arr[i]
|
||||
}
|
||||
return(n)
|
||||
}
|
||||
|
|
@ -1,5 +1,18 @@
|
|||
'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
|
||||
'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
|
||||
|
|
|
|||
|
|
@ -1,9 +1,5 @@
|
|||
10 LET I=21
|
||||
20 LET J=2
|
||||
30 FOR K=-PI TO PI STEP 0.07
|
||||
40 PLOT 21+I*SIN K,22+21*COS K
|
||||
50 PLOT 21+21*SIN K,22+(I-1)*COS K
|
||||
60 NEXT K
|
||||
70 LET I=I-J
|
||||
80 LET J=J+1
|
||||
90 IF I>0 THEN GOTO 30
|
||||
'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
|
||||
|
|
|
|||
9
Task/Draw-a-sphere/BASIC/draw-a-sphere-12.basic
Normal file
9
Task/Draw-a-sphere/BASIC/draw-a-sphere-12.basic
Normal file
|
|
@ -0,0 +1,9 @@
|
|||
10 LET I=21
|
||||
20 LET J=2
|
||||
30 FOR K=-PI TO PI STEP 0.07
|
||||
40 PLOT 21+I*SIN K,22+21*COS K
|
||||
50 PLOT 21+21*SIN K,22+(I-1)*COS K
|
||||
60 NEXT K
|
||||
70 LET I=I-J
|
||||
80 LET J=J+1
|
||||
90 IF I>0 THEN GOTO 30
|
||||
|
|
@ -1,251 +1,36 @@
|
|||
; 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
|
||||
10 MODE 2:s$=".:!*oe&#%@"
|
||||
20 DIM v(2),vec(2)
|
||||
30 v(0)=30:v(1)=30:v(2)=-50
|
||||
40 lung=SQR(v(0)*v(0)+v(1)*v(1)+v(2)*v(2))
|
||||
50 v(0)=v(0)/lung
|
||||
60 v(1)=v(1)/lung
|
||||
70 v(2)=v(2)/lung
|
||||
80 r=10:k=2:ambient=0.4
|
||||
90 FOR i=INT(-r) TO INT(r)
|
||||
100 x=i+0.5
|
||||
110 FOR j=INT(-2*r) TO INT(2*r)
|
||||
120 y=j/2+0.5
|
||||
130 IF (x*x+y*y<=r*r) THEN GOSUB 1000 ELSE PRINT" ";
|
||||
140 NEXT j
|
||||
150 PRINT
|
||||
160 NEXT i
|
||||
170 END
|
||||
1000 vec(0)=x
|
||||
1010 vec(1)=y
|
||||
1020 vec(2)=SQR(r*r-x*x-y*y)
|
||||
1030 GOSUB 2000
|
||||
1040 GOSUB 3000
|
||||
1050 b=d^k+ambient
|
||||
1060 intensity%=(1-b)*(LEN(s$)-1)
|
||||
1070 IF (intensity%<0) THEN intensity%=0
|
||||
1080 IF (intensity%>LEN(s$)-1) THEN intensity%=LEN(s$)-2
|
||||
1090 PRINT MID$(s$,intensity%+1,1);
|
||||
1100 RETURN
|
||||
2000 lung=SQR(vec(0)*vec(0)+vec(1)*vec(1)+vec(2)*vec(2))
|
||||
2010 vec(0)=vec(0)/lung
|
||||
2020 vec(1)=vec(1)/lung
|
||||
2030 vec(2)=vec(2)/lung
|
||||
2040 RETURN
|
||||
3000 d=v(0)*vec(0)+v(1)*vec(1)+v(2)*vec(2)
|
||||
3010 IF d<0 THEN d=-d ELSE d=0
|
||||
3020 RETURN
|
||||
|
|
|
|||
|
|
@ -1,19 +1,251 @@
|
|||
SCREEN 13 ' enter high-color graphic mode
|
||||
; Original by Comtois @ 28/03/06
|
||||
;
|
||||
; Updated/Formated by Fluid Byte @ March.24,2009
|
||||
;
|
||||
; http://www.purebasic.fr/english/viewtopic.php?p=281258#p281258
|
||||
|
||||
' 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
|
||||
Declare CreateSphere(M,P)
|
||||
Declare UpdateMesh()
|
||||
|
||||
' 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
|
||||
#_SIZEVERT = 36
|
||||
#_SIZETRIS = 6
|
||||
#FULLSCREEN = 0
|
||||
|
||||
' wait until keypress
|
||||
DO: LOOP WHILE INKEY$ = ""
|
||||
END
|
||||
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
|
||||
|
|
|
|||
|
|
@ -1,18 +1,19 @@
|
|||
'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
|
||||
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
|
||||
|
|
|
|||
38
Task/Draw-a-sphere/Perl-6/draw-a-sphere-1.pl6
Normal file
38
Task/Draw-a-sphere/Perl-6/draw-a-sphere-1.pl6
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
my $width = my $height = 255; # must be odd
|
||||
|
||||
my @light = normalize([ 3, 2, -5 ]);
|
||||
|
||||
my $depth = 255;
|
||||
|
||||
sub MAIN ($outfile = 'sphere-perl6.pgm') {
|
||||
spurt $outfile, "P5\n$width $height\n$depth\n"; # .pgm header
|
||||
my $out = open( $outfile, :a, :bin ) orelse .die;
|
||||
$out.write( Blob.new(draw_sphere( ($width-1)/2, .9, .2) ) );
|
||||
$out.close;
|
||||
}
|
||||
|
||||
sub normalize (@vec) { @vec »/» ([+] @vec »*« @vec).sqrt }
|
||||
|
||||
sub dot (@x, @y) { -([+] @x »*« @y) max 0 }
|
||||
|
||||
sub draw_sphere ( $rad, $k, $ambient ) {
|
||||
my @pixels[$height];
|
||||
my $r2 = $rad * $rad;
|
||||
my @range = -$rad .. $rad;
|
||||
@range.hyper.map: -> $x {
|
||||
my @row[$width];
|
||||
@range.map: -> $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;
|
||||
my $pixel = (0 max ($intensity * $depth).Int) min $depth;
|
||||
@row[$y+$rad] = $pixel;
|
||||
}
|
||||
else {
|
||||
@row[$y+$rad] = 0;
|
||||
}
|
||||
}
|
||||
@pixels[$x+$rad] = @row;
|
||||
}
|
||||
flat |@pixels.map: *.list;
|
||||
}
|
||||
31
Task/Draw-a-sphere/Perl-6/draw-a-sphere-2.pl6
Normal file
31
Task/Draw-a-sphere/Perl-6/draw-a-sphere-2.pl6
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
use Cairo;
|
||||
|
||||
given Cairo::Image.create(Cairo::FORMAT_ARGB32, 256, 256) {
|
||||
given Cairo::Context.new($_) {
|
||||
|
||||
my Cairo::Pattern::Solid $bg .= create(.5,.5,.5);
|
||||
.rectangle(0, 0, 256, 256);
|
||||
.pattern($bg);
|
||||
.fill;
|
||||
$bg.destroy;
|
||||
|
||||
my Cairo::Pattern::Gradient::Radial $shadow .=
|
||||
create(105.2, 102.4, 15.6, 102.4, 102.4, 128.0);
|
||||
$shadow.add_color_stop_rgba(0, .3, .3, .3, .3);
|
||||
$shadow.add_color_stop_rgba(1, .1, .1, .1, .02);
|
||||
.pattern($shadow);
|
||||
.arc(136.0, 134.0, 110, 0, 2 * pi);
|
||||
.fill;
|
||||
$shadow.destroy;
|
||||
|
||||
my Cairo::Pattern::Gradient::Radial $sphere .=
|
||||
create(115.2, 102.4, 25.6, 102.4, 102.4, 128.0);
|
||||
$sphere.add_color_stop_rgba(0, 1, 1, .698, 1);
|
||||
$sphere.add_color_stop_rgba(1, .923, .669, .144, 1);
|
||||
.pattern($sphere);
|
||||
.arc(128.0, 128.0, 110, 0, 2 * pi);
|
||||
.fill;
|
||||
$sphere.destroy;
|
||||
};
|
||||
.write_png('sphere2-perl6.png');
|
||||
}
|
||||
|
|
@ -1,35 +0,0 @@
|
|||
my $x = my $y = 255;
|
||||
$x +|= 1; # must be odd
|
||||
|
||||
my @light = normalize([ 3, 2, -5 ]);
|
||||
|
||||
my $depth = 255;
|
||||
|
||||
sub MAIN ($outfile = 'sphere-perl6.pgm') {
|
||||
spurt $outfile, "P5\n$x $y\n$depth\n"; # .pgm header
|
||||
my $out = open( $outfile, :a, :bin ) or die "$!\n";
|
||||
$out.write( Blob.new(draw_sphere( ($x-1)/2, .9, .2) ) );
|
||||
$out.close;
|
||||
}
|
||||
|
||||
sub normalize (@vec) { return @vec »/» ([+] @vec »*« @vec).sqrt }
|
||||
|
||||
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 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;
|
||||
my $pixel = (0 max ($intensity * $depth).Int) min $depth;
|
||||
@pixels.push($pixel);
|
||||
}
|
||||
else {
|
||||
@pixels.push(0);
|
||||
}
|
||||
}
|
||||
return @pixels;
|
||||
}
|
||||
|
|
@ -1,38 +1,35 @@
|
|||
/*REXX program expresses a lighted sphere with simple characters used for shading. */
|
||||
call drawSphere 19, 4, 2/10 /*draw a sphere with a radius of 19. */
|
||||
call drawSphere 10, 2, 4/10 /* " " " " " " " ten. */
|
||||
call drawSphere 19, 4, 2/10, '30 30 -50' /*draw a sphere with a radius of 19. */
|
||||
call drawSphere 10, 2, 4/10, '30 30 -50' /* " " " " " " " ten. */
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
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 $a $b $c; _=sqrt($a**2 + $b**2 + $c**2); return $a/_ $b/_ $c/_
|
||||
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 $a $b $c; _= sqrt($a**2 + $b**2 + $c**2); return $a/_ $b/_ $c/_
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
drawSphere: procedure; parse arg r, k, ambient /*get the arguments from CL*/
|
||||
if 5=='f5'x then shading= ".:!*oe&#%@" /* EBCDIC dithering chars. */
|
||||
drawSphere: procedure; parse arg r, k, ambient, lightSource /*obtain the four arguments*/
|
||||
if 8=='f8'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. */
|
||||
shadeLen=length(shading) - 1; rr=r**2; r2=r+r /*handy─dandy variables. */
|
||||
parse value norm(lightSource) with s1 s2 s3 /*normalize light source. */
|
||||
shadeLen= length(shading) - 1; rr= r**2; r2= r+r /*handy─dandy variables. */
|
||||
|
||||
do i=floor( -r) to ceil( r); x=i + .5; xx=x**2; $=
|
||||
do j=floor(-r2) to ceil(r2); y=j * .5 + .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*/ /*◄■■■■ same as: dot=max(0, dot) */
|
||||
b=-dot**k + ambient /*calculate the brightness.*/
|
||||
if b<=0 then brite=shadeLen
|
||||
else brite=max( (1-b) * shadeLen, 0) % 1
|
||||
$=($)substr(shading, brite + 1, 1)
|
||||
end /* [↑] build display line.*/
|
||||
else $=$' ' /*append a blank to line. */
|
||||
do i=floor(-r ) to ceil(r ); x= i + .5; xx= x**2; $=
|
||||
do j=floor(-r2) to ceil(r2); y= j * .5 + .5; yy= y**2; z= xx+yy
|
||||
if z<=rr then do /*is point within sphere ? */
|
||||
parse value norm(x y sqrt(rr - xx - yy) ) with v1 v2 v3
|
||||
dot= min(0, s1*v1 + s2*v2 + s3*v3) /*the dot product of above.*/
|
||||
b= -dot**k + ambient /*calculate the brightness.*/
|
||||
if b<=0 then brite= shadeLen
|
||||
else brite= max(0, (1-b) * shadeLen) % 1
|
||||
$= $ || substr(shading, brite + 1, 1)
|
||||
end /* [↑] build display line.*/
|
||||
else $= $' ' /*append a blank to line. */
|
||||
end /*j*/ /*[↓] strip trailing blanks*/
|
||||
say strip($, 'T') /*show a line of the sphere*/
|
||||
end /*i*/ /* [↑] display the sphere.*/
|
||||
return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d=digits(); m.=9; numeric form
|
||||
numeric digits; parse value format(x,2,1,,0) 'E0' with g "E" _ .; g=g*.5'e'_%2
|
||||
h=d+6; 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
|
||||
sqrt: procedure; parse arg x; if x=0 then return 0; d= digits(); numeric digits; h= d+6
|
||||
numeric form; m.=9; 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*/; return g
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue