%begin !Solid body modeller - original version by P. Reid. !Looks a hack - no clipping and crashes out frequently. !Modded JHB Oct 86 !All comments inserted by JHB from examination of program. !Input file Formats: !1) Peter Reid's format... !All text ignored up to and including a '#' character. !Then up to 58 point sets may follow. Each of form.. !First printable character taken as point set name. 'A'<=char<='z' !then lines may be.. !Point description: ! Point number (ignored), ':' then X,Y,Z !End of list: '$' !Set name of '$' terminates list of sets !Polygon list. !All text ignored up to '#', then lines may be.. !Colour indication: ! '>' followed by colour no. or INVISIBLE (255) then colour no. !Polygon description: ! (ignored) ':' followed by number of vertices then vertex list. ! Vertices specified as SETm, SETn,.... where SET is the set name ('A'-'z') !End of list: '$' !?Viewpoint description: !Text ignored up to '#', then !number (ignored), sp_cx, sp_cy, sp_dist, xa, ya, za !2) Iff' (JHB) !&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %include "level1:graphinc.imp" @16_E30000 %short %integer %array Colour Map (0:511) %routine Mix Colour (%short Col, Red, Green, Blue) Colour Map(Col<<1+1)=Red+Green<<5+Blue<<10 %end %routine VClear Print Symbol (27); Print Symbol (118) %end %routine Clear All VClear Clear %end %routine Set Up %integer i %integer z = 0 Offset (0,0) Colour (White) %for i = 0, 32, 480 %cycle Colour Map (1+i) = z Colour Map (3+i) = 31 Colour Map (5+i) = 31<<5 Colour Map (7+i) = 31<<5+31 Colour Map (9+i) = 31<<10 Colour Map (11+i) = 31<<10+31 Colour Map (13+i) = 31<<10+31<<5 Colour Map (15+i) = 31<<10+31<<5+31 Colour Map (17+i) = 31<<10+31<<5+31 Colour Map (19+i) = 31<<10+31<<5 Colour Map (21+i) = 31<<10+31 Colour Map (23+i) = 31<<10 Colour Map (25+i) = 31<<5+31 Colour Map (27+i) = 31<<5 Colour Map (29+i) = 31 Colour Map (31+i) = z %repeat %end !&&&&&&&&&&&&&&&&&&&&&&&&&&&&& %include "inc:random.imp" %include "inc:util.imp" %const %real PI = 3.141592653589793238462643 %external %real %fn %spec Sin (%real x) %external %real %fn %spec Cos (%real x) %const %byte XY = 0, XZ = 1, YZ = 2 %const %integer PMax = 3000; ! max points & polygons %const %integer Max Stars = 100 %short %array Stars (1:Max Stars,1:2) %short OX, OY, MX = -1, MY = -1,Temp, Di = 10 %integer StB,StT %string (30) File,fa,fb %const %short One = 16_4000, Zero = 0, f128 = One>>7 %const %byte Background = 9, Shade Line Col = Black, Hidden Poly Col = Black, Hidden Line Col = White, Wire Col = White, Invisible = 255 %const %integer Big = 256 << 6 - One %record %format Pt (%short X, Y, Z) %record %format RPt (%real X, Y, Z) %record %format Matrix (%record (Pt) A,B,C) %record (Matrix) R,T %short %array Sine, Cosine (0:359) %record %format Polt (%short Depth, %byte Num,Col,Col2, %record (Pt) %array V(1:32)) %record (Pt) %array %name PV (1:32) %record (Pt) %name PpV, QpV %record (Polt) %array P,Q (0:PMax) %record (Polt) %name Pp,Qp %record (Polt) %name %array PL (0:Pmax) %switch TD (32:122) %const %short Ambient = 8 %short xp,yp,Ang = 30, Max %const %real Rad = Pi/180 %const %byte True = 1, False = 0 %byte Shading = False, Shade Line = False, Hidden = False, Show = True %byte Moving = False, Changing = False, Show Stars = False, ReCalc %real A,Len %short Sc, xa, ya, za %integer Num Ships %record %format SF (%short CX, CY, Dist) %record (SF) Sp %record (RPt) Light %integer CX,CY %short DS %short Lx = 10, Ly = -10, Lz = -10 %integer ships,ii,i,j,k,NumPoly %byte MB %short %fn Product (%short A,B) %short Res *Move.w A,d0 *Muls B,d0 *Asl.l #2,d0 *Swap d0 *Move.w d0,Res %result = Res %end %routine Rite (%short n) Print (Float(n)/One,2,4) %end %routine Swap (%short %name A, B) %short temp Temp = A; A = B; B = Temp %end %routine Transpose (%record (Matrix) %name M) Swap (M_A_Y, M_B_X) Swap (M_B_Z, M_C_Y) Swap (M_A_Z, M_C_X) %end %routine Transform (%record (Matrix) %name M, %record (Pt) %name O,O2) %record (Pt) N N_X =Product(O_X,M_A_X)+Product(O_Y,M_A_Y)+Product(O_Z,M_A_Z) N_Y =Product(O_X,M_B_X)+Product(O_Y,M_B_Y)+Product(O_Z,M_B_Z) N_Z =Product(O_X,M_C_X)+Product(O_Y,M_C_Y)+Product(O_Z,M_C_Z) O2 = N %end %routine MMult (%record (Matrix) %name P,Q) Transpose (Q) Transform (P, Q_A, Q_A) Transform (P, Q_B, Q_B) Transform (P, Q_C, Q_C) Transpose (Q) %end %byte %fn Get Mouse %byte M,N %integer i %cycle M = Mouse Buttons N = Mouse Buttons %for i = 1,1,2000 %repeat %until M = N %result = M %end %routine Convert OX = MX; OY = MY MX = (MouseX//3) & 1023 MY = (MouseY//3) & 1023 %end %routine Rotate (%short xa, ya, za) %record (Pt) %name PpV, QpV %record (Matrix) R,T %integer i,j T_A_X = One; T_A_Y = 0; T_A_Z = 0 T_B_X = 0; T_B_Y = One; T_B_Z = 0 T_C_X = 0; T_C_Y = 0; T_C_Z = One %if za # 0 %start R_A_X = Cosine (za); R_A_Y = Sine (za); R_A_Z = 0 R_B_X = -Sine (za); R_B_Y = Cosine (za); R_B_Z = 0 R_C_X = 0; R_C_Y = 0; R_C_Z = One MMult (R,T) %finish %if ya # 0 %start R_A_X = Cosine (ya); R_A_Y = 0; R_A_Z = Sine (ya) R_B_X = 0; R_B_Y = One; R_B_Z = 0 R_C_X = -Sine (ya); R_C_Y = 0; R_C_Z = Cosine (ya) MMult (R,T) %finish %if xa # 0 %start R_A_X = One; R_A_Y = 0; R_A_Z = 0 R_B_X = 0; R_B_Y = Cosine (xa); R_B_Z = Sine (xa) R_C_X = 0; R_C_Y = -Sine (xa); R_C_Z = Cosine (xa) MMult (R,T) %finish Pp == P(0); Qp == Q(0) %for i = 0,1,Num Poly %cycle PL(i) == Q(i) PpV == Pp_V(1); QpV == Qp_V(1) Qp_Num = Pp_Num %for j = 1,1,Pp_Num %cycle Transform (T,PpV,QpV) QpV_X = QpV_X-Big; QpV_Y = QpV_Y-Big; QpV_Z = QpV_Z-Big PpV == PpV[1]; QpV == QpV[1] %repeat Pp == Pp[1]; Qp == Qp[1] %repeat %end %routine make unit vector(%record (rpt) %name vec) %real len Len=Sqrt(vec_X*vec_X+vec_Y*vec_Y+vec_Z*vec_Z) %if Len # 0 %start vec_X=vec_X/Len; vec_Y=vec_Y/Len; vec_Z=vec_Z/Len %finish %end %byte %fn Shade (%record (Pt) %name P1, P2, P3) %record (RPt) N, T1, T2 %real Dot %integerfn Sign (%name N) !Returns the sign (-1 or 1) of a real by inspecting its top bit %result=-1 %if 16_80000000 & Integer(Addr(N)) # 0; %result=1 %end T1_x=P1_x-P2_x; T1_y=P1_y-P2_y; T1_z=P1_z-P2_z ;! T1 = P1-P2 T2_x=P1_x-P3_x; T2_y=P1_y-P3_y; T2_z=P1_z-P3_z ;! T2 = P1-P3 N_X=T1_Y*T2_Z-T1_Z*T2_Y ;! N = Cross product of N_Y=T1_Z*T2_X-T1_X*T2_Z ;! T1 and T2, ie is the N_Z=T1_X*T2_Y-T1_Y*T2_X ;! normal of the poly. Make unit vector(N) Dot = N_X*Light_X+N_Y*Light_Y+N_Z*Light_Z %if Sign (Dot) = - Sign (N_Z) %c %then %result = Ambient + IntPt ( (31-Ambient) * |Dot|) %result = Ambient %end %routine Load Trig Tables !Load scaled integer sine and cosine tables. Scaling factor is "one" (16384) %real Rads %integer Th %for Th = 0,1,359 %cycle Rads = Float (Th) * Rad Sine (Th) = Int (One * Sin (Rads)) Cosine (Th) = Int (One * Cos (Rads)) %repeat %end %routine Quick Sort (%short A, B) !Sort array PL from A to B inclusive on PL_DEPTH. %short l,u %record (Polt) %name Pp %while a < b %cycle l = a; u = b Pp == PL(u) -> Get Up: l = l + 1 -> Got %if l = u Get: -> Up %unless Pp_Depth > PL(l)_Depth PL(u) == PL(l) Down: u = u - 1 -> Got %if l = u -> Down %unless Pp_Depth < PL(u)_Depth PL(l) == PL(u) -> Up Got: PL(u) == Pp l = l - 1 u = u + 1 %if l - a > b - l %then Quick Sort (u,b) %and b = l %c %else Quick Sort (a,l) %and a = u %repeat %end %routine Load data %byte Col = White << 5, Col2 %real A %integer i,j,c %integer hlen, type, wid, ht %integer PtNum %record (Pt) %array Pn (1:PMax) %record (Pt) %name Pp %record (Polt) %name Pt %short %array Ad ('A':'z') %integer dummy %routine rshort(%integername i) %integer a,b readsymbol(a); readsymbol(b) i=(a<<8+b)&16_FFFF %end !Load file. PrintString ("Opening ".File."... ") Open Input (3,File); Select Input (3) set input(46) rshort(i) set input(0) NumPoly = -1 PtNum = 1 %if i=16_8516 %start ;!IFF format magic number at position 46 printline("IFF format") rshort(hlen); rshort(type); rshort(ht); rshort(wid) hlen=hlen*2 set input(hlen) %if ht * wid > PMax %start printline("Can't cope with > ".itos(pmax,-1)." points") %stop %elseif type & 16_c0 # 0 printline("Can't cope with compressed files") %stop %else ad('A') = ptnum-1 %for i=1,1,ht %cycle %for j=1,1,wid %cycle readsymbol(c) pp == Pn(PtNum) Pp_x = (i-ht)*100; Pp_y = (j-wid)*100; Pp_z = c*3 PtNum = PtNum + 1 %repeat %repeat %finish write(PtNum-1,0); printstring(" points, and ") %for i=0,1,ht-2 %cycle k = i * wid %for j=0,1,wid-2 %cycle numpoly=numpoly+1 pt == P(NumPoly) q(numpoly)_col = col pt_num = 4 pt_v(1) = Pn(k+1) pt_v(2) = Pn(k+1+1) pt_v(3) = Pn(k+wid+1+1) pt_v(4) = Pn(k+wid+1) k = k + 1 %repeat %repeat closeinput selectinput(0) write(numpoly+1, -1); printline(" polygons read in"); newline prompt("Viewing parameters:") read(sp_cx); read(sp_cy); read(sp_dist) read(xa); read(ya); read(za) %else ;!P. Read format Read Symbol (j) %until j = '#' %cycle Read Symbol (j) %until j # ' ' %and j # NL %exit %if j = '$' Ad (j) = PtNum - 1 %cycle Read Symbol (j) %until j = ':' %or j = '$' %exit %if j = '$' Pp == Pn(PtNum) Read (A); Pp_X = Int (f128*A) Read (A); Pp_Y = Int (f128*A) Read (A); Pp_Z = Int (f128*A) PtNum = PtNum + 1 %repeat %repeat Write(PtNum,0);PrintString (" Points, and ") Read Symbol (j) %until j = '#' %cycle Read Symbol (j) %until j = ':' %or j = '$' %or j = '>' %exit %if j = '$' %if j = '>' %start Read (Col); %if Col = Invisible %thenc Read (Col2) %and Col2 = Col2 << 5 %else Col = Col << 5 %continue %finish NumPoly = NumPoly + 1 Pt == P(NumPoly) Q(NumPoly)_Col = Col Q(NumPoly)_Col2 = Col2 %if Col = Invisible Read (Pt_Num) %for j = 1,1,Pt_Num %cycle ReadSymbol (i) %until i # ' ' %and i # NL Read (k) k = k + Ad (i) Pt_V(j) = Pn(k) %repeat %repeat Write(NumPoly+1,0);Printline (" Polygons read in"); newline Read Symbol (j) %until j = '#' Read (dummy) Read (Sp_CX); Read (Sp_CY); Read (Sp_Dist) Read (XA); Read (YA); Read (ZA) Close Input %finish Select Input (0) %if xa >= 360 %then xa = xa - 360 %elseif xa < 0 %then xa = xa + 360 %if Ya >= 360 %then Ya = Ya - 360 %elseif Ya < 0 %then Ya = Ya + 360 %if Za >= 360 %then Za = Za - 360 %elseif Za < 0 %then Za = Za + 360 %end %routine Up PrintSymbol(27);PrintSymbol('A') PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') %end %routine Set up Stars %integer i StB = Addr(Stars(1,1)) StT = Addr(Stars(MaxStars,2)) %for i = 1,1,Max Stars %cycle Stars (i,1) = Random Int (1,686) Stars (i,2) = Random Int (1,510) %repeat %end %routine Draw Body %integer i,j,CX,CY %routine plot polys(%integer col) %integer j !!{t} printstring("Polys "); write(col, -1); newline {set} colour(col) Poly (PV(j)_X//SC+CX, PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num Close Poly %end %routine plot outlines(%integer col) %integer j !!{t} printstring("Outlines"); write(col, 3); newline {set} colour(col) %for j=1,1,Qp_Num-1 %cycle Line(PV(j)_X//SC+CX,PV(j)_Y//SC+CY,PV(j+1)_X//SC+CX,PV(j+1)_Y//SC+CY) %repeat Line(PV(1)_X//SC+CX,PV(1)_Y//SC+CY,PV(Qp_Num)_X//SC+CX,PV(Qp_Num)_Y//SC+CY) %end %const %integer Frame Addr = 16_E00000 @Frame Addr %integerarray Frame(0:32767) %if Show Stars = True %start Half Clear (DS>>9) {set} colour(white) *Movea.l StB,a1 StLp: *Move.w (a1)+,xp *move.w (a1)+,d0 *add.w DS,d0 *Move.w d0,yp Frame (yp<<5+xp>>5)=1<<(31-xp&31) *cmpa.l StT,a1 *ble StLp %else {set} Colour (Background) Fill (0,DS,687,511+DS) %finish OffSet (0,DS) %if Show = True CX = Sp_CX CY = Sp_CY + DS %if Hidden = True %start %if ReCalc = True %start Qp == Q(0) %for i = 0,1,NumPoly %cycle PV == Qp_V Max = PV(1)_Z %for j = 1,1,Qp_Num %cycle Max = PV(j)_Z %if PV(j)_Z > Max %repeat Qp_Depth = Max Qp == Qp[1] %repeat Quick Sort (0, Num Poly) %finish %for i = 0,1,NumPoly %cycle Qp == PL(i) PV == Qp_V %if Shading = True %start %if Qp_Num >= 3 %and Qp_Col # Invisible %start %if Qp_Col = Black %then Plot Polys(Black) %elsec Plot Polys(Qp_Col+Shade(PV(1), PV(2), PV(3))) %finish %if Qp_Col = Invisible %start Plot Outlines(Qp_Col2+Shade(PV(1), PV(2), PV(3))) %elseif Shade Line = True Plot Outlines(Shade Line Col) %finish %else %if Qp_Num >= 3 %and Qp_Col # Invisible %start Plot Polys(Hidden Poly Col) %finish %if Qp_Col = Invisible %then Plot Outlines(Qp_Col2>>5) %elsec Plot Outlines(Hidden Line Col) %finish %repeat %else Qp == Q(0) %for i = 0,1,Num Poly %cycle PV == Qp_V Plot Outlines(Wire Col) Qp == Qp[1] %repeat %finish OffSet (0,DS) %unless Show = True DS = 512 - DS !! !Display colour map at LHS of screen !! %for i=0,1,255 %cycle !! {set} colour(i) !! fill(0,i*2, 10, i*2+2) !!{t} printstring("Fill "); write(i, 3); newline !! %repeat %end %routine flush %cycle; %repeat %until Test Symbol = -1 %end Setup VClear Set Terminal Mode (No Page) Initialise Random Set up Stars File = CliParam Load Trig Tables newline; Printline ("General (Depth Sorting) Polygons Program"); newline Stahrt: PrintSymbol(13) Prompt("File: ") flush Read Line(File) %while file = "" Clear All newline Printline ("General (Depth Sorting) Polygons Program"); newline Printline("MsR,L,M = Rotate X,Y,Z, or any combination of buttons") Printline("Move Mouse to move shape, if Moving option selected") Printline("a = Enter Increment Angle ' ' = Negate Current Angle") Printline("v = Move Towards Shape b = Move Away from Shape") Printline("c = Enter X,Y Coordinates r = Enter angles X,Y,Z") Printline("h = Hidden Line On/Off s = Shading On/Off") Printline("z = Shade Line On/Off l = Enter Light Vector") Printline("d = Change Distance i = Change Distance Inc") Printline("m = Moving On/Off f = Enter File Name") Printline("q = Drawing Visiblity On/Off g = Toggle Stars or Blue"); newline load data ReCalc = Hidden Len = Sqrt(Lx*Lx + Ly*Ly + Lz*Lz) Light_X = Lx/Len; Light_Y = Ly/Len; Light_Z = Lz/Len %for i = 1,1,7 %cycle k = 32*i Mix Colour (k+j, (i&1)*j, (i&2)>>1*j, (i&4)>>2*j) %for j = 0,1,31 %repeat mix colour (9,6,5,11) mousex = 0; mousey = 0 convert DS = 512 Sc = Sp_Dist { >> 1 Rotate (xa,ya,za) Draw Body flush %cycle Changing = False ReCalc = False %cycle PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') MB = Get Mouse %cycle ii = Test Symbol %repeatuntil ii<0 %or ' '<=ii<='z' %if MB # 0 %start %if MB & 1 = 1 %start xa = xa + Ang %if xa >= 360 %then xa = xa - 360 %elseif xa < 0 %then xa = xa + 360 %finish %if MB & 2 = 2 %start ya = ya + Ang %if ya >= 360 %then ya = ya - 360 %elseif ya < 0 %then ya = ya + 360 %finish %if MB & 4 = 4 %start za = za + Ang %if za >= 360 %then za = za - 360 %elseif za < 0 %then za = za + 360 %finish Changing = True; ReCalc = True Rotate (xa,ya,za) %finish -> Nex %if ii = -1 PrintSymbol(ii); PrintString ("...") -> TD(ii) TD('r'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("X Angle (Currently ".Itos(Xa,0).") : ") read(Xa) %and Up %until -359 <= Xa <= 359 Xa = Xa + 360 %if Xa < 0 Prompt ("Y Angle (Currently ".Itos(Ya,0).") : ") read(Ya) %and Up %until -359 <= Ya <= 359 Ya = Ya + 360 %if Ya < 0 Prompt ("Z Angle (Currently ".Itos(Za,0).") : ") read(Za) %and Up %until -359 <= Za <= 359 Za = Za + 360 %if Za < 0 flush Changing = True ReCalc = True Rotate (xa,ya,za) -> Nex TD(' '): Ang = -Ang -> Nex TD('f'): File = "" -> Stahrt TD('m'): Moving = 1 - Moving; Changing = Moving -> Nex TD ('q'): Show = 1 - Show flush Changing = Show {** ie: only Change if we are rebuilding -> Nex TD('s'): Shading = 1-Shading ReCalc = True %if Hidden = False %and Shading = True Hidden = True %if Shading = True Changing = True -> Nex TD('g'): Show Stars = 1 - Show Stars %if Show Stars = True %then Half Clear ((Ds-1)>>9) Changing = True -> Nex TD('z'): Shade Line = 1-Shade Line Changing = Shading {** ie: only Change if we are shading -> Nex TD('h'): Hidden = 1-Hidden; ReCalc = Hidden Shading = False %if Hidden = False Changing = True -> Nex TD('l'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("Light_X: ");read(light_x);Up Prompt ("Light_Y: ");read(light_Y);Up Prompt ("Light_Z: ");read(light_Z);Up make unit vector(light) Changing = True flush -> Nex TD('a'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("Increment Angle (Currently ".Itos(Ang,0).") : ");read (ang);Up flush -> Nex TD('i'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("Distance Increment (Currently ".Itos(Di,0).") : ") read (Di);Up flush -> Nex TD('d'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("Distance (Currently ".Itos(Sc,0).") : ");read (Sc);Up Changing = True flush -> Nex TD('c'): PrintSymbol(13);PrintSymbol(27);PrintSymbol('t') flush Prompt ("CentreX (Currently ".Itos(Sp_Cx,0).") : ");read (sp_cx);Up Prompt ("CentreY (Currently ".Itos(Sp_CY,0).") : ");read (sp_cY);Up Changing = True flush -> Nex TD('v'): Sc = Sc - Di %unless Sc <= Di Changing = True flush -> Nex TD('b'): Sc = Sc + Di Changing = True flush -> Nex TD(*): ii = -1 Nex: %if Moving = True %start Convert i = mx - ox; j = my - oy sp_cx = (sp_cx + i) & 1023 sp_cy = (sp_cy + j) & 1023 ii = 1 %if i # 0 %or j # 0 Changing = True %finish %repeat %until MB # 0 %or ii # -1 Draw Body %if Changing = True %repeat %endofprogram