Rem TDK's Entry In The 3D Modeller DBPro Challenge Rem 14th November 2005 Gosub Setup Do Mx=MouseX(): My=MouseY(): Mc=MouseClick(): MMz=MouseMoveZ(): I$=Upper$(Inkey$()) MenuSelect$ = CheckMenu(DropDowns,0): Rem This checks for any action on the menu system If MenuSelect$ <> "" Entry = Asc(Left$(MenuSelect$,1))-64: Rem This extracts the dropdown which was used Item = Val(Right$(MenuSelect$,Len(MenuSelect$)-1)): Rem This extracts the selected item on the dropdown If Entry > 0 And Item > 0 Gosub Action: Rem This processes the results from the menu Endif Endif If SelectedMenu = 0 Then Gosub CheckMouse Loop Rem ******************** Procedures ******************** CheckMouse: Rem Camera Zoom (All Windows) Camzoom: If MMz > 0 Move Camera CurrentCam,30 Else If MMz < 0 Move Camera CurrentCam,-30 Endif Endif Rem Axis Buttons Set Text Transparent: Ink 0,0 ClickAxisButtons: If Mx>351 and My>23 and Mx<363 and My<38 and Mc=1: Rem Front X If FrontX = 0 FrontX = 1 Paste Image 1002,351,23: Text 355,25,"X" Else FrontX = 0 Paste Image 1001,351,23: Text 355,24,"X" Endif Repeat Until MouseClick()=0 Endif If Mx>366 and My>23 and Mx<378 and My<38 and Mc=1: Rem Front Y If FrontY = 0 FrontY = 1 Paste Image 1002,366,23: Text 370,25,"Y" Else FrontY = 0 Paste Image 1001,366,23: Text 370,24,"Y" Endif Repeat Until MouseClick()=0 Endif If Mx>381 and My>23 and Mx<393 and My<38 and Mc=1: Rem Front Z If FrontZ = 0 FrontZ = 1: FrontX = 1: FrontY = 1 Paste Image 1002,381,23: Text 385,25,"Z" Paste Image 1002,351,23: Text 355,25,"X" Paste Image 1002,366,23: Text 370,25,"Y" Else FrontZ = 0 Paste Image 1001,381,23: Text 385,24,"Z" Endif Repeat Until MouseClick()=0 Endif If Mx>751 and My>23 and Mx<763 and My<38 and Mc=1: Rem Right X If RightX = 0 RightX = 1 Paste Image 1002,751,23: Text 755,25,"X" Else RightX = 0 Paste Image 1001,751,23: Text 755,24,"X" Endif Repeat Until MouseClick()=0 Endif If Mx>766 and My>23 and Mx<778 and My<38 and Mc=1: Rem Right Y If RightY = 0 RightY = 1 Paste Image 1002,766,23: Text 770,25,"Y" Else RightY = 0 Paste Image 1001,766,23: Text 770,24,"Y" Endif Repeat Until MouseClick()=0 Endif If Mx>781 and My>23 and Mx<793 and My<38 and Mc=1: Rem Right Z If RightZ = 0 RightZ = 1 Paste Image 1002,781,23: Text 785,25,"Z" Else RightZ = 0 Paste Image 1001,781,23: Text 785,24,"Z" Endif Repeat Until MouseClick()=0 Endif If Mx>351 and My>313 and Mx<363 and My<328 and Mc=1: Rem Top X If TopX = 0 TopX = 1 Paste Image 1002,351,313: Text 355,315,"X" Else TopX = 0 Paste Image 1001,351,313: Text 355,314,"X" Endif Repeat Until MouseClick()=0 Endif If Mx>366 and My>313 and Mx<378 and My<328 and Mc=1: Rem Top Y If TopY = 0 TopY = 1 Paste Image 1002,366,313: Text 370,315,"Y" Else TopY = 0 Paste Image 1001,366,313: Text 370,314,"Y" Endif Repeat Until MouseClick()=0 Endif If Mx>381 and My>313 and Mx<393 and My<328 and Mc=1: Rem Top Z If TopZ = 0 TopZ = 1 Paste Image 1002,381,313: Text 385,315,"Z" Else TopZ = 0 Paste Image 1001,381,313: Text 385,314,"Z" Endif Repeat Until MouseClick()=0 Endif Rem Mode Buttons ClickModeButtons: If (Mx>533 and My>310 and Mx<574 and My<325 and Mc=1) or I$="M": Rem Move If MoveMode=0 MoveMode=1 ResizeMode=0 RotateMode=0 Paste Image 1004,533,310: Text 542,311,"Move" Paste Image 1003,577,310: Text 583,311,"Resize" Paste Image 1003,621,310: Text 626,311,"Rotate" Endif Endif If (Mx>577 and My>310 and Mx<618 and My<325 and Mc=1) or I$="S": Rem Resize If ResizeMode=0 MoveMode=0 ResizeMode=1 RotateMode=0 Paste Image 1003,533,310: Text 542,311,"Move" Paste Image 1004,577,310: Text 583,311,"Resize" Paste Image 1003,621,310: Text 626,311,"Rotate" Endif Endif If (Mx>621 and My>310 and Mx<662 and My<325 and Mc=1) or I$="R": Rem Rotate If RotateMode=0 MoveMode=0 ResizeMode=0 RotateMode=1 Paste Image 1003,533,310: Text 542,311,"Move" Paste Image 1003,577,310: Text 583,311,"Resize" Paste Image 1004,621,310: Text 626,311,"Rotate" Endif Endif Rem Colour Button If (Mx>665 and My>310 and Mx<691 and My<325 and Mc=1) or I$="C": Rem Colour If ObjSelected>0 Paste Image 1006,665,310 TS=Text size(): Tf$=TEXT FONT$() Set Text Font "Tahoma" Set Text Size 14 Set Camera View 1,0,0,1,1 Set Camera View 2,0,0,1,1 Set Camera View 3,0,0,1,1 Set Camera View 0,0,0,1,1 Get Image 2000,0,0,800,600,1 OldR=ObjData(ObjSelected,1) OldG=ObjData(ObjSelected,2) OldB=ObjData(ObjSelected,3) X=Screen Width()/2-100: Y=Screen Height()/2-130 Finished=0: Set Text Transparent W=200: H=260: C1=16777215: C2=12632256: C3=3618615 Ink C3,0: Box X,Y,X+W,Y+H Ink C1,0: Box X,Y,X+W-1,Y+H-1 Ink C2,0: Box X+1,Y+1,X+W-1,Y+H-1: Rem Panel Face Ink C1,0: Box X+5,Y+235,X+5+90,Y+253: Box X+105,Y+235,X+5+189,Y+253: Rem Black & White Ink C3,0: Box X+6,Y+236,X+96,Y+253: Box X+106,Y+236,X+195,Y+253 Ink C2,0: Box X+6,Y+236,X+6+89,Y+252 Box X+106,Y+236,X+6+188,Y+252 Ink C3,0: Box X+5,Y+210,X+5+190,Y+228 Ink C1,0: Box X+6,Y+211,X+5+190,Y+228 Ink RGB(ObjData(ObjSelected,1),ObjData(ObjSelected,2),ObjData(ObjSelected,3)),0 Box X+6,Y+211,X+100,Y+227: Rem Current Colour Ink 0,0: Box X+101,Y+211,X+194,Y+227: Rem New Colour Ink 0,0: Box X+5,Y+21,X+195,Y+200+5: Rem Colour Palette Box X+6,Y+22,X+194,Y+22+20, RGB(0,0,0), RGB(255,0,0), RGB(255,255,255), RGB(255,0,0) Box X+6,Y+22+20,X+194,Y+22+40, RGB(0,0,0), RGB(0,255,0), RGB(255,255,255), RGB(0,255,0) Box X+6,Y+22+40,X+194,Y+22+60, RGB(0,0,0), RGB(0,0,255), RGB(255,255,255), RGB(0,0,255) Box X+6,Y+22+60,X+194,Y+22+80, RGB(255,255,255), RGB(0,0,0), RGB(255,255,255), RGB(0,0,0) Box X+6,Y+22+80,X+194,Y+22+100, RGB(255,0,0), RGB(255,0,0), RGB(0,255,0), RGB(0,255,0) Box X+6,Y+22+100,X+194,Y+22+120,RGB(0,0,255), RGB(0,0,255), RGB(255,0,0), RGB(255,0,0) Box X+6,Y+22+120,X+194,Y+22+140,RGB(0,255,0), RGB(0,255,0), RGB(0,0,255), RGB(0,0,255) Box X+6,Y+22+140,X+194,Y+22+161,RGB(255,255,0), RGB(0,0,0), RGB(0,255,255), RGB(255,0,255) Box X+6,Y+22+161,X+194,Y+22+182,RGB(255,255,255), RGB(255,255,0),RGB(255,0,255), RGB(0,255,255) Ink RGB(255,255,255),0: Center Text X+100,Y+2,"Select Colour" Ink 0,0: Center Text X+100,Y+3,"Select Colour" Text X+44,Y+237,"OK" Text X+134,Y+237,"Cancel" Repeat Mx=MouseX(): My=MouseY(): Mc=MouseClick() If Mx>X+5 and Mx<X+195 and My>Y+21 and My<Y+206 Rem Over Palette NewCol = Point(Mx,My) R=RGBR(NewCol): G=RGBG(NewCol): B=RGBB(NewCol) Ink RGB(R,G,B),0: Box X+101,Y+211,X+194,Y+227: Rem Hover Colour Box If Mc=1 SelR=R: SelG=G: SelB=B Ink RGB(SelR,SelG,SelB),0: Box X+6,Y+211,X+100,Y+227 Color Object ObjSelected, RGB(SelR,SelG,SelB) Endif Endif If Mx>X+5 and Mx<X+96 and My>Y+236 and My<Y+253 and Mc=1 Rem OK ObjData(ObjSelected,1)=SelR ObjData(ObjSelected,2)=SelG ObjData(ObjSelected,3)=SelB rem Color Object ObjSelected,RGB(R,G,B) Finished=1 Endif If Mx>X+106 and Mx<X+195 and My>Y+236 and My<Y+253 and Mc=1 Rem Cancel ObjData(ObjSelected,1)=OldR ObjData(ObjSelected,2)=OldG ObjData(ObjSelected,3)=OldB Color Object ObjSelected, RGB(OldR,OldG,OldB) Finished=1 Endif Until Finished=1 Set Text Font Tf$ Set Text Size TS Paste Image 2000,0,0 Delete Image 2000 Set Camera View 1,6,42,393,303 Set Camera View 2,406,42,793,303 Set Camera View 3,6,332,393,593 Set Camera View 0,406,332,793,593 Repeat Until MouseClick()=0 Paste Image 1005,665,310 Endif Endif Rem Cam View Reset If Mx>779 and My>310 and Mx<703 and My<325 and Mc=1 Position Camera 0,0-CamDist,CamDist,0-CamDist Point Camera 0,0,0,0 Endif Rem 3D Screens ClickOn3DScreens: Set Text Opaque: Ink RGB(255,255,255),0 FrontView: If Mx>5 and My>41 and Mx<393 and My<303: Rem Front View If MouseClick() Then CurrentCam=1: SET CURRENT CAMERA CurrentCam: Hide Mouse If MouseClick() = 1 or MouseClick() = 3 If Pickmode = 0 ObjSelected = Pick object(Mousex(),Mousey(), 1, NumObjects) If ObjSelected > 0 Pickmode = 1 Vdist# = Get Pick Distance() VStartX# = Get Pick vector x() VStartY# = Get Pick vector y() VStartZ# = Get Pick vector z() objx# = Object position x(ObjSelected) objy# = Object position y(ObjSelected) objz# = Object position z(ObjSelected) Gosub HighlightObj Else Rem Clicked Off Object (Deselect it) If Object Exist(1000) Then Hide Object 1000 Pickmode = 0: ObjSelected = 0 Endif Endif If Pickmode = 1: Rem If Object is now selected If MoveMode=1 AllowX=FrontX: AllowY=FrontY: AllowZ=FrontZ Gosub MoveObject Endif If ResizeMode=1 AllowX=FrontX: AllowY=FrontY: AllowZ=FrontZ Gosub ResizeObject Endif If RotateMode=1 AllowX=FrontX: AllowY=FrontY: AllowZ=FrontZ Gosub RotateObject Endif Endif Endif If MouseClick() = 2 Gosub MoveCamView Endif Show Mouse Endif RightView: If Mx>405 and My>41 and Mx<793 and My<303: Rem Right View If MouseClick() Then CurrentCam=2: SET CURRENT CAMERA CurrentCam: Hide Mouse If MouseClick() = 1 If Pickmode = 0 ObjSelected = Pick object(Mousex(),Mousey(), 1, NumObjects) If ObjSelected > 0 Pickmode = 1 Vdist# = Get Pick Distance() VStartX# = Get Pick vector x() VStartY# = Get Pick vector y() VStartZ# = Get Pick vector z() objx# = Object position x(ObjSelected) objy# = Object position y(ObjSelected) objz# = Object position z(ObjSelected) Gosub HighlightObj Else Rem Clicked Off Object (Deselect it) If Object Exist(1000) Then Hide Object 1000 Pickmode = 0: ObjSelected = 0 Endif Endif If Pickmode = 1: Rem If Object is now selected If MoveMode=1 AllowX=RightZ: AllowY=RightY: AllowZ=RightX Gosub MoveObject Endif If ResizeMode=1 AllowX=RightZ: AllowY=RightY: AllowZ=RightX Gosub ResizeObject Endif If RotateMode=1 AllowX=RightZ: AllowY=RightY: AllowZ=RightX Gosub RotateObject Endif Endif Endif If MouseClick() = 2 Gosub MoveCamView Endif Show Mouse Endif TopView: If Mx>5 and My>331 and Mx<393 and My<593: Rem Top View If MouseClick() Then CurrentCam=3: SET CURRENT CAMERA CurrentCam: Hide Mouse If MouseClick() = 1 If Pickmode = 0 ObjSelected = Pick object(Mousex(),Mousey(), 1, NumObjects) If ObjSelected > 0 Pickmode = 1 Vdist# = Get Pick Distance() VStartX# = Get Pick vector x() VStartY# = Get Pick vector y() VStartZ# = Get Pick vector z() objx# = Object position x(ObjSelected) objy# = Object position y(ObjSelected) objz# = Object position z(ObjSelected) Gosub HighlightObj Else Rem Clicked Off Object (Deselect it) If Object Exist(1000) Then Hide Object 1000 Pickmode = 0: ObjSelected = 0 Endif Endif If Pickmode = 1: Rem If Object is now selected If MoveMode=1 AllowX=TopX: AllowY=0: AllowZ=TopY Gosub MoveObject Endif If ResizeMode=1 AllowX=TopX: AllowY=0: AllowZ=TopY Gosub ResizeObject Endif If RotateMode=1 AllowX=TopX: AllowY=0: AllowZ=TopY Gosub RotateObject Endif Endif Endif If MouseClick() = 2 Gosub MoveCamView Endif Show Mouse Endif CamView: If Mx>405 and My>331 and Mx<793 and My<593: Rem Camera View If MouseClick()=2 and ObjSelected = 0 Rem Rotate Camera CX#=CAMERA ANGLE X(): CY#=CAMERA ANGLE Y(): CZ#=CAMERA ANGLE Z() MMx=mousemovex(): MMy=mousemovey(): Hide Mouse Repeat CX#=Wrapvalue(CX#+mousemovey()*3) CY#=Wrapvalue(CY#+mousemovex()*3) Rotate Camera 0,CX#,CY#,CZ# Until MouseClick()=0 Show Mouse Endif If MouseClick() > 0 CurrentCam=0: SET CURRENT CAMERA CurrentCam: Hide Mouse If Pickmode = 0 ObjSelected = Pick object(Mousex(),Mousey(), 1, NumObjects) If ObjSelected > 0 Pickmode = 1 Vdist# = Get Pick Distance() VStartX# = Get Pick vector x() VStartY# = Get Pick vector y() VStartZ# = Get Pick vector z() objx# = Object position x(ObjSelected) objy# = Object position y(ObjSelected) objz# = Object position z(ObjSelected) Gosub HighlightObj Else Rem Clicked Off Object (Deselect it) If Object Exist(1000) Then Hide Object 1000 Pickmode = 0: ObjSelected = 0 Endif Endif If Pickmode = 1: Rem If Object is now selected If MoveMode=1 AllowX=(MouseClick()=1): AllowY=(MouseClick()=2): AllowZ=(MouseClick()=1) Gosub MoveObject Endif If ResizeMode=1 If MouseClick()=1 AllowX=1: AllowY=0: AllowZ=1 Endif If MouseClick()=2 AllowX=0: AllowY=1: AllowZ=0 Endif If MouseClick()=3 AllowX=1: AllowY=1: AllowZ=1 Endif Gosub ResizeObject Endif If RotateMode=1 AllowX=(MouseClick()=1): AllowY=(MouseClick()=2): AllowZ=(MouseClick()=1) Gosub RotateObject Endif Else If MouseClick() = 2 Gosub MoveCamView Endif Endif Endif Show Mouse Endif Return HighlightObj: If Object Exist(ObjSelected) If Object Exist(1000) Then Delete Object 1000 Make Object Box 1000,OBJECT SIZE X(ObjSelected)+6,OBJECT SIZE Y(ObjSelected)+6,OBJECT SIZE Z(ObjSelected)+6 Position Object 1000,objx#,objy#,objz# Rotate Object 1000,Object Angle X(ObjSelected),Object Angle Y(ObjSelected),Object Angle Z(ObjSelected) Color Object 1000,RGB(255,255,255) Set Object Wireframe 1000,1 Show Object 1000 Endif Return DisplayXYZ: Rem Object Position update IntPartX = Int(DispX#) IPX$ = Str$(IntPartX): Neg=0 If IntPartX < 0 Then IPX$ = Right$(IPX$,Len(IPX$)-1): Neg=1 While Len(IPX$) < 4 - Neg IPX$ = "0"+IPX$ EndWhile If Neg=1 Then IPX$ = "-"+IPX$ DecPartX# = DispX#-IntPartX: DPX$ = Left$(Str$(ABS(DecPartX#)),3) If Len(DPX$)<4 Then DPX$=DPX$+"0" If DispX# = 0.0 XLoc$="00000.00" Else XLoc$=IPX$+DPX$ Endif IntPartY = Int(DispY#): IPY$ = Str$(IntPartY): Neg=0 If IntPartY<0 IPY$ = Right$(IPY$,Len(IPY$)-1): Neg=1 Endif While Len(IPY$)<4-Neg IPY$ = "0"+IPY$ EndWhile If Neg=1 Then IPY$ = "-"+IPY$ DecPartY# = DispY#-IntPartY: DPY$ = Left$(Str$(ABS(DecPartY#)),3) If Len(DPY$)<4 Then DPY$=DPY$+"0" If DispY# = 0.0 YLoc$="00000.00" Else YLoc$=IPY$+DPY$ Endif IntPartZ = Int(DispZ#): IPZ$ = Str$(IntPartZ): Neg=0 If IntPartZ<0 IPZ$ = Right$(IPZ$,Len(IPZ$)-1): Neg=1 Endif While Len(IPZ$)<4-Neg IPZ$ = "0"+IPZ$ EndWhile If Neg=1 Then IPZ$ = "-"+IPZ$ DecPartZ# = DispZ#-IntPartZ: DPZ$ = Left$(Str$(ABS(DecPartZ#)),3) If Len(DPZ$)<4 Then DPZ$=DPZ$+"0" If DispZ# = 0.0 ZLoc$="00000.00" Else ZLoc$=IPZ$+DPZ$ Endif Ink 0,0 Box 556,24,609,38: Box 622,24,675,38: Box 688,24,741,38 Ink RGB(255,255,255),0 Text 559,24,XLoc$: Text 625,24,YLoc$: Text 691,24,ZLoc$ Return Action: If Entry=1: Rem Entry is the number of the dropdown menu the item was chosen off (Max 20) Select Item Case 1 For N = 1 To NumObjects If Object Exist(N) Then Delete Object N Next N If Object Exist(1000) Then Delete Object 1000 FName$="" NumObjects = 0 Ink 0,RGB(200,200,200) Paste Image 32,0,0 Text 800-Text Width("[New Scene] "),2,"[New Scene]" Entry=0: Chosen$ = "": Itm=0 EndCase Case 3: Rem Load .TOG File For N = 1 To NumObjects If Object Exist(N) Then Delete Object N Next N If Object Exist(1000) Then Delete Object 1000 NumObjects = 0: FileMode=0: Gosub FileSelect If FName$<>"" Then Gosub LoadFile Ink 0,RGB(200,200,200) Paste Image 32,0,0 Text 800-Text Width("["+FName$+"] "),2,"["+FName$+"]" Entry=0: Chosen$ = "": Itm=0 EndCase Case 4: Rem Save File If FName$="" FileMode=1: Gosub FileSelect Gosub SaveFile Else Gosub SaveFile Endif Ink 0,RGB(200,200,200) Paste Image 32,0,0 Text 800-Text Width("["+FName$+"] "),2,"["+FName$+"]" Entry=0: Chosen$ = "": Itm=0 EndCase Case 5: Rem Save As FileMode=1: Gosub FileSelect If FName$<>"" Then Gosub SaveFile Ink 0,RGB(200,200,200) Paste Image 32,0,0 Text 800-Text Width("["+FName$+"] "),2,"["+FName$+"]" Entry=0: Chosen$ = "": Itm=0 EndCase Case 7: Rem Load Texture FileMode=2: Gosub FileSelect Gosub LoadTexture Entry=0: Chosen$ = "": Itm=0 EndCase Case 8: Rem Remove Texture Entry=0: Chosen$ = "": Itm=0 EndCase Case 10: Rem Exit End EndCase EndSelect Endif rem Menu$(2)="Solid Objects|Wireframe Objects|-|Show Floor|Hide Floor" If Entry=2: Rem The Option menu Select Item Case 1: Rem Solid Objects ObWireView=1 For N = 1 To NumObjects If Object Exist(N) SET OBJECT WIREFRAME N, 0 Endif Next N Entry=0: Chosen$ = "": Itm=0 EndCase Case 2: Rem Wireframe Objects ObWireView=0 For N = 1 To NumObjects If Object Exist(N) SET OBJECT WIREFRAME N, 1 Endif Next N Entry=0: Chosen$ = "": Itm=0 EndCase Case 4: Rem Show Floor If Matrix Exist(1) = 0 Make Matrix 1,MatWidth,MatHeight,TileWidth,TileHeight Prepare Matrix Texture 1,1000,2,2 Tnum=1 For Nz=0 To TileWidth-1 For Nx=0 To TileHeight-1 Set Matrix Tile 1,Nx,Nz,Tnum Inc Tnum: If Tnum=3 Then Tnum=1 Next Nx Next Nz Position Matrix 1,0-MatWidth/2,0,0-MatHeight/2 Update Matrix 1 Endif Entry=0: Chosen$ = "": Itm=0 EndCase Case 5: Rem Hide Floor If Matrix Exist(1) = 1 Then Delete Matrix 1 Entry=0: Chosen$ = "": Itm=0 EndCase Case 7: Rem Duplicate Object Inc NumObjects Clone Object NumObjects, ObjSelected Position Object NumObjects,0,Object Position Y(ObjSelected),0 Rotate Object NumObjects,Object Angle X(ObjSelected),Object Angle Y(ObjSelected),Object Angle Z(ObjSelected) Scale Object NumObjects,ObjData(ObjSelected,4),ObjData(ObjSelected,5),ObjData(ObjSelected,6) SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 ObjData(NumObjects,0)=ObjData(ObjSelected,0) ObjData(NumObjects,1)=ObjData(ObjSelected,1) ObjData(NumObjects,2)=ObjData(ObjSelected,2) ObjData(NumObjects,3)=ObjData(ObjSelected,3) ObjData(NumObjects,4)=ObjData(ObjSelected,4) ObjData(NumObjects,5)=ObjData(ObjSelected,5) ObjData(NumObjects,6)=ObjData(ObjSelected,6) ObjData(NumObjects,7)=ObjData(ObjSelected,7) objx#=0: objy#=0: objz#=0 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 8: Rem Delete Object Entry=0: Chosen$ = "": Itm=0 EndCase EndSelect Endif rem Menu$(3)="Cube|Box|Sphere|Cylinder|Cone|Plain|Triangle|-|Load .X Model|-|Delete Object|Centre Object" If Entry=3: Rem The third dropdown menu (Add Primitive) Select Item Case 1: Rem Cube Inc NumObjects Make Object Cube NumObjects,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 Rem Default Attributes ObjData(NumObjects,0)=0 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 2: Rem Box Inc NumObjects Make Object Box NumObjects,50,50,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=1 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 3: Rem Sphere Inc NumObjects Make Object Sphere NumObjects,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=2 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 4: Rem Cylinder Inc NumObjects Make Object Cylinder NumObjects,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=3 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 5: Rem Cone Inc NumObjects Make Object Cone NumObjects,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=4 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 6: Rem Plain Inc NumObjects Make Object Plain NumObjects,50,50 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=5 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 7: Rem Triangle Inc NumObjects Make Object Triangle NumObjects,-25,-25,0, 0,25,0, 25,-25,0 Position Object NumObjects,0,0,0 Color Object NumObjects,RGB(0,255,255) objx#=0: objy#=0: objz#=0 ObjData(NumObjects,0)=6 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 9: Rem .X File FileMode=3: Gosub FileSelect If FName$<>"" Inc NumObjects Load Object FName$,NumObjects Position Object NumObjects,0,0,0 objx#=0: objy#=0: objz#=0 Rem Default Attributes ObjData(NumObjects,0)=7 ObjData(NumObjects,1)=0 ObjData(NumObjects,2)=255 ObjData(NumObjects,3)=255 ObjData(NumObjects,4)=100 ObjData(NumObjects,5)=100 ObjData(NumObjects,6)=100 ObjData(NumObjects,7)=0 SET OBJECT NumObjects,ObWireView,1,1,0,1,0,1 Endif Entry=0: Chosen$ = "": Itm=0: ObjSelected=NumObjects Gosub HighlightObj EndCase Case 11: Rem Centre Object If ObjSelected > 0 Position Object ObjSelected,0,0,0 If Object Exist(1000) Then Position Object 1000,0,0,0 DispX#=0: DispY#=0: DispZ#=0 Gosub DisplayXYZ Sync Endif Entry=0: Chosen$ = "": Itm=0 EndCase EndSelect Endif If Entry=4: Rem The fourth dropdown menu Select Item Case 1: Rem About Entry=0: Chosen$ = "": Itm=0 EndCase Case 3: Rem Program Help Entry=0: Chosen$ = "": Itm=0 EndCase Case 4: Rem Link To My Web Site Entry=0: Chosen$ = "": Itm=0 EndCase EndSelect Endif Return SaveFile: If File Exist(FName$) Then Delete File FName$ Open To Write 1,FName$ Write String 1,"TDK3D Object Group File V0.1" Write String 1,Str$(NumObjects) For N=1 To NumObjects Rem 0=Shape 123=Colour RGB 456=Scale 7=Texture Flag For N2=0 To 7 Write String 1,Str$(ObjData(N,N2)) Next N2 Write String 1,Str$(Object Position X(N)) Write String 1,Str$(Object Position Y(N)) Write String 1,Str$(Object Position Z(N)) Write String 1,Str$(Object Angle X(N)) Write String 1,Str$(Object Angle Y(N)) Write String 1,Str$(Object Angle Z(N)) Write String 1,TextureName$(N) Next N Close File 1 Return LoadFile: Open To Read 1,FName$ Read String 1,Temp$: Rem Discard Header Read String 1,Temp$: NumObjects=VAL(Temp$) For N=1 To NumObjects For N2=0 To 7 Read String 1,Temp$: ObjData(N,N2)=VAL(Temp$) Next N2 Select ObjData(N,0) Case 0 Make Object Cube N,50 EndCase Case 1 Make Object Box N,50,50,50 EndCase Case 2 Make Object Sphere N,50 EndCase Case 3 Make Object Cylinder N,50 EndCase Case 4 Make Object Cone N,50 EndCase Case 5 Make Object Plain N,50,50 EndCase Case 6 Make Object Triangle N,-25,-25,0, 0,25,0, 25,-25,0 EndCase EndSelect Color Object N,RGB(ObjData(N,1),ObjData(N,2),ObjData(N,3)) Scale Object N,ObjData(N,4),ObjData(N,5),ObjData(N,6) Read String 1,Temp$: XVal#=VAL(Temp$) Read String 1,Temp$: YVal#=VAL(Temp$) Read String 1,Temp$: ZVal#=VAL(Temp$) Position Object N,XVal#,YVal#,ZVal# Read String 1,Temp$: XVal#=VAL(Temp$) Read String 1,Temp$: YVal#=VAL(Temp$) Read String 1,Temp$: ZVal#=VAL(Temp$) Rotate Object N,XVal#,YVal#,ZVal# Read String 1,Temp$: TextureName$(N)=Temp$ If ObjData(N,7) =1 Rem Texture Object With TextureName$(N) Endif Next N Close File 1 Return ResizeObject: Startx=MouseX(): Starty=MouseY() Dx = OldDx Dy = OldDy Dz = OldDz If Object Exist(1000) Then Delete Object 1000 Repeat Mx=MouseX(): My=MouseY() rem Dx = (Mx-OldMx)*AllowX: If AllowX = 0 Then Dx = 0 rem Dy = (OldMy-My)*AllowY: If AllowY = 0 Then Dy = 0 rem Dz = (OldMy-My)*AllowZ: If AllowZ = 0 Then Dz = 0 If MouseX()<>StartX or MouseY()<>StartY If MouseClick()=1 Dx = OldDx + (Mx-Startx) Dy = OldDy Dz = OldDz + (My-Starty) Endif If MouseClick()=2 Dx = OldDx Dy = OldDy + (Starty-My) Dz = OldDz Endif If MouseClick()=3 Dx = OldDx + (Mx-Startx) Dy = OldDx + (Mx-Startx) Dz = OldDx + (Mx-Startx) Endif Endif NewSizeX# = 100+Dx*10: If NewSizeX# < 1 Then NewSizeX# = 1 NewSizeY# = 100+Dy*10: If NewSizeY# < 1 Then NewSizeY# = 1 NewSizeZ# = 100+Dz*10: If NewSizeZ# < 1 Then NewSizeZ# = 1 Scale Object ObjSelected,NewSizeX#,NewSizeY#,NewSizeZ# ObjData(ObjSelected,4)=NewSizeX# ObjData(ObjSelected,5)=NewSizeY# ObjData(ObjSelected,6)=NewSizeZ# Sync Until MouseClick()=0 OldDx=Dx: OldDy=Dy: OldDz=Dz Gosub HighlightObj Pickmode = 0 Return MoveObject: If Object Exist(1000) Then Hide Object 1000 Repeat If Pickmode = 1 Pick Screen Mousex(),Mousey(),Vdist# VEndX# = Get Pick vector x() VEndY# = Get Pick vector y() VEndZ# = Get Pick vector z() Diffx# = (VEndX#-VStartX#)*AllowX Diffy# = (VEndY#-VStartY#)*AllowY Diffz# = (VEndZ#-VStartZ#)*AllowZ Position Object ObjSelected, objx#+Diffx#, objy#+Diffy#, objz#+Diffz# Position Object 1000,objx#+Diffx#, objy#+Diffy#, objz#+Diffz# DispX#=Object Position X(ObjSelected): DispY#=Object Position Y(ObjSelected): DispZ#=Object Position Z(ObjSelected) Gosub DisplayXYZ Sync Endif Until MouseClick()=0 If Object Exist(1000) Then Show Object 1000 Pickmode = 0 Return RotateObject: OldMx=MouseX(): OldMy=MouseY() rem If Object Exist(1000) Then Hide Object 1000 Repeat Mx=MouseX(): My=MouseY() Rem Dx = (Mx-OldMx)*AllowX Rem Dy = (OldMy-My)*AllowY Rem Dz = (Mx-OldMx)*AllowZ Select CurrentCam Case 0 EndCase Case 1 Dy = (Mx-OldMx)*AllowY Dx = (OldMy-My)*AllowX Rotate Object ObjSelected,WrapValue(Object Angle X(ObjSelected)+Dx),WrapValue(Object Angle Y(ObjSelected)+Dy),Object Angle Z(ObjSelected) Rotate Object 1000,WrapValue(Object Angle X(ObjSelected)+Dx),WrapValue(Object Angle Y(ObjSelected)+Dy),Object Angle Z(ObjSelected) EndCase Case 2 Dx = (OldMy-My)*AllowX Dy = (Mx-OldMx)*AllowY Rotate Object ObjSelected,WrapValue(Object Angle X(ObjSelected)+Dy),WrapValue(Object Angle Y(ObjSelected)+Dx),Object Angle Z(ObjSelected) Rotate Object 1000,WrapValue(Object Angle X(ObjSelected)+Dx),WrapValue(Object Angle Y(ObjSelected)+Dy),Object Angle Z(ObjSelected) EndCase Case 3 Dx = (OldMy-My)*AllowX Dy = (Mx-OldMx)*AllowY Rotate Object ObjSelected,WrapValue(Object Angle X(ObjSelected)+Dy),WrapValue(Object Angle Y(ObjSelected)+Dx),Object Angle Z(ObjSelected) Rotate Object 1000,WrapValue(Object Angle X(ObjSelected)+Dx),WrapValue(Object Angle Y(ObjSelected)+Dy),Object Angle Z(ObjSelected) EndCase EndSelect Sync OldMx=Mx: OldMy=My Until MouseClick()=0 rem If Object Exist(1000) Then Show Object 1000 Pickmode = 0 Return MoveCamView: OldMx=MouseX(): OldMy=MouseY() Repeat Mx=MouseX(): My=MouseY() Dx = (Mx-OldMx)*10 Dy = (OldMy-My)*10 Select CurrentCam Case 0 EndCase Case 1 Position Camera CurrentCam,Camera Position X(CurrentCam)+Dx,Camera Position Y(CurrentCam)+Dy,Camera Position Z(CurrentCam) EndCase Case 2 Position Camera CurrentCam,Camera Position X(CurrentCam),Camera Position Y(CurrentCam)+Dy,Camera Position Z(CurrentCam)+Dx EndCase Case 3 Position Camera CurrentCam,Camera Position X(CurrentCam)+Dx,Camera Position Y(CurrentCam),Camera Position Z(CurrentCam)+Dy EndCase EndSelect Sync OldMx=Mx: OldMy=My Until MouseClick()=0 Return Setup: Set Display Mode 800,600,32 SW=Screen Width() Set Text Opaque Sync Rate 0 CLS RGB(127,151,175): Rem Clear screen to required colour Global DropDowns as integer DropDowns=4: Rem Number of entries on the menu bar Dim ActMenu$(DropDowns) Dim EntryPosX(DropDowns+1) Dim DropEntry$(DropDowns,20): Rem Max 20 Entries Per Dropdown Dim DropMenuCount(DropDowns) Dim Menu$(DropDowns) Dim BoxWid(DropDowns) Dim BoxHig(DropDowns) Dim Key$(DropDowns,20) Dim HDFiles$(1000,1) Dim ObjData(1000,10) Dim TextureName$(1000) Global SelectedMenu as integer Global OverEntry as integer Global SE as integer Global TH as integer Global Top as integer Global MenuItemNum as integer Global Itm as integer Global Itm2 as integer Global MenuChar$ as String Menu$(0)="File|Options|Objects|Help" Menu$(1)="New Scene|-|Load File|Save File|Save File As|-|Load Texture|Remove Texture|-|Exit" Menu$(2)="Solid Objects|Wireframe Objects|-|Show Floor|Hide Floor|-|Duplicate Object|Delete Object" Menu$(3)="Cube|Box|Sphere|Cylinder|Cone|Plain|Triangle|-|Load .X Model|-|Centre Object" Menu$(4)="About...|-|Program Help|TDK's Web Site" FrontX=0: FrontY=0: FrontZ=0 RightX=0: RightY=0: RightZ=0 TopX=0: TopY=0: TopZ=0 CamDist = 500: NumObjects = 0 MatWidth = 5000: MatHeight = 5000 TileWidth = 51: TileHeight = 51 MoveMode=1: ResizeMode=0: RotateMode=0: ObWireView=1 Rem Create Media Create Bitmap 1,800,600 CLS 0 Rem Matrix Textures Ink RGB(255,255,255),0: Box 128,0,256,128 Ink RGB(170,170,170),0: Box 0,0,128,128 Get Image 1000,0,0,256,256,1 CLS 0 Rem Small Buttons Ink RGB(239,235,255),0: Box 0,0,13,16: Rem XYZ Button Up (1001) Ink RGB(82,81,99),0: Box 1,1,13,16 Ink RGB(127,151,175),0: Box 1,1,12,15 Get Image 1001,0,0,13,16,1 Ink RGB(64,64,64),0: Box 0,0,13,16: Rem XYZ Button Down (1002) Ink RGB(255,255,255),0: Box 1,1,13,16 Ink RGB(127,151,175),0: Box 1,1,12,15 Get Image 1002,0,0,13,16,1 Rem Large Buttons CLS 0 Ink RGB(239,235,255),0: Box 0,0,42,16: Rem Large Button Up (1003) Ink RGB(82,81,99),0: Box 1,1,42,16 Ink RGB(127,151,175),0: Box 1,1,41,15 Get Image 1003,0,0,42,16,1 Ink RGB(64,64,64),0: Box 0,0,42,16: Rem Large Button Down (1004) Ink RGB(255,255,255),0: Box 1,1,42,16 Ink RGB(127,151,175),0: Box 1,1,41,15 Get Image 1004,0,0,42,16,1 Ink RGB(239,235,255),0: Box 665,310,692,326: Rem Colour Button Up Ink RGB(82,81,99),0: Box 666,311,692,326 Ink RGB(127,151,175),0: Box 666,311,691,325 Ink RGB(255,0,0),0: Box 668,314,675,322 Ink RGB(0,255,0),0: Box 675,314,682,322 Ink RGB(0,0,255),0: Box 682,314,689,322 Get Image 1005,665,310,692,326,1 Ink RGB(82,81,99),0: Box 665,310,692,326: Rem Colour Button Down Ink RGB(239,235,255),0: Box 666,311,692,326 Ink RGB(127,151,175),0: Box 666,311,691,325 Ink RGB(255,0,0),0: Box 668,314,675,322 Ink RGB(0,255,0),0: Box 675,314,682,322 Ink RGB(0,0,255),0: Box 682,314,689,322 Get Image 1006,665,310,692,326,1 Delete Bitmap 1 Rem Initialise The Matrix Make Matrix 1,MatWidth,MatHeight,TileWidth,TileHeight Prepare Matrix Texture 1,1000,2,2 Tnum=1 For Nz=0 To TileWidth-1 For Nx=0 To TileHeight-1 Set Matrix Tile 1,Nx,Nz,Tnum Inc Tnum: If Tnum=3 Then Tnum=1 Next Nx Next Nz Position Matrix 1,0-MatWidth/2,0,0-MatHeight/2 Update Matrix 1 Rem Create Screen Ink RGB(82,82,102),0 Box 5,41,394,304: Rem Front Box 405,41,794,304: Rem Right Box 5,331,394,594: Rem Top Box 405,331,794,594: Rem Camera Ink RGB(235,235,255),0 Box 6,42,394,304: Rem Front Box 406,42,794,304: Rem Right Box 6,332,394,594: Rem Top Box 406,332,794,594: Rem Camera Ink RGB(147,171,195),0 Box 6,42,393,303: Rem Front Box 406,42,793,303: Rem Right Box 6,332,393,593: Rem Top Box 406,332,793,593: Rem Camera Set Text Transparent Set Text Font "Tahoma" Set Text Size 13 Ink RGB(255,255,255),0 Text 5,27,"Front View" Text 405,27,"Right View" Text 5,317,"Top View" Text 405,317,"Camera View" Ink 0,0 Text 6,26,"Front View" Text 406,26,"Right View" Text 6,316,"Top View" Text 406,316,"Camera View" Text 547,24,"X" Text 613,24,"Y" Text 679,24,"Z" Rem Axis Buttons Paste Image 1001,351,23: Text 355,24,"X" Paste Image 1001,366,23: Text 370,24,"Y" Paste Image 1001,381,23: Text 385,24,"Z" Paste Image 1001,751,23: Text 755,24,"X" Paste Image 1001,766,23: Text 770,24,"Y" Paste Image 1001,781,23: Text 785,24,"Z" Paste Image 1001,351,313: Text 355,314,"X" Paste Image 1001,366,313: Text 370,314,"Y" Paste Image 1001,381,313: Text 385,314,"Z" Rem Mode Buttons Paste Image 1004,533,310: Text 542,311,"Move" Paste Image 1003,577,310: Text 583,311,"Resize" Paste Image 1003,621,310: Text 626,311,"Rotate" Rem Colour Button Paste Image 1005,665,310 Rem Reset Camera Button Ink RGB(239,235,255),0: Box 779,310,793,326 Ink RGB(82,81,99),0: Box 780,311,793,326 Ink RGB(127,151,175),0: Box 780,311,792,325 Ink 0,0: Text 784,311,"R" Rem Object X, Y, Z Ink RGB(64,64,64),0 Box 555,23,610,39 Box 621,23,676,39 Box 687,23,742,39 Ink RGB(255,255,255),0 Box 556,24,610,39 Box 622,24,676,39 Box 688,24,742,39 Ink 0,0 Box 556,24,609,38 Box 622,24,675,38 Box 688,24,741,38 Set Text Opaque Ink RGB(255,255,255),0 Text 559,24,"00000.00" Text 625,24,"00000.00" Text 691,24,"00000.00" Rem Initialise The Camera System Backdrop On AutoCam Off Position Light 0,0,500000,0 Rem Front View Camera (1) Make Camera 1 Color Backdrop 1,0 Position Camera 1,0,0.003,0-CamDist Rotate Camera 1,0,0,0 Set Camera Range 1,1.0,20000.0 Set Camera View 1,6,42,393,303 Rem Right View Camera (2) Make Camera 2 Color Backdrop 2,0 Position Camera 2,CamDist,0.003,0 Turn Camera Left 2,-270 Set Camera Range 2,1.0,20000.0 Set Camera View 2,406,42,793,303 Rem Top View Camera (3) Make Camera 3 Color Backdrop 3,0 Position Camera 3,0,CamDist,0 Rotate Camera 3,90,0,0 Set Camera Range 3,1.0,20000.0 Set Camera View 3,6,332,393,593 Rem Camera View Camera (0) Color Backdrop 0,0 Position Camera 0,0-CamDist,CamDist,0-CamDist Point Camera 0,0,0,0 Set Camera Range 0,1.0,20000.0 Set Camera View 0,406,332,793,593 Sync Make Object Box 1000,50,50,50 Color Object 1000,RGB(255,255,0) Set Object Wireframe 1000,1 Position Object 1000,0,0,0 If Object Exist(1000) Then Hide Object 1000 Rem Initialise The Menu System InitMenuSystem(4,"Tahoma",16,10,0,1): Rem This sets up the menu system and creates all the menus TitleBar("TDK's 3D Modeller",0): Rem this add the tile and the date Set Text Font "Tahoma" Set Text Size 13 Ink 0,RGB(200,200,200) Get Image 32,0,0,SW-1,20,1 Text 800-Text Width("[New Scene] "),2,"[New Scene]" Return FileSelect: Set Camera View 1,0,0,1,1 Set Camera View 2,0,0,1,1 Set Camera View 3,0,0,1,1 Set Camera View 0,0,0,1,1 Get Image 2000,0,0,800,600,1 TS=Text size(): Tf$=TEXT FONT$() Set Text Font "Tahoma" Set Text Size 14 X=Screen Width()/2-100: Y=Screen Height()/2-130 FName$="": Finished=0: Offset=0: Set Text Transparent W=200: H=260: C1=16777215: C2=12632256: C3=3618615 Ink C3,0: Box X,Y,X+W,Y+H Ink C1,0: Box X,Y,X+W-1,Y+H-1 Ink C2,0: Box X+1,Y+1,X+W-1,Y+H-1 Ink C1,0: Box X+5,Y+235,X+5+90,Y+253:Box X+105,Y+235,X+5+189,Y+253 Ink C3,0: Box X+6,Y+236,X+96,Y+253:Box X+106,Y+236,X+195,Y+253 Ink C2,0: Box X+6,Y+236,X+6+89,Y+252:Box X+106,Y+236,X+6+188,Y+252 Ink C3,0: Box X+5,Y+210,X+5+190,Y+228 Ink C1,0: Box X+6,Y+211,X+5+190,Y+228 Ink 0,0: Box X+6,Y+211,X+5+189,Y+227 If FileMode=0 Ink C1,0: Center Text X+100,Y+2,"Load File" Ink 0,0: Center Text X+101,Y+1,"Load File" Ext$=".TOG" Endif If FileMode=1 Ink C1,0: Center Text X+100,Y+2,"Save File" Ink 0,0: Center Text X+101,Y+1,"Save File" Ext$=".TOG" Endif If FileMode=2 Ink C1,0: Center Text X+100,Y+2,"Load Texture" Ink 0,0: Center Text X+101,Y+1,"Load Texture" Ext$=".BMP" Endif If FileMode=3 Ink C1,0: Center Text X+100,Y+2,"Load .X File" Ink 0,0: Center Text X+101,Y+1,"Load .X File" Ext$=".X" Endif Text X+44,Y+237,"OK" Text X+134,Y+237,"Cancel" Set Text Opaque Gosub Scan Repeat Mx=MouseX(): My=MouseY(): OldMz=Mz: Mz=MouseMoveZ(): Mc=MouseClick() If Mx>=X+6 and Mx<=X+5+189 and My>=Y+211 and My<=Y+227 and Mc=1 Rem Clicked On Filename box for saving Ink 0,0: Box X+6,Y+211,X+5+189,Y+227 Ink C1,0: Set Cursor X+6,Y+211: Print ">": Set Cursor X+6,Y+211: Input FName$ If Upper$(Right$(FName$,4))<>".TOG" Then FName$=FName$+".TOG" Endif If My>Y+21 and My<Y+206 and Mc=1 Rem Selected Filename of Dir on list OF=(My-Y-21)/16+1 If OF<=EList Then OverFile=OF If HDFiles$(OverFile,1)="0" If OverFile <= 11 Ink 0,0: Box X+6,Y+211,X+5+189,Y+227 Ink C1,0: Text X+6,Y+211,HDFiles$(OverFile+Offset,0) FName$=HDFiles$(OverFile+Offset,0) Endif Else CD HDFiles$(OverFile,0) Gosub Scan Endif Endif If Mx>X+5 and Mx<X+96 and My>Y+236 and My<Y+253 and Mc=1 Rem OK Button If FName$="" FName$ = HDFiles$(OverFile+Offset,0): Finished=1 Else Finished=1 Endif Endif If Mx>X+106 and Mx<X+195 and My>Y+236 and My<Y+253 and Mc=1 Rem Cancel Button FName$="": Finished=1 Endif If OldMz<>Mz If Mz>OldMz If Offset>0 Dec Offset Endif Endif If Mz<OldMz If Offset+11<FNum Then Inc Offset Endif Gosub UpdateList Endif Sync Until Finished=1 Set Text Font Tf$ Set Text Size TS Paste Image 2000,0,0 Delete Image 2000 Set Camera View 1,6,42,393,303 Set Camera View 2,406,42,793,303 Set Camera View 3,6,332,393,593 Set Camera View 0,406,332,793,593 Repeat Until MouseClick()=0 Return Scan: Perform Checklist For Files Fnum=Checklist Quantity() Offset=0 FileCounter=0 For N=1 To Fnum If FileMode=3 If Upper$(Right$(CheckList String$(N),2))=Ext$ or CHECKLIST VALUE A(N)=1 Inc FileCounter HDFiles$(FileCounter,0)=CheckList String$(N) HDFiles$(FileCounter,1)=Str$(CHECKLIST VALUE A(N)) Endif Else If Upper$(Right$(CheckList String$(N),4))=Ext$ or CHECKLIST VALUE A(N)=1 Inc FileCounter HDFiles$(FileCounter,0)=CheckList String$(N) HDFiles$(FileCounter,1)=Str$(CHECKLIST VALUE A(N)) Endif Endif Next N If FileCounter<=11 EList=FileCounter Else EList=11 Endif Gosub UpdateList Repeat Until MouseClick()=0 Return UpdateList: Ink 0,0: Box X+5,Y+21,X+5+190,Y+200+5: Rem Blank files area For N=0 To EList-1 D$=HDFiles$(N+Offset+1,0) If Len(D$)>20 D$=Left$(D$,20) Endif If HDFiles$(N+1+Offset,1)="0" Ink RGB(255,255,255),0 Text X+5,N*16+Y+21,D$ Else Ink RGB(255,255,0),0 Text X+5,N*16+Y+21,"<Dir> "+D$ Endif Next N Sync Return LoadTexture: Return LoadModel: Return Rem ******************** Functions ******************** Function CheckMenu(DropDowns,LineY) SW=Screen Width(): Mx=MouseX(): My=MouseY(): Mc=MouseClick(): I$=Upper$(Inkey$()) Chosen$="": TH=TEXT HEIGHT("XXXX")+2 Rem Over the menu bar If My>=0 and My<19 If Mc = 1 If SelectedMenu = 0 Then Get Image 31,0,0,SW-1,250,1: Rem Grab current dropdown area into an image SelectedMenu = 1 Set Camera View 1,0,0,1,1 Endif If SelectedMenu = 1: Rem Clicked once, so show the dropdowns as you move across For T = 1 To DropDowns If Mx>EntryPosX(T) and Mx<EntryPosX(T+1) OverEntry = T SE = EntryPosX(OverEntry) Paste Image 31,0,0: Rem Blanking Image Paste Image OverEntry,SE,TH+2: Rem Dropdown MenuChar$ = Chr$(64+OverEntry) Mc=0 Endif Next T Endif Endif Rem Moving over dropdown If (Mx>SE and Mx<SE+BoxWid(OverEntry) and My>19 and My<19+BoxHig(OverEntry)) And SelectedMenu=1 Itm = 0 If Mc = 0 MenuItemNum = BoxHig(OverEntry)/DropMenuCount(OverEntry) Itm2 = (My-(TH+5))/MenuItemNum Rem Highlight Here If Itm2 < DropMenuCount(OverEntry) Top = TH+4: Rem Top Of Panel Paste Image 31,0,0 Paste Image OverEntry,EntryPosX(OverEntry),TH+2: Rem Dropdown If DropEntry$(OverEntry,Itm2+1)<>"-" Get Image 1010,SE+1,Itm2*(MenuItemNum-1)+Top+4, SE+BoxWid(OverEntry)-11, Itm2*(MenuItemNum-1)+Top+TH+4,1 Paste Image 1010,SE+10,Itm2*(MenuItemNum-1)+Top+4 Endif Endif Else Rem Clicked on something Itm = (My-(TH+5))/MenuItemNum+1 Paste Image 31,0,0 Repeat Until MouseClick()=0 Endif Endif Rem Move off menu so remove highlight If (Mx<SE or Mx>SE+BoxWid(OverEntry) or My<TH+5 or My>TH+5+BoxHig(OverEntry)) And SelectedMenu=1 And MC=0: rem And FinSel=0 Paste Image OverEntry,EntryPosX(OverEntry),TH+2: Rem Dropdown Endif Rem Click off menu to remove it If (Mx<SE or Mx>SE+BoxWid(OverEntry) or My<TH+5 or My>TH+5+BoxHig(OverEntry)) And SelectedMenu=1 And MC=1 Paste Image 31,0,0 Mc = 0: SelectedMenu = 0: Itm = 0: MenuChar$ = "" Set Camera View 1,6,42,393,303 Endif If MenuChar$<>"" and Itm <> 0: Rem Both = something Chosen$ = MenuChar$+Str$(Itm) SelectedMenu = 0 Set Camera View 1,6,42,393,303 Repeat Until MouseClick()=0 Endif EndFunction Chosen$ Rem ************ CREATE THE MENU SYSTEM ****************** Function InitMenuSystem(DropDowns,FontName$,FontSize,XPosition,YPosition,ColScheme) TS=Text size(): Tf$=TEXT FONT$(): Rem Grab starting settings Set Text Font FontName$: Set Text Size FontSize: Rem Set new ones SW=Screen Width(): SH=Screen Height(): TH=TEXT HEIGHT("XXXX")+0: Highlight=0 Set Text Transparent Create Bitmap 1,SW,SH Ink RGB(255,255,255),0 For N2=1 To DropDowns: Rem Split each dropdown entry into an array Current=1 For N=1 To Len(Menu$(N2)) Char$=Mid$(Menu$(N2),N) If Char$<>"|" DropEntry$(N2,Current)=DropEntry$(N2,Current)+Char$ Else Inc Current Endif Next N DropMenuCount(N2)=Current Next N2 For D=1 To DropDowns Longest=0 For N=1 To DropMenuCount(D) If Len(DropEntry$(D,N))>Len(DropEntry$(D,Longest)) Then Longest=N Next N Rem ************************************************************* Rem ****************** BUILD DROPDOWN PANELS ****************** Rem ************************************************************* BoxWid(D)=TEXT WIDTH(DropEntry$(D,Longest))*1.7 BoxHig(D)=(DropMenuCount(D))*(TH+1)+3 CLS Select ColScheme Case 1 Rem Grey Ink RGB(255,255,255),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(150,150,150),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(200,200,200),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 2 Rem Blue Ink RGB(0,200,255),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(0,0,200),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(0,100,255),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 3 Rem Green Ink RGB(150,255,150),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(0,100,0),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(0,155,0),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 4 Rem Red Ink RGB(255,100,100),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(100,0,0),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(155,0,0),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 5 Rem Purple Ink RGB(200,200,200),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(100,0,255),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(155,0,255),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 6 Rem White Ink RGB(200,200,200),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(100,100,10),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(255,255,255),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase Case 7 Rem Black Ink RGB(70,70,70),0: Box 0,0,BoxWid(D),BoxHig(D) Ink RGB(30,30,30),0: Box 0,1,BoxWid(D),BoxHig(D) Ink RGB(0,0,0),0: Box 1,1,BoxWid(D)-1,BoxHig(D)-1 EndCase EndSelect Rem ************************************************************* Rem **************** POPULATE DROPDOWN PANELS ***************** Rem ************************************************************* For N=0 To DropMenuCount(D)-1 CPos=20: Ink 0,0 For N2=1 To Len(DropEntry$(D,N+1)) Char$=Mid$(DropEntry$(D,N+1),N2) If Char$="_": Rem Underscore - Next character to be highlighted Highlight=0 Else If Char$="-": Rem A Spacer Line Between Entries Select ColScheme Case 1 Rem Grey Ink RGB(150,150,150),0 EndCase Case 2 Rem Blue Ink RGB(0,0,50),0 EndCase Case 3 Rem Green Ink RGB(0,50,0),0 EndCase Case 4 Rem Red Ink RGB(50,0,0),0 EndCase Case 5 Rem Purple Ink RGB(50,0,59),0 EndCase Case 6 Rem White Ink RGB(50,50,50),0 EndCase Case 7 Rem Black Ink RGB(30,30,30),0 EndCase EndSelect Line 3,N*TH+15,BoxWid(D)-3,N*TH+15 Else: Rem Not A Spacer Line Select ColScheme Case 1 Rem Grey If Highlight=1 Then Ink RGB(255,0,0),0: Key$(D,N)=Upper$(char$) EndCase Case 2 Rem Blue If Highlight=1 Then Ink RGB(0,0,0),0: Key$(D,N)=Upper$(char$) EndCase Case 3 Rem Green If Highlight=1 Then Ink RGB(255,255,255),0: Key$(D,N)=Upper$(char$) EndCase Case 4 Rem Red If Highlight=1 Then Ink RGB(255,255,255),0: Key$(D,N)=Upper$(char$) EndCase Case 5 Rem Purple If Highlight=1 Then Ink RGB(255,255,255),0: Key$(D,N)=Upper$(char$) EndCase Case 6 Rem White If Highlight=1 Then Ink RGB(255,0,0),0: Key$(D,N)=Upper$(char$) EndCase Case 7 Rem Black If Highlight=1 Then Ink RGB(255,255,255),0: Key$(D,N)=Upper$(char$) EndCase EndSelect Text CPos,N*TH+5,Char$ Select ColScheme Case 1 Rem Grey Ink RGB(0,0,0),0: Highlight=0 EndCase Case 2 Rem Blue Ink RGB(255,255,255),0: Highlight=0 EndCase Case 3 Rem Green Ink RGB(0,0,0),0: Highlight=0 EndCase Case 4 Rem Red Ink RGB(255,120,120),0: Highlight=0 EndCase Case 5 Rem Red Ink RGB(50,0,50),0: Highlight=0 EndCase Case 6 Rem White Ink RGB(0,0,0),0: Highlight=0 EndCase Case 7 Rem Black Ink RGB(100,100,150),0: Highlight=0 EndCase EndSelect Inc CPos,TEXT WIDTH(Char$) Endif: Rem End Of Spacer Line If loop Endif Next N2 Next N Get Image D,0,0,BoxWid(D)+1,BoxHig(D)+1,1 Next D Delete Bitmap 1 Rem ************************************************************* Rem ********************* BUILD MENU BAR ********************** Rem ************************************************************* Select ColScheme Case 1 Rem Grey Ink RGB(255,255,255),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15, 4, SW-5, 14 Ink RGB(150,150,150),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14, 5, SW-5, 14 Ink RGB(200,200,200),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14, 5, SW-6, 13 EndCase Case 2 Rem Blue Ink RGB(0,200,255),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(0,0,200),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(0,100,255),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase Case 3 Rem Green Ink RGB(150,255,150),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(0,100,0),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(0,155,0),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase Case 4 Rem Red Ink RGB(255,100,100),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(100,0,0),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(155,0,0),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase Case 5 Rem Purple Ink RGB(200,200,200),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(100,0,255),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(155,0,255),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase Case 6 Rem White Ink RGB(200,200,200),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(100,100,10),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(255,255,255),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase Case 7 Rem Black Ink RGB(70,70,70),0: Box 0,YPosition,SW,YPosition+TH+3: Box SW-15,4,SW-5,14 Ink RGB(30,30,30),0: Box 1,YPosition+1,SW,YPosition+TH+3: Box SW-14,5,SW-5,14 Ink RGB(0,0,0),0: Box 1,YPosition+1,SW-1,YPosition+TH+2: Box SW-14,5,SW-6,13 EndCase EndSelect Rem ************************************************************* Rem ******************* POPULATE MENU BAR ********************* Rem ************************************************************* CPos=XPosition: EntryPosX(1)=CPos: Current=1: Ink 0,0 For N=1 To Len(Menu$(0)) Char$=Mid$(Menu$(0),N) If Char$="|" or Char$="_" If Char$="_" Highlight=0 Else Inc CPos,15: Inc Current EntryPosX(Current)=CPos Endif Else Select ColScheme Case 1 Rem Grey If Highlight=1 Then Ink RGB(255,0,0),0: Key$(0,Current)=Upper$(char$) EndCase Case 2 Rem Blue If Highlight=1 Then Ink 0,0: Key$(0,Current)=Upper$(char$) EndCase Case 3 Rem Green If Highlight=1 Then Ink RGB(255,255,255),0: Key$(0,Current)=Upper$(char$) EndCase Case 4 Rem Red If Highlight=1 Then Ink RGB(255,255,255),0: Key$(0,Current)=Upper$(char$) EndCase Case 5 Rem Purple If Highlight=1 Then Ink RGB(255,255,255),0: Key$(0,Current)=Upper$(char$) EndCase Case 6 Rem White If Highlight=1 Then Ink RGB(255,0,0),0: Key$(0,Current)=Upper$(char$) EndCase Case 7 Rem Black If Highlight=1 Then Ink RGB(255,255,255),0: Key$(0,Current)=Upper$(char$) EndCase EndSelect Text CPos,YPosition,Char$: rem Menu Bar Text Select ColScheme Case 1 Rem Grey Ink RGB(0,0,0),0: Highlight=0 EndCase Case 2 Rem Blue Ink RGB(255,255,255),0: Highlight=0 EndCase Case 3 Rem Green Ink RGB(0,0,0),0: Highlight=0 EndCase Case 4 Rem Red Ink RGB(255,120,120),0: Highlight=0 EndCase Case 5 Rem Red Ink RGB(50,0,50),0: Highlight=0 EndCase Case 6 Rem White Ink RGB(0,0,0),0: Highlight=0 EndCase Case 7 Rem Black Ink RGB(100,100,150),0: Highlight=0 EndCase EndSelect Inc CPos, TEXT WIDTH(Char$) Endif Next N Inc CPos,15: Inc Current EntryPosX(Current)=CPos EndFunction Function TitleBar(Title$,Day) SW=Screen Width() Ink RGB(255,255,255),0: Center Text SW/2-1,1,Title$ Ink RGB(0,0,0),0: Center Text SW/2,0,Title$ If Day=1 Then Text SW-90,0,Get Date$() EndFunction Function KillMenuSystem() Set Text Font Tf$ Set Text Size TS EndFunction