%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 %owninteger marker=0 %routine cpu(%string (255) s) %if s="" %then marker=cputime %elsestart write(cputime-marker, 6); space; printstring(s); newline %finish %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 !R#0 means that the edge from this point to the next is redundant %record %format Pt (%short X, Y, Z) %record %format RPt (%real X, Y, Z) %record %format Matrix (%record (Pt) A,B,C) %short %array Sine, Cosine (0:359) !V are the original coords, TV are the transformed coords %record %format Polt (%short Depth, %byte Num,Col,Col2, %record (Pt) %array V(1:32), TV(1:32), %bytearray omit(0:32)) %record (Pt) %array %name PV (1:32) %record (Polt) %array P(0:PMax) %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 *MOVE.W (A0),A2 *MOVE.W (A1),(A0) *MOVE.W A2,(A1) %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) !! %return *MOVE.W 6(a0),A1 *MOVE.W 2(a0),6(a0) *MOVE.W A1,2(a0) *MOVE.W 14(a0),A1 *MOVE.W 10(a0),14(a0) *MOVE.W A1,10(a0) *MOVE.W 12(a0),A1 *MOVE.W 4(a0),12(a0) *MOVE.W A1,4(a0) %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 !! %return *MOVE.L M,A1 *MOVE.L O,A0 *MOVE.w 0(A0),D1 *muls 0(A1),D1 *asl.l #2,D1 *swap D1 *MOVE.W 2(A0),D0 *muls 2(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D1 *MOVE.W 4(A0),D0 *muls 4(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D1 *MOVE.w 0(A0),D2 *muls 6(A1),D2 *asl.l #2,D2 *swap D2 *MOVE.W 2(A0),D0 *muls 8(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D2 *MOVE.W 4(A0),D0 *muls 10(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D2 *MOVE.w 0(A0),D3 *muls 12(A1),D3 *asl.l #2,D3 *swap D3 *MOVE.W 2(A0),D0 *muls 14(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D3 *MOVE.W 4(A0),D0 *muls 16(A1),d0 *asl.l #2,d0 *swap d0 *ADD.L D0,D3 *MOVEA.L O2,A0 *move.w D1,0(A0) *move.w D2,2(A0) *move.w D3,4(A0) %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 (Polt) %name Pp %record (Pt) %name PpV, QpV %record (Matrix) R,T %integer i,j {}cpu("") 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) %for i = 0,1,Num Poly %cycle PL(i) == P(i) PpV == Pp_V(1); QpV == Pp_TV(1) %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] %repeat {}cpu("rotate") %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,LastX,lastY,lastZ %integerarray this,last(0:32) %integer i,j,c,j1,k1 %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, omitted %routine rshort(%integername i) %integer a,b readsymbol(a); readsymbol(b) i=(a<<8+b)&16_FFFF %end !Load file. omitted=0 %for i=0,1,32 %cycle; last(i)=-1; %repeat 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) p(numpoly)_col = col pt_num = 4 pt_v(1) = Pn(k+1) %if i=0 %then pt_omit(1)=0 %else pt_omit(1)=1 pt_v(2) = Pn(k+1+1) pt_omit(2)=0 pt_v(3) = Pn(k+wid+1+1) pt_omit(3)=0 pt_v(4) = Pn(k+wid+1) %if j=0 %then pt_omit(4)=0 %else pt_omit(4)=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 = '#' ;!Skip introduction %cycle Read Symbol (j) %until j # ' ' %and j # NL ;!point set name %exit %if j = '$' Ad (j) = PtNum - 1 ;!point set offset %cycle Read Symbol (j) %until j = ':' %or j = '$' %exit %if j = '$' Pp == Pn(PtNum) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then A=lastX %else} Read (A) Pp_X = Int (f128*A) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then A=lastY %else} Read (A) Pp_Y = Int (f128*A) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then a=lastZ %else} 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) Pt_Col = Col Pt_Col2 = Col2 %if Col = Invisible Read (Pt_Num) ;!No of points in polygon %for j = 1,1,Pt_Num %cycle ReadSymbol (i) %until i # ' ' %and i # NL Read (k) ;!point number in point set k = k + Ad (i) ;!add in point set offset Pt_V(j) = Pn(k) ; pt_omit(j)=0 this(j) = k %repeat %if numpoly#0 %start ;!check last poly to see if there are common edges %for j=1,1,Pt_Num %cycle %for k=1,1,last(0) %cycle j1 = j+1; j1=1 %if j1>Pt_num k1 = k+1; k1=1 %if k1>last(0) %if (last(k) = this(j) %and last(k1) = this(j1)) %or %c (last(k) = this(j1) %and last(k1) = this(j)) %start Pt_omit(j) = 1; omitted=omitted+1 !!{t} printstring(" remove "); write(numpoly, 3); printsymbol('.'); write(j,-1) !!{t} newline %finish %repeat %repeat %finish %for i=1,1,Pt_Num %cycle; last(i) = this(i); %repeat last(0) = Pt_Num %repeat Write(NumPoly+1,0);Printstring (" Polygons read in") write(omitted, 4); printstring(" lines omitted") 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 %record (polt) %name Qp %routine plot polys(%integer col) %integer j !!{t} printstring("Polys "); write(col, -1); newline colour(col) Poly (PV(j)_X//SC+CX, PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num Close Poly %end %constinteger vl=0, vr=688 %routine clipped line(%integer x1,y1,x2,y2) %integer c1,c2 %integer dx,dy, vb, vt %integerfn clipcode(%integer x,y) %integer c=0 c = 1 %if xvr c = c+4 %if yvt %result=c %end %routine into range(%integername x,y) y = intpt((vl-x)*dy/dx)+y %and x = vl %if xvr x = intpt((vb-y)*dx/dy)+x %and y = vb %if yvt %end vb=DS; vt=ds+512 c1 = clipcode(x1,y1) c2 = clipcode(x2,y2) %returnunless c1&c2=0 %unless c1!c2=0 %start dx = x2-x1; dy = y2-y1 into range(x1,y1) into range(x2,y2) %finish line(x1,y1,x2,y2) %end %routine plot outlines(%integer col) %integer j,x0,x1,y0,y1,x00,y00 colour(col) x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0 %for j=1,1,Qp_Num-1 %cycle x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY clipped Line(x0,y0,x1,y1) x0=x1; y0=y1 %repeat clipped Line(x00,y00,x0,y0) %end %routine plot wires(%integer col) !Same as above but misses out redundant wires %integer j,x0,x1,y0,y1,x00,y00 !t! printstring("Outlines"); write(col, 3); newline colour(col) x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0 %for j=1,1,Qp_Num-1 %cycle x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY clipped line(x0,y0,x1,y1) %if Qp_omit(j)=0 !t! printline("Line omitted") %if qp_omit(j)#0 x0=x1; y0=y1 %repeat clipped Line(x00,y00,x0,y0) %if qp_omit(qp_num)=0 !t! printline("Line omitted") %if qp_omit(qp_num)#0 %end %const %integer Frame Addr = 16_E00000 @Frame Addr %integerarray Frame(0:32767) {} cpu("") %if Show Stars = True %start Half Clear (DS>>9) 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 Colour (Background) Fill (0,DS,687,511+DS) %finish OffSet (0,DS) %if Show = True CX = Sp_CX CY = Sp_CY + DS {} cpu("background") %if Hidden = True %start %if ReCalc = True %start Qp == P(0) %for i = 0,1,NumPoly %cycle PV == Qp_TV 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_TV %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) --------------------------------------------------------------------------------- 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 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,LastX,lastY,lastZ %integerarray this,last(0:Vmax-1) %integer aa,i,j,c,j1,k1,x,y %integer hlen, type, wid, ht %integer PtNum %record (Pt) %array Pn (1:PMax) %record (Pt) %name Pp %short %array Ad ('A':'z') %integer dummy, omitted {t} %routine writevert(%record (pt) %name p) {t} printstring("{"); write(p_x,4); write(p_y,4); write(p_z,4) {t} printsymbol('}') {t} %end %record (Polt) %name Pt !Load file. omitted=0 %for i=0,1,Vmax-1 %cycle; last(i)=-1; %repeat NumPoly = -1 PtNum = 1 %if iff file=1 %start ;!IFF format magic number at position 46 printline("IFF format") !We overlay the image onto array P. aa=addr(p(0)); i = iff readin(file, iffin, aa) %if i#0 %start printline("Problem with ".file) %stop %elseif iffin_ht * iffin_wid > PMax printline("Can't cope. ".itos(iffin_wid,-1)." * ".itos(iffin_ht,-1)." > ".itos(pmax,-1)." points") %stop %else ad('A') = ptnum-1 x = (1-iffin_ht) * 100 pp == Pn(PtNum) %for i=1,1,iffin_ht %cycle y = (1-iffin_wid) * 100 %for j=1,1,iffin_wid %cycle c = byteinteger(aa+ptnum-1) Pp_x = x; Pp_y = y; Pp_z = c+c+c !t! write(PtNum, 4); writevert(Pn(PtNum)); newline pp == pp[1] PtNum = PtNum + 1 y = y + 100 %repeat x = x + 100 %repeat %finish write(PtNum-1,0); printstring(" points, and ") k=1 pt == P(0) %for i=0,1,iffin_ht-2 %cycle %for j=0,1,iffin_wid-2 %cycle numpoly=numpoly+1 pt_col = col pt_num = 4 pt_v(0)_x = Pn(k)_x pt_v(0)_y = Pn(k)_y pt_v(0)_z = Pn(k)_z {t}write(k, 4); writevert(Pn(k)); ; space; writevert(pt_v(0)); newline %if i=0 %then pt_omit(0)=0 %else pt_omit(0)=1 pt_v(1)_x = Pn(k+1)_x pt_v(1)_y = Pn(k+1)_y pt_v(1)_z = Pn(k+1)_z pt_omit(1)=0 pt_v(2)_x = Pn(k+iffin_wid+1)_x pt_v(2)_y = Pn(k+iffin_wid+1)_y pt_v(2)_z = Pn(k+iffin_wid+1)_z pt_omit(2)=0 pt_v(3)_x = Pn(k+iffin_wid)_x pt_v(3)_y = Pn(k+iffin_wid)_y pt_v(3)_z = Pn(k+iffin_wid)_z %if j=0 %then pt_omit(3)=0 %else pt_omit(3)=1 {t} Write(NumPoly, 4); write(k, 4); space; phex2(pt_col); space {t} writevert(pt_v(0)); writevert(pt_v(1)); writevert(pt_v(2)); writevert(pt_v(3)) {t} newline k = k + 1 pt == pt[1] %repeat k = k + 1 %repeat 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 PrintString ("Opening ".File."... ") Open Input (3,File); Select Input (3) Read Symbol (j) %until j = '#' ;!Skip introduction %cycle Read Symbol (j) %until j # ' ' %and j # NL ;!point set name %exit %if j = '$' Ad (j) = PtNum - 1 ;!point set offset %cycle Read Symbol (j) %until j = ':' %or j = '$' %exit %if j = '$' Pp == Pn(PtNum) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then A=lastX %else} Read (A) Pp_X = Int (f128*A) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then A=lastY %else} Read (A) Pp_Y = Int (f128*A) {skipsymbol %while nextsymbol<=' '; readsymbol(c)} {%if c='"' %then a=lastZ %else} 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) Pt_Col = Col Pt_Col2 = Col2 %if Col = Invisible Read (Pt_Num) ;!No of points in polygon %for j = 0,1,Pt_Num-1 %cycle ReadSymbol (i) %until i # ' ' %and i # NL Read (k) ;!point number in point set k = k + Ad (i) ;!add in point set offset Pt_V(j) = Pn(k) ; pt_omit(j)=0 this(j) = k %repeat %if numpoly#0 %start ;!check last poly to see if there are common edges %for j=1,1,Pt_Num %cycle %for k=1,1,last(0) %cycle j1 = j+1; j1=1 %if j1>Pt_num k1 = k+1; k1=1 %if k1>last(0) %if (last(k) = this(j) %and last(k1) = this(j1)) %or %c (last(k) = this(j1) %and last(k1) = this(j)) %start Pt_omit(j) = 1; omitted=omitted+1 !!{t} printstring(" remove "); write(numpoly, 3); printsymbol('.'); write(j,-1) !!{t} newline %finish %repeat %repeat %finish %for i=1,1,Pt_Num %cycle; last(i) = this(i); %repeat E.L 0(A0,D0.L),0(A1,D0.L): 23B0 0800 0800 last(0) = Pt_Num %repeat Write(NumPoly+1,0);Printstring (" Polygons read in") write(omitted, 4); printstring(" lines omitted") 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 Draw Body %integer i,j,CX,CY %record (polt) %name Qp %routine plot polys(%integer col) %integer j !!{t} printstring("Polys "); write(col, -1); newline colour(col) Poly (PV(j)_X//SC+CX, PV(j)_Y//SC+CY) %for j = 1,1,Qp_Num Close Poly %end %constinteger vl=0, vr=687 ;!should be 688 %routine clipped line(%integer x1,y1,x2,y2) %integer c1,c2 %integer dx,dy, vb, vt %integerfn clipcode(%integer x,y) %integer c=0 c = 1 %if xvr c = c+4 %if yvt %result=c %end %routine into range(%integername x,y) y = intpt((vl-x)*dy/dx)+y %and x = vl %if xvr x = intpt((vb-y)*dx/dy)+x %and y = vb %if yvt %end vb=DS; vt=ds+511 ;!should be 512 c1 = clipcode(x1,y1) c2 = clipcode(x2,y2) %returnunless c1&c2=0 %unless c1!c2=0 %start dx = x2-x1; dy = y2-y1 into range(x1,y1) into range(x2,y2) %finish line(x1,y1,x2,y2) %end %routine plot outlines(%integer col) %integer j,x0,x1,y0,y1,x00,y00 colour(col) x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0 %for j=1,1,Qp_Num-1 %cycle x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY clipped Line(x0,y0,x1,y1) x0=x1; y0=y1 %repeat clipped Line(x00,y00,x0,y0) %end %routine plot wires(%integer col) !Same as above but misses out redundant wires %integer j,x0,x1,y0,y1,x00,y00 !t! printstring("Outlines"); write(col, 3); newline colour(col) x0 = PV(1)_X//SC+CX; y0 = PV(1)_Y//SC+CY; x00=x0; y00=y0 %for j=1,1,Qp_Num-1 %cycle x1 = PV(j+1)_X//SC+CX; y1 = PV(j+1)_Y//SC+CY clipped line(x0,y0,x1,y1) %if Qp_omit(j)=0 !t! printline("Line omitted") %if qp_omit(j)#0 x0=x1; y0=y1 %repeat clipped Line(x00,y00,x0,y0) %if qp_omit(qp_num)=0 !t! printline("Line omitted") %if qp_omit(qp_num)#0 %end %const %integer Frame Addr = 16_E00000 @Frame Addr %integerarray Frame(0:32767) {} cpu("") %if Show Stars = True %start Half Clear (DS>>9) 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 Colour (Background) Fill (0,DS,687,511+DS) %finish OffSet (0,DS) %if Show = True CX = Sp_CX CY = Sp_CY + DS {} cpu("background") %if Hidden = True %start %if ReCalc = True %start Qp == P(0) %for i = 0,1,NumPoly %cycle PV == Qp_TV 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_TV %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 == P(0) %for i = 0,1,Num Poly %cycle PV == Qp_TV Plot Wires(Wire Col) Qp == Qp[1] %repeat {}cpu("Outlines") %finish OffSet (0,DS) %unless Show = True DS = 512 - DS %end %integerfn next command !Forces 'e' command if run off end of a comand file. %integer c %on 3,9 %start; %result='e'; %finish %cycle readsymbol(c) %repeatuntil c<0 %or ' '<=c<='z' %result=c %end 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) prompt("?") mousex = 0; mousey = 0 convert DS = 512 Sc = Sp_Dist { >> 1 Rotate (xa,ya,za) Draw Body %cycle Changing = False ReCalc = False %cycle MB = Get Mouse ii = next command %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'): 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 Changing = True ReCalc = True Rotate (xa,ya,za) -> Nex TD(' '): Ang = -Ang -> Nex TD('f'): File = "" %exit; !-> Stahrt TD('m'): Moving = 1 - Moving; Changing = Moving -> Nex TD ('q'): Show = 1 - Show 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'): 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 -> Nex TD('a'): Prompt ("Increment Angle (Currently ".Itos(Ang,0).") : ");read (ang);Up -> Nex TD('i'): Prompt ("Distance Increment (Currently ".Itos(Di,0).") : ") read (Di);Up -> Nex TD('d'): Prompt ("Distance (Currently ".Itos(Sc,0).") : ");read (Sc);Up Changing = True -> Nex TD('c'): Prompt ("CentreX (Currently ".Itos(Sp_Cx,0).") : ");read (sp_cx);Up Prompt ("CentreY (Currently ".Itos(Sp_CY,0).") : ");read (sp_cY);Up Changing = True -> Nex TD('v'): Sc = Sc - Di %unless Sc <= Di Changing = True -> Nex TD('b'): Sc = Sc + Di Changing = True -> Nex TD('e'): %stop TD('p'): !Input a complete parameter set (angles and distance) read(xa); read(ya); read(za); read(sc) changing=true recalc=true rotate(xa, ya, za) -> Nex TD('w'): !Do nothing for a while. For demonstration purposes prompt("Interval (ms):"); read(ii) ii=cputime+ii; %cycle; %repeatuntil cputime>=ii ii=-1 -> 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 %end ;!--------------------------------inner block -------------------- %endofprogram