Juggler demo From Commodore Amiga 500

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Juggler demo From Commodore Amiga 500

Post by jepalza »

NEW!!! now with external definition for scenes

(sorry for translated text, don't speak english)
The famous 3d demo "Juggler" from the Commodore AMIGA 500.
The original source code is available at "aminet".
https://archive.org/details/raytracer-1 ... de.adf.-7z

Inside the original A500 disk (ADF format) come three C files of which only RT1 and RT2 are needed, since RT3 was only for the Amiga's HAM graphics system.

I have converted both RT1,RT2 "C" to FB and used a couple of enhanced routines from:
http://www.etwright.org/cghist/juggler_rt.html

I have included two demos, one of spheres with the three possible modes DULL, BRIGHT and MIRROR and another demo of the famous "JUGGLER".

It is not very optimized, since it is thought for its operation in C, not in Basic, but it makes its function, that is what matters.
It uses too many pointers, which makes it complicated to understand and even more to modify.
The use of "DOUBLE" is mandatory, because of the way it makes the calculations. If you change it to "SINGLE", the "MIRROR" function calculates it wrong.

Eventually I want to implement also the possibility to create the animation that gives life to this demo.

Translated with www.DeepL.com/Translator (free version)



(Spanish, in case you do not understand the automatic translation well)
La famosa demo 3d "Juggler" del Commodore AMIGA 500.
El codigo fuente original esta disponible en "aminet"
https://archive.org/details/raytracer-1 ... de.adf.-7z

Dentro del disco original del A500 (formato ADF) vienen tres ficheros C de los cuales solo son necesario el RT1 y RT2, dado que el RT3 era solo para el sistema grafico HAM del Amiga.

He convertido ambos C a FB y utilizado un par de rutinas mejoradas de:
http://www.etwright.org/cghist/juggler_rt.html

He incluido dos demos , una de esferas con los tres modos posibles DULL, BRIGHT y MIRROR y otra demo del famoso "JUGGLER"

No esta muy optimizada, dado que esta pensada para su funcionamiento en C, no en Basic, pero hace su funcion, que es lo que importa.
Emplea demasiados punteros, lo que lo hace complicado de entender y mas aun de modificar.
Es obligatorio el uso de "DOUBLE", por la forma en la que hace los cálculos. SI se cambia a "SINGLE" , la funcion "MIRROR" la calcula mal.

Con el tiempo quiero implementar tambien la posibilidad de crear la animacion que da vida a esta demo.


Main RT1.BAS

Code: Select all

/'      RT1.C    Ray tracing program
        Copyright 1987 Eric Graham
        Permission is granted to copy and modify this file, provided
        that this notice is retained.
        
        FreeBasic Version By Jepalza_22 (gmail.com)
'/

#Include "defs.bi"
#Include "world.bi"
#Include "rt2.bas"




/' Do the raytracing '/
Sub raytrace(brite() As Double , lines As Double Ptr , w As world Ptr)

    Dim As Double t,tmin,pos_(2) 
	 Dim As Long k 
    Dim As patch ptch 
	 Dim As sphere Ptr spnear=0 
    Dim As lamp Ptr lmpnear=0 

    tmin=_BIG 

	 spnear=0    /' can we see some spheres '/
    for k=0 To w->numsp -1 
        if (intsplin(@t,lines,@w->sp[k])) Then 
            if (t<tmin) Then tmin=t: spnear=@w->sp[k] 
        EndIf 
    Next

    lmpnear=0   /' are we looking at a lamp '/
    for k=0 To w->numlmp -1
        if (intsplin(@t,lines,Cast(sphere Ptr,@w->lmp[k]) )) Then ' LMP necesita ser SPHERE para evitar advertencia
            if (t < tmin) Then tmin=t: lmpnear=@w->lmp[k] 
        EndIf
    Next

    if (lmpnear) Then   /' we see a lamp! '/
        For k=0 To 2
				brite(k)=lmpnear->color_(k)/(lmpnear->radius*lmpnear->radius) 
        Next
        Exit Sub 
    EndIf
  
    if (inthor(@t,lines)) Then  /' do we see the ground? '/
        If (t<tmin) Then 
            point_(@pos_(0),t,lines)
				k=gingham(@pos_(0))  /' cheap vinyl '/
            veccopy(@w->horizon(k).pos_(0),@pos_(0))
            pixbrite(brite(), @w->horizon(k),w,0) 
            Exit sub 
        EndIf
    EndIf

    If (spnear<>0) Then  /' we see a sphere '/
        point_(@ptch.pos_(0),tmin,lines) 
		  setnorm(@ptch,spnear) 
        colorcpy(@ptch.color_(0),@spnear->color_(0)) 
        Select Case (spnear->type_)    /' treat the surface type '/
        	Case _BRIGHT ' type 1 
                If glint_(brite(),@ptch,w,spnear,lines)=0 Then
                	 pixbrite(brite(),@ptch,w,spnear) 'DULL
                EndIf
        	Case _DULL ' type 0
                pixbrite(brite(),@ptch,w,spnear) 
        	Case _MIRROR ' type 2
                mirror(brite(),@ptch,w,lines)
        End Select
        Exit Sub 
    EndIf

    skybrite(brite(),lines,w)      /' nothing else, must be sky '/
End Sub

/' calculate sky color '/
Sub skybrite(brite() As Double , lines As Double Ptr , w As world Ptr)
   /' Blend a sky color from the zenith to the horizon '/
    Dim As Double sin2,cos2 
	 Dim As Long k 
    Sin2=lines[5]*lines[5]
    Sin2/=(lines[1]*lines[1]+lines[3]*lines[3]+sin2) 
    Cos2=1.0-Sin2 
    for k=0 To 2      
		  brite(k)=cos2*w->skyhor(k)+Sin2*w->skyzen(k) 
    Next

End Sub

/' calculate ray for pixel i,j '/
Sub pixline( lines As Double Ptr , o As observer Ptr , i As Long , j As Long)

    Dim As Double x,y,tp(3) 
	 Dim As Long k 
    y=(0.5*o->ny-j)*o->py 
    x=(i-0.5*o->nx)*o->px 
    for k=0 To 2       
		 tp(k)=o->viewdir(k) * o->fl + y * o->vhat(k) + x * o->uhat(k) + o->obspos(k) 
    Next

    genline(lines,@o->obspos(0),@tp(0))  /' generate equation of line '/
End Sub

/' a=b-c for vectors '/
Sub vecsub( a As Double Ptr ,  b As Double Ptr ,  c As Double Ptr)

    Dim As Long k 
    for k=0 To 2
    	a[k]=b[k]-c[k] 
    Next

End Sub

/' intersection of sphere and line '/
Function intsplin( t As Double Ptr ,  lines As Double Ptr , sp As sphere Ptr) As Long
	/' t returns the parameter for where on the line '/
    Dim As Double a,b,c,d,p,q,tt
	 Dim As Long k  /' the sphere is hit '/
    a=0.0
    b=0.0 
	 c=sp->radius
	 c=-c*c 
    for k=0 To 2        
        p=*lines - sp->pos_(k):lines+=1
		  q=*lines:lines+=1
        a=q*q+a 
		  tt=q*p 
		  b=tt+tt+b 
		  c=p*p+c 
    Next
    /' a,b,c are coefficients of quadratic equation for t '/
    d=b*b-4.0*a*c 
    if (d <= 0) Then return 0        /' line misses sphere '/
    d=Sqr(d) 
	 *t=-(b+d)/(a+a) 
    if (*t<_SMALL) Then *t=(d-b)/(a+a) 
    return IIf(*t >_SMALL,1,0)     /' is sphere is in front of us? '/
End Function


/' intersection of line with ground '/
Function inthor( t As Double Ptr ,  lines As Double Ptr) As Long
    if (lines[5] = 0.0) Then return 0 
    *t=-lines[4]/lines[5]
	 return IIf(*t > _SMALL,1,0)
End Function

/' generate the equation of a line through the two points a and b  '/
Sub genline( l As Double Ptr ,  a As Double Ptr ,  b As Double Ptr)

    Dim As Long k 
    for k=0 To 2         
    	*l=a[k]:l+=1
    	*l=b[k]-a[k]:l+=1 
    Next

End Sub

 /' dot product of 2 vectors '/
Function dot( a As Double Ptr ,  b As Double Ptr) As Double
 return a[0]*b[0] + a[1]*b[1] + a[2]*b[2]
End Function


/' calculate position of a point on the line with parameter t '/
Sub point_( pos_ As Double Ptr , t As Double , lines As Double Ptr)

    Dim As Long k
    Dim As Double a 
    for k=0 To 2         
       a=*lines:lines+=1
		 pos_[k]=a+(*lines)*t:lines+=1
    Next

End Sub


' ----------------------------------------------
' solo llega cuando la esfera usa el modo BRIGHT
/' are we looking at a highlight? '/
Function glint_(brite() As Double , p As patch Ptr , w As world Ptr , spc_ As sphere Ptr ,incident As Double Ptr) As Long

    Dim As Long k,lo,firstlite=1 
	 Dim As Double minglint=0.95 
    Dim As Double lines(5),t,r,lp(2) 
    Dim As Double Ptr pp
    Dim As Double Ptr ll
    Dim As Double cosi 
    Dim As Double incvec(2),refvec(2),ref2 

    for lo=0 To w->numlmp -1        
        ll=@w->lmp[lo].pos_(0) 
		  pp=@p->pos_(0)
        vecsub(@lp(0),ll,pp) 
		  cosi=dot(@lp(0),@p->normal(0)) 
        if (cosi <= 0.0) Then continue For /' not with this lamp! '/
        
        genline(@lines(0),pp,ll) 
        for k=0 To w->numsp -1 
            if (@w->sp[k] = spc_) Then Continue For
            if (intsplin(@t,@lines(0),@w->sp[k])) Then goto cont 
        Next

        if (firstlite) Then 
            incvec(0)=incident[1] 
				incvec(1)=incident[3] 
            incvec(2)=incident[5] 
            reflect(@refvec(0),@p->normal(0),@incvec(0)) 
            ref2=dot(@refvec(0),@refvec(0)) 
				firstlite=0 
        EndIf
  
        r=dot(@lp(0),@lp(0))
        t=dot(@lp(0),@refvec(0)) 
        t*=t/(dot(@lp(0),@lp(0))*ref2) 
        if (t > minglint) Then  /' it´s a highlight '/
            for k=0 To 2
            	brite(k)=1.0 
            Next
            return 1 
        EndIf
  
    cont:
   Next

    return 0 
End Function


' ----------------------------------------------
'  solo llega cuando la esfera usa el modo MIRROR 
/' bounce ray off mirror '/
Sub mirror(brite() As Double , p As patch Ptr , w As world Ptr , incident As Double Ptr)

    Dim As Long k 
	 Dim As Double lines(5),incvec(2),refvec(2),t 
	 
	 ' lines origin
    incvec(0)=incident[1] 
	 incvec(1)=incident[3] 
    incvec(2)=incident[5] 

	 t=dot(@p->normal(0),@incvec(0)) 
    if (t >= 0) Then  /' we´re inside a sphere, it´s dark '/
        for k=0 To 2
        	 brite(k)=0.0 
        Next
        Exit Sub
    EndIf
  
    reflect(@refvec(0),@p->normal(0),@incvec(0))
    
    ' lines origin
    lines(0)=p->pos_(0)
    lines(2)=p->pos_(1) 
	 lines(4)=p->pos_(2) 
	 
	 ' lines dir
	 lines(1)=refvec(0) 
    lines(3)=refvec(1) 
	 lines(5)=refvec(2) 
	 
	 Dim aa As Double=brite(0)
	 Dim bb As Double=brite(1)
	 Dim cc As Double=brite(2)

    raytrace(brite(),@lines(0),w)   /' recursion saves the day '/
    for k=0 To 2
    	brite(k)=brite(k)*p->color_(k) 
    Next

End Sub


' llamado con el modo normal (DULL) y al calcular el suelo (GROUND)
/' how bright is the patch? '/
Sub pixbrite(brite() As Double , p As patch Ptr , w As world Ptr , spc_ As sphere Ptr)

    Dim As Long k,lo
    Dim As Double lines(5),t,r,lp(2) 
    Dim As Double Ptr pp
    Dim As Double Ptr ll
    Dim As Double cosi,diffuse 
    Dim As Double zenith(2)={0.0 ,0.0 ,1.0}
    Dim As Double f1=1.5
    Dim As Double f2=0.4 
    
    diffuse=(dot(@zenith(0),@p->normal(0))+f1)*f2 
    for k=0 To 2
    	brite(k)=diffuse*w->illum(k)*p->color_(k) 
    Next

    'If (p<>0) And (w<>0) Then ' siempre existen P y W ?
        for lo=0 To w->numlmp -1         
            ll=@w->lmp[lo].pos_(0)
				pp=@p->pos_(0)
				vecsub(@lp(0),ll,pp) 
            cosi=dot(@lp(0),@p->normal(0)) 
				if (cosi <= 0.0) Then Continue For

            genline(@lines(0),pp,ll) 
            For k=0 To w->numsp-1         
                If (@w->sp[k] = spc_) Then Continue For ' sphere can't shadow itself
                if (intsplin(@t,@lines(0),@w->sp[k])) Then GoTo cont ' exit for: continue for
            Next

            r=Sqr(dot(@lp(0),@lp(0))) 
				cosi=cosi/(r*r*r) 
            For k=0 To 2      
					 brite(k)=brite(k) + cosi * p->color_(k) * w->lmp[lo].color_(k) 
            Next

            cont:
        Next
    'EndIf
  
End Sub


/' normal (radial) direction of sphere '/
Sub setnorm( p As patch Ptr , s As sphere Ptr)

    ' old from Eric Graham
    'Dim As Double Ptr t
    'Dim As Double a 
	 'Dim As Long k 
	 't=@p->normal(0)
    'vecsub(t,@p->pos_(0),@s->pos_(0)) 
	 'a=1.0/s->radius 
    'for k=0 To 2
    '	*t=(*t)*a:t+=1
    'Next
    
    ' new from  http://www.etwright.org/cghist/juggler_rt.html
    vecsub(@p->normal(0),@p->pos_(0),@s->pos_(0)) 
	 p->normal(0) /=s->radius
	 p->normal(1) /=s->radius
	 p->normal(2) /=s->radius
	 
	 
End Sub


/' a=b for colors '/
Sub colorcpy( a As Double Ptr , b As Double Ptr)

 Dim As Long k 
 for k=0 To 2
 	a[k]=b[k] 
 Next

End Sub

/' a=b for vectors '/
Sub veccopy( a As Double Ptr , b As Double Ptr)

	Dim As Long k 
	for k=0 To 2
		a[k]=b[k] 
   Next

End Sub

' floor square tiles
 /' are we on ´black´ or ´white´ tile? '/
Function gingham( pos_ As Double Ptr) As Long

	/' tiles are 3 units wide '/
    Dim As Double x,y 
	 Dim As Long kx,ky 
	 
    kx=0
    ky=0 
	 x=pos_[0]
	 y=pos_[1] 
	 
    if (x < 0) Then 
      x=-x
      kx+=1
	 EndIf
  
    if (y < 0.0) Then 
  		y=-y
  		ky+=1
    EndIf
  
    return ( cint((x+kx)\3) + cint((y+ky)\3) ) Mod 2 
End Function


/' ======================================================================
reflect()
Calculate the reflection ray 'Y' (incoming ray x reflected about the surface normal n).  
Eric's code had some wacky cross-product stuffgoing on, with a special case for x || n.  
I've replaced it with the standard calculation.  
See for example --> http://paulbourke.net/geometry/reflected/
====================================================================== '/
Sub reflect( y As Double Ptr ,  n As Double Ptr ,  x As Double Ptr)

    Dim As Double xx(2),d
	 Dim As Long k 

	 d=dot(x,n) 
    for k=0 To 2
    	y[k]=x[k] - 2 *d*n[k]
    Next

End Sub



  

 ' ==================================   MAIN   ====================================
 
 
 
	' read file with composition scene
	Dim As String fichero,sa
	fichero=Command
	'fichero="robot.txt" ' demo
	If fichero="" Then Print "Falta indicar el nombre del fichero con la escena":Sleep:End
	Dim As Integer nlin
	Open fichero For Input As 1
	While Not (Eof(1))
		Line Input #1,sa
		scene(nlin)=sa
		nlin+=1
	Wend


   ' initiate world    
    Dim As Double lines(5),brite(2) 
    Dim As observer o 
	 Dim As world w 
    Dim As Long ii,jj
	 Dim As Long si,sj 

	 ' create world from scene file
	 read_scene()
    setup(@o,@w)
    
    si=1+(o.nx-1)
    sj=1+(o.ny-1)
    ScreenRes si,sj,32 

    for jj=0 To o.ny -1        
        for ii=0 To o.nx -1      
            pixline(@lines(0),@o,ii,jj) 
				raytrace(brite(),@lines(0),@w) 
            ham(ii,jj,brite(),@o)  ' HAM=Original High Resolution from Amiga 500 ;-)
        Next
    Next
    
 	Beep
 	Sleep


RT2.BAS

Code: Select all

/'      RT2.C
        Copyright 1987 Eric Graham
        All rights reserved.
        This file may not be copied, modified or uploaded to a bulletin
        board system, except as provided below.
        Permission is granted to make a reasonable number of backup copies,
        in order that it may be used to generate executable code for use
        on a Double computer system.
        Permission is granted to modify this code and use the modified code
        for non commercial use by the original purchaser of this software,
        and provided that this notice is included in the modified version.
'/


/'This function is really a stub, you should, change it to suit your needs'/
Sub setup( o As observer Ptr , w As world Ptr)

 Dim As Double alt,azm,degtorad 
 Dim As Long i,j,k 
 Dim As Double t,r,tp(2),lampfac,pmin(2),pmax(2) 

 degtorad=0.0174533 ' PI/180
 
 for k=0 To 2
 	pmin(k)=_BIG
 	pmax(k)=-_BIG 
 Next


 ' -------------  WORLD DEFINITION ----------

 ' picture resolution
 o->nx=scx
 o->ny=scy

 ' pixels sizes ratio
 o->px= 1.0/o->nx 
 o->py=0.75/o->ny 
  
 ' observer position
 o->obspos(0)=obsx
 o->obspos(1)=obsy
 o->obspos(2)=obsz 

 ' altitude - azimuth
 alt=obsalt * degtorad
 azm=obsazm * degtorad

 ' focal length
 o->fl=0.028*obsfl 

 ' view point
 o->viewdir(0)=cos(azm)*cos(alt) 
 o->viewdir(1)=sin(azm)*cos(alt) 
 o->viewdir(2)=sin(alt) 

 o->uhat(0)= Sin(azm) 
 o->uhat(1)=-cos(azm) 
 o->uhat(2)=0.0 

 o->vhat(0)=-cos(azm)*sin(alt) 
 o->vhat(1)=-sin(azm)*sin(alt) 
 o->vhat(2)= Cos(alt) 


 ' define spheres
	w->numsp=nspheres
	w->sp=@rtspheres(0)

	w->numlmp=nlamps
	w->lmp=@rtlamps(0)

	w->horizon(0).pos_(0)=rttiles(0).pos_(0)
	w->horizon(0).pos_(1)=rttiles(0).pos_(1) 
	w->horizon(0).pos_(2)=rttiles(0).pos_(2) 
	w->horizon(1).pos_(0)=rttiles(1).pos_(0) 
	w->horizon(1).pos_(1)=rttiles(1).pos_(1) 
	w->horizon(1).pos_(2)=rttiles(1).pos_(2)
	
	w->horizon(0).normal(0)=rttiles(0).normal(0)
	w->horizon(0).normal(1)=rttiles(0).normal(1) 
	w->horizon(0).normal(2)=rttiles(0).normal(2) 
	w->horizon(1).normal(0)=rttiles(1).normal(0) 
	w->horizon(1).normal(1)=rttiles(1).normal(1) 
	w->horizon(1).normal(2)=rttiles(1).normal(2)
	
	w->horizon(0).color_(0)=rttiles(0).color_(0)
	w->horizon(0).color_(1)=rttiles(0).color_(1) 
	w->horizon(0).color_(2)=rttiles(0).color_(2)
	w->horizon(1).color_(0)=rttiles(1).color_(0)
	w->horizon(1).color_(1)=rttiles(1).color_(1)
	w->horizon(1).color_(2)=rttiles(1).color_(2) 
	
	w->illum(0)=rtambient.r
	w->illum(1)=rtambient.g
	w->illum(2)=rtambient.b 
	
	w->skyzen(0)=rtskyzen.r 
	w->skyzen(1)=rtskyzen.g
	w->skyzen(2)=rtskyzen.b
	
	w->skyhor(0)=rtskyhor.r
	w->skyhor(1)=rtskyhor.g 
	w->skyhor(2)=rtskyhor.b 


 lampfac=_BIG  /' modify the lamp brightness so as to '/
 for i=0 To w->numsp -1  /' get the right exposure '/
        for j=0 To w->numlmp -1      
					  vecsub(@tp(0),@w->sp[i].pos_(0),@w->lmp[j].pos_(0)) 
                 r=Sqr(dot(@tp(0),@tp(0)))
                 r-=w->sp[i].radius 
                 for k=0 To 2
								 t=w->sp[i].color_(k)*w->lmp[j].color_(k)/(r*r) 
                         if (t = 0.0) Then Continue For 
                         t=(1.0-w->sp[i].color_(k)*w->illum(k))/t 
                         if (t<lampfac) Then lampfac=t 
                 Next
        Next
 Next

 for j=0 To w->numlmp -1       
    For k=0 To 2
    	w->lmp[j].color_(k)*=lampfac 
    Next
 Next

 'print "lampfac=";lampfac
End Sub




Function MAX(a As Double, b As Double) As Double
	Return IIf(a>b,a,b)
End Function

Function MIN(a As Double, b As Double) As Double
	Return IIf(a<b,a,b)
End Function


' HAM!!! HAHA!!
Sub ham(i As Long , j As Long , brite() As Double, o As observer Ptr)

 Dim As Integer d,ch,level,pix(2)
 d=4*(j*o->nx+i)
 For ch=0 To 2
 	level=CInt(MAX(MIN(brite(ch)*255,255),0))
 	pix(ch)=level
 Next

 PSet(i,j),RGB(pix(0),pix(1),pix(2))
End Sub

DEFS.BI

Code: Select all



#define _BIG 1.0e10
#define _SMALL 1.0e-5 ' correccion mejora sombras Ernie Wright --> http://www.etwright.org/cghist/juggler_rt.html

#define _DULL    0
#define _BRIGHT  1
#define _MIRROR  2

Type light
	As Double r
	As Double g
	As Double b
End Type

Type lamp 'Field=4
    As Double pos_(2)       /' position of lamp '/
    As Double color_(2)     /' color of lamp '/
    As Double radius        /' size of lamp '/
End Type 

Type sphere 'Field=4
    As Double pos_(2)       /' position of sphere '/
    As Double color_(2)     /' color of sphere '/
    As Double radius        /' size of sphere '/
    As Long type_           /' type of surface, DULL, BRIGHT or MIRROR '/
End Type 

Type patch 'Field=4         /' As a small bit of something visible '/
    As Double pos_(2)       /' position '/
    As Double normal(2)     /' direction 90 degrees to surface '/
    As Double color_(2)     /' color of patch '/
End Type 

Type world 'Field=4      /' As everything in the universe, except observer '/
    As Long numsp        /' number of spheres '/
    As sphere Ptr sp     /' array of spheres '/
    As Long numlmp       /' number of lamps '/
    As lamp Ptr lmp      /' array of lamps '/
    As patch horizon(1)  /' alternate squares on the ground '/
    As Double illum(2)   /' background diffuse illumination '/
    As Double skyhor(2)  /' sky color at horizon '/
    As Double skyzen(2)  /' sky color overhead '/
End Type 

Type observer 'Field=4     /' As now the observer '/
    As Double obspos(2)    /' his position '/
    As Double viewdir(2)   /' direction he is looking '/
    As Double uhat(2)      /' left to right in view plane '/
    As Double vhat(2)      /' down to up in view plane '/
    As Double fl,px,py     /' focal length and pixel sizes '/
    As Long nx,ny          /' number of pixels '/
End Type 





' RT1
Declare Function dot( a As Double Ptr ,  b As Double Ptr) As Double    /' Vector dot product '/
Declare Function intsplin( t As Double Ptr , lines As Double Ptr , sp As sphere Ptr) As Long
Declare Function inthor( t As Double Ptr ,  lines As Double Ptr) As Long
Declare Function gingham( pos_ As Double Ptr) As Long
Declare Function glint_(brite() As Double , p As patch Ptr , w As world Ptr , spc_ As sphere Ptr , incident As Double Ptr) As Long
Declare Sub point_( pos_ As Double Ptr , t As Double , lines As Double Ptr)
Declare Sub veccopy( a As Double Ptr ,  b As Double Ptr)
Declare sub reflect( y As Double Ptr ,  n As Double Ptr ,  x As Double Ptr)
Declare Sub colorcpy( a As Double Ptr ,  b As Double Ptr)
Declare Sub setnorm(p As patch Ptr , s As sphere Ptr)
Declare Sub pixbrite(brite() As Double , p As patch Ptr , w As world Ptr , spc_ As sphere Ptr)
Declare Sub skybrite(brite() As Double , lines As Double Ptr , w As world Ptr)
Declare sub mirror(brite() As Double , p As patch Ptr , w As world Ptr , incident As Double Ptr)
Declare Sub pixline( lines As Double Ptr , o As observer Ptr , i As Long , j As Long)
Declare Sub vecsub( a As Double Ptr ,  b As Double Ptr ,  c As Double Ptr)
Declare Sub genline( l As Double Ptr ,  a As Double Ptr ,  b As Double Ptr)

' RT2
Declare Sub setup( o As observer Ptr , w As world Ptr)
Declare Sub ham(i As Long , j As Long , brite() As Double, o As observer Ptr)

WORLD.BI

Code: Select all

 
 #Define MAXLINES   1000  ' max 1000  lines of scene. is it enough???   >:-?
 #Define MAXSPHERES 10000 ' max 10000 spheres , enough???

 Dim Shared As String scene(MAXLINES) ' to load scene file
 Dim Shared As Long nspheres=MAXSPHERES
 Dim Shared As sphere rtspheres(nspheres-1)
 
 Dim Shared As Integer scx,scy ' screen resolution
 Dim Shared As double  obsx,obsy,obsz ' observer position
 Dim Shared As Integer obsalt,obsazm ' altitude, azimut
 Dim Shared As Integer obsfl ' focal lenght
 
 Dim Shared As Double ambient(8) ' ambient color
 Dim Shared As Double lights(10,6) ' ambient lights (one or more, max 10)

 Dim Shared As Integer nlamps=9
 Dim Shared As lamp  rtlamps(nlamps) ' max ten(0-9)
 
 Dim Shared As patch rttiles(1) ' floor tiles colors (x2) in chess mode            

 Dim Shared As light rtambient ' ambient color
 Dim Shared As light rtskyzen  ' sky zenith color
 Dim Shared As light rtskyhor  ' sky horizon color
 
Sub read_scene()
	Dim As Integer a,f,g
	Dim As string sa,sb

	' in order to avoid format errors, reformat it
	Dim As String temp(MAXLINES)
	g=0
	For f=0 To MAXLINES
		sa=scene(f)
		a=1
		While a
			a=InStr(sa,Chr(9)) ' eliminate CHR(9) (tab)
			If a Then Mid(sa,a)=" "
		Wend
		sa=Trim(sa) ' eliminate spaces
		If Left(sa,1)=";" Then sa="" ' eliminate comments
		a=InStr(sa,";") 
		If a Then
			sa=Left(sa,a-1)
		EndIf
		If sa<>"" Then temp(g)=Trim(sa):g+=1 ' eliminate empty lines
	Next
	g-=1
	
	'For f=0 To g
	'	Print temp(f)
	'Next

	' create world
	For f=0 To g
		sa=temp(f)
		sa=Trim(sa)
		
		If sa="" Then Continue For
		
		If sa="[RESOLUTION]" Then
			sa=temp(f+1)
			scx=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			scy=Val(sa)
			f+=1
		EndIf
		
		If sa="[OBSERVER]" Then
			sa=temp(f+1)
			obsx=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			obsy=Val(sa)	
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			obsz=Val(sa)	
			f+=1		
		EndIf
		
		If sa="[ALTITUDE]" Then
			sa=temp(f+1)
			obsalt=Val(sa)		
			f+=1	
		EndIf
		
		If sa="[AZIMUT]" Then
			sa=temp(f+1)
			obsazm=Val(sa)		
			f+=1				
		EndIf
		
		If sa="[FOCAL]" Then
			sa=temp(f+1)
			obsfl=Val(sa)		
			f+=1			
		EndIf
		
		If sa="[TILES]" Then
			' primer azulejo
			sa=temp(f+1)
			a=InStr(sa,"(") ' --------- position XYZ
			sa=Mid(sa,a+1)
			rttiles(0).pos_(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).pos_(1)=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).pos_(2)=Val(sa)
			'----------
			a=InStr(sa,"(") ' --------- normal UVW
			sa=Mid(sa,a+1)
			rttiles(0).normal(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).normal(1)=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).normal(2)=Val(sa)
			'----------
			a=InStr(sa,"<") ' --------- color RGB
			sa=Mid(sa,a+1)
			rttiles(0).color_(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).color_(1)=Val(sa)	
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(0).color_(2)=Val(sa)						
						
						
			' segundo azulejo	
			sa=temp(f+2)
			a=InStr(sa,"(") ' --------- position XYZ
			sa=Mid(sa,a+1)
			rttiles(1).pos_(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).pos_(1)=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).pos_(2)=Val(sa)
			'----------
			a=InStr(sa,"(") ' --------- normal UVW
			sa=Mid(sa,a+1)
			rttiles(1).normal(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).normal(1)=Val(sa)	
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).normal(2)=Val(sa)
			'----------
			a=InStr(sa,"<") ' --------- color RGB
			sa=Mid(sa,a+1)
			rttiles(1).color_(0)=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).color_(1)=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rttiles(1).color_(2)=Val(sa)	
			
			f+=2				
		EndIf
		   
		If sa="[AMBIENT]" Then
			sa=temp(f+1)
			a=InStr(sa,"<") ' --------- ambient color RGB
			sa=Mid(sa,a+1)
			rtambient.r=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rtambient.g=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rtambient.b=Val(sa)
			'----------
			a=InStr(sa,"<") ' --------- sky zenith color
			sa=Mid(sa,a+1)
			rtskyzen.r=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rtskyzen.g=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rtskyzen.b=Val(sa)
			'----------
			a=InStr(sa,"<") ' --------- sky horizon color
			sa=Mid(sa,a+1)
			rtskyhor.r=Val(sa)
			a=InStr(sa,",")
			sa=Mid(sa,a+1)
			rtskyhor.g=Val(sa)	
			a=Instr(sa,",")
			sa=Mid(sa,a+1)
			rtskyhor.b=Val(sa)
			f+=1		
		EndIf
		
		If sa="[LIGHTS]" Then
			nlamps=0 ' start with '0'
			sa=temp(f+1)
			While Left(sa,1)<>"[" ' look for all lights (min. 1)
				a=InStr(sa,"(") ' --------- light position XYZ
				sa=Mid(sa,a+1)
				rtlamps(nlamps).pos_(0)=Val(sa)
				a=InStr(sa,",")
				sa=Mid(sa,a+1)
				rtlamps(nlamps).pos_(1)=Val(sa)	
				a=Instr(sa,",")
				sa=Mid(sa,a+1)
				rtlamps(nlamps).pos_(2)=Val(sa)
				'----------			
				a=InStr(sa,":") ' --------- light radius
				sa=Mid(sa,a+1)
				rtlamps(nlamps).radius=Val(sa)
				'-----------
				a=InStr(sa,"<") ' --------- light color RGB
				sa=Mid(sa,a+1)
				rtlamps(nlamps).color_(0)=Val(sa)
				a=InStr(sa,",")
				sa=Mid(sa,a+1)
				rtlamps(nlamps).color_(1)=Val(sa)	
				a=Instr(sa,",")
				sa=Mid(sa,a+1)
				rtlamps(nlamps).color_(2)=Val(sa)	
				'-----------
				nlamps+=1 ' lamp created	
				If nlamps=10 Then Exit While ' max 10 lights		
				sa=temp(f+1+nlamps)	
			Wend
			f+=nlamps
		EndIf
		
		If sa="[SCENE]" Then
			' calculo de repeticiones de esferas en casos de lineas usando el comando "#"
			Dim As single x1,x2,x3,y1,y2,y3,z1,z2,z3,r1,r2,r3 ' uso SINGLE temporalmente, luego guardo como DOUBLE
			Dim As Integer repeticiones,primeraesfera=0
			Dim As Integer esferaactual
			nspheres=0 ' start with '0'
			f+=1
			sa=temp(f)
			While 1 ' infinito, ya no sale, dado que es la ultima entidad a tratar
				' si lleva "#" delante, es una repeticion (linea de esferas)
				If Left(sa,1)="#" Then 
					'Print "inicio:";sa
					esferaactual=nspheres-1 ' esfera anterior para repetir su color y tipo
					'----------			color_
					a=InStr(sa,"#") ' --------- repeticiones
					sa=Mid(sa,a+1)
					repeticiones=Val(Trim(sa))
					a=InStr(sa,"(") ' --------- sphere position XYZ
					sa=Mid(sa,a+1)
					rtspheres(nspheres).pos_(0)=Val(sa)
					a=InStr(sa,",")
					sa=Mid(sa,a+1)
					rtspheres(nspheres).pos_(1)=Val(sa)	
					a=Instr(sa,",")
					sa=Mid(sa,a+1)
					rtspheres(nspheres).pos_(2)=Val(sa)	
					a=InStr(sa,":") ' --------- sphere radius
					sa=Mid(sa,a+1)
					rtspheres(nspheres).radius=Val(sa)
					' guardo los datos de la esfera destino (hacia donde queremos llegar)
					x2=rtspheres(nspheres).pos_(0)
					y2=rtspheres(nspheres).pos_(1)
					z2=rtspheres(nspheres).pos_(2)
					r2=rtspheres(nspheres).radius
					' obtengo el factor de escala para llegar de la esfera 1 a la espera 2
					x3=(x2-x1)/repeticiones
					y3=(y2-y1)/repeticiones
					z3=(z2-z1)/repeticiones
					r3=(r2-r1)/repeticiones
					' y ahora la magia: creamos "n" esferas entre la 1 y la 2
					For g=1 To repeticiones
						x1=x1+x3
						y1=y1+y3
						z1=z1+z3
						r1=r1+r3
						rtspheres(nspheres).pos_(0)=x1
						rtspheres(nspheres).pos_(1)=y1	
						rtspheres(nspheres).pos_(2)=z1
						rtspheres(nspheres).radius =r1
						' el color y el tipo de esfera es el de la esfera inicial
						rtspheres(nspheres).color_(0)=rtspheres(esferaactual).color_(0)
						rtspheres(nspheres).color_(1)=rtspheres(esferaactual).color_(1)	
						rtspheres(nspheres).color_(2)=rtspheres(esferaactual).color_(2)
						rtspheres(nspheres).type_    =rtspheres(esferaactual).type_
						nspheres+=1
					Next
					'nspheres-=1
					'f+=1
					'Print "sig:";temp(f):sleep
					GoTo cont
				EndIf
				primeraesfera=0
				a=InStr(sa,"<") ' --------- sphere color RGB
				sa=Mid(sa,a+1)
				rtspheres(nspheres).color_(0)=Val(sa)
				a=InStr(sa,",")
				sa=Mid(sa,a+1)
				rtspheres(nspheres).color_(1)=Val(sa)	
				a=Instr(sa,",")
				sa=Mid(sa,a+1)
				rtspheres(nspheres).color_(2)=Val(sa)
				'----------			color_
				a=InStr(sa,">") ' --------- sphere type: 0=DULL, 1=BRIGHT, 2=MIRROR
				sa=Mid(sa,a+1)
				rtspheres(nspheres).type_=Val(Trim(sa))
				'----------
				a=InStr(sa,"(") ' --------- sphere position XYZ
				sa=Mid(sa,a+1)
				rtspheres(nspheres).pos_(0)=Val(sa)
				a=InStr(sa,",")
				sa=Mid(sa,a+1)
				rtspheres(nspheres).pos_(1)=Val(sa)	
				a=Instr(sa,",")
				sa=Mid(sa,a+1)
				rtspheres(nspheres).pos_(2)=Val(sa)	
				a=InStr(sa,":") ' --------- sphere radius
				sa=Mid(sa,a+1)
				rtspheres(nspheres).radius=Val(sa)
				'----------
				'If primeraesfera=0 Then
				'	primeraesfera=1
					' la primera esfera guardamos su posicion y radio
					x1=rtspheres(nspheres).pos_(0)
					y1=rtspheres(nspheres).pos_(1)
					z1=rtspheres(nspheres).pos_(2)
					r1=rtspheres(nspheres).radius
				'EndIf
				nspheres+=1 ' sphere created	
				cont:
				If nspheres=MAXSPHERES Then Exit While ' max 100000 spheres		
				f+=1
				sa=temp(f)'+nspheres)
				If sa="" Then f=10000: Exit While' end , no more data
			Wend
		EndIf
	Next
	
	Print "screen resolution:";scx;" , ";scy 
 	Print "observer position:";obsx;" , ";obsy;" , ";obsz 
 	Print "altitude, azimut :";obsalt;" , ";obsazm
 	Print "focal lenght     :";obsfl 
 	
	Print
	Print "pos    TILE 0:";rttiles(0).pos_(0)  ;" , ";rttiles(0).pos_(1)  ;" , ";rttiles(0).pos_(2) 
	Print "normal TILE 0:";rttiles(0).normal(0);" , ";rttiles(0).normal(1);" , ";rttiles(0).normal(2) 
	Print "color  TILE 0:";rttiles(0).color_(0);" , ";rttiles(0).color_(1);" , ";rttiles(0).color_(2)
	Print
	Print "pos    TILE 1:";rttiles(1).pos_(0)  ;" , ";rttiles(1).pos_(1)  ;" , ";rttiles(1).pos_(2)	
	Print "normal TILE 1:";rttiles(1).normal(0);" , ";rttiles(1).normal(1);" , ";rttiles(1).normal(2)
	Print "color  TILE 1:";rttiles(1).color_(0);" , ";rttiles(1).color_(1);" , ";rttiles(1).color_(2) 
	Print
	Print "ambient     :";rtambient.r;" , ";rtambient.g;" , ";rtambient.b 
	Print
	Print "sky zenith  :";rtskyzen.r;" , ";rtskyzen.g;" , ";rtskyzen.b
	Print
	Print "sky horizont:";rtskyhor.r;" , ";rtskyhor.g;" , ";rtskyhor.b 
	Print
	For f=0 To nlamps-1
	Print "Light pos";f;":";rtlamps(f).pos_(0);" , ";rtlamps(f).pos_(1);" , ";rtlamps(f).pos_(2)
	Print "Light rad";f;":";rtlamps(f).radius
	Print "Light col";f;":";rtlamps(f).color_(1);" , ";rtlamps(f).color_(0);" , ";rtlamps(f).color_(2)
	Next
	
End Sub
 


Image
Image
Last edited by jepalza on Oct 15, 2022 13:03, edited 1 time in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Juggler demo From Commodore Amiga 500

Post by D.J.Peters »

Thank you for the good old memories ;-)

Joshy
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Juggler demo From Commodore Amiga 500

Post by UEZ »

Very nice :evil: - thx for sharing.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

D.J.Peters wrote: Oct 14, 2022 8:25 Thank you for the good old memories ;-)
Joshy
My first computer was ZX81, then ZX Spectrum, CPC6128 and.... Amiga500, and this demo was so cool for those days.
(now in day, I have been the author of an FPGA system called "UnAmiga" ;-)
Last edited by jepalza on Oct 15, 2022 13:38, edited 1 time in total.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

NEW!!! now with externall definition files.

I have made some important modifications to the initial code (see first thread and download new sources).

To build sphere-based worlds, I have adapted Eric Graham's original format (Copyright 1987) from his .DAT files to a more user-friendly .TXT format.
Basically it's the same, but organised and commented, with separator headers, which are missing in the original file and make it difficult to understand.
A documented example is given below.
The coordinates are enclosed in "()", the RGB colours (values 0 to 1) are enclosed in "<>" and the radius of the sphere is preceded by ":".
To create repetitions of a sphere in linear form, we place the number of interactions in front of the coordinate, followed by the first sphere, and thus create a line of decremental, incremental or fixed spheres, with fixed or variable diameter. The colour remains the same.

There are three types of spheres:
DULL=0, BRIGHT=1 and MIRROR=2 (0=solid matt, 1=bright, 2=reflects the environment).
Composition for each sphere (ball) is like:
<COLOR_RGB> SPHERE_TYPE (COORDINATES_XYZ):RADIUS

Translated with www.DeepL.com/Translator (free version)
----------------------------------------------------------------------------------------------


Para construir mundos a base de esferas, he adaptado el formato original de Eric Graham (Copyright 1987) de sus ficheros .DAT a un formato mas amigable en .TXT.
Basicamente es lo mismo, pero organizado y comentado, con cabeceras de separacion, que en el fichero original no vienen y lo hace dificil de entender.
Un ejemplo documentado viene a continuacion.
Las coordenadas van encerradas entre "()", los colores RGB (valores 0 a 1) van entre "<>" y el radio de la esfera va precedido de ":"
Para crear repeticiones de una esfera en forma lineal, colocamos el numero de interacciones delante de la coordenada, seguido de la primera esfera, y de ese modo se crea una linea de esferas decrementales, incrementales o fijas, con diametro fijo o variable. El color permanece el mismo.

Existen tres tipos de esferas:
DULL=0, BRIGHT=1 y MIRROR=2 (0=solida mate, 1=brillante, 2=refleja el entorno)
La composición de cada esfera (bola) es como:
<COLOR_RGB> ESFERA_TIPO (COORDENADAS_XYZ):RADIO



-----------------------------------------------------------------------------------------------
Ejemplos:
single ball color R0.9 G0.9 B0.9 type 2(MIRROR) center XYZ -0.9,-2.1,5.3 radius 0.6
<0.9,0.9,0.9> 2 (-0.9,-2.1,5.3):0.6

one line of decremental spheres
<1,.1,.1> 1 (0,0,4.6):0.8 --> initial sphere color .1,.1,.1 origin 0,0,4.6 radius 0.8
#5 (0,0,3.3):0.6 --> FIVE(#5) decremental spheres from original one to final position 0,0,3.3 and final radius 0.6

two lines of decremental spheres
<1,.7,.7> 1 (0,0.6,2.9):0.2 --> initial
#6 (-0.6,0.6,1.6):0.2 --> first line with 6 elements from initial sphere above
#7 (-0.4,0.6,0):0.1 --> secondary line with 7 elements from final of above sphere
Last edited by jepalza on Oct 15, 2022 13:39, edited 1 time in total.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

Example three spheres

Code: Select all

[RESOLUTION]
640,480 ; screen resolution

[OBSERVER]
-10,-4,5.5 ; xyz

[ALTITUDE]
-10 ; angle in degrees

[AZIMUT]
20 ; angle in degrees

[FOCAL]
35 ; factor of view

[LIGHTS]
(-100,-100,100):10 <1,1,1> ; one or more lights: (XYZ):RADIUS <COLOR>

[TILES]
(0.,0.,0.) (0.,0.,1.) <1.,0.0,0.0>  ; TWO tiles: position (XYZ) normal (UVW) and <COLOR>
(0.,0.,0.) (0.,0.,1.) <0.0,1.,0.0>  ; if both colors are same value, floor is solid, no chess

[AMBIENT]
<.3,.3,.3> <0.1,0.1,1.0> <0.2,0.2,0.4> ; ambient color + sky zenith color + sky horizon color

[SCENE]
<0.7,1.0,0.7> 0  (0,-4,4):1
<0.7,0.7,1.0> 1  (0,5,4):1
<1.0,0.7,0.7> 2  (0,0,4):3

Last edited by jepalza on Oct 15, 2022 13:33, edited 1 time in total.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

Juggler Amiga 500 demo (with comments explaining each group)

Code: Select all

[RESOLUTION]
640,480 ; screen resolution

[OBSERVER]
-10,-4,5.5 ; xyz

[ALTITUDE]
-10 ; angle in degrees

[AZIMUT]
20 ; angle in degrees

[FOCAL]
35 ; factor of view

[LIGHTS]
(-100,50,150):15 <1,1,1> ; one or more lights: (XYZ):RADIUS <COLOR>

[TILES]
(0.,0.,0.) (0.,0.,1.) <1.0,1.0,0.0>  ; TWO tiles: position (XYZ) normal (UVW) and <COLOR>
(0.,0.,0.) (0.,0.,1.) <0.0,1.0,0.0>  ; if both colors are same value, floor is solid, no chess

[AMBIENT]
<.25,.25,.25> <0.1,0.1,1.0> <0.7,0.7,1.0> ; ambient color + sky zenith color + sky horizon color

[SCENE]
; three crystal spheres
<.9,.9,.9> 2  (-0.9,-2.1,5.3):0.6
<.9,.9,.9> 2  (-1.1,1.9,5.9):0.6
<.9,.9,.9> 2  (-0.4,-1.2,6.8):0.6

; head
<1,.7,.7>  1  (0,0,6.1):0.5 
<.2,.1,.1> 1  (0.02,0,6.12):0.5 ; hair
<.1,.1,1.> 1  (-0.4,0.2,6.1):0.15 ; right eye
<.1,.1,1.> 1  (-0.4,-0.2,6.1):0.15 ; left eye

; neck
<1,.7,.7>  1  (0,0,5.5):0.2

; body
<1,.1,.1>  1  (0,0,4.6):0.8 
 #5 (0,0,3.3):0.6
 
;right leg 
<1,.7,.7>  1  (0,0.6,2.9):0.2 
 #6 (-0.6,0.6,1.6):0.2
 #7 (-0.4,0.6,0):0.1
			 
; left leg			 
<1,.7,.7>  1  (0,-0.6,2.9):0.2 
 #6 (0.2,-0.6,1.6):0.2
 #7 (0.4,-0.6,0):0.1

; right arm				  
<1,.7,.7>  1  (0,-0.7,5.1):0.2 
 #6 (-0.2,-1.2,4.2):0.2
 #7 (-1.1,-2.0,4.1):0.1

; left arm				  
<1,.7,.7>  1  (0,0.7,5.1):0.2 
 #6 (-0.2,1.2,4.2):0.2
 #7 (-1.0,1.9,4.8):0.1
Last edited by jepalza on Oct 15, 2022 13:35, edited 2 times in total.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

Besides, two surprises!!!

I found two .DAT files with test scenes inside the original Amiga ADF disc.
One called "ELE.DAT" and the other "DRAGON.DAT", very simple, but unknown.
I have converted them to my format, so you can see them.

Elephant

Code: Select all

[RESOLUTION]
640,480

[OBSERVER]
0,-22,3

[ALTITUDE]
13

[AZIMUT]
61

[FOCAL]
28

[LIGHTS]
(-15,-50,40):15 <1,1,1>

[TILES]
(0.,0.,0.) (0.,0.,1.) <1.0,1.,0>  
(0.,0.,0.) (0.,0.,1.) <1.0,1.,0> 

[AMBIENT]
<.25,.25,.25> <.1,.1,1> <.7,.7,1>

[SCENE]
<.7,.6,.7> 0 (1,-5,2):0.2 
#6 (1.7,-4.3,2.8):0.3
#5 (2.0,-4,4.0):0.4
#5 (2.3,-3.7,5.5):0.5
#5 (2.7,-3.3,7.0):0.55
#5 (3.0,-3.0,8.5):0.6
#5 (4.,-2.0,10.0):0.65
 
<0.7,0.6,0.7> 0  (6.0,0,11.0):3.0

<1,0,0> 1 (3.0,0.0,12.0):0.5
<1,0,0> 1 (6.0,-3.0,12.0):0.5
 
<.7,.6,.7> 0   (11,0,8):3.5 
#4 (18,0,7.2):3.5
#4 (25,0,8):3.5
 
<.7,.6,.7> 0 (28,0,10):0.2 
#4 (29,0,9.8):0.2
#4 (30,0,9.0):0.2
#4 (30,0,8.0):0.15
 
<.7,.6,.7> 0   (11,3,6):1 
#5 (9,4,3):1
#5 (9,4,0):1
 
<.7,.6,.7> 0  (11,-3,6):1 
#5 (12,-4,3):1
#5 (13,-4,0):1
 
<.7,.6,.7> 0  (25,3,6):1 
#5 (26,4,3):1
#5 (27,4,0):1
 
<.7,.6,.7> 0  (25,-3,6):1 
#5 (23,-4,3):1
#5 (23,-4,0):1
 
 
Dragon

Code: Select all

[RESOLUTION]
640,480 

[OBSERVER]
-22,-44,11

[ALTITUDE]
9

[AZIMUT]
61

[FOCAL]
28

[LIGHTS]
(-45,-150,120):15 <1,1,1>

[TILES]
(0.,0.,0.) (0.,0.,1.) <1.5,1.,0>  
(0.,0.,0.) (0.,0.,1.) <1.5,1.,0> 

[AMBIENT]
<.25,.25,.25> <.1,.1,1> <.7,.7,1>

[SCENE]
<1.0,.7,.7> 1 (26,6,15):15
 
<0.2,1.0,0.2> 0 (-5,4.5,16):0.5      
   #10 (-8,3,14):0.7        
   #5 (-9.2,1,13.4):0.8    
   #5 (-10,-2.5,13):0.9    
   #5 (-9,-6,12.5):1.0     
   #5 (-6,-9,12.5):1.1     
   #5 (-2,-10.5,14):1.2    
   #5 (3,-10,16):1.4       
   #5 (9,-8.5,17.5):1.6    
   #4 (13.5,-6,17):1.8     
   #4 (15.5,-5,14.8):1.9   
   #3 (16,-4,12):2.0       
   #3 (14.9,-2.75,10):2.15 
   #3 (13,-1.5,8):2.3      
   #3 (7.5,0,6):3          
   #2 (2,0,8):4.2          
   #2 (0,0,12):6           
   #1 (0,0,18):5           
   #1 (0,0,23):3.5         
   #1 (0,0,28):2.5         
   #1 (-0.2,0,31):2        
   #1 (-0.5,0,34):1.9      
   #1 (-0.7,0,37.5):1.8    
   #1 (-1.2,0,39):1.7      
   #1 (-2.8,0,39.5):1.6    
   #1 (-5,-.5,38.5):1.4    
   #1 (-6.5,-2,36.5):1.2
 
<0.2,1.0,0.2> 0   (-1,-3.2,23):1
  #8 (-2,-4.4,18):0.9
  #8 (-8,-5,21):0.7
<0.2,1.0,0.2> 0   (-1,3.2,23):1
  #8 (-3,4.4,20):0.9
  #8 (-8,5,19):0.7
 
<0.2,1.0,0.2> 0   (-9.7,-2.2,34.5):2
  #5 (-5.9,-5.4,34.5):2
 
<1.0,0,0> 1       (-11.3,-2,34):1.5
<1.0,0,0> 1       (-5.4,-6.8,34):1.5
 
<0.2,1.0,0.2> 0   (-10.2,-4.3,32.5):1
  #5 (-15.1,-11.3,24.5):0.8
<0.2,1.0,0.2> 0   (-9.5,-4.9,32.5):1
  #5 (-15.0,-11.9,24.5):0.8
<0.2,1.0,0.2> 0   (-8.7,-5.7,32.5):1
  #5 (-14.4,-12.4,24.5):0.8
<0.2,1.0,0.2> 0   (-7.9,-6.3,32.5):1
  #5 (-13.8,-12.4,24.5):0.8
 
<0.2,0.2,1.0> 1   (-15.3,-12.8,24):0.5 
                 #7 (-17,-13.6,22.5):0.5 
                 #7 (-17.9,-14.6,21.5):0.5 
                 #7 (-18.3,-15.6,20.5):0.3
 
<0.2,0.2,1.0> 1 (-17.9,-14.6,21.5):0.5 
                 #7 (-19,-15,20.5):0.3
 
 
<0.2,1.0,0.2> 0   (2,-4,10):3  
#5 (7,-6,4):2 
#7 (5,-6,0):1
 
<0.2,1.0,0.2> 0   (4,-6,0.5):0.5 
#5 (-1,-6,0.3):0.3
<0.2,1.0,0.2> 0   (4,-6,0.5):0.5 
#5 (-1,-4,0.3):0.3
<0.2,1.0,0.2> 0   (4,-6,0.5):0.5 
#5 (-1,-8,0.3):0.3
 
<0.2,1.0,0.2> 0   (2,4,10):3  
#5 (3,6,4):2 
#7 (2,6,0):1
 
<0.2,1.0,0.2> 0   (1,6,0.5):0.5 
#5 (-4,6,0.3):0.3
<0.2,1.0,0.2> 0   (1,6,0.5):0.5 
#5 (-4,4,0.3):0.3
<0.2,1.0,0.2> 0   (1,6,0.5):0.5 
#5 (-4,8,0.3):0.3
 

Image

Image
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Juggler demo From Commodore Amiga 500

Post by D.J.Peters »

jepalza wrote: Oct 15, 2022 12:54My first computer was ZX81, then ZX Spectrum, CPC6128 and.... Amiga500, and this demo was so cool for those days.
(now in day, I have been the author of an FPGA system called "UnAmiga" ;-)
Same here I started with a Tandy MC-10 MC6803, CPC464, C64, Amiga 500, PC XT 4MHz, 286 8MHz, 386 DX 66MHz , 486 120MHz, Pentium I ...

I wrote my first raytracer on the CPC "With 64 shades of Green" :lol: (green monitor)

I won in germany the "goden modem" for my Tutorials in "neuronal networks back propagation"

The time before Internet, via TeleText "Bildschirm Text" called BTX system.

What a fun at all and I would do it the same way again and again and again.

Joshy
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

Wow! you are like me, a programmer since the beginning of time.
I have participated in Spanish computer magazines in the 80's and 90's and I have made commercial games from the golden age of the 8 bits.
And I have participated in the development of FPGA 8 and 16bits systems, such as ZXUNO or UNAMIGA. :wink:
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

Another example with multiple spheres

Code: Select all

[RESOLUTION]
1024,768; screen resolution

[OBSERVER]
-2,-7,5.5 ; xyz

[ALTITUDE]
-10 ; angle in degrees

[AZIMUT]
45 ; angle in degrees

[FOCAL]
35 ; factor of view

[LIGHTS]
(-100,-100,100):10 <1,1,1> ; one or more lights: (XYZ):RADIUS <COLOR>

[TILES]
(0.,0.,0.) (0.,0.,1.) <0.8,0.8,0.0>  ; TWO tiles: position (XYZ) normal (UVW) and <COLOR>
(0.,0.,0.) (0.,0.,1.) <0.4,0.8,0.2>  ; if both colors are same value, floor is solid, no chess

[AMBIENT]
<.7,.7,.7> <0.1,0.1,1.0> <0.4,0.4,0.8> ; ambient color + sky zenith color + sky horizon color

[SCENE]
< 0.3300996, 0.3290385, 0.5324828>  2 ( 12, 0, 0.5): 0.5
< 0.6424803, 0.6527108, 0.2956116>  2 ( 11, 0, 0.5): 0.5
< 0.9696021, 0.9504358, 0.5354314>  2 ( 10, 0, 0.5): 0.5
< 0.07139794, 0.6646097, 0.02476472>  1 ( 9, 0, 0.5): 0.5
< 0.0394583, 0.4660093, 0.8267168>  2 ( 8, 0, 0.5): 0.5
< 0.8964728, 0.2704488, 0.3204605>  1 ( 7, 0, 0.5): 0.5
< 0.437302, 0.5509636, 0.881838>  0 ( 6, 0, 0.5): 0.5
< 0.1796756, 0.5502083, 0.3810085>  0 ( 12, 1, 0.5): 0.5
< 0.4162265, 0.2768588, 0.8479728>  1 ( 11, 1, 0.5): 0.5
< 0.2878213, 0.6768259, 0.765179>  1 ( 10, 1, 0.5): 0.5
< 0.3388629, 0.6327573, 0.967032>  1 ( 9, 1, 0.5): 0.5
< 0.5326403, 0.6693776, 0.7210397>  1 ( 8, 1, 0.5): 0.5
< 0.934157, 0.8131022, 0.7924528>  2 ( 7, 1, 0.5): 0.5
< 0.8477999, 0.2787921, 0.9675062>  0 ( 6, 1, 0.5): 0.5
< 0.6103168, 0.4258673, 0.01053051>  2 ( 12, 2, 0.5): 0.5
< 0.01502077, 0.5717952, 0.3351754>  2 ( 11, 2, 0.5): 0.5
< 0.7979138, 0.5113571, 0.717841>  0 ( 10, 2, 0.5): 0.5
< 0.743208, 0.40011, 0.7905434>  2 ( 9, 2, 0.5): 0.5
< 0.1157196, 0.4176795, 0.2937634>  2 ( 8, 2, 0.5): 0.5
< 0.7769904, 0.1271566, 0.6951949>  0 ( 7, 2, 0.5): 0.5
< 0.2758411, 0.3543816, 0.5140281>  0 ( 6, 2, 0.5): 0.5
< 0.417998, 0.319551, 0.01457345>  2 ( 12, 3, 0.5): 0.5
< 0.9613547, 0.1822213, 0.5438171>  0 ( 11, 3, 0.5): 0.5
< 0.6193774, 0.9496793, 0.5576718>  1 ( 10, 3, 0.5): 0.5
< 0.7891371, 0.9497626, 0.4334949>  2 ( 9, 3, 0.5): 0.5
< 0.8497106, 0.1317883, 0.2213245>  2 ( 8, 3, 0.5): 0.5
< 0.4838689, 0.5184743, 0.9392864>  2 ( 7, 3, 0.5): 0.5
< 0.28511, 0.9421121, 0.7127483>  1 ( 6, 3, 0.5): 0.5
< 0.9396777, 0.8357884, 0.6184946>  1 ( 12, 4, 0.5): 0.5
< 0.4594584, 0.9468997, 0.6291922>  0 ( 11, 4, 0.5): 0.5
< 0.6210665, 0.8978193, 0.3628569>  0 ( 10, 4, 0.5): 0.5
< 0.5931256, 0.2770914, 0.5845177>  2 ( 9, 4, 0.5): 0.5
< 0.5905803, 0.06730495, 0.8959224>  2 ( 8, 4, 0.5): 0.5
< 0.7753733, 0.8611609, 0.2529278>  0 ( 7, 4, 0.5): 0.5
< 0.7781842, 0.3770084, 0.8552815>  1 ( 6, 4, 0.5): 0.5
< 0.4960772, 0.4506256, 0.9243354>  1 ( 12, 5, 0.5): 0.5
< 0.1984628, 0.9259577, 0.4826551>  1 ( 11, 5, 0.5): 0.5
< 0.3572821, 0.04977824, 0.6179002>  0 ( 10, 5, 0.5): 0.5
< 0.7634588, 0.1303929, 0.782089>  0 ( 9, 5, 0.5): 0.5
< 0.786482, 0.7619622, 0.1956084>  0 ( 8, 5, 0.5): 0.5
< 0.7113346, 0.8358881, 0.5026466>  1 ( 7, 5, 0.5): 0.5
< 0.01252429, 0.7393991, 0.3981127>  0 ( 6, 5, 0.5): 0.5
< 0.2041121, 0.4089057, 0.4846319>  2 ( 12, 6, 0.5): 0.5
< 0.6055205, 0.5742222, 0.8833963>  1 ( 11, 6, 0.5): 0.5
< 0.7290956, 0.3091375, 0.3482573>  1 ( 10, 6, 0.5): 0.5
< 0.09296128, 0.9209855, 0.2613535>  2 ( 9, 6, 0.5): 0.5
< 0.6317781, 0.3727942, 0.6580303>  1 ( 8, 6, 0.5): 0.5
< 0.9353359, 0.1040777, 0.2131953>  2 ( 7, 6, 0.5): 0.5
< 0.2416428, 0.8619686, 0.6336348>  1 ( 6, 6, 0.5): 0.5
< 0.1876874, 0.7075725, 0.7954536>  1 ( 11.5, 0.5, 1.2): 0.5
< 0.3335093, 0.7818773, 0.7965506>  2 ( 10.5, 0.5, 1.2): 0.5
< 0.7088113, 0.252826, 0.1738597>  0 ( 9.5, 0.5, 1.2): 0.5
< 0.02326675, 0.9111732, 0.06426612>  1 ( 8.5, 0.5, 1.2): 0.5
< 0.8250352, 0.3907989, 0.8707458>  2 ( 7.5, 0.5, 1.2): 0.5
< 0.3830511, 0.416646, 0.2179228>  2 ( 6.5, 0.5, 1.2): 0.5
< 0.349021, 0.08705762, 0.6583465>  0 ( 11.5, 1.5, 1.2): 0.5
< 0.9436912, 0.6236911, 0.08367555>  1 ( 10.5, 1.5, 1.2): 0.5
< 0.4308469, 0.5823697, 0.5726525>  2 ( 9.5, 1.5, 1.2): 0.5
< 0.3506016, 0.9597097, 0.06533319>  2 ( 8.5, 1.5, 1.2): 0.5
< 0.4182679, 0.9204233, 0.02955334>  2 ( 7.5, 1.5, 1.2): 0.5
< 0.1325597, 0.08381096, 0.04935262>  2 ( 6.5, 1.5, 1.2): 0.5
< 0.6813814, 0.6914791, 0.05164545>  2 ( 11.5, 2.5, 1.2): 0.5
< 0.1301743, 0.9593732, 0.8129268>  2 ( 10.5, 2.5, 1.2): 0.5
< 0.6716009, 0.9889469, 0.1061741>  1 ( 9.5, 2.5, 1.2): 0.5
< 0.881849, 0.8587705, 0.01356564>  1 ( 8.5, 2.5, 1.2): 0.5
< 0.4724605, 0.5209415, 0.9024289>  0 ( 7.5, 2.5, 1.2): 0.5
< 0.2164809, 0.1723415, 0.9174203>  1 ( 6.5, 2.5, 1.2): 0.5
< 0.556178, 0.5825671, 0.2291707>  1 ( 11.5, 3.5, 1.2): 0.5
< 0.9153533, 0.3632029, 0.6522981>  0 ( 10.5, 3.5, 1.2): 0.5
< 0.5701615, 0.6312183, 0.9464533>  0 ( 9.5, 3.5, 1.2): 0.5
< 0.5600786, 0.01732849, 0.3944381>  1 ( 8.5, 3.5, 1.2): 0.5
< 0.3223418, 0.055406, 0.7501278>  0 ( 7.5, 3.5, 1.2): 0.5
< 0.7765893, 0.2344378, 0.8587794>  1 ( 6.5, 3.5, 1.2): 0.5
< 0.05857724, 0.1689793, 0.7563491>  1 ( 11.5, 4.5, 1.2): 0.5
< 0.08840264, 0.5284861, 0.4974384>  2 ( 10.5, 4.5, 1.2): 0.5
< 0.6149952, 0.7719701, 0.546243>  0 ( 9.5, 4.5, 1.2): 0.5
< 0.3992387, 0.4083982, 0.1807573>  0 ( 8.5, 4.5, 1.2): 0.5
< 0.6249612, 0.842044, 0.9938141>  0 ( 7.5, 4.5, 1.2): 0.5
< 0.7963062, 0.989269, 0.6228631>  0 ( 6.5, 4.5, 1.2): 0.5
< 0.2410094, 0.3071016, 0.3779231>  1 ( 11.5, 5.5, 1.2): 0.5
< 0.2678941, 0.2939098, 0.2092192>  2 ( 10.5, 5.5, 1.2): 0.5
< 0.2545585, 0.272709, 0.5723346>  2 ( 9.5, 5.5, 1.2): 0.5
< 0.8719699, 0.2861152, 0.3452253>  0 ( 8.5, 5.5, 1.2): 0.5
< 0.6013864, 0.2678331, 0.6005246>  1 ( 7.5, 5.5, 1.2): 0.5
< 0.9332549, 0.8287967, 0.1185326>  2 ( 6.5, 5.5, 1.2): 0.5
< 0.2263754, 0.1721829, 0.4917163>  1 ( 11, 1, 1.9): 0.5
< 0.1265026, 0.1113947, 0.3009591>  0 ( 10, 1, 1.9): 0.5
< 0.6026402, 0.5499077, 0.5102984>  0 ( 9, 1, 1.9): 0.5
< 0.4176767, 0.3123854, 0.0790501>  1 ( 8, 1, 1.9): 0.5
< 0.9514908, 0.4115821, 0.3293135>  2 ( 7, 1, 1.9): 0.5
< 0.9141728, 0.6171295, 0.6578627>  2 ( 11, 2, 1.9): 0.5
< 0.6305993, 0.942196, 0.1129067>  1 ( 10, 2, 1.9): 0.5
< 0.0472666, 0.1580774, 0.3346479>  2 ( 9, 2, 1.9): 0.5
< 0.9289845, 0.1546186, 0.4360763>  2 ( 8, 2, 1.9): 0.5
< 0.1383495, 0.1312279, 0.9150096>  0 ( 7, 2, 1.9): 0.5
< 0.5343608, 0.3181234, 0.5514176>  0 ( 11, 3, 1.9): 0.5
< 0.3766094, 0.5513175, 0.9663707>  0 ( 10, 3, 1.9): 0.5
< 0.4356931, 0.2196947, 0.2842941>  1 ( 9, 3, 1.9): 0.5
< 0.1380334, 0.3561684, 0.204915>  1 ( 8, 3, 1.9): 0.5
< 0.4273346, 0.6457288, 0.2886594>  2 ( 7, 3, 1.9): 0.5
< 0.04013203, 0.7385769, 0.836109>  1 ( 11, 4, 1.9): 0.5
< 0.05450903, 0.7673808, 0.05976341>  1 ( 10, 4, 1.9): 0.5
< 0.926155, 0.828385, 0.6348596>  2 ( 9, 4, 1.9): 0.5
< 0.2929609, 0.3638741, 0.1504003>  1 ( 8, 4, 1.9): 0.5
< 0.1326295, 0.9436786, 0.6093795>  1 ( 7, 4, 1.9): 0.5
< 0.3939872, 0.5279819, 0.1367385>  1 ( 11, 5, 1.9): 0.5
< 0.5669067, 0.5971139, 0.09934737>  0 ( 10, 5, 1.9): 0.5
< 0.2133632, 0.4177657, 0.7940919>  2 ( 9, 5, 1.9): 0.5
< 0.3308455, 0.3901502, 0.09205937>  2 ( 8, 5, 1.9): 0.5
< 0.5461674, 0.9647208, 0.5222146>  0 ( 7, 5, 1.9): 0.5
< 0.08605069, 0.5801874, 0.8511408>  1 ( 10.5, 1.5, 2.9): 0.5
< 0.7385843, 0.1978408, 0.5529279>  2 ( 9.5, 1.5, 2.6): 0.5
< 0.505861, 0.05809473, 0.8224746>  1 ( 8.5, 1.5, 2.6): 0.5
< 0.999656, 0.600471, 0.5585177>  1 ( 7.5, 1.5, 2.6): 0.5
< 0.9935418, 0.5831217, 0.5573545>  2 ( 10.5, 2.5, 2.6): 0.5
< 0.2118733, 0.8261363, 0.02265341>  2 ( 7.5, 2.5, 2.6): 0.5
< 0.5171599, 0.7648816, 0.688381>  1 ( 10.5, 3.5, 2.6): 0.5
< 0.03085424, 0.73345, 0.2713769>  0 ( 7.5, 3.5, 2.6): 0.5
< 0.9213515, 0.8471186, 0.2136383>  1 ( 10.5, 4.5, 2.6): 0.5
< 0.8751925, 0.8446686, 0.004996068>  1 ( 9.5, 4.5, 2.6): 0.5
< 0.6014154, 0.2989852, 0.5175177>  2 ( 8.5, 4.5, 2.6): 0.5
< 0.349035, 0.6899243, 0.7743218>  2 ( 7.5, 4.5, 2.6): 0.5
< 0.3634773, 0.4712523, 0.012268>  2 ( 9.5, 2.5, 3.6): 0.5
< 0.7874818, 0.9205763, 0.7041087>  2 ( 8.5, 2.5, 3.6): 0.5
< 0.05206751, 0.6481423, 0.918031>  0 ( 9.5, 3.5, 3.6): 0.5
< 0.6751136, 0.5245205, 0.6416085>  0 ( 8.5, 3.5, 3.6): 0.5

< 0.9, 0.9, 0.9>  2 ( 8.949, 9.986, 7): 4

Image
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Juggler demo From Commodore Amiga 500

Post by jepalza »

And here, random scene generator

Code: Select all


Dim As String sa
Dim As Integer a
Dim As Single fa, fb, fc
Dim As Single r,g,b,diam
Dim As Integer tipo

Randomize timer

Open "random.txt" For Output As 2


Print #2,"[RESOLUTION]"
Print #2,"640,480"
Print #2,"[OBSERVER]"
Print #2,"-2,-2,5.5"
Print #2,"[ALTITUDE]"
Print #2,"-10"
Print #2,"[AZIMUT]"
Print #2,"45"
Print #2,"[FOCAL]"
Print #2,"35"
Print #2,"[LIGHTS]"
Print #2,"(-100,-100,100):10 <1,1,1>"
Print #2,"[TILES]"
Print #2,"(0.,0.,0.) (0.,0.,1.) <0.8,0.8,0.0>"
Print #2,"(0.,0.,0.) (0.,0.,1.) <0.4,0.8,0.2>"
Print #2,"[AMBIENT]"
Print #2,"<.7,.7,.7> <0.1,0.1,1.0> <0.4,0.4,0.8>"
Print #2,"[SCENE]"


a=Int(Rnd(1)*7)+5 ' minimo 5
While a
	fa=Rnd(1)*6+4
	fb=Rnd(1)*6+4
	fc=Rnd(1)*6+1

	r=Rnd(1)
	g=Rnd(1)
	b=Rnd(1)
	tipo=Int(Rnd(1)*3)
	diam=Rnd(1)*2
	Print #2,"<";r;",";g;",";b;"> ";tipo;" (";fa;",";fb;",";fc;"):";diam

	a-=1
Wend

Close 2
Post Reply