{** Bezier Surface Editor **} {** See User Manual and documentation for details of program **} %begin %option "-nons-low" %include "inc:util.imp" %include "level1:graphinc.imp" !------- !!%include "ram_1:ramgraph.Inc" {** Standard Fmacs-type routines **} ! ! PR_1:GRAPH.INC - graphics routines, based on Fmacs:Frame with additions ! %const %integer Frame Addr = 16_E00000 @Frame Addr %integerarray Frame(0:32767) @16_E20002 %short Origin Reg @16_E20001 %byte Colour Reg @16_E20000 %byte Enable Reg @16_E30000 %short %integer %array Colour Map (0:511) ! MOUSE constants and locations ! !@16_7FFF0 %short MouseX !@16_7FFF2 %short MouseY !@16_7FFF4 %byte MouseButtons @16_7F45B %byte MsButtons !!%integerfn mouse buttons !!%constinteger flip = mouseleft+mouseright, mask = flip+mousemiddle !!@16_7F45B %byte %integer duartinp !!%integer b !! b = duartinp>>1&mask !! %result = b %if b&flip=0 %or b&flip=flip !! %result = b!!flip !!%end %const %real Level 0 = 0, Level 1 = 1, Level 15 = 1.5, Level 2 = 2 %own %real APM Level = 1 %ownbyte Mouse Flag = 0 %const %string (1) nls = " " ! ! Values returned by MouseButtons ! %const %byte MsNone = 0, MsL = 1, MsM = 2, MsLM = 3, MsR = 4, MsLR = 5, MsMR = 6, MsLMR = 7 ! ! Colour & Plane Constants ! %constinteger Invert = 8, RGB Plane = 7 %own %integer Current Colour = 0 %ownshort Hi Font = 0 %ownbyte Font Append = 0 %routine Wait (%integer MS) %integer T T = MS + Cpu Time %cycle %repeat %until Cpu Time >= T %end ! MOUSE FLAG = 1 %if there is a Mouse attached ! %routine Check for Mouse %byte Dummy %on 0 %start Mouse Flag = 0 %return %finish Dummy = MouseButtons Mouse Flag =1 %end !%routine Offset(%integer x,y) ! Origin Reg <- x>>4&63+(y+511)<<6 !%end %routine Set Colour(%integer C) Current Colour = C Colour Reg = Current Colour %end %routine Disable (%integer Planes) Enable Reg = Planes!!255 %end %routine Mix Colour (%short Col, Red, Green, Blue) Colour Map(Col<<1+1)=Red+Green<<5+Blue<<10 %end %routine Mix Image (%short %array %name CM (0:511), %integer C, R, G, B) CM (C<<1+1)=R+G<<5+B<<10 %end %routine Mix and Set (%short Col, Red, Green, Blue) Colour Map((Col&255)<<1+1)=(Red&31)+(Green&31)<<5+(Blue&31)<<10 Current Colour = Col; Colour Reg = Current Colour %end %routine Map Cycle (%integer C1, C2, Val, %short %array %name CM (0:511)) %integer i, T=C2-C1 Colour Map ((i+C1)<<1+1)=CM((Rem(i+Val,T+1)+C1)<<1+1) %for i=0,1,T %end %routine VClear Print Symbol (27); Print Symbol (118) %end %routine Clear All VClear Clear %end %routine Clear and Set Clear Set Colour (Current Colour) %end ! FONT handling routines ! The layout of the array is as follows: ! For 0<=i<=255, let p(i)=j ! p(j) is height of character i ! p(j+1) is width of character i ! p(j+2) to p(j+p(j)+1) describe the character %integerarray Font(0:5999) %const %string (255) Default Font = "Fmacs:Font.Visual" %routine Read Font (%string (255) File) %owninteger Index=128, Num Chars = 0 %integer Char,Num,i,n,Min,Max %integer %fn Reverse (%integer N) *Move.l N,d0 *Clr.l d1 *Move.w #31,d2 L: *Roxr.l #1,d0 *Roxl.l #1,d1 *Dbra d2,L *Move.l d1,N %result = N %end Open Input(3, File) %if Font Append = 0 %start Font(i) = 256 %for i=0,1,255 Font(256) = 0; Font(257) = 0 Index = 258; Hi Font = 0 %finish %else Font Append = 0 read(Min); read(Max); Num Chars = Max - Min %for char=0,1,Num Chars %cycle readsymbol(num) %until num=':' font(Hi Font + char)=index read(num); font(index)=num; index=index+1 read(font(index)) %for i = num,-1,1 %cycle Read (N) font(index+i) = Reverse (N) %repeat index = index+num+1 %repeat Hi Font = Hi Font + Num Chars + 1 closeinput; selectinput(0) %end %routine Append Font (%string (255) File) Font Append = 1 Read Font (File) %end %routine Read Default Font Read Font (Default Font) %end %owninteger xpos=0, ypos=0 %routine At(%integer x,y) xpos = x; ypos = y %end %routine Show Symbol (%integer k) %integer q = Frame Addr + (ypos&1023)<<7+(xpos&1023)>>4<<1 %integer shiftcount = xpos&15 %integer p = addr(font(font(k&255)))+4 %integer height = integer(p-4) xpos = xpos+integer(p) %returnif height=0 *move.l p,a0 *move.l q,a1 *move.l height,d0 *move.l (a0)+,d1; !width *moveq #-128,d2 *move.l shiftcount,d3 loop: *move.l (a0)+,d4 *lsr.l d3,d4 *move.l d4,(a1) *sub.l d2,a1 *move.l a1,d1 *=16_0881; *=17; !*bclr #17,d1 *move.l d1,a1 *subq #1,d0 *bgt loop *clr.l d4 %end %routine Show Symbol2 (%integer k) %integer p = addr(font(font(k&255)))+4 Show Symbol (k) xpos = xpos-integer(p) %end %routine Show String (%string (255) s) %integer i Show Symbol (Char No (s,i)) %for i = 1,1, Length (s) %end !%routine Show Number (%integer N) !%external %real %fn %spec LOG TEN (%real x) !%integer p10 ! Show Symbol ('0') %and %return %if N <= 0 ! %if N < 10 %then p10 = 1 %else p10 = 10 ^^ Int Pt (Log Ten (N)) ! %cycle ! Show Symbol (N//p10 + '0') ! N = Rem (n,p10) ! p10 = p10//10 ! %repeat %until p10 = 0 !%end %routine Frame Message Newline; Print String ("WARNING : ");Newline Print String (" This Program needs a Level 1.5 APM");Newline Print String ("which supports 32768 colours. You are using");Newline Print String ("a Level 1 APM with only 8 colours, so things");Newline Print String ("won't look quite the same. Try the machine in");Newline Print String ("the Fred Lab - the room with the prom blowers");Newline Newline %end %integerfn Whipped Cream @16_7FFFF %byte Red Hot @16_7FFFC %byte Who am I @16_0372E %short Minutely %constinteger Fish = 5 Minutely = 0 %cycle; %repeat %until Who am I & 8 # 0 Red Hot = Fish %cycle; %repeat %until Who am I & 8 # 0 %cycle %result = Minutely %unless Minutely = 0 %repeat %end %routine Set Up %integer i %integer z = 0 %on 0 %start APM Level = 0 Newline Print String ("Hey shithead, why not pick an APM with a graphics monitor?") Newlines (2) %stop %finish Offset (0,0) Disable (0) Hi Font = 0 Font Append = 0 Set 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 Check for Mouse %return %if APM Level # 1 APM Level = 1.5 %if Whipped Cream = 16_37 %or Whipped Cream = 16_12 %c %or Whipped Cream = 16_22 {%or Whipped Cream = 16_20 %end !------- !%include "ram_1:poly2" {** System routines and consts **} %const %real PI = 3.141592653589793238462643 %external%real%fn%spec SIN(%real x) %external%real%fn%spec COS(%real x) %string (30) File %const %short Max Mesh = 75 {** Menu options **} %const %byte MMax = 13 %const %byte MIn = 0, MOu = 1, MEd = 2, MXY = 3, MYZ = 4, MXZ = 5, MRo = 6, MDr = 7, MHi = 8, MPe = 9, MSh =10, MMe =11, MAn =12, MQu =13 %own %string (30) %array Text (0:MMax,0:2) = "Input File", "*","", "Output File", "*","", "Edit Points","","", "Edit XY","","", "Edit YZ","","", "Edit XZ","","", "View Grid","","", "Draw","Surface","", "Hidden Line","*","Off", "Perspective","*","On", "Shading","*","Off", "Mesh Size","*","5", "Rotate Angle","*","10", "Quit","","" %const %string (6) %array MN (MsL:MsLMR) = "Ms_L ","Ms_M ","Ms_LM ","Ms_R ", "Ms_LR ","Ms_MR ","Ms_LMR" %const %string (30) %array BInfo (MsL:MsLMR) = "Rotate X", "Rotate Y", "Move Away", "Rotate Z", "", "Move Closer", "Exit" %const %short %array BCoord (MsL:MsLMR,0:1) = 10,493, 239,493, 10,4, 468,493, -1,-1, 239,4, 468,4 %const %string (30) %array EInfo (MsL:MsLMR) = "Move Away", "Pick/Drop", "Move Away", "Move Closer", "", "Move Closer", "Abort" %const %string (30) %array VInfo (MsL:MsLMR) = "Pick", "Pick", "Abort", "Pick", "", "Abort", "Abort" %const %short %array CCoord (MsL:MsLMR,0:1) = 132,472, 315,472, 132,458, 505,472, -1,-1, 315,458, 505,458 %const %string (3) %array OO (0:1) = "Off", "On" {** Areas of the Screen **} %const %byte Menu = 0, CGrid = 1, Limbo = 2 {** Cursor Characters **} %const %byte Arrow = 128, Cross = 129, Square = 130 %own %byte %array CurC (Menu:Limbo) = Arrow, Cross, Square %own %byte %array CurT (Menu:Limbo) = 0, 1, 1 %const %byte XY = 0, XZ = 1, YZ = 2 {** View Plane consts **} %const %string (2) %array VPStr (XY:YZ) = "XY", "XZ", "YZ" %const %byte Off = 0, On = 1, False = 0, True = 1 {** Colour values **} %const %byte Hide Fore = Black, Hide Mesh = White, Hide Back = Blue+32, Wire Mesh = White, Wire Back = Black %const %short BoxWid = 118, BoxX = 2 {** Menu box info **} {** Control Grid Virtual Coords **} %const %short CGx = 406, CGy = 243, CGl =-279, CGr = 279, CGb =-206, CGt = 206, {** Bezier Surface Virtual Coords **} BSx = 343, BSy = 256, BSl =-341, BSr = 341, BSb =-230, BSt = 230 %integer i,j,k,l,m %switch MenuCom (0:13) %short Mouse Delay = 2000, MX, MY, MMX, MMY, OX, OY, Cur, CurType, Offs %short Opos, OSub, NPos, NSub %byte MB, OMB %short Mesh Size = 5, Top, Bottom, Left, Right, CX, CiY, CY, Draw Screen, Scr {** Distances to Object and Screen **} %short Screen Dist = 500, Object Dist = 1000, OI = 60 %short Angle = 10 %real Rad = Angle * Pi / 180, SinRad, CosRad %byte View Plane=XY, Perspect=On, Hidden=Off, Shading =Off %real Step Size = 1/Mesh Size %record %format Pt (%real X, Y, Z) {** Standard Point Format **} {** Polygon format, List of Vertices V, Number **} {** of vertices NUM, and deepest Z val - DEPTH **} %record %format Polt (%short Num, %real Depth, %record (Pt) %array V (1:8)) %real %array SM (0:Max Mesh, 0:3) {** Matrix of Blending functions **} %record (Pt) %array SMQ (0:Max Mesh, 0:3) %record (Pt) %array Q,QO (0:3, 0:3) {** Control Grid Points **} %record (Pt) %array Per (0:3, 0:3) {** Perspective Grid Points **} %record (Pt) %array Bez (0:Max Mesh, 0:Max Mesh) {** Bezier Points **} %record (Pt) %array IBez (0:Max Mesh, 0:Max Mesh) %record (Polt) %array Pol (0:Max Mesh-1,0:Max Mesh-1) {** Polygon List **} %record (Polt) %name %array PL (0:Max Mesh * Max Mesh) {** Polygon pointers **} %record (Pt) Light {** Source of Light **} {** ---===<<< B A S I C R O U T I N E S >>>===--- **} {** ---===<<< READ STR >>>===--- **} %routine Read Str (%string (30) %name S, %integer X, Y, C) {** {** READ STR gets a string (showing it on the Graphics Screen) from point X,Y {** %integer ch,col,l,ll %byte %name Len == Length (S) s = "" At (X,Y) Set Colour (C) %cycle ch = testsymbol %until ch # -1 %exit %if ch = nl %if ch # 127 %start s = s.tostring(ch) showsymbol(ch) %else %continue %if Len = 0 Set Colour (Black) XPos = Xpos - 9 Fill(Xpos,Y,Xpos+9,Y+12) Len = Len - 1 Set Colour (C) %finish %repeat %until Len = 12 {** Maximum length on strings **} {** Erase error box and flush type-ahead **} Set Colour (Black) Fill (135,3+Offs,380,29+Offs) %for Offs = 0,512,512 %cycle; %repeat %until Test Symbol = -1 %end {** ---===<<>>===--- **} %routine Get Num (%short %name Num, %short X, Y, %string (30) Str) {** {** GET NUM uses Read Str above to get a number (showing it on the screen). It {** uses the standard Imp Event 4 to trap bad numbers. Number got from X,Y {** %string (30) S %short N At (X,Y) Set Colour (Yellow) Show String (Str." : ") %unless Str = "" {** STR is a prompt **} %cycle; %repeat %until Test Symbol = -1 Read Str (S, Xpos, Ypos, Green) %return %if S = "" N = StoI (S) Num = N %unless N = 0 %and S # "0" {** If typed don't alter **} %end {** ---===<<>>===--- **} %routine Get Str (%string (30) %name S, %string (30) Str) {** {** GET STR uses Read Str to prompt for and get a string from the lower box on {** the Menu Screen {** At (135,Scr+17) At (135,Scr+17) Set Colour (Yellow) Show String (Str." : ") %cycle; %repeat %until Test Symbol = -1 Read Str (S, Xpos, Ypos, Green) %end {** ---===<<< CONVERT >>>===--- **} %routine Convert {** {** CONVERT updates the MX and MY mouse parameters, scaled down by 3 {** OX = MX; OY = MY MX = (MouseX//3) & 1023 MY = (MouseY//3) & 1023 %end {** ---===<<< ERASE CURSOR >>>===--- **} %routine Erase Cursor {** {** ERASE CURSOR removes the Cursor when Data entry is required {** Disable (RGBPlane) Set Colour (Black) %if CurType = 0 %then At (OX,OY+Scr-16) %else At (OX-10,OY+Scr-8) Show Symbol (Cur) %if CurType = 0 %then At (MX,MY+Scr-16) %else At (MX-10,MY+Scr-8) Show Symbol (Cur) Enable Reg = 15 %end {** ---===<<< CURSOR >>>===--- **} %routine Cursor (%byte New Cursor) {** {** CURSOR redraws the cursor (if necessary), erasing the old one and picking {** a new one if NEW CURSOR is True (ie user moved to another area of screen) {** %return %if OX=MX %and OY=MY Disable (RGBPlane) Set Colour (Black) %if CurType = 0 %then At (OX,OY+Scr-16) %else At (OX-10,OY+Scr-8) Show Symbol (Cur) Set Colour (Invert) Cur = CurC(NPos) %and CurType = CurT(NPos) %if New Cursor = True %if CurType = 0 %then At (MX,MY+Scr-16) %else At (MX-10,MY+Scr-8) Show Symbol (Cur) Enable Reg = 15 %end {** ---===<<< POSITION >>>===--- **} %routine Position (%short %name Mode, Sub) {** {** POSITION returns the Screen position (in Menu, Control Area, or Limbo) when {** in Menu mode. The SUB parameter is used when in the Menu area to indicate {** which box is chosen. {** %own %short %array Pos (Menu:CGrid,0:3) = BoxX,0,BoxX+BoxWid,487, CGx+CGl,CGy+CGb,CGx+CGr,CGY+CGt %integer i Mode = Limbo; Sub = -1 %for i = Menu,1,CGrid %cycle %if Pos(i,0) <= MX <= Pos(i,2) %and Pos(i,1) <= MY <= Pos(i,3) %thenc Mode = i %and %exit %repeat %if Mode = Menu %then Sub = 13 - MY // 35 {** Calculate Box No for Menu **} %end {** ---===<<< GET MOUSE >>>===--- **} %byte %fn Get Mouse {** {** GET MOUSE avoids the problem of having the system pick up changes of Mouse {** too quickly (ie going from Ms_L to Ms_LMR the system sometimes registers {** Ms_LM or Ms_LR) by introducing a small polling delay. {** %byte M,N %integer i %cycle M = Mouse Buttons N = Mouse Buttons %for i = 1,1,Mouse Delay %repeat %until M = N %result = M %end {** ---===<<< REC >>>===--- **} %routine Rec (%short x1, y1, x2, y2, C) {** {** REC Draws a rectangle with clipped edges {** Set Colour (C) Line (x1+2,y1,x2-2,y1); Line (x2-2,y1,x2,y1+2) Line (x2,y1+2,x2,y2-2); Line (x2,y2-2,x2-2,y2) Line (x2-2,y2,x1+2,y2); Line (x1+2,y2,x1,y2-2) Line (x1,y2-2,x1,y1+2); Line (x1,y1+2,x1+2,y1) %end {** ---===<<< BOX >>>===--- **} %routine Box (%short i,C1,C2) {** {** BOX draws Menu box I with Colours C1 and C2. The TEXT array gives the info {** to put in the box. If T1 is blank the T0 string is centered itself (ie the {** QUIT box. If T1 is "*" then the second string is a parameter TEXT(i,2), as {** with the HIDDEN or MESH boxes. Otherwise T0 and T1 are centered and drawn {** %string (30) T0 = Text (i,0), T1 = Text (i,1) %short Y = 35 * (13-i), Off {** Everything nicely centered **} %for Off = 0,512,512 %cycle Rec (BoxX,Y+Off,BoxX+BoxWid,Y+32+Off,C1) Set Colour (C2) %if T1 = "" %start At (BoxX+(BoxWid-Length (T0)*8)>>1-3,Y+Off+11) Show String (T0) %else At (BoxX+(BoxWid-Length (T0)*8)>>1-3,Y+Off+17) Show String (T0) %if T1 = "*" %start Disable(Invert) Set Colour (Black); Fill (BoxX+1,Y+Off+3,BoxX+BoxWid-1,Y+Off+14) Set Colour (C2) At (BoxX+(BoxWid-Length (Text (i,2))*8)>>1-3,Y+Off+3) Show String (Text(i,2)) %else At (BoxX+(BoxWid-Length (T1)*8)>>1-3,Y+Off+3) Show String(T1) %finish %finish %repeat %end {** ---===<<< MSINFO >>>===--- **} %routine MsInfo (%short %array (2) %name A, %short M,C, %string (30) S) {** {** MSINFO prints the information string S for MouseButton M in the Mouse Info {** box above the Control Points area or the Bezier area. The relevant {** coordinates are chosen from the parameter array A {** %short Offs %return %if M = MsLR %for Offs = 0,512,512 %cycle Set Colour (C) At (A(M,0),A(M,1)+Offs) Show String (MN(M).": ".S) %repeat %end {** ---===<<< SHOW COORDS >>>===--- **} %routine Show Coords (%record (Pt) %name IP, %real Per, %byte VP) {** {** SHOW COORDS displays the Point IP coords (scaled by the param PER) in the {** information box. The Point is in screen coords, and has to be altered if the {** user is editing in the XZ or YZ planes (ie for XZ the mapping is Y <-> Z {** (see documentation) {** %short Offs %real X=IP_X/Per, Y=IP_Y/Per, Z=IP_Z %if VP = XZ %then Y = IP_Z %and Z = IP_Y %elsec %if VP = YZ %then X = IP_Z %and Z = IP_X Disable (Red) %for Offs = 0,512,512 %cycle Set Colour (Black); Fill (384,3+Offs,600,15+Offs) Set Colour (Yellow) At (384+ 18, 3+Offs); Show String (ItoS(Int(X),0)) At (384+ 90, 3+Offs); Show String (ItoS(Int(Y),0)) At (384+162, 3+Offs); Show String (ItoS(Int(Z),0)) %repeat Enable Reg = 15 %end {** ---===<<< SET UP SCREEN >>>===--- **} %routine Set up Screen {** {** SET UP SCREEN sets up the Control Grid area and Menu (in both halves of {** the framestore for animation purposes). {** %short Offs %integer i Clear {** Set up the Clip Coords to the Control Grid Virtual Coords **} CX = CGx; CiY = CGy; Top = CGt; Bottom = CGb; Left = CGl; Right = CGr Box (i,Red,Yellow) %for i = 0,1,13 {** Draw Menu Boxes **} {** Draw all the rest of the stuff **} %for Offs = 0,512,512 %cycle Rec (CX+Left-2,CiY+Bottom-2+Offs,CX+Right+2,CiY+Top+2+Offs,Red) Rec (CGx+Left-2,455+Offs,CGx+Right+2,487+Offs,Red) Rec (CGx+Left-2,Offs,CGx+Right+2,32+Offs,Red) At (384,17+Offs); Set Colour (Red) Show String ("View Plane: Distance:") At (384,3+Offs); Show String ("X: Y: Z:") %repeat {** Set up the Mouse Information **} MsInfo (CCoord,MB,Red,"Pick") %for MB = MsL,1,MsLMR %end {** ---===<<< CALC SM >>>===--- **} %routine Calc SM {** T {** CALC SM calculates the SM matrix in the (SM)Q(SM) equation {** %real %name SMp %integer i, j, k %const %real %array M (0:3,0:3) = 0, 0, 0, 1, 0, 0, 3,-3, 0, 3,-6, 3, 1,-3, 3,-1 %for i = 0,1,Mesh Size %cycle %for j = 0,1,3 %cycle SMp == SM (i,j); SMp = 0 SMp = SMp + (i * Step Size)^k * M (k,j) %for k = 0,1,3 %repeat %repeat %end {** ---===<<< CALC BEZIER >>>===--- **} %routine Calc Bezier {** T {** CALC BEZIER calculates the Bezier points from SMQ(SM) equation {** %real %name SMp %integer i, j, k %record (Pt) %name SMQp, Qp, Bp {** Calculate SMQ **} %for i = 0,1,Mesh Size %cycle %for j = 0,1,3 %cycle SMQp == SMQ (i,j); SMQp = 0 %for k = 0,1,3 %cycle Qp == Q (k,j); SMp == SM (i,k) SMQp_x = SMQp_x + SMp * Qp_x SMQp_y = SMQp_y + SMp * Qp_y SMQp_z = SMQp_z + SMp * Qp_z %repeat %repeat %repeat {** Calculate Points **} %for i = 0,1,Mesh Size %cycle %for j = 0,1,Mesh Size %cycle Bp == Bez (i,j); Bp = 0; %for k = 0,1,3 %cycle SMQp == SMQ (j,k); SMp == SM (i,k) Bp_x = Bp_x + SMp * SMQp_x Bp_y = Bp_y + SMp * SMQp_y Bp_z = Bp_z + SMp * SMQp_z %repeat %repeat %repeat %end {** ---===<<< LIES WITHIN >>>===--- **} %predicate Lies Within (%record (Pt) %name P, %short k) {** {** A variation on Sutherland outcodes (with next routine) and quite fast {** LIES WITHIN returns True if point P Is inside the boundary defined by K {** %switch Bnd (0:3) -> Bnd (k) Bnd(0): %true %if P_X > Left; %false Bnd(1): %true %if P_X < Right; %false Bnd(2): %true %if P_Y > Bottom; %false Bnd(3): %true %if P_Y < Top; %false %end {** ---===<<< INTER >>>===--- **} %record (Pt) %fn Inter (%record (Pt) %name A, B, %short X) {** {** INTER returns the intersection of Points A and B with respect to the {** boundary X in the point A {** %switch Bnd (0:3) %record (Pt) Temp -> Bnd (X) Bnd (0): Temp_Y = A_y + (B_y-A_y) * (Left - A_x) / (B_x-A_x) Temp_X = Left; %result = Temp Bnd (1): Temp_Y = A_y + (B_y-A_y) * (Right - A_x) / (B_x-A_x) Temp_X = Right; %result = Temp Bnd (2): Temp_X = A_x + (B_x-A_x) * (Bottom - A_y) / (B_y-A_y) Temp_Y = Bottom; %result = Temp Bnd (3): Temp_X = A_x + (B_x-A_x) * (Top - A_y) / (B_y-A_y) Temp_Y = Top; %result = Temp %end {** ---===<<< CLIPLINE >>>===--- **} %routine ClipLine (%record (Pt) %name P1, P2, %byte %name Vis) {** {** CLIPLINE takes P1 and P2 and clips them to the current Clip Window. Returns {** with VIS False if the line is totally hidden {** %integer i Vis = True {** For each BOUND i **} %for i = 0,1,3 %cycle %if Lies Within (P1,i) %start {** If P1 is in bound **} %continue %if Lies Within (P2,i) {** Continue if P2 is in **} P2 = Inter (P1, P2, i) {** Else Clip P2 **} %else {** If P1 not in bound **} {** Then either clip it or P2 isn't in, so VIS=False **} %if Lies within (P2, i) %then P1 = Inter (P1, P2, i) %c %else Vis = False %and %exit %finish %repeat %end {** ---===<<< CLIP DRAW >>>===--- **} %routine Clip Draw (%record (Pt) P1, P2) {** {** CLIP DRAW Clips line P1->P2 and draws it in Clip area if it is visible {** %byte Vis ClipLine (P1, P2, Vis) Line (Int(P1_x + CX), Int(P1_y + CY), Int(P2_x + CX), Int(P2_y + CY)) %if Vis = True %end {** ---===<<< PLOTP >>>===--- **} %routine PlotP (%record (Pt) P) {** {** PLOTP plots a red blob on each control point in the grid {** %if Left < P_x < Right %and Bottom < P_y < Top %start Plot (Int(P_x+CX),Int(P_y+CY)) Plot (Int(P_x+CX+1),Int(P_y+CY)) Plot (Int(P_x+CX),Int(P_y+CY+1)) Plot (Int(P_x+CX),Int(P_y+CY-1)) Plot (Int(P_x+CX-1),Int(P_y+CY)) %finish %end {** ---===<<< EDIT VALS >>>===--- **} %routine Edit Vals {** {** EDIT VALS is entered when the user wishes to edit the control points in a {** numeric manner rather than by using the elastic line. {** %short TPos = NPos, TSub = NSub, Yp = 380 + Draw Screen, Xp, Offs %short Pi, Pj, OPi, OPj, Xc, Yc, OXc, OYc, N %real OVal %real %name NVal %real ScX = 1, ScY = 1, ScZ = 1 %record (Pt) %name Qp %switch EVCom (MsL:MsLMR) %integer i, j {** Event Block used to pick up errors in Integer entry **} %on %event 4 %start %cycle; %repeat %until Test Symbol = -1 %for Offs = 0,512,512 %cycle At (135,3+Offs); Set Colour (Green) Show String (Event_Message) %repeat -> EVCom (MB) %finish {** Set up EditVals info for Mouse **} Set Colour(Black); Fill(129,457+Offs,685,485+Offs) %for Offs=0,512,512 MsInfo (CCoord,MB,Red,VInfo(MB)) %for MB = MsL,1,MsLMR {** Set up screen headings **} CY = CiY + Draw Screen Enable Reg = 15; Set Colour (Black) Fill (CX+Left,CY+Bottom,CX+Right,CY+Top) Set Colour (Red) At (200,Yp);Show String(" Point:") At (315,Yp);Show Symbol ('X'); At (415,Yp);Show Symbol ('Y') At (515,Yp);Show Symbol('Z') {** Show Control Grid Coords as integers **} %for i = 0,1,3 %cycle %for j = 0,1,3 %cycle Yp = Yp - 20 Qp == Q(i,j) At (200,Yp); Show String ("P(".ItoS(i,0).",".ItoS(j,0)."):") At (300,Yp); Show String (ItoS(Int(Qp_X),3)) At (400,Yp); Show String (ItoS(Int(Qp_Y),3)) At (500,Yp); Show String (ItoS(Int(Qp_Z),3)) %repeat %repeat Offset (0,Draw Screen) Scr = Draw Screen Draw Screen = 512 - Draw Screen OXc = -1 OVal = 0; NVal == Oval OMB = MsNone %cycle {** Cycle around loop till User finishes editing **} Opos = NPos Convert {** New Mouse Position **} Position (NPos, NSub) %if Opos = NPos %then Cursor (False) %else Cursor (True) MB = Get Mouse %if MB # OMB %start MsInfo (CCoord,OMB,Red,VInfo(OMB)) %unless OMB = MsNone MsInfo (CCoord,MB,Yellow,VInfo(MB)) %unless MB = MsNone OMB = MB %finish %continue %if NPos # CGrid %and MB = MsNone {** Decode Coord Value from MX and MY **} Yc = (380 - MY) // 20 %if 0 <= Yc <= 15 %start Xc = (MX - 250) // 100 %if 0 <= Xc <= 2 %start Pi = Yc // 4; Pj = Yc & 3 Xp = Xc * 100 + 300; Yp = 360 - Yc * 20 + Scr %finish %else Xc = -1 %finish %else Xc = -1 {** Change Old Coord from Yellow to Red **} %if OXc # Xc %or OYc # Yc %start %if OXc # -1 %start At (OXc*100+300,360-OYc*20+Scr); Set Colour(Red) ShowString(ItoS(Int(OVal),3)) %finish {** Change New Coord from Red to Yellow **} %if Xc # -1 %start At (Xp,Yp); Set Colour(Yellow) %if Xc = 0 %then NVal == Q(Pi,Pj)_X %elsec %if Xc = 1 %then NVal == Q(Pi,Pj)_Y %elsec NVal == Q(Pi,Pj)_Z ShowString(ItoS(Int(NVal),3)) %finish OXc = Xc; OYc = Yc; OVal = NVal %finish %continue %if MB = MsNone {** User wants to change a value so get Cursor out of the way **} Erase Cursor -> EVCom (MB) {** Get Value and replace Old Coord with it **} EVCom (MsL): EVCom (MsM): EVCom (MsR): Set Colour (Black); Fill(Xp,Yp,Xp+80,Yp+12) N = Int(NVal); Get Num (N,Xp,Yp,"") NVal = N; OVal = NVal Set Colour (Black); Fill(Xp,Yp,Xp+80,Yp+12) At(Xp,Yp);Set Colour(Yellow); ShowString(ItoS(Int(Nval),3)) %continue {** Quit **} EVCom (MsLM): EVCom (MsLMR): EVCom (MsMR): %exit EVCom (*): %repeat {** Last data value altered **} %if Xc # -1 %start {** Make last value Red if needed **} At (Xp,Yp); Set Colour(Red) %if Xc = 0 %then NVal == Q(Pi,Pj)_X %elsec %if Xc = 1 %then NVal == Q(Pi,Pj)_Y %elsec NVal == Q(Pi,Pj)_Z ShowString(ItoS(Int(NVal),3)) %finish {** Restore standard info in Mouse area **} Set Colour(Black); Fill(129,457+Offs,685,485+Offs) %for Offs=0,512,512 MsInfo (CCoord,MB,Red,"Pick") %for MB = MsL,1,MsLMR NSub = TSub; NPos = TPos %end {** ---===<<< DRAW GRID >>>===--- **} %routine Draw Grid {** {** DRAW GRID Draws the Control Grid points in the Control Clip area, according {** to the View Plane in use. Perspective is applied if necessary. {** %record (Pt) %name Pp %record (Pt) %name Qp %real Persp = 1 %integer i, j {** Calculate Perspective and perform View Plane **} {** transformation (swop X and Z or Y and Z etc **} %for i = 0,1,3 %cycle %for j = 0,1,3 %cycle Pp == Per (i,j); Qp == Q (i,j) Persp = Screen Dist / Object Dist %if Perspect = On %if View Plane = YZ %then Pp_x = Persp * Qp_z %c %else Pp_x = Persp * Qp_x %if View Plane = XZ %then Pp_y = Persp * Qp_z %c %else Pp_y = Persp * Qp_y Pp_z = Screen Dist + Object Dist %repeat %repeat {** CLIP DRAW all the control grid lines on screen **} Enable Reg = Green; Set Colour (Green) %for i = 0,1,3 %cycle %for j = 0,1,2 %cycle Clip Draw (Per(i,j),Per(i,j+1)) Clip Draw (Per(j,i),Per(j+1,i)) %repeat %repeat Enable Reg = Red; Set Colour (Red) %for i = 0,1,3 %cycle Plotp (Per(i,j)) %for j = 0,1,3 %repeat Enable Reg = 15 %end {** ---===<<< ROTATE >>>===--- **} %routine Rotate (%byte Plane, %record (Pt) %array (2) %name P, %short Step, %realname CosTheta, SinTheta) {** {** ROTATE takes the Array of point P, angles and a View Plane, and rotates {** P about the axis specified by the View Plane (ie XY => Z axis rotation {** Since homogeneous coords are not needed, the rotations are most easily {** done by hand rather than as strict matrix multiplications {** %record (Pt) %name Pp %switch VP (XY:YZ) %real t %integer i, j -> VP (Plane) VP (XY): %for i = 0,1,Step %cycle %for j = 0,1,Step %cycle Pp == P (i,j) t = Pp_x Pp_x = CosTheta * t + SinTheta * Pp_y Pp_y = -SinTheta * t + CosTheta * Pp_y %repeat %repeat %return VP (XZ): %for i = 0,1,Step %cycle %for j = 0,1,Step %cycle Pp == P (i,j) t = Pp_x Pp_x = CosTheta * t + SinTheta * Pp_z Pp_z = -SinTheta * t + CosTheta * Pp_z %repeat %repeat %return VP (YZ): %for i = 0,1,Step %cycle %for j = 0,1,Step %cycle Pp == P (i,j) t = Pp_y Pp_y = CosTheta * t + SinTheta * Pp_z Pp_z = -SinTheta * t + CosTheta * Pp_z %repeat %repeat %end {** ---===<<< DRAW WIRE >>>===--- **} %routine Draw Wire {** {** DRAW WIRE draws the wire frames Bezier surface, Clipped against the Bezier {** Screen {** %integer i, j Set Colour (Wire Mesh) %for i = 0,1,Mesh Size %cycle Clip Draw (IBez(i,j),IBez(i,j+1)) %andc Clip Draw (IBez(j,i),IBez(j+1,i)) %for j = 0,1,Mesh Size - 1 %repeat %end {** ---===<<< BIGGESTZ >>>===--- **} %real %fn BiggestZ (%record (Pt) %name A, B, C, D) {** {** BIGGESTZ returns the largest Z coord from the four Point given {** %real Res = A_Z Res = B_Z %if B_Z > Res Res = C_Z %if C_Z > Res Res = D_Z %if D_Z > Res %result = Res %end {** ---===<<< QUICK SORT >>>===--- **} %routine Quick Sort (%short A, B) {** {** QUICK SORT - standard quick sort routine (Lattice Logic) used to sort the {** deepest points of the polygon list {** %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 {** ---===<<< SHADE >>>===--- **} %byte %fn Shade (%record (Pt) %name P1, P2, P3) {** {** SHADE performs the Lambert reflection operations for the shaded Bezier {** surfaces (Level 1.5). The operations are 'hardwired' to speed up the {** process, but it is still slow. The parameters are three points of the {** polygon being shaded. {** %byte dp, %real Len %record (Pt) N,M,L,T1,T2 %real Dot %integerfn Sign (%name N) {** SIGN 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. **} Len=Sqrt(N_X*N_X+N_Y*N_Y+N_Z*N_Z) {** Make N a unit vector **} %if Len # 0 %start N_X=N_X/Len; N_Y=N_Y/Len; N_Z=N_Z/Len %finish {** The Eye point is (0,0,-1) as a unit vector, so **} {** compare signs of (N.Light) and (N.Eye) to get **} {** illumination of polygon **} Dot = N_X*Light_X+N_Y*Light_Y+N_Z*Light_Z %if Sign (Dot) = - Sign (N_Z) %then %result = 69 + IntPt (90 * |Dot|) %result = 69 %end {** ---===<<< DRAW HIDDEN >>>===--- **} %routine Draw Hidden {** {** DRAW HIDDEN calculates the polygon patches required for the Painter {** algorithm, depth sorts them in order of Z coordinate, and displays them {** either shaded or as black patches. %short DP, X %record (Polt) %name P %record (Pt) %name Plp, Pp %record (Polt) O %integer i, j, k, l DP = -1 {** Calculate Polygon values **} %for i = 0,1,Mesh Size-1 %cycle %for j = 0,1,Mesh Size-1 %cycle P == Pol(i,j); P = 0 P_Num = 4 {** P_Num = 4 (at start) **} {** Get deepest Vertex of Polygon **} P_Depth = BiggestZ (IBez(i,j),IBez(i,j+1),IBez(i+1,j+1),IBez(i+1,j)) P_V(1) = IBez(i,j) P_V(2) = IBez(i,j+1) {** Store Bezier Points as Polygon Vertices **} P_V(3) = IBez(i+1,j+1) P_V(4) = IBez(i+1,j) {** Perform Front Plane Clipping **} %continue %if (P_Depth + Object Dist < Screen Dist) %and Perspect = On %for k = 0,1,3 %cycle {** Clip Polygons to Screen Boundaries **} X = 0; O = 0 {** Same as for Line, but do for each **} Plp == P_V(P_Num) {** line in Polygon **} %for l = 1,1,P_Num %cycle Pp == P_V(l) %if Lies Within (Pp, k) %start %if Lies Within (Plp, k) %then X=X+1 %and O_V(X) = Pp %c %else %start X = X+2 O_V(X-1) = Inter (Plp, Pp, k) O_V(X) = Pp %finish %finish %else %start X=X+1 %and O_V(X) = Inter(Plp, Pp, k) %if Lies Within (Plp, k) %finish Plp == Pp %repeat -> Outside %if X = 0 {** Abort test if Polygon isn't visible **} P_Num = X; P_V = O_V %repeat DP = DP + 1; PL (DP) == P {** Polygon is visible so put in list **} Outside: %repeat %repeat !t!printline("Sort ".itos(DP,-1)." polys") Quick Sort (0, DP) {** Sort Polygons into depth order **} !t!printline("Sorted. Plot polys") %if Shading = Off %start {** Non shaded surface **} %for i = 0,1,DP %cycle P == PL (i) Set Colour (Hide Fore) {** An alternative to using POLY is to **} {** use TRIANGLES, but not as fast. **} {** Form Polygons and CLOSE them **} Poly (Int(P_V(j)_X+CX), Int(P_V(j)_Y+CY)) %for j = 1,1,P_Num Close Poly Set Colour (Hide Mesh) {** Draw Line around Polygon **} Line(Int(P_V(j)_X+CX),Int(P_V(j)_Y+CY), Int(P_V(j+1)_X+CX),Int(P_V(j+1)_Y+CY)) %for j=1,1,P_Num-1 Line(Int(P_V(1)_X+CX),Int(P_V(1)_Y+CY), Int(P_V(P_Num)_X+CX),Int(P_V(P_Num)_Y+CY)) %repeat %else {** SHADING used here **} %for i = 0,1,DP %cycle P == PL (i) !t!printstring("Poly"); write(i,4); write(p_num,1) !t!%for j=1,1,p_num %cycle !t! write(int(P_V(j)_X+CX), 4); write(int(P_V(j)_Y+CY), 4) !t!%repeat %continue %if P_Num < 3 {** Calculate Intensity of surface **} Set Colour (Shade(P_V(1), P_V(2), P_V(3))) %if p_num=4 %start triangle(INT(P_V(1)_X+CX), INT(P_V(1)_Y+CY), INT(P_V(2)_X+CX), INT(P_V(2)_Y+CY), INT(P_V(3)_X+CX), INT(P_V(3)_Y+CY)) triangle(INT(P_V(3)_X+CX), INT(P_V(3)_Y+CY), INT(P_V(4)_X+CX), INT(P_V(4)_Y+CY), INT(P_V(1)_X+CX), INT(P_V(1)_Y+CY)) %else Poly (Int(P_V(j)_X+CX), Int(P_V(j)_Y+CY)) %for j = 1,1,P_Num Close Poly %finish !t!printstring(" closed"); newline %repeat %finish !t!printline("Plotted") %end {** ---===<<< DRAW SURFACE >>>===--- **} %routine Draw Surface {** {** DRAW SURFACE performs the perspective transformation on the Bezier points {** if necessary and then calls either the Wire or Hidden Surface routines. {** %real Persp = 1 %record (Pt) %name Bp %record (Pt) %name IBp %integer i, j Set Colour (Hide Back) Fill (CX+Left,CY+Bottom,CX+Right,CY+Top) {** Calculate Perspective Points **} Persp = Screen Dist / Object Dist %if Perspect = On %for i = 0,1,Mesh Size %cycle %for j = 0,1,Mesh Size %cycle Bp == Bez (i,j); IBp == IBez (i,j) IBp_x = Persp * Bp_x IBp_y = Persp * Bp_y IBp_z = Bp_z %repeat %repeat %if Hidden = On %then Draw Hidden %else Draw Wire %end {** ---===<<< UPDATE GRID >>>===--- **} %routine Update Grid (%byte Flip) {** {** UPDATE GRID draws the new Control Grid on the current Draw Screen (invisible {** to the user. If FLIP is True the Offset is altered to display the new screen {** %integer i CY = CiY + Draw Screen Enable Reg = 15; Set Colour (Black) Fill (CX+Left,CY+Bottom,CX+Right,CY+Top) {** Erase old Grid and Info **} Fill (609,17+Draw Screen,684,29+Draw Screen) Set Colour (Yellow); At(609,17+Draw Screen) {** Write Object Distance **} Show String (ItoS(Object Dist,0)) {** Write View Plane **} Set Colour (Black); Fill (492,17+Draw Screen,510,29+Draw Screen) Set Colour (Yellow); At (492,17+Draw Screen) ShowString(VPStr(View Plane)) Draw Grid {** Draw new Control Grid **} %return %if Flip = False {** Flip screen if necessary **} Offset (0,Draw Screen) Scr = Draw Screen Draw Screen = 512 - Draw Screen %end {** ---===<<< EDIT GRID >>>===--- **} %routine Edit Grid (%byte Plane) {** {** EDIT GRID is called to invoke the elastic line editor to alter control {** points in the specified PLANE {** %record (Pt) %name Qp, Qp2 %record (Pt) %name Ep %record (Pt) IOPp, IPp %record (Pt) %array TE, OE, E (1:4) %real Per = 1 %short MsX, MsY, TSub, TPos, Num %switch EditCom(MsNone:MsLMR) %switch Edit2Com(MsNone:MsLMR) %integer Pi,Pj,Px,Py {** ---===<<< UPDATE LINES >>>===--- **} %routine Update Lines (%record (Pt) IPp) {** {** UPDATE LINES draws the new elastic lines on the Draw Screen, Flips to {** display them, and then Erases the old lines (on the previously visible {** screen {** %byte Vis Disable (Green); Set Colour (Red) {** Draw New Lines **} TE = E %for i = 1,1,Num %cycle ClipLine (IPp, TE(i), Vis) Line (Int(IPp_x + CX), Int(IPp_y + CY), Int(TE(i)_x + CX), Int(TE(i)_y + CY)) %if Vis = True %repeat Offset (0,Draw Screen) {** Flip Screen **} Scr = Draw Screen Draw Screen = 512 - Draw Screen CY = CiY + Draw Screen Set Colour (Black) {** Erase old lines **} %for i = 1,1,Num %cycle ClipLine (IOPp, OE(i), Vis) Line (Int(IOPp_x + CX), Int(IOPp_y + CY), Int(OE(i)_x + CX), Int(OE(i)_y + CY)) %if Vis = True %repeat OE = TE Enable Reg = 15 IOPp_x = IPp_x; IOPp_y = IPp_y {** Update New Point to Old **} %end {** ---===<<< PICKED POINT >>>===--- **} %routine Picked Point (%real X, Y, %integer %name Pi, Pj) {** {** PICKED POINT returns the Control Grid Coordinates (Pi,Pj) of the first {** point to be less then Min Dist away from the point X, Y (where the Mouse {** is, scaled by Perspective), or -1 in Pi if no point is near {** %integer Min Dist = 40 %record (Pt) %name Qp %switch VP (XY:YZ) %for Pi = 0,1,3 %cycle %for Pj = 0,1,3 %cycle Qp == Q (Pi,Pj) -> VP (View Plane) VP(XY): %return %if (|Qp_X - X | < Min Dist) %andc (|Qp_Y - Y | < Min Dist) %continue VP(XZ): %return %if (|Qp_X - X | < Min Dist) %andc (|Qp_Z - Y | < Min Dist) %continue VP(YZ): %return %if (|Qp_Z - X | < Min Dist) %andc (|Qp_Y - Y | < Min Dist) %repeat %repeat Pi = -1 %end {** ---===<<< CALC JOIN >>>===--- **} %routine Calc Join {** {** CALC JOIN works out the edges to be attached to the elastic point. It places {** them in the array E and the number (from 2 to 4) in NUM, both local to the {** EDIT GRID routine. The E array contains the coordinate values of the edge {** vertices. {** %integer i, j Num = 0 %for i = Pi-1,2,Pi+1 %cycle {** Calculate i edges (on either side) **} %continue %if i=-1 %or i=4 Num= Num + 1 Qp2 == Q(i,Pj); Ep == E(Num) %if View Plane = YZ %then Ep_X = Qp2_Z %else Ep_X = Qp2_X %if View Plane = XZ %then Ep_Y = Qp2_Z %else Ep_Y = Qp2_Y %repeat %for j = Pj-1,2,Pj+1 %cycle {** Calculate j edges (above & below) **} %continue %if j=-1 %or j=4 Num= Num + 1 Qp2 == Q(Pi,j); Ep == E(Num) %if View Plane = YZ %then Ep_X = Qp2_Z %else Ep_X = Qp2_X %if View Plane = XZ %then Ep_Y = Qp2_Z %else Ep_Y = Qp2_Y %repeat %return %if Perspect = Off %for i = 1,1,Num %cycle {** Transform the edges to their screen values **} Ep == E(i) Ep_X = Ep_X * Per Ep_Y = Ep_Y * Per %repeat %end {** EDIT GRID Main Code **} TSub = NSub; TPos = NPos View Plane = Plane {** Update Grid **} Update Grid (True) {** Set up the editing Mouse Info **} Set Colour (Black); Fill (129,457+Offs,685,485+Offs) %for Offs = 0,512,512 MsInfo (CCoord,MB,Red,EInfo(MB)) %for MB = MsL,1,MsLMR %cycle; %repeat %until Mouse Buttons = MsNone OMB = MsNone %cycle {** Cycle till no more points to edit **} OSub = NSub; OPos = NPos Convert Position (NPos, NSub) MB = Get Mouse %if MB = MsNone %start %if Opos = NPos %then Cursor (False) %else Cursor (True) %finish %if MB # OMB %start MsInfo (CCoord,OMB,Red,EInfo(OMB)) %unless OMB = MsNone MsInfo (CCoord,MB,Yellow,EInfo(MB)) %unless MB = MsNone OMB = MB %finish %continue %if MB = MsNone Erase Cursor %exit %if MB = MsLMR {** MsLMR => Abort **} -> EditCom(MB) EditCom(MsL): EditCom(MsLM): {** L or LM => Move Away **} Object Dist = Object Dist + OI Update Grid (True) %continue {** R or MR => Move Closer **} EditCom(MsR): EditCom(MsMR): Object Dist = Object Dist - OI %unless Object Dist <= OI Update Grid (True) %continue {** M => Try to Pick a Point **} EditCom(MsM): Per = Screen Dist / Object Dist %if Perspect = On {** Check for point **} Picked Point ((MX-CX)/Per, (MY-CiY)/Per, Pi, Pj) %cycle; %repeat %until Mouse Buttons = MsNone %continue %if Pi = -1 {** Continue if no point **} Qp == Q(Pi,Pj) {** QP point to the point **} {** Get the Screen values of the Point **} IPp_Z = Qp_Z %if View Plane = YZ %then IPp_X = Qp_Z %and IPp_Z = Qp_X %c %else IPp_X = Qp_X %if View Plane = XZ %then IPp_Y = Qp_Z %and IPp_Z = Qp_Y %c %else IPp_Y = Qp_Y IPp_X = IPp_X * Per IPp_Y = IPp_Y * Per Show Coords (IPp, Per, View Plane) IOPp = IPp OE(Num) = IPp %for Num = 1,1,4 Calc Join {** Find the edges to the point **} Update Grid (False) {** Draw the Grid in Draw Screen **} Update Lines (IPp) {** and draw the lines and flip **} {** Cycle in here until the user deposits the point or aborts **} %cycle Convert MB = Get Mouse %continue %if OX = MX %and OY = MY %and MB = MsNone {** Determine the new point, Clip and Show it **} IPp_X = MX - CX; IPp_Y = MY - CiY %if IPp_X < Left %then IPp_X = Left %elsec %if IPp_X > Right %then IPp_X = Right %if IPp_Y < Bottom %then IPp_Y = Bottom %elsec %if IPp_Y > Top %then IPp_Y = Top Show Coords (IPp,Per,View Plane) -> Edit2Com(MB) Edit2Com(MsM): {** M => Deposit the Point **} {** According to the View Plane update the **} {** Point in the appropriate order **} Qp_Z = IPp_Z %if View Plane=YZ %then Qp_Z=IPp_X/Per %and Qp_X=IPp_Z %c %else Qp_X=IPp_X/Per %if View Plane=XZ %then Qp_Z=IPp_Y/Per %and Qp_Y=IPp_Z %c %else Qp_Y=IPp_Y/Per {** Fall through to LMR below **} {** Update the Grid with the new point (or not) **} Edit2Com(MsLMR): Update Grid (True) {** Fix or Abort **} %cycle; %repeat %until MouseButtons = MsNone; %exit {** R => Move Closer **} Edit2Com(MsMR): Edit2Com(MsR): -> Edit2Com (MsNone) %unless Object Dist > OI Object Dist = Object Dist - OI -> Cont {** Go on to update lines **} Edit2Com(MsLM): Edit2Com(MsL): {** L => Move Away **} Object Dist = Object Dist + OI Cont: Per = Screen Dist / Object Dist %if Perspect = On Calc Join {** Edges have altered so recalculate **} Update Grid (False) {** Draw new Grid in Draw Screen **} Update Lines (IPp) {** Update lines and Flip **} Update Grid (False) {** Draw Grid in Draw Screen **} %continue Edit2Com(MsNone): {** No buttons pressed, so Update **} Update Lines (IPp) {** lines and continue **} Edit2Com(*): %repeat {** Exit when point is fixed or abandoned **} EditCom(*): %repeat {** Exit when user hits LMR **} NSub = TSub; NPos = TPos Set Colour (Black); Disable (Red) Fill (384,3+Offs,600,15+Offs) %and Fill (129,457+Offs,685,485+Offs) %c %for Offs = 0,512,512 Enable Reg = 15 Set Colour(Black); Fill(129,457+Offs,685,485+Offs) %for Offs=0,512,512 MsInfo (CCoord,MB,Red,"Pick") %for MB = MsL,1,MsLMR %end {** ---===<<< DRAW BEZIER >>>===--- **} %routine Draw Bezier {** {** DRAW BEZIER calculates and displays the Bezier Curve on the screen and {** allows the user to rotate and move towards or away from the curve. {** %switch BezCom (MsL:MsLMR) Calc Bezier {** Calculate Bezier Points **} {** Set up Clip boundaries for Bezier window **} CX = BSx; CiY = BSy; Top = BSt; Bottom = BSb; Left = BSl; Right = BSr {** Draw various Boxes on both screens **} Clear Offset (0,0); Draw Screen = 512; Scr = 0 %for Offs = 0,512,512 %cycle Rec (CX+Left+2,CiY+Bottom+2+Offs,CX+Right-2,CiY+Top-2+Offs,Red) Rec (2,2+Offs,685,19+Offs,Red) Rec (2,491+Offs,685,508+Offs,Red) %repeat MsInfo (BCoord,MB,Red,BInfo(MB)) %for MB = MsL,1,MsLMR Set Colour (Hide Back) Fill (CX+Left,CiY+Bottom,CX+Right,CiY+Top) %cycle; %repeat %until Mouse Buttons = MsNone OMB = MsNone {** Cycle round here until the user aborts **} %cycle CY = CiY + Draw Screen Draw Surface {** Draw Bezier Surface **} Offset (0,Draw Screen) {** Flip screen to display surface **} Scr = Draw Screen Draw Screen = 512 - Draw Screen %cycle {** Get a Mouse Command **} MB = Get Mouse %if MB # OMB %start MsInfo (BCoord,OMB,Red,BInfo(OMB)) %if OMB # MsNone MsInfo (BCoord,MB,Yellow,BInfo(MB)) %unless MB = MsNone OMB = MB %finish %repeat %until MB # MsNone -> BezCom (MB) BezCom(MsLMR): %exit {** L, M, R => Rotate X, Y, Z **} BezCom( MsL): Rotate (YZ,Bez,Mesh Size, CosRad,SinRad); %continue BezCom( MsM): Rotate (XZ,Bez,Mesh Size, CosRad,SinRad); %continue BezCom( MsR): Rotate (XY,Bez,Mesh Size, CosRad,SinRad); %continue {** LM, MR => Move Away, Towards **} BezCom( MsLM): Object Dist = Object Dist + OI; %continue BezCom( MsMR): Object Dist = Object Dist - OI %unless Object Dist <= OI BezCom( *): %repeat {** Exit when LMR pressed **} Set up Screen {** Set screen up for Control Grid again **} Box (MDr,Blue,Cyan) Update Grid (True) {** Draw Control Grid **} MsInfo (CCoord,MB,Red,"Pick") %for MB = MsL,1,MsLMR %end {** ---===<<< ROTATE GRID >>>===--- **} %routine Rotate Grid %switch RotCom (MsNone:MsLMR) {** {** ROTATE GRID allows the user to rotate the Control Grid points about the {** X, Y and Z axes. {** Set Colour(Black); Fill(129,457+Offs,685,485+Offs) %for Offs=0,512,512 MsInfo (CCoord,MB,Red,BInfo(MB)) %for MB = MsL,1,MsLMR %cycle; %repeat %until MouseButtons = MsNone OMB = MsNone %cycle Update Grid (True) {** Update Grid on Screen and Flip **} %cycle {** Get Mouse command and act accordingly **} MB = Get Mouse %if MB # OMB %start MsInfo (CCoord,OMB,Red,BInfo(OMB)) %if OMB # MsNone MsInfo (CCoord,MB,Yellow,BInfo(MB)) %unless MB = MsNone OMB = MB %finish %repeat %until MB # MsNone -> RotCom (MB) {** Act on Mouse command (all standard) **} RotCom(MsLMR): %exit RotCom( MsL): Rotate (YZ, Q, 3, CosRad,SinRad); %continue RotCom( MsM): Rotate (XZ, Q, 3, CosRad,SinRad); %continue RotCom( MsR): Rotate (XY, Q, 3, CosRad,SinRad); %continue RotCom( MsLM): Object Dist = Object Dist + OI; %continue RotCom( MsMR): Object Dist = Object Dist - OI %unless Object Dist <= OI RotCom( *): %repeat {** Restore Standard Mouse Info **} Set Colour(Black); Fill(129,457+Offs,685,485+Offs) %for Offs=0,512,512 MsInfo (CCoord,MB,Red,"Pick") %for MB = MsL,1,MsLMR %end {** ---===<<< READ IN FILE >>>===--- **} %routine Read in File {** {** READ IN FILE Gets a Control Grid file from the user. Uses events to {** trap bad files {** %integer i, j Get Str (File,"Input File") %if File # "" %start Text(MIn,2) = File Box (MIn,Blue,Cyan) Open Input (1,File) Select Input (1) %for i = 0,1,3 %cycle %for j = 0,1,3 %cycle Read (QO(i,j)_X) Read (QO(i,j)_Y) Read (QO(i,j)_Z) %repeat %repeat Close Input Select Input (0) %for i = 0,1,3 %cycle %for j = 0,1,3 %cycle Q(i,j)_X = QO(i,j)_X Q(i,j)_Y = QO(i,j)_Y Q(i,j)_Z = QO(i,j)_Z %repeat %repeat Update Grid (True) %finish MsInfo (CCoord,MB,Red,"Pick") %end {** ---===<<< SAVE FILE >>>===--- **} %routine Save File {** {** SAVE FILE Saves a Control Grid file for the user. Uses events to trap {** bad files {** %integer i, j Get Str (File,"Output File") %if File # "" %start Text(MOu,2) = File Open Output (1,File) Box (MOu,Blue,Cyan) Select Output (1) %for i = 0,1,3 %cycle %for j = 0,1,3 %cycle Print (Q(i,j)_X,5,5) Print (Q(i,j)_Y,5,5) Print (Q(i,j)_Z,5,5) %repeat Newline %repeat Close Output Select Output (0) %finish MsInfo (CCoord,MB,Red,"Pick") %end {** ---===<<< INITIALISE >>>===--- **} %routine Initialise {** {** INITIALISE Sets up default grid and other parameters {** %real Len %const %short Lx = 10, Ly = -10, Lz = -10 %integer i {** Set up LIGHT vector and shades **} ! %if APM Level = Level 15 %start Len = Sqrt (Lx*Lx + Ly*Ly + Lz*Lz) Light_X = Lx/Len; Light_Y = Ly/Len; Light_Z = Lz/Len Mix Colour (Hide Back,6,10,8) Mix Colour (64+i,0,0,i) %for i = 5,1,31 Mix Colour (96+i,0,i,31) %for i = 0,1,31 Mix Colour (128+i,i,31,31) %for i = 0,1,31 ! %finish Q(0,0)_X = -300; Q(0,0)_Y = -300; Q(0,0)_Z = 0 Q(0,1)_X = -300; Q(0,1)_Y = -100; Q(0,1)_Z = 0 Q(0,2)_X = -300; Q(0,2)_Y = 100; Q(0,2)_Z = 0 Q(0,3)_X = -300; Q(0,3)_Y = 300; Q(0,3)_Z = 0 Q(1,0)_X = -100; Q(1,0)_Y = -300; Q(1,0)_Z = 0 Q(1,1)_X = -100; Q(1,1)_Y = -100; Q(1,1)_Z = 0 Q(1,2)_X = -100; Q(1,2)_Y = 100; Q(1,2)_Z = 0 Q(1,3)_X = -100; Q(1,3)_Y = 300; Q(1,3)_Z = 0 Q(2,0)_X = 100; Q(2,0)_Y = -300; Q(2,0)_Z = 0 Q(2,1)_X = 100; Q(2,1)_Y = -100; Q(2,1)_Z = 0 Q(2,2)_X = 100; Q(2,2)_Y = 100; Q(2,2)_Z = 0 Q(2,3)_X = 100; Q(2,3)_Y = 300; Q(2,3)_Z = 0 Q(3,0)_X = 300; Q(3,0)_Y = -300; Q(3,0)_Z = 0 Q(3,1)_X = 300; Q(3,1)_Y = -100; Q(3,1)_Z = 0 Q(3,2)_X = 300; Q(3,2)_Y = 100; Q(3,2)_Z = 0 Q(3,3)_X = 300; Q(3,3)_Y = 300; Q(3,3)_Z = 0 SinRad = Sin (Rad); CosRad = Cos (Rad) Draw Screen = 512; Scr = 0 MouseX = 0; MouseY = 0 Hidden = Off Shading = Off Perspect = On %end {** ---===<<< EVENT BLOCK >>>===--- **} %on %event 0,4,9 %start {** {** The EVENT BLOCK is used to trap all data and file errors and display a {** message on the screen. {** %cycle; %repeat %until Test Symbol = -1 {** Flush Type-ahead **} {** If Ctrl-Y was typed then restart the program **} -> Starting %if Event_Event = 0 %for Offs = 0,512,512 %cycle At (135,3+Offs); Set Colour (Green) Show String (Event_Message) %repeat -> MenuCom (NSub) %finish {** ---===<<< MAIN CODE>>>===--- **} Set Up Set Terminal Mode(No Page) VClear Read Default Font Append Font ("Cursors") {** Get Cursor definitions **} Initialise Calc SM {** Set up the SM matrix **} Starting: Set up Screen {** Set up the Control Grid and Menu screen **} Update Grid (True) {** Draw the Control Grid **} Npos = Limbo; NSub = -1 Cur = CurC(Limbo); CurType = CurT(Limbo) OMB = MsNone {** Main loop **} %cycle %cycle; %repeat %until Mouse Buttons = MsNone OSub = NSub; OPos = NPos {** Update position in standard way **} Convert Position (NPos, NSub) %if Opos = NPos %then Cursor (False) %else Cursor (True) %if NPos # Menu %start {** Make menu box red if left menu **} Box (OSub,Red,Yellow) %if OPos = Menu %else {** Make old menu box red and new one yellow **} %if OSub # NSub %start Box (OSub,Red,Yellow) %unless OSub = -1 Box (NSub,Blue,Cyan) %finish MB = Get Mouse %if MB # OMB %start MsInfo (CCoord,OMB,Red,"Pick") %if OMB # MsNone MsInfo (CCoord,MB,Yellow,"Pick") %unless MB = MsNone OMB = MB %finish %continue %if MB = MsNone Erase Cursor {** Get cursor out of the way **} -> MenuCom (NSub) MenuCom(MIn) : Read in File; %continue MenuCom(MOu) : Save File; %continue MenuCom(MEd) : Edit Vals; %continue MenuCom(MXY) : Edit Grid (XY); %continue MenuCom(MXZ) : Edit Grid (XZ); %continue MenuCom(MYZ) : Edit Grid (YZ); %continue MenuCom(MRo) : Rotate Grid; %continue MenuCom(MDr) : Draw Bezier; %continue {** Toggle Hidden Surface and alter Box **} MenuCom(MHi) : Hidden = 1-Hidden; Text(MHi,2) = OO(Hidden) Box (MHi,Blue,Cyan) MsInfo (CCoord,MB,Red,"Pick"); %continue {** Toggle Perspective and alter Box **} MenuCom(MPe) : Perspect = 1-Perspect; Text(MPe,2) = OO(Perspect) Box (MPe,Blue,Cyan); Update Grid (True) MsInfo (CCoord,MB,Red,"Pick"); %continue {** Toggle Shading and alter Box. Also**} {** set Hidden Line ON if Shading is On.} MenuCom(MSh) : ! %if APM Level = Level 15 %start Shading = 1-Shading; Text(MSh,2)=OO(Shading); Box (MSh,Blue,Cyan) %if Shading = On %start Hidden = On; Text(MHi,2) = OO(Hidden) Box (MHi,Red,Yellow) %finish ! %else ! Set Colour (Green) ! %for Offs = 0,512,512 %cycle ! At (135,3+Offs) ! Show String("No Shading on Level 1 APM") ! %repeat ! %finish MsInfo (CCoord,MB,Red,"Pick") %continue {** Alter Mesh Size **} MenuCom(MMe): Get Num(Mesh Size, 135, Scr+17,"Mesh Size (1-".ItoS(Max Mesh,0).")") %c %until 0 < Mesh Size <= Max Mesh Text(MMe,2) = ItoS(Mesh Size,0) Box(MMe,Blue,Cyan) Step Size = 1/Mesh Size Calc SM MsInfo (CCoord,MB,Red,"Pick") %continue {** Alter Rotate Angle **} MenuCom(MAn): Get Num(Angle,135,Scr+17,"Rotate Angle") %until |Angle| < 360 Rad = Angle * Pi / 180 Text(MAn,2) = ItoS(Angle,0); Box(MAn,Blue,Cyan) SinRad = Sin (Rad); CosRad = Cos(Rad) MsInfo (CCoord,MB,Red,"Pick") %continue MenuCom(MQu): MsInfo(CCoord,MB,Red,"Pick"); %exit {** Quit Program **} %finish %repeat %endofprogram