Another star wars like intro

[BasicCoder2]

Inspired by the UEZ example however I don't know how to use the gdiplus library so this just uses plain old FreeBASIC graphics.
I couldn't figure out the proper geometric transformation function so I changed it to a curved scroll into a black hole :)
You could use a PAINT program to make a scroll text bitmap using fancy fonts.
Haven't had time to add the music but might do so later.

Code: Select all

'BasicCoder 7th July 2018

screenres 700,500,32

dim shared as any ptr image
image = imagecreate(700,1500,rgb(255,0,255))  'hold enlarged text
dim shared as any ptr starfield
starfield = imagecreate(700,500,rgb(255,0,255))  'hold star field
dim as integer x,y
for i as integer = 0 to 1000
    x = int(rnd(1)*700)
    y = int(Rnd(1)*500)
    circle starfield,(x,y),int(Rnd(1)*1)+1,rgb(255,255,255),,,,f
next i
circle starfield,(260,200),50,rgb(10,10,10),,,,f   'black hole
circle starfield,(260,200),40,rgb(0,0,0),,,,f   'black hole

'============== create bitmap image with large text  ===========================
dim as any ptr temp
temp = imagecreate(250,400,rgb(255,0,255))    'hold small text
dim as string s
for i as integer = 0 to 20
    read s
    draw string temp,(0,i*8),s,rgb(255,255,0)   'draw on temp bitmap
next i

'copy enlarged version of temp bitmap to image bitmap
dim as ulong v1
for j as integer = 0 to 399
    for i as integer = 0 to 249
        v1 = point(i,j,temp)
        line image,(i*3,j*3+400)-(i*3+2,j*3+2+400),v1,bf
    next i
next j

'===============================================================================

sub drawText(s1 as single)
    dim as ulong v1
    dim as single x,y
    screenlock
    cls
    put (0,0),starfield,trans
    for j as single = 0 to 500 step 0.5
        for i as single = 0 to 699
            x = i/700*j
            y = j*j/700
            v1 = point(i,j+s1,image)  's1 is starting line in image bitmap
            if v1<>rgb(255,0,255) then
                pset (x+250-y/2,y+200),v1
            end if
        next i
    next j
    screenunlock
end sub

'scroll where p points to the starting pixel line
for p as single = 0 to 1000 step 16
    drawText(p)
    sleep 2
next p


sleep

imagedestroy(temp)         'small text to place in image bitmap
imagedestroy(starfield)
imagedestroy(image)        'large text to scroll


data "It is a period of civil war."
data "Rebel spaceships, striking"
data "from a hidden base, have"
data "won their first victory"
data "against the evil Galactic"
data "Empire."
data "During the battle, rebel"
data "spies managed to steal"
data "secret plans to the Empire's"
data "ultimate weapon, the"
data "Death Star, an armored space"
data "station with enough"
data "power to destroy an entire"
data "planet."
data "Pursued by the Empire's"
data "sinister agents, Princess"
data "Leia races home aboard her"
data "starship, custodian of the"
data "stolen plans that can save"
data "her people and restore"
data "freedom to the galaxy...."

[BasicCoder2]

Using some code snippets that came with the FreeBASIC download I added the star wars music.

Code: Select all

'BasicCoder 7th July 2018
#include once "fmod.bi"

Const SOUND_FILE = "StarWars.mp3"

Sub print_all_tags(ByVal stream As FSOUND_STREAM Ptr)
    Dim As Integer count = 0
    FSOUND_Stream_GetNumTagFields(stream, @count)

    For i As Integer = 0 To (count - 1)
        Dim As Integer tagtype, taglen
        Dim As ZString Ptr tagname, tagvalue
        FSOUND_Stream_GetTagField(stream, i, @tagtype, @tagname, @tagvalue, @taglen)
        Print Left(*tagname, taglen)
    Next
End Sub

    If (FSOUND_GetVersion < FMOD_VERSION) Then
        Print "FMOD version " + Str(FMOD_VERSION) + " or greater required!"
        End 1
    End If

    If (FSOUND_Init(44100, 4, 0) = 0) Then
        Print "Could not initialize FMOD"
        End 1
    End If

    FSOUND_Stream_SetBufferSize(50)

    Dim As FSOUND_STREAM Ptr stream = FSOUND_Stream_Open(SOUND_FILE, FSOUND_MPEGACCURATE, 0, 0)
    If (stream = 0) Then
        Print "FMOD could not load '" & SOUND_FILE & "'"
        FSOUND_Close()
        End 1
    End If


    FSOUND_Stream_Play(FSOUND_FREE, stream)
    
'====================================================================================
screenres 700,500,32

dim shared as any ptr image
image = imagecreate(700,1500,rgb(255,0,255))  'hold enlarged text
dim shared as any ptr starfield
starfield = imagecreate(700,500,rgb(255,0,255))  'hold star field
dim as integer x,y
for i as integer = 0 to 1000
    x = int(rnd(1)*700)
    y = int(Rnd(1)*500)
    circle starfield,(x,y),int(Rnd(1)*1)+1,rgb(255,255,255),,,,f
next i
circle starfield,(260,200),50,rgb(10,10,10),,,,f   'black hole
circle starfield,(260,200),40,rgb(0,0,0),,,,f   'black hole

'============== create bitmap image with large text  ===========================
dim as any ptr temp
temp = imagecreate(250,400,rgb(255,0,255))    'hold small text
dim as string s
for i as integer = 0 to 20
    read s
    draw string temp,(0,i*8),s,rgb(255,255,0)   'draw on temp bitmap
next i

'copy enlarged version of temp bitmap to image bitmap
dim as ulong v1
for j as integer = 0 to 399
    for i as integer = 0 to 249
        v1 = point(i,j,temp)
        line image,(i*3,j*3+400)-(i*3+2,j*3+2+400),v1,bf
    next i
next j

'===============================================================================

sub drawText(s1 as single)
    dim as ulong v1
    dim as single x,y
    screenlock
    cls
    put (0,0),starfield,trans
    for j as single = 0 to 500 step 0.5
        for i as single = 0 to 699
            x = i/700*j
            y = j*j/700
            v1 = point(i,j+s1,image)  's1 is starting line in image bitmap
            if v1<>rgb(255,0,255) then
                pset (x+250-y/2,y+200),v1
            end if
        next i
    next j
    screenunlock
end sub

'scroll where p points to the starting pixel line
for p as single = 0 to 1000 step 16
    drawText(p)
    sleep 2
next p


sleep
FSOUND_Stream_Stop(stream)
FSOUND_Stream_Close(stream)
FSOUND_Close()

imagedestroy(temp)
imagedestroy(starfield)
imagedestroy(image)


data "It is a period of civil war."
data "Rebel spaceships, striking"
data "from a hidden base, have"
data "won their first victory"
data "against the evil Galactic"
data "Empire."
data "During the battle, rebel"
data "spies managed to steal"
data "secret plans to the Empire's"
data "ultimate weapon, the"
data "Death Star, an armored space"
data "station with enough"
data "power to destroy an entire"
data "planet."
data "Pursued by the Empire's"
data "sinister agents, Princess"
data "Leia races home aboard her"
data "starship, custodian of the"
data "stolen plans that can save"
data "her people and restore"
data "freedom to the galaxy...."

[dodicat]

My effort.
Only three stars.
Gravity waves were invented AFTER the premiere, so I have indulged.

Code: Select all

 

#include "windows.bi"
#include "fbgfx.bi"
Type pt
    As Single x,y,z
    As Single rd,gr,bl,al
End Type
Type _float As pt

Dim Shared As pt eyepoint=Type(400,300,800)

'Fonts concise from Mysoft's
Const FS_BOLD = 2
Const FS_ITALIC = 4 

Sub DrawFont(Byref BUFFER As Any Ptr=0,Byval POSX As Long, Byval POSY As Long, _
    Byref FTEXT As String, Byref FNAME As String,Byval FSIZE As Long, _
    Byval FCOLOR As Ulong=Rgb(255,255,255),Byval FSTYLE As Long=0,Byval CHARSET As Long=DEFAULT_CHARSET )
    
    Static FINIT As Long
    Static As hdc THEDC
    Static As hbitmap THEBMP
    Static As Any Ptr THEPTR
    Static As fb.image Ptr FBBLK
    Static As Long TXTSZ,RESU,RESUU
    Static As hfont THEFONT
    Static As Long FW,FI,TXYY
    Static DSKWND As hwnd, DSKDC As hdc
    Static MYBMPINFO As BITMAPINFO
    Static As TEXTMETRIC MYTXINFO
    Static As SIZE TXTSIZE
    Static As RECT RCT
    Static As Ubyte Ptr ubp
    ubp=Cptr(Ubyte Ptr,@FCOLOR)
    Swap ubp[0],ubp[2]
    Dim As Ubyte alphaval =ubp[3]
    ubp[3]=0
    #define FontSize(PointSize) -MulDiv(PointSize, GetDeviceCaps(THEDC, LOGPIXELSY), 72) 
    
    If FINIT = 0 Then   
        FINIT = 1   
        With MYBMPINFO.bmiheader
            .biSize = Sizeof(BITMAPINFOHEADER)
            .biWidth = 2048
            .biHeight = -513
            .biPlanes = 1
            .biBitCount = 32
            .biCompression = BI_RGB
        End With   
        DSKWND = GetDesktopWindow()
        DSKDC = GetDC(DSKWND)
        THEDC = CreateCompatibleDC(DSKDC)
        THEBMP = CreateDIBSection(THEDC,@MYBMPINFO,DIB_RGB_COLORS,@THEPTR,null,null)  
        ReleaseDC(DSKWND,DSKDC)   
    End If
    If (FSTYLE And FS_BOLD) Then FW = FW_BOLD Else FW = FW_NORMAL   
    If (FSTYLE And FS_ITALIC) Then FI = True Else FI = False   
    THEFONT = CreateFont(FontSize(FSIZE),0,0,0,FW,FI,0,0,CHARSET,0,0,0,0,Cast(Any Ptr,Strptr(FNAME)))   
    SelectObject(THEDC,THEBMP)
    SelectObject(THEDC,THEFONT)
    GetTextMetrics(THEDC,@MYTXINFO)
    GetTextExtentPoint32(THEDC,Strptr(FTEXT),Len(FTEXT),@TXTSIZE) 
    TXTSZ = TXTSIZE.CX
    TXYY = TXTSIZE.CY
    If (FSTYLE And FS_ITALIC) Then
        If MYTXINFO.tmOverhang Then
            TXTSZ += MYTXINFO.tmOverhang
        Else
            TXTSZ += 1+(FSIZE/2)
        End If
        TXYY += 1+(FSIZE/8)
    End If
    RCT.LEFT = 0
    RCT.TOP = 1
    RCT.RIGHT = TXTSZ
    RCT.BOTTOM = TXYY+1
    TXTSZ -= 1
    TXYY -= 1
    SetBkColor(THEDC,Rgba(255,0,255,0))
    SetTextColor(THEDC,FCOLOR)
    SystemParametersInfo(SPI_GETFONTSMOOTHING,null,@RESU,null)
    If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,False,@RESUU,null)
    ExtTextOut(THEDC,0,1,ETO_CLIPPED Or ETO_OPAQUE,@RCT,Strptr(FTEXT),Len(FTEXT),null)
    If RESU Then SystemParametersInfo(SPI_SETFONTSMOOTHING,True,@RESUU,null)
    FBBLK = THEPTR+(2048*4)-Sizeof(fb.image)
    FBBLK->Type = 7
    FBBLK->bpp = 4
    FBBLK->Width = 2048
    FBBLK->height = 512
    FBBLK->pitch = 2048*4
    Put BUFFER,(POSX,POSY),FBBLK,(0,0)-(TXTSZ-1,TXYY),Alpha,alphaval
    DeleteObject(THEFONT)
End Sub

Sub getarray(a() As pt,i As Any Ptr)
    Dim As String           Text(22) = {   "It  is  a  period  of civil war.", _
    "Rebel  spaceships,  striking", _
    "from  a  hidden base, have", _
    "won    their    first   victory", _
    "against   the  evil  Galactic", _
    "Empire.", _
    "During   the   battle,  rebel", _
    "spies   managed   to   steal", _
    "secret  plans to the Empire's", _
    "ultimate     weapon,     the", _
    "Death  Star, an armored space", _
    "station      with      enough", _
    "power  to destroy an entire", _
    "planet.", _
    "Pursued   by  the  Empire's", _
    "sinister   agents,   Princess", _
    "Leia  races home aboard her", _
    "starship,  custodian  of the", _
    "stolen  plans that can save", _
    "her   people   and   restore", _
    "freedom  to  the  galaxy....", _
    "Coded          by          UEZ"}
    
    
    For n As Long=0 To 22
        drawfont (i,10,70*n,text(n),"Verdana",40,Rgb(0,200,0))
    Next
    Dim As Long counter
    Dim As Ulong clr
    For z As Long=1 To 2
        
        For x As Long=0 To 849
            For y As Long=0 To 40*40-1
                clr=Point(x,y,i)
                If clr<>Rgb(255,0,255) Then
                    counter+=1
                    If z=2 Then
                        With a(counter)
                            .x=x
                            .y=y
                            .rd=Cast(Ubyte Ptr,@clr)[2]
                            .gr=Cast(Ubyte Ptr,@clr)[1]
                            .bl=Cast(Ubyte Ptr,@clr)[0]
                            .al=255
                        End With
                    End If
                End If
            Next
        Next
        If z=1 Then Redim a(1 To counter):counter=0
    Next z
End Sub

Sub star(starx As Long,stary As Long,size As Long,col As Ulong,rot As Single)
    Var count=0,rad=0.0,_px=0.0,_py=0.0,pi=4*Atn(1),prime=Rgb(255,254,253)
    For x As Integer=1 To 2
        For z As Single=0+.28 +rot To 2*pi+.1+.28 +rot Step 2*pi/10
            count=count+1
            If count Mod 2=0 Then rad=size Else rad=.4*size
            _px=starx+rad*Cos(z)
            _py=stary+rad*Sin(z)
            If count=1 Then Pset (_px,_py)Else Line -(_px,_py),prime
        Next z
        Paint (starx,stary),prime,prime
        count=0:prime=col
    Next x
End Sub

Sub RotateArray(wa() As pt,result() As pt,angle As _float,centre As pt,flag As Long=1,s As Single=1)
    Dim As Single dx,dy,dz,w
    Dim As Single SinAX=Sin(angle.x)
    Dim As Single SinAY=Sin(angle.y)
    Dim As Single SinAZ=Sin(angle.z)
    Dim As Single CosAX=Cos(angle.x)
    Dim As Single CosAY=Cos(angle.y)
    Dim As Single CosAZ=Cos(angle.z)
    Redim result(Lbound(wa) To Ubound(wa))
    For z As Long=Lbound(wa) To Ubound(wa)
        dx=wa(z).x-centre.x
        dy=wa(z).y-centre.y
        dz=wa(z).z-centre.z
        Result(z).x=(((Cosay*Cosaz)*dx+(-Cosax*Sinaz+Sinax*Sinay*Cosaz)*dy+(Sinax*Sinaz+Cosax*Sinay*Cosaz)*dz))+centre.x
        result(z).y=(((Cosay*Sinaz)*dx+(Cosax*Cosaz+Sinax*Sinay*Sinaz)*dy+(-Sinax*Cosaz+Cosax*Sinay*Sinaz)*dz))+centre.y
        result(z).z=(((-Sinay)*dx+(Sinax*Cosay)*dy+(Cosax*Cosay)*dz))+centre.z
        #macro perspective()
        w = 1 + (result(z).z/eyepoint.z)
        result(z).x = s*(result(z).x-eyepoint.x)/w+eyepoint.x 
        result(z).y = s*(result(z).y-eyepoint.y)/w+eyepoint.y 
        result(z).z = s*(result(z).z-eyepoint.z)/w+eyepoint.z
        #endmacro
        If flag Then: perspective():End If
        result(z).rd=wa(z).rd
        result(z).gr=wa(z).gr
        result(z).bl=wa(z).bl
        result(z).al=wa(z).al
    Next z
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

Sub preview
    Dim As Long fps
    Dim As String g(1 To 3)={"A long time ago.", "In a galaxy far,","far away...."}
    Dim As Any Ptr i2=Imagecreate(800,400)
    For n As Long=1 To 3
        drawfont (i2,10,80*n,g(n),"Comic Sans MS",70,Rgb(0,100,200))
    Next n
    Dim As Single al=255
    Do
        al-=.75
        Screenlock
        Cls
        Put(0,0),i2,Alpha,al
        Screenunlock
        Sleep regulate(60,fps),1
    Loop Until al<10
    Imagedestroy i2
End Sub

'=========================================
Screen 19,32,,64
Dim As Any Ptr i=Imagecreate(850,40*40)
Redim As pt a()
getarray(a(),i)
Redim As pt b(1 To Ubound(a))
Imagedestroy(i)
Dim As _float angle
angle.x=-1.25
Dim As pt centre=Type(400,400,-400)
Dim As Long fps
preview 'the start screen

Do
    Randomize 13
    angle.x-=.0001*2
    centre.z+=1*2
    centre.y+=.7*2
    rotatearray(a(),b(),angle,centre,,1.2)
    Screenlock
    Cls
    For n As Long=1 To 3
        star(Rnd*800,Rnd*600,5+Rnd*5,Rgb(255,255,255-20*n),50*angle.x)
    Next n
    For n As Long=Lbound(b) To Ubound(b)
        If b(n).z<1500 Then
            b(n).al-=b(n).z/4
            If b(n).al<1 Then b(n).al=0
            Pset(b(n).x,b(n).y+5*Sin(n/5000+300*angle.x)),Rgba(b(n).rd,b(n).gr,b(n).bl,b(n).al)
        End If
    Next n
    Draw String(50,50),"FPS  "&fps,Rgb(100,100,100)
    
    Screenunlock
    Sleep regulate(25,fps),1
Loop Until Len(Inkey)

Sleep 

[BasicCoder2]

@dodicat,
What no music :)
Nice little demo as usual.
I had thought about using code from your pixel based 3d examples of textured surfaces however I couldn't see why for such a fixed 3d viewpoint a simple geometric transformation equation wouldn't be possible I just couldn't find or figure one out.

I wonder if a cross platform version of DrawFont is possible or at least a Linux substitute?

A Linux user could just make their own 850 x 1600 text bitmap in a Paint program and load it to use your code example.

Code: Select all

Sub getarray(a() As pt,i As Any Ptr)
    bload "textImage.bmp",i
    ...

Not sure of the numbers in,

Code: Select all

    angle.x  =  angle.x - .0001*2
    centre.z =  centre.z + 1*2        'scroll back along z axis
    centre.y =  centre.y + .7*2

I would have assumed you only had to move it back along the z axis.

edit:
Have been studying your code some more and think I am beginning to understand it better.
Here I have added the axis positions relative to the image and see it involves moving the origin sort of along the y axis direction.

[dodicat]

I don't think many have fmod or the music file so I skipped it.
The increase in centre.z goes into the screen.
I noticed that the array was moving too far up the screen so I increased the .y a little to settle it.
I added a tiny rotation about the x axis as a final touch.
I used the tiny rotation value for the wavy effect.

I could have used some other fonts for Linux, but they don't look so good.
And what about sound for Linux?
So I kept the code windows only.

[BasicCoder2]

I noticed that the array was moving too far up the screen so I increased the .y a little to settle it.

So the numbers are essentially a bit of a hack to make it work.
I was so sure there must be a simple 3d to 2d translation as it is a fixed view and a single fixed plane involved.
After some more attempts I haven't been able to get a simpler version working so I guess I just have to accept it is beyond me as I had to do with Paul Doe's attempt at explaining the math in a full functioning 3D demo.
viewtopic.php?f=8&t=26000

[dodicat]

A 3D rotate about a point (I think meaning Paul doe's Euler type rotation), is the first type of rotation which springs to mind anyway.
In order to simulate a rotation about a fixed axis (and not use more extensive vectors - e.g. Rodrigues type rotation) a fudge can be applied to the simpler 3D about a point rotation.

Code: Select all

 

Type V3
    As Single x,y,z
    As Ulong col
End Type

Type Angle 'to optimize rotating many points
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle
End Type

'all the sines and cosines are pre calculated and sent to rotate 
Function Angle.construct(x As Single,y As Single,z As Single) As Angle
    Return   Type (Sin(x),Sin(y),Sin(z), _
                   Cos(x),Cos(y),Cos(z))
            'sx=sin(x), sy=sin(y) ... e.t.c.
End Function
  
Function Rotate(c As V3,p As V3,a As Angle,scale As V3=Type(1,1,1)) As V3
    'note; no trig done, all trig is in parameter angle
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col)
End Function 

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function 

 sub createpoints(a() as v3) 'set up points in a ring
  'set some points in a saturn type disc
  #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    #define ub rnd*255
        For n As Long=0 To 50000
            Var xp=Rnd*800,yp=Rnd*600
            If incircle(400,300,200,xp,yp)=0 Then
                If incircle(400,300,250,xp,yp) Then
                    Var u=Ubound(a)
                    Redim Preserve a(1 To u+1)
                    with a(ubound(a))
                        .x=xp
                        .y=yp
                        .z=Rnd*10-Rnd*10 'give the z component small values
                        .col=Rgb(ub,ub,ub)
                    end with
                    Pset(xp,yp),a(Ubound(a)).col
                End If
            End If
        Next
    end sub
    
     Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            frames+=1
            If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=Timer
            Return sleeptime
        End Function
  '==============================   visual fudge  ==========================      
   screen 19,32,,64
   
    redim as v3 a(0)
    createpoints a()
    
    
     locate 1
    print "Initial array points -- press a key"
    sleep
    line(0,0)-(800,600),rgba(0,0,0,190),bf 'fade out the initial points
    
        dim as double pi=4*atn(1)
        dim as v3 screencentre = type(400,300,0)
         
      'PART 1 of fudge                  (x  y   z)
        Dim As Angle A3d=Angle.construct(0,pi/2,0)   
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=rotate(screencentre,a(n),A3D)                  'rotate all points by pi/2 around the y axis
            Pset(a(n).x,a(n).y),a(n).col                           'draw the points
        Next
        locate 1
        Print "Points are all rotated by 90 degrees around the vertical (y) axis"
        Print "Press a key"
        sleep
        
       Redim As V3 rot(Lbound(a) To Ubound(a))'to hold all rotated points(a working array) 
       Dim As String key
       dim as long fps
       Dim As V3 ang 
       dim as v3 eyepoint      =type(400,300,1000) 'for perspective
       
       'PART 2 of fudge
       ang.z=pi/2  'offset .z by 90 degrees 
       ang.y=-pi/7 'start off with a tilt, optional
        Do
            key=Inkey
            If key=Chr(255)+"K" Then ang.z-=.05     'left
            If key=Chr(255)+"M" Then ang.z+=.05     'right
            If key=Chr(255)+"P" Then ang.y-=.05     'down
            If key=Chr(255)+"H" Then ang.y+=.05     'up 
            If key=Chr(32) Then ang.z=pi/2:ang.y=-pi/7 'space
            
            ang.x+=.01  'the rotating speed 
            if ang.x>=2*pi then ang.x=0
            'use ang and construct parameter 3 for rotate()
            A3D=Angle.construct(ang.x,ang.y,ang.z)' ... get the six rotate components (sines, coses .. for rotate())
            Screenlock
            Cls
            print "fudged axis (x and y apparently interchanged, z has a 90 degree offset)"
            print "X angle ";int(ang.x*180/pi);tab(20);" degrees"
            print "Y angle ";int(ang.y*180/pi);tab(20);" degrees"
            print "z angle ";int(ang.z*180/pi);tab(20);" degrees"
            Draw String(50,130),"Framerate "&fps
            Draw String(50,150),"Use the arrow and space keys "
            
            For n As Long=Lbound(a) To Ubound(a)
                rot(n)=rotate(screencentre,a(n),A3D,Type(1.2,1.2,1.2))'scale up by 1.2  for nicer size
                rot(n)=perspective(rot(n),eyepoint)
            Next
        'can sort rot() in here if needed
            For n As Long=Lbound(rot) To Ubound(rot)
                pset(rot(n).x,rot(n).y),rot(n).col
            Next
            Screenunlock
            Sleep regulate(64,fps),1
        Loop Until key=Chr(27)
         

[BasicCoder2]

I am unable to understand what you have written. I just have to accept my comprehension of the math is limited.
This is how I imagined the sheet of text relative to the axis and the viewer.

The viewer is looking along the y axis in this case the eye is on the z axis but I guess it would be moved back along the y axis.

Code: Select all

'              | z axis up
'             eye
'              |         / text
'              |        /
'  ------------o-------/---------> y into screen
'              |      /
'              |     /
'              |    /

This is looking in the same direction as the viewer is looking.

Code: Select all

'              | z axis up
'             eye
'      +----------------+
'      |  text |  page  |
'      |       |        |
'  ------------o----------------> x axis left to right 
'      |       |        |
'      |       |        |
'      +----------------+
'              |

I like to see the axis to see how it relates to the other points.

Code: Select all

 

Type V3
    As Single x,y,z
    As Ulong col
End Type

Type Angle 'to optimize rotating many points
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle
End Type

'all the sines and cosines are pre calculated and sent to rotate 
Function Angle.construct(x As Single,y As Single,z As Single) As Angle
    Return   Type (Sin(x),Sin(y),Sin(z), _
                   Cos(x),Cos(y),Cos(z))
            'sx=sin(x), sy=sin(y) ... e.t.c.
End Function
  
Function Rotate(c As V3,p As V3,a As Angle,scale As V3=Type(1,1,1)) As V3
    'note; no trig done, all trig is in parameter angle
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col)
End Function 

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function 

 sub createpoints(a() as v3) 'set up points in a ring
  'set some points in a saturn type disc
  #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    #define ub rnd*255
        For n As Long=0 To 50000
            Var xp=Rnd*800,yp=Rnd*600
            If incircle(400,300,200,xp,yp)=0 Then
                If incircle(400,300,250,xp,yp) Then
                    Var u=Ubound(a)
                    Redim Preserve a(1 To u+1)
                    with a(ubound(a))
                        .x=xp
                        .y=yp
                        .z=Rnd*10-Rnd*10 'give the z component small values
                        .col=Rgb(ub,ub,ub)
                    end with
                    Pset(xp,yp),a(Ubound(a)).col
                End If
            End If
        Next
        
        'add three axis
        
        For n As Long= -50 To 50
            Var xp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=xp
                .y=0
                .z=0
                .col=Rgb(255,0,0)
            end with
        Next
        
        For n As Long= -50 To 50
            Var yp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=0
                .y=yp
                .z=0
                .col=Rgb(0,255,0)
            end with
        Next
        
        For n As Long= -50 To 50
            Var zp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=0
                .y=0
                .z=zp
                .col=Rgb(0,0,255)
            end with
        Next

    end sub
    
     Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            frames+=1
            If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=Timer
            Return sleeptime
        End Function
  '==============================   visual fudge  ==========================      
   screen 19,32,,64
   
    redim as v3 a(0)
    createpoints a()
    
    
     locate 1
    print "Initial array points -- press a key"
    sleep
    line(0,0)-(800,600),rgba(0,0,0,190),bf 'fade out the initial points
    
        dim as double pi=4*atn(1)
        dim as v3 screencentre = type(400,300,0)
         
      'PART 1 of fudge                  (x  y   z)
        Dim As Angle A3d=Angle.construct(0,pi/2,0)   
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=rotate(screencentre,a(n),A3D)                  'rotate all points by pi/2 around the y axis
            Pset(a(n).x,a(n).y),a(n).col                           'draw the points
        Next
        locate 1
        Print "Points are all rotated by 90 degrees around the vertical (y) axis"
        Print "Press a key"
        sleep
        
       Redim As V3 rot(Lbound(a) To Ubound(a))'to hold all rotated points(a working array) 
       Dim As String key
       dim as long fps
       Dim As V3 ang 
       dim as v3 eyepoint      =type(400,300,1000) 'for perspective
       
       'PART 2 of fudge
       ang.z=pi/2  'offset .z by 90 degrees 
       ang.y=-pi/7 'start off with a tilt, optional
        Do
            key=Inkey
            If key=Chr(255)+"K" Then ang.z-=.05     'left
            If key=Chr(255)+"M" Then ang.z+=.05     'right
            If key=Chr(255)+"P" Then ang.y-=.05     'down
            If key=Chr(255)+"H" Then ang.y+=.05     'up 
            If key=Chr(32) Then ang.z=pi/2:ang.y=-pi/7 'space
            
            ang.x+=.01  'the rotating speed 
            if ang.x>=2*pi then ang.x=0
            'use ang and construct parameter 3 for rotate()
            A3D=Angle.construct(ang.x,ang.y,ang.z)' ... get the six rotate components (sines, coses .. for rotate())
            Screenlock
            Cls
            print "fudged axis (x and y apparently interchanged, z has a 90 degree offset)"
            print "X angle ";int(ang.x*180/pi);tab(20);" degrees"
            print "Y angle ";int(ang.y*180/pi);tab(20);" degrees"
            print "z angle ";int(ang.z*180/pi);tab(20);" degrees"
            Draw String(50,130),"Framerate "&fps
            Draw String(50,150),"Use the arrow and space keys "
            
            For n As Long=Lbound(a) To Ubound(a)
                rot(n)=rotate(screencentre,a(n),A3D,Type(1.2,1.2,1.2))'scale up by 1.2  for nicer size
                rot(n)=perspective(rot(n),eyepoint)
            Next
        'can sort rot() in here if needed
            For n As Long=Lbound(rot) To Ubound(rot)
                pset(rot(n).x,rot(n).y),rot(n).col
            Next
            Screenunlock
            Sleep regulate(64,fps),1
        Loop Until key=Chr(27)
 

[dodicat]

Normally:
The z axis is into the screen and out of the screen because the x,y points are plotted on the x/y plane (the screen).
This of course is different from the standard maths representation.

But the way it pans out after the fudge is the z axis (blue) is sticking up (standard representation)
Nice touch putting in the axis.I have translated them to the centre.

Code: Select all

  

Type V3
    As Single x,y,z
    As Ulong col
End Type

Type Angle 'to optimize rotating many points
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle
End Type

'all the sines and cosines are pre calculated and sent to rotate 
Function Angle.construct(x As Single,y As Single,z As Single) As Angle
    Return   Type (Sin(x),Sin(y),Sin(z), _
                   Cos(x),Cos(y),Cos(z))
            'sx=sin(x), sy=sin(y) ... e.t.c.
End Function
  
Function Rotate(c As V3,p As V3,a As Angle,scale As V3=Type(1,1,1)) As V3
    'note; no trig done, all trig is in parameter angle
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col)
End Function 

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function

Sub QsortZ(array() As V3,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As V3 x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
            While array(J).z < X .z:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J >begin Then QsortZ(array(),begin,J)
            If I <Finish Then QsortZ(array(),I,Finish)
        End Sub
        
sub createpoints2(a() as v3)
    dim as ulong clr
    for z as long=-25 to 25 step 2  'step 2 to keep the number of points lower
        for x as long=250 to 550 step 2
            for y as long=150 to 450 step 2
              
                if x=250 then clr=rgb(200,0,0)
                if x=550 then clr=rgb(0,100,0)
                if y=150 then clr=rgb(0,100,255)
                if y= 450 then clr=rgb(255,255,255)
              
                if x=250 or y=150 or x=550 or y= 450 then
                    Var u=Ubound(a)
                     Redim Preserve a(1 To u+1)
                     with a(ubound(a))
                        .x=x
                        .y=y
                        .z=z
                        .col=clr
                    end with
                    Pset(x,y),a(Ubound(a)).col
                    end if
            next y
        next x
    next z
     'add three axis
        
        For n As Long= 350 To 450
            Var xp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=xp
                .y=300
                .z=0
                .col=Rgb(255,0,0)
            end with
        Next
        
        For n As Long= 250 To 350
            Var yp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=yp
                .z=0
                .col=Rgb(0,255,0)
            end with
        Next
        
        For n As Long= -200 To 200
            Var zp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=300
                .z=zp
                .col=Rgb(0,0,255)
            end with
        Next
    end sub
    
 sub createpoints(a() as v3) 'set up points in a ring
  'set some points in a saturn type disc
  #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
    #define ub rnd*255
        For n As Long=0 To 50000
            Var xp=Rnd*800,yp=Rnd*600
            If incircle(400,300,200,xp,yp)=0 Then
                If incircle(400,300,250,xp,yp) Then
                    Var u=Ubound(a)
                    Redim Preserve a(1 To u+1)
                    with a(ubound(a))
                        .x=xp
                        .y=yp
                        .z=Rnd*10-Rnd*10 'give the z component small values
                        .col=Rgb(ub,ub,ub)
                    end with
                    Pset(xp,yp),a(Ubound(a)).col
                End If
            End If
        Next
        
        'add three axis
        
        For n As Long= 350 To 450
            Var xp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=xp
                .y=300
                .z=0
                .col=Rgb(255,0,0)
            end with
        Next
        
        For n As Long= 250 To 350
            Var yp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=yp
                .z=0
                .col=Rgb(0,255,0)
            end with
        Next
        
        For n As Long= -200 To 200
            Var zp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=300
                .z=zp
                .col=Rgb(0,0,255)
            end with
        Next

    end sub
    
     Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            frames+=1
            If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=Timer
            Return sleeptime
        End Function
  '==============================   visual fudge  ==========================      
   screen 19,32,,64
  
    redim as v3 a(0)
    createpoints2 a()
    
    
     locate 1
    print "Initial array points -- press a key"
    sleep
    line(0,0)-(800,600),rgba(0,0,0,190),bf 'fade out the initial points
    
        dim as double pi=4*atn(1)
        dim as v3 screencentre = type(400,300,0)
         
      'PART 1 of fudge                  (x  y   z)
        Dim As Angle A3d=Angle.construct(0,pi/2,0)   
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=rotate(screencentre,a(n),A3D)                  'rotate all points by pi/2 around the y axis
            Pset(a(n).x,a(n).y),a(n).col                           'draw the points
        Next
        locate 1
        Print "Points are all rotated by 90 degrees around the vertical (y) axis"
        Print "Press a key"
        sleep
        
       Redim As V3 rot(Lbound(a) To Ubound(a))'to hold all rotated points(a working array) 
       Dim As String key
       dim as long fps
       Dim As V3 ang 
       dim as v3 eyepoint      =type(400,300,1000) 'for perspective
       
       'PART 2 of fudge
       ang.z=pi/2  'offset .z by 90 degrees 
       ang.y=-pi/7 'start off with a tilt, optional
        Do
            key=Inkey
            If key=Chr(255)+"K" Then ang.z-=.05     'left
            If key=Chr(255)+"M" Then ang.z+=.05     'right
            If key=Chr(255)+"P" Then ang.y-=.05     'down
            If key=Chr(255)+"H" Then ang.y+=.05     'up 
            If key=Chr(32) Then ang.z=pi/2:ang.y=-pi/7 'space
            
            ang.x+=.01  'the rotating speed 
            if ang.x>=2*pi then ang.x=0
            'use ang and construct parameter 3 for rotate()
            A3D=Angle.construct(ang.x,ang.y,ang.z)' ... get the six rotate components (sines, coses .. for rotate())
            Screenlock
            Cls
            print "fudged axis (x and y apparently interchanged, z has a 90 degree offset)"
            print "X angle ";int(ang.x*180/pi);tab(20);" degrees"
            print "Y angle ";int(ang.y*180/pi);tab(20);" degrees"
            print "z angle ";int(ang.z*180/pi);tab(20);" degrees"
            Draw String(50,130),"Framerate "&fps
            Draw String(50,150),"Use the arrow and space keys "
            
            For n As Long=Lbound(a) To Ubound(a)
                rot(n)=rotate(screencentre,a(n),A3D,Type(1,1,1))'scale up by 1.2  for nicer size
                rot(n)=perspective(rot(n),eyepoint)
            Next
            qsortz(rot(),lbound(rot),ubound(rot))
        'can sort rot() in here if needed
            For n As Long=Lbound(rot) To Ubound(rot)
                circle(rot(n).x,rot(n).y),2,rot(n).col,,,,f
            Next
            Screenunlock
            Sleep regulate(64,fps),1
        Loop Until key=Chr(27)
    

[Dr_D]

Cool stuff! Sorry, I don't have anything to add, but this is just fun stuff. :D

[BasicCoder2]

Don't understand why xp and yp isn't also -200 to 200 to go through an origin?
Anyway I have added some text. The idea would be for the red axis to line up with a vertical blue axis.
Then the origin could change along the x and z axis to move down and away from the text?
For some reason the text is blurry?

Code: Select all

screenres 640,480,32
'============== create bitmap image with large text  ===========================
dim shared as any ptr image
image = imagecreate(700,1500,rgb(255,0,255))  'hold enlarged text
dim as any ptr temp
temp = imagecreate(250,400,rgb(255,0,255))    'hold small text
dim as string s
for i as integer = 0 to 20
    read s
    draw string temp,(0,i*8),s,rgb(255,255,0)   'draw on temp bitmap
next i

'copy enlarged version of temp bitmap to image bitmap
dim as ulong v1
for j as integer = 0 to 399
    for i as integer = 0 to 249
        v1 = point(i,j,temp)
        line image,(i*3,j*3+400)-(i*3+2,j*3+2+400),v1,bf
    next i
next j

'===============================================================================


Type V3
    As Single x,y,z
    As Ulong col
End Type

Type Angle 'to optimize rotating many points
    As Single sx,sy,sz
    As Single cx,cy,cz
    Declare Static Function construct(As Single,As Single,As Single) As Angle
End Type

'all the sines and cosines are pre calculated and sent to rotate 
Function Angle.construct(x As Single,y As Single,z As Single) As Angle
    Return   Type (Sin(x),Sin(y),Sin(z), _
                   Cos(x),Cos(y),Cos(z))
            'sx=sin(x), sy=sin(y) ... e.t.c.
End Function
  
Function Rotate(c As V3,p As V3,a As Angle,scale As V3=Type(1,1,1)) As V3
    'note; no trig done, all trig is in parameter angle
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
    (scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
    (scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z,p.col)
End Function 

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function

Sub QsortZ(array() As V3,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As V3 x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
        While array(J).z < X .z:J-=1:Wend
            If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J >begin Then QsortZ(array(),begin,J)
    If I <Finish Then QsortZ(array(),I,Finish)
End Sub
        
sub createpoints2(a() as v3)
    
    dim as ulong clr

    dim as long z
    z = 100
        for x as long= 0 to 699
            z = z - 1
            for y as long= 0 to 1499
             '   if x = 250 then clr=rgb(200,0,0)
             '   if x = 550 then clr=rgb(0,100,0)
             '   if y = 150 then clr=rgb(0,100,255)
             '   if y = 450 then clr=rgb(255,255,255)
              
             '   if x=250 or y=150 or x=550 or y= 450 then
             if point(x,y,image)<>rgb(255,0,255) then
                    Var u=Ubound(a)
                     Redim Preserve a(1 To u+1)
                     with a(ubound(a))
                        .x=x-350
                        .y=y-350
                        .z=z
                        .col=point(x,y,image)
                    end with
                    Pset(x,y),a(Ubound(a)).col
                end if
            next y
        next x

     'add three axis
        
        For n As Long= 350 To 450
            Var xp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=xp
                .y=300
                .z=0
                .col=Rgb(255,0,0)
            end with
        Next
        
        For n As Long= 250 To 350
            Var yp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=yp
                .z=0
                .col=Rgb(0,255,0)
            end with
        Next
        
        For n As Long= -200 To 200
            Var zp = n
            Var u=Ubound(a)
            Redim Preserve a(1 To u+1)
            with a(ubound(a))
                .x=400
                .y=300
                .z=zp
                .col=Rgb(0,0,255)
            end with
        Next
    end sub
    
    
     Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
            Static As Double timervalue,_lastsleeptime,t3,frames
            frames+=1
            If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
            Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
            If sleeptime<1 Then sleeptime=1
            _lastsleeptime=sleeptime
            timervalue=Timer
            Return sleeptime
        End Function
  '==============================   visual fudge  ==========================      

  
    redim as v3 a(0)
    createpoints2 a()
    
    
     locate 1
    print "Initial array points -- press a key"
    sleep
    line(0,0)-(800,600),rgba(0,0,0,190),bf 'fade out the initial points
    
        dim as double pi=4*atn(1)
        dim as v3 screencentre = type(400,300,0)
         
      'PART 1 of fudge                  (x  y   z)
        Dim As Angle A3d=Angle.construct(0,pi/2,0)   
        For n As Long=Lbound(a) To Ubound(a)                        
            a(n)=rotate(screencentre,a(n),A3D)                  'rotate all points by pi/2 around the y axis
            Pset(a(n).x,a(n).y),a(n).col                           'draw the points
        Next
        locate 1
        Print "Points are all rotated by 90 degrees around the vertical (y) axis"
        Print "Press a key"
        sleep
        
       Redim As V3 rot(Lbound(a) To Ubound(a))'to hold all rotated points(a working array) 
       Dim As String key
       dim as long fps
       Dim As V3 ang 
       dim as v3 eyepoint      =type(400,300,1000) 'for perspective
       
       'PART 2 of fudge
       ang.z=pi/2  'offset .z by 90 degrees 
       ang.y=-pi/7 'start off with a tilt, optional
        Do
            key=Inkey
            If key=Chr(255)+"K" Then ang.z-=.05     'left
            If key=Chr(255)+"M" Then ang.z+=.05     'right
            If key=Chr(255)+"P" Then ang.y-=.05     'down
            If key=Chr(255)+"H" Then ang.y+=.05     'up 
            If key=Chr(32) Then ang.z=pi/2:ang.y=-pi/7 'space
            
            ang.x+=.01  'the rotating speed 
            if ang.x>=2*pi then ang.x=0
            'use ang and construct parameter 3 for rotate()
            A3D=Angle.construct(ang.x,ang.y,ang.z)' ... get the six rotate components (sines, coses .. for rotate())
            Screenlock
            Cls
            print "fudged axis (x and y apparently interchanged, z has a 90 degree offset)"
            print "X angle ";int(ang.x*180/pi);tab(20);" degrees"
            print "Y angle ";int(ang.y*180/pi);tab(20);" degrees"
            print "z angle ";int(ang.z*180/pi);tab(20);" degrees"
            Draw String(50,130),"Framerate "&fps
            Draw String(50,150),"Use the arrow and space keys "
            
            For n As Long=Lbound(a) To Ubound(a)
                rot(n)=rotate(screencentre,a(n),A3D,Type(1,1,1))'scale up by 1.2  for nicer size
                rot(n)=perspective(rot(n),eyepoint)
            Next
            qsortz(rot(),lbound(rot),ubound(rot))
        'can sort rot() in here if needed
            For n As Long=Lbound(rot) To Ubound(rot)
                pset (rot(n).x,rot(n).y),rot(n).col
               ' circle(rot(n).x,rot(n).y),2,rot(n).col,,,,f
            Next
            Screenunlock
            Sleep regulate(64,fps),1
        Loop Until key=Chr(27)
   
imagedestroy(temp)         'small text to place in image bitmap
imagedestroy(image)        'large text to scroll


data "It is a period of civil war."
data "Rebel spaceships, striking"
data "from a hidden base, have"
data "won their first victory"
data "against the evil Galactic"
data "Empire."
data "During the battle, rebel"
data "spies managed to steal"
data "secret plans to the Empire's"
data "ultimate weapon, the"
data "Death Star, an armored space"
data "station with enough"
data "power to destroy an entire"
data "planet."
data "Pursued by the Empire's"
data "sinister agents, Princess"
data "Leia races home aboard her"
data "starship, custodian of the"
data "stolen plans that can save"
data "her people and restore"
data "freedom to the galaxy...."

[dodicat]

I suppose

with a(ubound(a))
.x=x
.y=y-350
.z=0
.col=point(x,y,image)
end with

lines it up better.

i kept the blue axis longer because it the axis of rotation.

Use pset instead of circle to draw the points.

[BasicCoder2]

i kept the blue axis longer because it the axis of rotation.

Of course for the Star Wars intro we don't want rotation just the text sliding from under the viewer and into the distance.
Changed circle to pset in the previous post should have noticed it myself. Circle is a good fill in when required.