Sorry your browser is not supported!

Rem TDK's Entry In The 3D Modeller DBPro Challenge
Rem 14th November 2005
Gosub Setup

Do
  Mx=MouseX(): My=MouseY(): Mc=MouseClick(): 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
  Gosub CheckMouse
Loop

Rem ******************** Procedures ********************
CheckMouse:
  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
      Paste Image 1002,381,23: Text 385,25,"Z"
    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: 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: 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: 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 3D Screens
  ClickOn3DScreens:
  Set Text Opaque: Ink RGB(255,255,255),0
  If Mx>5 and My>41 and Mx<393 and My<303: Rem Front View
    If MouseClick() = 1
      SET CURRENT CAMERA 1
      Hide Mouse
      If MoveMode=1
        AllowX=FrontX: AllowY=FrontY: AllowZ=FrontZ
        Gosub MoveObject
      Endif
    Else
      Pickmode = 0
      Show Mouse
    Endif
  Endif

  If Mx>405 and My>41 and Mx<793 and My<303: Rem Right View
    If MouseClick() = 1
      SET CURRENT CAMERA 2
      Hide Mouse
      If MoveMode=1
        AllowX=RightZ: AllowY=RightY: AllowZ=RightX
        Gosub MoveObject
      Endif
    Else
      Pickmode = 0
      Show Mouse
    Endif
  Endif

  If Mx>5 and My>331 and Mx<393 and My<593: Rem Top View
    If MouseClick() = 1
      SET CURRENT CAMERA 3
      Hide Mouse
      If MoveMode=1
        AllowX=TopX: AllowY=0: AllowZ=TopY
        Gosub MoveObject
      Endif
    Else
      Pickmode = 0
      Show Mouse
    Endif
  Endif

  If Mx>405 and My>331 and Mx<793 and My<593: Rem Camera View
    If MouseClick() > 0
      SET CURRENT CAMERA 0
      Hide Mouse
      If MoveMode=1
        AllowX=(MouseClick()=1): AllowY=(MouseClick()=2): AllowZ=(MouseClick()=1)
        Gosub MoveObject
      Endif
    Else
      Pickmode = 0
      Show Mouse
    Endif
  Endif
Return

HighlightObj:
  Delete Object 1000
  Make Object Box 1000,OBJECT SIZE X(ObjClickedOn)+1,OBJECT SIZE Y(ObjClickedOn)+1,OBJECT SIZE Z(ObjClickedOn)+1
  Position Object 1000,objx#,objy#,objz#
  Color Object 1000,RGB(255,255,0)
  Set Object Wireframe 1000,1
  Show Object 1000
Return

DisplayXYZ:
  Rem Object Position update
  IntPartX = Int(DispX#): IPX$ = Str$(IntPartX): Neg=0
  If IntPartX<0
    IPX$ = Right$(IPX$,Len(IPX$)-1): Neg=1
  Endif
  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"
  XLoc$=IPX$+DPX$
  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"
  YLoc$=IPY$+DPY$
  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"
  ZLoc$=IPZ$+DPZ$
  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
        NumObjects = 0
      EndCase
      Case 3: Rem Open .TOG File
      EndCase
      Case 4: Rem Close
      EndCase
      Case 5: Rem Save .TOG File
      EndCase
      Case 6: Rem Save As
      EndCase
      Case 8: Rem Exit
        End
      EndCase
    EndSelect
  Endif

  If Entry=2: Rem The second dropdown menu
    Select Item
      Case 1: Rem Undo
      EndCase
      Case 2: Rem Redo
      EndCase
      Case 4: Rem Cut
      EndCase
      Case 5: Rem Copy
      EndCase
      Case 6: Rem Paste
      EndCase
      Case 7: Rem Delete
      EndCase
      Case 8: Rem Select All
      EndCase
      Case 10: Rem Edit Options
      EndCase
    EndSelect
  Endif

  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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      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)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      EndCase
      Case 7: Rem Triangle
        Inc NumObjects
        Make Object Triangle NumObjects,0,0,0,0,50,0,50,0,0
        Position Object NumObjects,0,0,0
        Color Object NumObjects,RGB(0,255,255)
        ObjClickedOn = NumObjects
        objx#=0: objy#=0: objz#=0
        Gosub HighlightObj
        Chosen$ = "": Itm=0
      EndCase
    EndSelect
  Endif

  If Entry=4: Rem The fourth dropdown menu
    Select Item
      Case 1: Rem About
      EndCase
      Case 3: Rem Program Help
      EndCase
      Case 4: Rem Link To My Web Site
      EndCase
    EndSelect
  Endif
Return


MoveObject:
  If Pickmode = 0
        ObjClickedOn = Pick object(Mousex(),Mousey(), 1, NumObjects)
        If ObjClickedOn > 0
          Pickmode = 1
          Vdist# = Get Pick Distance()
          VStartX# = Get Pick vector x()
          VStartY# = Get Pick vector y()
          VStartZ# = Get Pick vector z()
          VEndX# = 0: VEndY# = 0: VEndZ# = 0
          objx# = Object position x(ObjClickedOn)
          objy# = Object position y(ObjClickedOn)
          objz# = Object position z(ObjClickedOn)
          Gosub HighlightObj
        Else
          Hide Object 1000
        Endif
  Endif
  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 ObjClickedOn,objx#+Diffx#,objy#+Diffy#,objz#+Diffz#
          Position Object 1000,objx#+Diffx#,objy#+Diffy#,objz#+Diffz#
          DispX#=objx#+Diffx#: DispY#=objy#+Diffy#: DispZ#=objz#+Diffz#
          Gosub DisplayXYZ
          Sync
        Endif
  Until MouseClick()=0
Return


Setup:
  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)
  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|_Add Primitive|_Help"
  Menu$(1)="_New|-|_Open|_Close|_Save|Save _As|-|E_xit"
  Menu$(2)="_Undo|_Redo|-|Cu_t|_Copy|_Paste|_Delete|Select _All|-|Edit _Options"
  Menu$(3)="_Cube|_Box|_Sphere|C_ylinder|C_one|_Plain|_Triangle"
  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

  Rem Create Media
  Create Bitmap 1,256,256
  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
  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
  Ghost Matrix Off 1
  Set Matrix 1,0,0,0,0,0,0,0
  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
  Ink RGB(239,235,255),0: Box 665,310,692,326
  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
  Rem Reset Camera Button
  Ink RGB(239,235,255),0: Box 779,310,793,325
  Ink RGB(82,81,99),0: Box 780,311,793,325
  Ink RGB(127,151,175),0: Box 780,311,792,324
  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

  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
  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

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,200,1: Rem Grab current dropdown area into an image
      SelectedMenu = 1
      rem SET CURRENT CAMERA 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: rem Itm = 0
        Endif
      Next T
      rem Mc=0: Itm = 0
    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+2: Rem Top Of Panel
        Paste Image 31,0,0
        Paste Image OverEntry,EntryPosX(OverEntry),TH+2: Rem Dropdown
        If DropEntry$(OverEntry,Itm2+1)<>" -"
          Ink RGB(0,0,0),0:       Box SE+5,  Itm2*(MenuItemNum-1)+Top+(TH/2),    SE+15,  Itm2*(MenuItemNum-1)+Top+TH
          Ink RGB(255,255,255),0: Box SE+6,  Itm2*(MenuItemNum-1)+Top+(TH/2)+1,  SE+14,  Itm2*(MenuItemNum-1)+Top+TH-1
        Endif
      Endif
    Else
      Rem Clicked on something
      Itm = (My-(TH+5))/MenuItemNum+1
      Paste Image 31,0,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
  Endif

EndFunction Chosen$


Rem ************ CREATE THE MENU SYSTEM ******************
Function InitMenuSystem(DropDowns,FontName$,FontSize,XPosition,YPosition,ColScheme)
  TS=Text size(): Tf$=TEXT FONT$(): Rem Grab stating settings
  Set Text Font FontName$: Set Text Size FontSize: Rem Set new ones
  SW=Screen Width(): SH=Screen Height(): TH=TEXT HEIGHT("XXXX")+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
      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=1
        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
            If Char$="I" or Char$="i" or Char$="l" or Char$="I" or Char$="1" or Char$="f" or Char$="r"
              Inc CPos, TEXT WIDTH(Char$)/2+2
            Else
              Inc CPos, TEXT WIDTH(Char$)+1
            Endif
          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
  For N=1 To Len(Menu$(0))
    Char$=Mid$(Menu$(0),N)
    If Char$="|" or Char$="_"
      If Char$="_"
        Highlight=1
      Else
        Inc CPos,10
        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 RGB(0,0,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$
      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
      If Char$="I" or Char$="i" or Char$="l" or Char$="I" or Char$="1" or Char$="f" or Char$="r"
        Inc CPos, TEXT WIDTH("R")/2
      Else
        Inc CPos, TEXT WIDTH("H")
      Endif
    Endif
  Next N
  Inc CPos,10
  Inc Current
  EntryPosX(Current)=CPos
  Ink RGB(50,200,0),0
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

Function FileSelect
EndFunction

`Primatives Creation Program!!!
`By Segan

`First, we will need a type that has all of each objects info
Type tObject
	X:	Y:	Z
	`AngX:AngY:AngZ Will use in the future (lets hope), but not now
	`TType I Don't know if this will eventually be of use. 
	Num	
endtype

Dim Objects(0) As TObject 

`Now we need some globals. As Homer would say: MMMMmmmm.... Glo-nuts
Global D3ClickX As Float
Global D3ClickZ As Float

`Now let's create the environment where we will be working
CreateEnvironment()


`Screen Stuff... FUN FUN FUN!!!
Sync On: Sync Rate 60
autocam off
backdrop on

CameraX As Float: CameraX = 0.0
CameraY As Float: CameraY = 10.0
CameraZ As Float: CameraZ = 0.0

PointCameraX = 0
PointCameraY = 0
PointCameraZ = 0

Position Camera CameraX,CameraY,CameraZ
Point Camera PointCameraX,PointCameraY,PointCameraZ

`Now it's time for our main loop!
Do
	Remstart
	`***My thought process...***
	
	Text 0,0,"Mouse X:  " + str$(MouseX())
	Text 200,0,"Mouse Y:  " + str$(MouseY())
	Lala# = Screen Width()
	Lala2# = Screen Height()
	Text 0,20,"Mouse X%: " + Str$(MouseX()/lala#*100)
	Text 200,20,"MouseY%: " + str$(MouseY()/lala2#*100)

	Text 0,40,"DistY: " + str$(sqrt((CameraY^2)+(CameraZ^2))*(tan(61.9621/2)))
	Text 0,60,"DistX: " + str$(sqrt((CameraY^2)+(CameraZ^2))*(tan(61.9621/2))*(lala#/Lala2#))
	
	Text 0,80,"AngleX: " + str$(Camera Angle X())
	Text 0,100,"AngleY: " + str$(Camera Angle Y())
	Text 0,120,"AngleZ: " + str$(Camera Angle Z())
	
	Text 0,140,"PointAtZ: " + str$(tan(90-Camera Angle X())*(CameraY-PointCameraY)+ CameraZ) 
	Remend
	
	If MouseClick3D(0.0,61.9621)	= 1 Then CreateObject(1, D3ClickX, 0, D3ClickZ) 
	MoveCamera()
	
	`Draw all of the stuff on the screen
	If Array Count(Objects()) > 0
		For TOB = 1 To Array Count(Objects())
			Position Object Objects(TOB).Num, Objects(TOB).X, Objects(TOB).Y, Objects(TOB).Z	
		next numobject
	Endif
	Sync
	

loop


Function CreateObject(ObjectType,X,Y,Z)
	If ObjectType < 1 Or ObjectType > 1 `NEED TO CHANGE AS MORE OBJECT TYPES ARE ADDED
		cls
		Text 0,0,"ERROR: Object Type Illegal in Create Object Function."
		Text 20,0,"Press any key to continue."
		Sync
		Wait Key
		ExitFunction	
	Endif
	
	Add To Queue Objects(0)
	ArraySpot = Array Count(Objects())
	Objects(ArraySpot).Num = Get_Free_Object_Number()
	
	If ObjectType = 1 Then Make Object Cube Objects(ArraySpot).Num, 1
	`Need to add more objects here as the ability to make more is added
	Position Object Objects(ArraySpot).Num, X, Y, Z
	
	Objects(ArraySpot).X = x: Objects(ArraySpot).Y = y: Objects(ArraySpot).Z = z	
endfunction

Function MoveCamera()
	MoveSpeed# = 0.13
	CameraX# = Camera Position X()
	CameraY# = Camera Position Y()
	CameraZ# = Camera Position Z()
	
	If LeftKey() = 1 Then CameraX# = CameraX# - MoveSpeed#
	If RightKey() = 1 Then CameraX# = CameraX# + MoveSpeed#
	If Upkey() = 1 Then CameraZ# = CameraZ# + MoveSpeed#
	If Downkey() = 1 Then CameraZ# = CameraZ# - MoveSpeed#
	
	Position Camera CameraX#,CameraY#,CameraZ#
endfunction


Function CreateEnvironment()
	cls 0
	Ink RGB(0,0,0),0
	Box 0,0,20,20
	Ink RGB(255,255,255),RGB(255,255,255)
	Line 0,0,20,0
	Line 0,0,0,20
	Line 0,20,20,20
	Line 20,0,20,20
	
	GridImage = Get_Free_Image_Number()
	Get Image GridImage,0,0,20,20
	
	Make Matrix 1, 100,100,100,100
	Prepare Matrix Texture 1, GridImage, 1, 1
	Position Matrix 1, -50,0,-50
	
	
	
endfunction



Function Get_Free_Object_Number()
	Do
		inc ObjectNumber
	 	If Object Exist(ObjectNumber) = 0 Then Exit
	Loop
EndFunction ObjectNumber


Function Get_Free_Image_Number()
	Do
		inc ImageNumber
		If Image Exist(ImageNumber) = 0 Then Exit
	loop
endfunction ImageNumber
 
 
Function MouseClick3D(YClicked#,FOV#)
	`Returns a 0 if mouse was not clicked
	If MouseClick() <> 1 Then ExitFunction 0
	
	ScreenWidth# = Screen Width()
	ScreenHeight# = Screen Height()
	
	MXpcent# = MouseX()/ScreenWidth#
	MYpcent# = 1-(MouseY()/ScreenHeight#)
	
	CamX# = Camera Position X()
	CamY# = Camera Position Y()
	CamZ# = Camera Position Z()
	
	`Note: This Formula assumes that CamZ# < CamPointAtZ#
	CamPointAtZ# = tan(90-Camera Angle X())*(CamY#-YClicked#) + CamZ#
	`Note: This Formula assumes that CamX# = CamPointAtX#
	CamPointAtX# = CamX#
	
	`I know that these formulas work with CamZ# = CamPointAtZ# and CamX# = CamPointAtX# 
	DistY# = sqrt(((CamY#-YClicked#)^2)+((CamZ#-CamPointAtZ#)^2))*(tan(FOV#/2))
	DistX# = sqrt(((CamY#-YClicked#)^2)+((CamZ#-CamPointAtZ#)^2))*(tan(FOV#/2))*(ScreenWidth#/ScreenHeight#)
	
	`Ditto on the formulas from previous comments
	D3ClickX = (DistX#*2)*MXpcent#-DistX#+CamPointAtX#
	D3ClickZ = (DistY#*2)*MYpcent#-DistY#+CamPointAtZ#
	
	`Returns a 1 if the mouse was clicked
endfunction 1

`Primatives Creation Program!!!
`By Segan

`First, we will need a type that has all of each objects info
Type tObject
	X As Float:	Y As Float:	Z As Float
	`AngX:AngY:AngZ Will use in the future (lets hope), but not now
	`TType I Don't know if this will eventually be of use. 
	Num	
endtype

Dim Objects(0) As TObject 

`Now we need some globals. As Homer would say: MMMMmmmm.... Glo-nuts
Global D3ClickX As Float
Global D3ClickZ As Float

`Now let's create the environment where we will be working
CreateEnvironment()


`Screen Stuff... FUN FUN FUN!!!
Sync On: Sync Rate 60
autocam off
backdrop on

CameraX As Float: CameraX = 0.0
CameraY As Float: CameraY = 10.0
CameraZ As Float: CameraZ = 0.0

PointCameraX = 0
PointCameraY = 0
PointCameraZ = 0

Position Camera CameraX,CameraY,CameraZ
Point Camera PointCameraX,PointCameraY,PointCameraZ

`Now it's time for our main loop!
Do
	Remstart
	`***My thought process...***
	
	Text 0,0,"Mouse X:  " + str$(MouseX())
	Text 200,0,"Mouse Y:  " + str$(MouseY())
	Lala# = Screen Width()
	Lala2# = Screen Height()
	Text 0,20,"Mouse X%: " + Str$(MouseX()/lala#*100)
	Text 200,20,"MouseY%: " + str$(MouseY()/lala2#*100)

	Text 0,40,"DistY: " + str$(sqrt((CameraY^2)+(CameraZ^2))*(tan(61.9621/2)))
	Text 0,60,"DistX: " + str$(sqrt((CameraY^2)+(CameraZ^2))*(tan(61.9621/2))*(lala#/Lala2#))
	
	Text 0,80,"AngleX: " + str$(Camera Angle X())
	Text 0,100,"AngleY: " + str$(Camera Angle Y())
	Text 0,120,"AngleZ: " + str$(Camera Angle Z())
	
	Text 0,140,"PointAtZ: " + str$(tan(90-Camera Angle X())*(CameraY-PointCameraY)+ CameraZ) 
	Remend
	
	If MouseClick3D(0.0,61.9621)	= 1 Then CreateObject(1, D3ClickX, 0.0, D3ClickZ) 
	MoveCamera()
	
	`Draw all of the stuff on the screen
	If Array Count(Objects()) > 0
		For TOB = 1 To Array Count(Objects())
			Position Object Objects(TOB).Num, Objects(TOB).X, Objects(TOB).Y, Objects(TOB).Z	
		next numobject
	Endif
	Sync
	

loop


Function CreateObject(ObjectType,X#,Y#,Z#)
	If ObjectType < 1 Or ObjectType > 1 `NEED TO CHANGE AS MORE OBJECT TYPES ARE ADDED
		cls
		Text 0,0,"ERROR: Object Type Illegal in Create Object Function."
		Text 20,0,"Press any key to continue."
		Sync
		Wait Key
		ExitFunction	
	Endif
	
	Add To Queue Objects(0)
	ArraySpot = Array Count(Objects())
	Objects(ArraySpot).Num = Get_Free_Object_Number()
	
	If ObjectType = 1 Then Make Object Cube Objects(ArraySpot).Num, 1
	`Need to add more objects here as the ability to make more is added
	Position Object Objects(ArraySpot).Num, X#, Y#, Z#
	
	Objects(ArraySpot).X = x#: Objects(ArraySpot).Y = y#: Objects(ArraySpot).Z = z#	
endfunction

Function MoveCamera()
	MoveSpeed# = 0.13
	CameraX# = Camera Position X()
	CameraY# = Camera Position Y()
	CameraZ# = Camera Position Z()
	
	If LeftKey() = 1 Then CameraX# = CameraX# - MoveSpeed#
	If RightKey() = 1 Then CameraX# = CameraX# + MoveSpeed#
	If Upkey() = 1 Then CameraZ# = CameraZ# + MoveSpeed#
	If Downkey() = 1 Then CameraZ# = CameraZ# - MoveSpeed#
	
	Position Camera CameraX#,CameraY#,CameraZ#
endfunction


Function CreateEnvironment()
	cls 0
	Ink RGB(0,0,0),0
	Box 0,0,20,20
	Ink RGB(255,255,255),RGB(255,255,255)
	Line 0,0,20,0
	Line 0,0,0,20
	Line 0,20,20,20
	Line 20,0,20,20
	
	GridImage = Get_Free_Image_Number()
	Get Image GridImage,0,0,20,20
	
	Make Matrix 1, 100,100,100,100
	Prepare Matrix Texture 1, GridImage, 1, 1
	Position Matrix 1, -50,0,-50
	
	
	
endfunction



Function Get_Free_Object_Number()
	Do
		inc ObjectNumber
	 	If Object Exist(ObjectNumber) = 0 Then Exit
	Loop
EndFunction ObjectNumber


Function Get_Free_Image_Number()
	Do
		inc ImageNumber
		If Image Exist(ImageNumber) = 0 Then Exit
	loop
endfunction ImageNumber
 
 
Function MouseClick3D(YClicked#,FOV#)
	`Returns a 0 if mouse was not clicked
	If MouseClick() <> 1 Then ExitFunction 0
	
	ScreenWidth# = Screen Width()
	ScreenHeight# = Screen Height()
	
	MXpcent# = MouseX()/ScreenWidth#
	MYpcent# = 1-(MouseY()/ScreenHeight#)
	
	CamX# = Camera Position X()
	CamY# = Camera Position Y()
	CamZ# = Camera Position Z()
	
	`Note: This Formula assumes that CamZ# < CamPointAtZ#
	CamPointAtZ# = tan(90-Camera Angle X())*(CamY#-YClicked#) + CamZ#
	`Note: This Formula assumes that CamX# = CamPointAtX#
	CamPointAtX# = CamX#
	
	`I know that these formulas work with CamZ# = CamPointAtZ# and CamX# = CamPointAtX# 
	DistY# = sqrt(((CamY#-YClicked#)^2)+((CamZ#-CamPointAtZ#)^2))*(tan(FOV#/2))
	DistX# = sqrt(((CamY#-YClicked#)^2)+((CamZ#-CamPointAtZ#)^2))*(tan(FOV#/2))*(ScreenWidth#/ScreenHeight#)
	
	`Ditto on the formulas from previous comments
	D3ClickX = (DistX#*2)*MXpcent#-DistX#+CamPointAtX#
	D3ClickZ = (DistY#*2)*MYpcent#-DistY#+CamPointAtZ#
	
	`Returns a 1 if the mouse was clicked
endfunction 1
 

Rem Created by RiiDii
Rem Created: 6/25/2004 8:18:22 PM  : Ignore this line. :o)

Rem ***** Main Source File *****

` Adjust the display mode as needed
Set Display Mode 1280,960,32
sync on : sync rate 30 : Color Backdrop rgb(0,0,0)
set camera range 0,1,7000
Position Camera 0,0,0,0
Autocam off
Set Image Colorkey 0,0,0

CreateStarField(16)
Make Object Sphere 2, 10000
Texture Object 2,16
Scale Object Texture 2,4,4
Position Object 2,0,0,0
Set Object Light 2,0
Set Object Cull 2,0
Fade Object 2,1000


Dim Modules#(1000,4)
Module(1)
`Load Image "Stars3.bmp",2
DryDock(3)
CreatePlanet(4)
CreateClouds(5)

ink rgb(255,255,255),0

`Images
Const_Skin1(6)
Const_Skin2(7)
Fire(8)
Beam_Effect1(9)
Grid1(11)
Beam_Effect1(12)
BaySide(13)
Star(15)

Set Ambient Light 1
Rem Fog On
Rem Fog Color 0
Rem Fog Distance 3000
Autocam Off
Make Light 2
Position Light 2,460,0,460
Set Directional Light 2,-1,0,0
Set Light Range 2,200
Color Light 2,RGB(0,0,250)

Rem <<< Base Module >>>
Make Object Cube 1,50
Position Object 1,450,0,460
Texture Object 1,1
Scale Object Texture 1,.25,.25

Make Object Cube 750,5
Position Object 750,-20,15,40
Texture Object 750,1
Scale Object Texture 750,.25,.25
Ghost Object On 750
Lock Object On 750
Hide Object 750
Disable Object ZDepth 750

Rem <<< Bright Star >>>
Make Object Plain 11,600,600
Texture Object 11,15
Set Object 11,1,1,0
Ghost Object On 11
Position Object 11,1800,100,100
Turn Object Right 11,90
Fade Object 11,1000
Make Light 1
Set Point Light 1, 1800,100,100
Color Light 1,240,240,255
Set Light Range 1, 10000

Rem <<< Planet >>>

PlanX = (rnd(1000)+1500)*(rnd(1)*2-1)
PlanY = 0
PLanZ = (rnd(1000)+1500)*(rnd(1)*2-1)

Make Object Sphere 502,1000,30,30
Position Object 502,PlanX,PlanY,PlanZ
Roll Object Left 502,38
Texture Object 502,5
Ghost Object On 502
Set Object 502,1,0,1,1,1,0,1
Fade Object 502,150


Make Object Sphere 507,970,30,30
Position Object 507,PlanX,PlanY,PlanZ
Texture Object 507,4
Roll Object Left 507,40
Set Object Smoothing 507,100

Make Object Sphere 508,1030,30,30
Position Object 508,PlanX,PlanY,PlanZ
Texture Object 508,5
Ghost Object On 508
Fade Object 508,60

Rem <<< Dry Dock >>>

Make Object Cube 503,0
Make Object Box 504,1000,3,1000

Make Mesh From Object 503,504
Add Limb 503,1,503
Offset Limb 503,1,0,0,500
Texture Limb 503,1,3
Rotate Limb 503,1,90,0,0
Scale Limb Texture 503,1,11,11

Make Mesh From Object 504,504
Add Limb 503,2,504
Offset Limb 503,2,0,0,-500
Texture Limb 503,2,3
Rotate Limb 503,2,90,0,0
Scale Limb Texture 503,2,11,11

Make Mesh From Object 505,504
Add Limb 503,3,505
Offset Limb 503,3,0,500,0
Texture Limb 503,3,3
Scale Limb Texture 503,3,11,11

Make Mesh From Object 506,504
Add Limb 503,4,506
Offset Limb 503,4,0,-500,0
Texture Limb 503,4,3
Scale Limb Texture 503,4,11,11
Fade Object 503,200

Delete Object 504
Set Object 503,1,1,0
Make Object Cube 2001,50
Texture Object 2001,11
Set Object 2001,1,0,0
Ghost Object On 2001
Fade Object 2001,250

Rem <<< Construction Bay >>>

Make Object Box 700,.5,.5,.5
Color Object 700,0
Make Object Box 701,104,79,8
For i = 1 to 4
   Make Mesh From Object 700+i,701
   Add Limb 700,i,700+i
   Texture Limb 700,i,13
Next i
Delete Object 701
Offset Limb 700,1,0,0,42
Offset Limb 700,2,0,0,-42
Offset Limb 700,3,0,42,0
Offset Limb 700,4,0,-42,0
Rotate Limb 700,3,90,0,0
Rotate Limb 700,4,90,0,0
Position Object 700,460,0,460
Set Object 700,1,1,1
Fix Object Pivot 700
Fade Object 700,200

Make Object Cylinder 701,70
Set Object 701,1,0,0,1,0,0,1
Scale Object 701,100,400,100
Texture Object 701,12
Scale Object Texture 701,4,1
Ghost Object On 701
Roll Object Right 701,90
Position Object 701,350,0,460
Fade Object 701,200
Make Particles 1,12,80,20
Position Particles 1,510,0,460
Color Particles 1,0,10,200
Rotate Particles 1,0,0,90
Set Particle Gravity 1,0
Set Particle Velocity 1,100
Set Particle Life 1,5

Make Object Box 702,280,60,60
Position Object 702,350,0,460
Set Object 702,1,1,0
Color Object 702,0

Rem <<< Constructor >>>

Make Object Sphere 600,25,20,20
Position Object 600,0,0,50
Make Object Box 601,25,10,25
Make Mesh From Object 601,601
Add Limb 600,1,601
Offset Limb 600,1,0,0,-15
Delete Object 601
Make Object Cylinder 602,3
Scale Object 602,100,1500,100
Pitch Object Up 602,90
Make Mesh From Object 602,602
Add Limb 600,2,602
Offset Limb 600,2,10.9,0,15
Make Mesh From Object 603,602
Add Limb 600,3,603
Offset Limb 600,3,-10.9,0,15
Scale Object 602,200,60,200
Make Mesh From Object 604,602
Add Limb 600,4,604
Offset Limb 600,4,-9,0,-28
Make Mesh From Object 605,602
Add Limb 600,5,605
Offset Limb 600,5,9,0,-28
Scale Object 602,190,65,190
Make Object Sphere 603,3
Scale Object 603,195,195,65
Make Mesh From Object 606,603
Add Limb 600,6,606
Offset Limb 600,6,-9,0,-28
Make Mesh From Object 607,603
Add Limb 600,7,607
Offset Limb 600,7,9,0,-28
Delete Object 603
Make Object Cube 604,1
Make Mesh From Object 608,604
Add Limb 600,8,608
Offset Limb 600,8,0,0,70
Hide Limb 600,8
Delete Object 604

Delete Object 602



Rem Hide Object 600

For I = 604 to 605
   Make Object Cylinder I,3
   Scale Object I,95,1800,95
   Texture Object I,9
   Ghost Object On I
   Pitch Object Up I,90
   Fade Object I,400
Next I
Glue Object to Limb 604,600,2
Glue Object to Limb 605,600,3

Texture Limb 600,0,7
Scroll Limb Texture 600,0,.5,-.1
For i = 1 to 5
   Texture Limb 600,i,6
Next I
Texture Limb 600,6,8
Texture Limb 600,7,8
Disable Object ZDepth 600

For I = 0 to 7
   Set Limb Smoothing 600,i,20
Next I

Make Object Sphere 610,80
Texture Object 610,12
Ghost Object On 610
Glue Object to Limb 610,600,0

Rem <<< Set Initial Camera Position and Variables >>>
Position Camera 0,0,0
Speed# = 0
yRot# = 0
AyRot# = 0
spin# = 0
spin2#= 0
AutoDock = 0
ySpeed#=0
Modnum=0
Grids = 1
ShieldOn=0
LastSaved=2

Do
Select AutoDock
Case 0,4
Rem <<< Control input for Constructor Movement >>>
   a$=""
   CX=Object Position X(600):CY=Object Position Y(600):CZ=Object Position Z(600)
   If Upkey()=1
      Speed# = Speed#+.2
   Else
      Speed#=Speed#-.1
   Endif
   If LeftKey()=1
      yRot# = yRot#-.2
   Else
      If yRot#<0 Then yRot#=yRot#+.1
   Endif
   If RightKey()=1
      yRot# = yRot#+.2
   Else
      If yRot#>0 Then yRot#=yRot#-.1
   Endif
   If yRot#<.2 And yRot#>-.2 Then yRot#=0
   If DownKey()=1 Then Speed# = Speed#-.2
   IF Speed# >10 Then Speed# = 10
   If Speed# <0 Then Speed# = 0
   If yRot# > 5 then yRot# = 5
   If yRot# <-5 then yRot# = -5
   AyRot#=0

Rem <<< Auto Align >>>
   If yRot# = 0
      Limb0X# = Int(Limb Position X(600,0)*10)/10
      Limb0Z# = Int(Limb Position Z(600,0)*10)/10
      Limb1X# = Int(Limb Position X(600,1)*10)/10
      Limb1Z# = Int(Limb Position Z(600,1)*10)/10
      DiffX# = Limb0X#-Limb1X#: DiffZ# = Limb0Z#-Limb1Z#
      If DiffX#*DiffZ# <> 0
         If Abs(DiffX#)>Abs(DiffZ#)
            If DiffX#*DiffZ#>0 Then AyRot#=.1
            If DiffX#*DiffZ#<0 Then AyRot#=-.1
         Else
            If DiffX#*DiffZ#>0 Then AyRot#=-.1
            If DiffX#*DiffZ#<0 Then AyRot#=.1
         Endif
      Endif
   Endif

Rem <<< Control Contstructor Vertical Movement >>>
   a$ = Inkey$()
   If a$="a"
      ySpeed#=1
   Endif
   If a$="z"
      ySpeed#=-1
   Endif

Rem Save Ship
   If AutoDock=0 and a$="s" and ModNum-LastSaved>0
      Gosub SaveShip
   Endif

Rem <<< Keep Constructor in Dry Dock >>>
   If Object Position Y(600) <-460
      Position Object 600,Object Position X(600),-458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Y(600) >460
      Position Object 600,Object Position X(600),458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) <-460
      Position Object 600,Object Position X(600),Object Position Y(600),-458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) >460
      Position Object 600,Object Position X(600),Object Position Y(600),458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position X(600) <-460
      Position Object 600,-458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If Object Position X(600) >460
      Position Object 600,458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If CheckLimbHit(600,0,80,700)=1
      Move Object 600,Speed#*-2
      Speed#=Int(Speed#/2)
      ShieldOn = 10
   Endif
   If ModNum>1
      LS=80:CLimb=0
      If Autodock=4
         LS=50
         CLimb=8
      Endif
      For i = 1 to ModNum-1
         cHit=CheckLimbhit(600,CLimb,LS,1000+i)
         If cHit=1
            Move Object 600,Speed#*-2
            Speed#=Int(Speed#/2)
            ySpeed#=OldySpeed#*-1
            yRot#=yRot#*-1
            IF LS=80 Then ShieldOn=10
         Endif
      Next i
   Endif

Rem <<< Check for Autodock >>>
   cHit = Checkhit(600,702)
   If cHit=1 And AutoDock<>4
      AutoDock = 1
      Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
      Enable Object ZDepth 600
   Endif

Rem <<< Check for Dropping Module Off And Drop >>>
   Rem <Check Grid Overlap>
   GridFlag = 0: GridHit = 0:TGridHit=0:Dist=2000
   If Autodock = 4 and asc(a$) = 13
      For i = 1 to Grids
         If CheckLimbHit(600,8,50,2000+i)=1
            GridFlag = 1
            TGridHit = 2000+i
            TDist=GetLimbDistance(600,8,2000+i)
            If TDist<Dist
               GridHit=TGridHit
               Dist=TDist
            Endif
         Endif
      Next i
   Endif

   Set Cursor 0,100: Print CheckLimbHit(1000+ModNum,8,50,2000+Grids);" ";Limb Position X(600,8);" ";Limb Position Z(600,8):Print Grids:Print ModNum
   If Autodock = 4 and asc(a$) = 13 and GridFlag=1
      Unglue Object 1000+ModNum
      Modules#(ModNum,1)=ModuleNum
      Show Object 1
      Position Object 1000+ModNum,Object Position X(GridHit), Object Position Y(GridHit),Object Position Z(GridHit)
      Modules#(ModNum,2) =Object Position X(1000+ModNum)
      Modules#(ModNum,3) =Object Position Y(1000+ModNum)
      Modules#(ModNum,4) =Object Position Z(1000+ModNum)
      Rotate Object 1000+ModNum,Object Angle X(1),Object Angle Y(1),Object Angle Z(1)
      AutoDock =0
      Hide Object 750
      Rem <Create New Grids>
      Restore GridOffset
      OldGrid = 2000+Grids
      For i = 1 to 6
         Read GX,GY,GZ
         Grids=Grids+1
         CopyObject(2000+Grids,2001)
         Position Object 2000+Grids,Object Position X(GridHit)+GX,Object Position Y(GridHit)+GY,Object Position Z(GridHit)+GZ
         TGrids=Grids
         Overlap=0
         For j = 2001 to OldGrid
            If CheckHit(2000+Grids,j) = 1
               Overlap=1
            Endif
         Next j
         If Overlap=1
            Delete Object 2000+Grids
            Grids=Grids-1
         Endif
         If TGrids=Grids
            Texture Object 2000+Grids,11
            Set Object 2000+Grids,1,0,0
            Ghost Object On 2000+Grids
            Fade Object 2000+Grids,250
         Endif
      Next i
      Hide Object GridHit
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      ModNum=ModNum+1
   Endif
   If ShieldOn>0
      ShieldOn = ShieldOn-1
      Show Object 610
   Else
      Hide Object 610
   Endif
EndCase
Case 1

Rem <<< Autodock >>>
Rem <<< Turn Constructor Toward Bay>>>
   Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
   If Int(Limb Position Z(600,0)*10)>Int(Limb Position Z(600,1)*10)
      aYRot#=.2
   Endif
   If Int(Limb Position Z(600,0)*10)<Int(Limb Position Z(600,1)*10)
      aYRot#=-.2
   Endif
Rem <<< Raise or Lower Constructor >>>
   If Int(Object Position Y(600)*10)<0 Then ySpeed# =.5
   If Int(Object Position Y(600)*10)>0 Then ySpeed# =-.5
Rem <<< Move Contructor Towards Bay >>>
   MoveX#=0
   If Int(Object Position X(600)*20)/20<380 Then MoveX#=.5
   If Int(Object Position X(600)*20)/20>380 Then MoveX#=-.5
   MoveZ#=0
   If Int(Object Position Z(600)*20)/20<460 Then MoveZ#=.2
   If Int(Object Position Z(600)*20)/20>460 Then MoveZ#=-.2
   Position Object 600,Object Position X(600)+MoveX#,Object Position Y(600),Object Position Z(600)+MoveZ#
   If MoveX#+MoveZ#+ySpeed#+AyRot#=0
      AutoDock=2
      Show Object 750
      ModuleNum=0
      OldModuleNum=0
      KeyDelay=0
      OldRow=0
      OldCol=0

      If ModNum=0 Then Modnum=Modnum+1
      CopyObject(1000+ModNum,1)
      Hide Object 1
      Hide Object 1000+ModNum
      Position Object 1,450,0,460
      Texture Object 1000+ModNum,1
      Position Object 1000+ModNum,450,0,460
      Show Object 1000+ModNum
   Endif
EndCase


` <<< Docked: Select Module >>>
Case 2
   a$ = ""
   Restore ModuleList
   For i = 0 to ModuleNum
      Read ModName$
   Next I
   If KeyDelay<1
      a$=Inkey$()
      KeyDelay = 10
   Else
      a$=""
      KeyDelay=KeyDelay-1
   Endif
   If a$="," Then ModuleNum=ModuleNum-1
   If a$="." Then ModuleNum=ModuleNum+1
   Set Cursor 0,100: Print ModuleNum
   If ModuleNum<>OldModuleNum
      If ModuleNum<0 Then ModuleNum=15
      If ModuleNum>15 Then   ModuleNum=0
      Col=Int(ModuleNum/4)
      Row=ModuleNum-(Col*4)
      OldModuleNum=ModuleNum
` <<< Unscroll Last Texture Scroll >>>
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
` <<< Scroll New Texture Scroll >>>
      ScrollRow#=.25*Row
      ScrollCol#=.25*Col
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      OldRow = Row:OldCol = Col
   Endif
   Set Cursor 100,100:Print ModName$
   If asc(a$)=13
      Autodock = 3
      ReleaseWait=0
   Endif
EndCase
` <<< Release From Autodock with Module in tow >>>
Case 3
   POsition Object 1000+ModNum,0,0,0
   Glue Object To Limb 1000+ModNum,600,8
   Speed#=-.3
   If Checkhit(600,702)=0
      ReleaseWait = ReleaseWait+1
      If ReleaseWait>10
         Speed#=0
         Autodock =4
      Endif
   Endif
EndCase

EndSelect
Set Cursor 0,0
Print Autodock
Print Asc(Inkey$())

` <<< Clean Up Movement and Camera >>>
   Move Object 600, Speed#
   Rem Scale Object 602,190,200+(Speed#*20),190
   Rem Scale Object 603,190,200+(Speed#*20),190
   Turn Object Right 600, yRot#+AyRot#
   Position Object 600, Object Position X(600),Object Position Y(600) + ySpeed#,Object Position Z(600)
   OldySpeed#=ySpeed#
   ySpeed#=0
   spin# = spin#+.2
   spin2# = spin2#+.3
   Turn Object Left 502,-.02
   Turn Object Left 507,-.02
   Turn Object Right 750, 3
   Scroll Limb Texture 600,6,.2,.3
   Scroll Limb Texture 600,7,.3,.2
   Rem Scroll Object Texture 602,.3,.2
   Rem Scroll Object Texture 603,.2,.3
   Scroll Object Texture 604,0,.3
   Scroll Object Texture 605,0,.3
   Scroll Object Texture 610,.3,.2
   Scroll Object Texture 701,0,.2
   If Spin2#>10
      Spin#=Spin#*-1
      Spin2#=Spin2#*-1
      Scroll Limb Texture 600,6,Spin#,Spin2#
      Scroll Limb Texture 600,7,Spin2#,Spin#
      Rem Scroll Object Texture 602,Spin2#,Spin#
      Rem Scroll Object Texture 603,Spin#,Spin2#
      Scroll Object Texture 604,0,Spin2#
      Scroll Object Texture 605,0,Spin2#
      Scroll Object Texture 605,Spin2#,Spin#
      Scroll Object Texture 701,0,Spin#
      Spin#=0
      Spin2#=0
   Endif
   Turn Object Left 701,.25

   Move Object 600,-80
   Move Object Up 600,20
   Set Camera To Follow Object Position X(600), Object Position Y(600),Object Position Z(600),0,0,0,50,1
   Move Object Down 600,20
   Move Object 600,80
   Point Camera Object Position X(600),Object POsition Y(600),Object POsition Z(600)
   Sync

Loop

SaveShip:
Set Text Size 32
a$=""
Do
   Center Text 700,400,"Save and Exit: Are You Sure (Y/N)?";
   a$= inkey$()
   If a$="n" then Return
   If a$="y" then exit
   Sync
Loop

If ModNum<3 then Return
Rotate Object 1001,0,0,0
For i = LastSaved to ModNum-1
   Position Object 1000+i,0,0,0
   Make Mesh From Object 8000+i,1000+i
   Add Limb 1001,i-1,8000+i
   Offset Limb 1001,i-1,Modules#(i,2),Modules#(i,3),Modules#(i,4)
   Delete Object 1000+i
Next i
LastSaved=ModNum-1
Make Mesh from Object 9001,1001
If File Exist ("Starship")=1
   Delete File "Starship"
Endif
Save Mesh "Starship",9001
Delete Mesh 9001
Delete Object 1001
Save Array "ShipMods.ssm",Modules#(1000,4)
Load Mesh "Starship",9002
Make Object 1001,9002,6

For I = 1 to 20
   SET OBJECT SMOOTHING 1001,100
Next I

Do
   Sync
   Turn Object Left 1001,1
   Roll Object Right 1001,1.2
   Pitch Object Up 1001,.6
Loop

Return

End

Function CheckHit(Object1,Object2)
   If Object Exist(Object1)=0 or Object Exist(Object2)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Object Position X(Object1)
   Y1#=Object Position Y(Object1)
   Z1#=Object Position Z(Object1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=Object Size X(Object1)
   SY1#=Object Size Y(Object1)
   SZ1#=Object Size Z(Object1)
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CheckLimbHit(Object1,Limb1,LimbSize1,Object2)
   If Object Exist(Object1)=0 Then ExitFunction 0
   If Object Exist(Object2)=0 Then ExitFunction 0
   If Limb Exist(Object1,Limb1)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Limb Position X(Object1,Limb1)
   Y1#=Limb Position Y(Object1,Limb1)
   Z1#=Limb Position Z(Object1,Limb1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=LimbSize1
   SY1#=LimbSize1
   SZ1#=LimbSize1
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CopyObject(ObjectTo,ObjectFrom)
   Do
      MeshNum = Rnd(5000)+1
      If Mesh Exist(MeshNum)=0 Then Exit
   Loop
   OX=Object Position X(ObjectFrom):OY=Object Position Y(ObjectFrom):OZ=Object Position Z(ObjectFrom)
   AX=Object Angle X(ObjectFrom):AY=Object Angle Y(ObjectFrom):AZ=Object Angle Z(ObjectFrom)
   Position Object ObjectFrom,0,0,0
   Rotate Object ObjectFrom,0,0,0
   Make Mesh From Object MeshNum,ObjectFrom
   Make Object ObjectTo,MeshNum,0
   Delete Mesh MeshNum
   Position Object ObjectFrom,OX,OY,OZ
   Rotate Object ObjectFrom,AX,AY,AZ
EndFunction

Function GetDistance(O1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   DX=Object Position X(O1)-Object Position X(O2)
   DY=Object Position Y(O1)-Object Position Y(O2)
   DZ=Object Position Z(O1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function GetLimbDistance(O1,L1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   If Limb Exist(O1,L1)=0 Then ExitFunction -1
   DX=Limb Position X(O1,L1)-Object Position X(O2)
   DY=Limb Position Y(O1,L1)-Object Position Y(O2)
   DZ=Limb Position Z(O1,L1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function CreatePlanet(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,240),1
   For i = 0 to 480
      Line 0,i,640,i
   Next i

   For j = 1 to rnd(10)+7
      Ink rgb(10,rnd(100)+50,10),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 720
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,640,480
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateClouds(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,240),1
   For i = 0 to 480
      Line 0,i,640,i
   Next i

   For j = 1 to rnd(10)+7
      w=rnd(50)+180
      Ink rgb(w,w,w),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 720
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,640,480
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateStarField(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,1000,1000
   Lock Pixels
   For j = 1 to 3
      For i = 1 to 1500
         Dot Rnd(1000),Rnd(1000),rgb(200+rnd(55),200+rnd(55),200+rnd(55))
      Next i
      Blur Bitmap 1,1
   Next j
   Unlock Pixels
   Get Image image,0,0,999,950
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction


Function Const_Skin1(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,500,500
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Const_Skin2(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,500,500
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   Box 125,60,375,185
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Fire(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,64,64
   Lock Pixels
   Ink rgb(200,0,0),0
   Box 0,0,64,64
   For i = 0 to 200
      red =rnd(200)+55
      Dot rnd(64),rnd(64),rgb(red,red-50,red-50)
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,64,64,1
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Beam_Effect1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,256,256
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(0,0,170),0
   For i = 0 to 30
      lx=rnd(256)
      ly1=rnd(256)
      ly2=rnd(256)
      Line lx,ly1,lx,ly2
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Grid1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,256,256
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(100,100,0),0
   Box 0,0,256,3
   Box 0,0,3,256
   Box 252,0,256,256
   Box 0,252,256,256
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function BaySide(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,256,256
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,256,256
   Ink RGB(175,175,175),0
   Box 20,20,236,236
   Ink Rgb(255,255,0),0
   For i = 236 to 256
      line i,0,0,i
      line i,256,256,i
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Star(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,512,512
   Lock Pixels
   Ink rgb(110,90,90),0
   For i = 1 to 200
      Ink rgb(200-i,100-(i/2),100-(i/2)),0
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Ink rgb(255,250,250),0
   For i = 1 to 20
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Blur Bitmap 1,1
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,512,512,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Drydock(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,512,512
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,512,512
   Ink 0,0
   Box 10,10,246,246
   Box 10,266,246,502
   Box 266,10,502,246
   Box 266,266,502,502
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Module(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,512,512
   Lock Pixels
   Ink RGB(128,128,128),0
   Box 0,0,512,512
   Restore ModuleSymbols
   Ink rgb(200,200,0),0
   For y=0 to 3
      For x=0 to 3
         Read m$
         Center Text x*64+32,y*64+32,m$
      Next x
   Next y
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

ModuleList:
Data "Hull (Empty)","Bridge","Shields","Deflectors"
Data "Marine Quarters","Computer","Phasors","Officer Quarters"
Data "Torpedo Bay","Medical Bay","Crew Quarters","Transporters"
Data "Armor","Repair Bay","Engines (Thrusters)","Warp Engines"

ModuleSymbols:
Data "H","B","S","D"
Data "M","C","P","O"
Data "T","+","Q","X"
Data "A","R","E","W"

GridOffset:
Data 0,0,51
Data 0,51,0
Data 51,0,0
Data 0,0,-51
Data 0,-51,0
Data -51,0,0

Rem Project: Starship
Rem Created: 6/25/2004 8:18:22 PM

Rem ***** Main Source File *****


Set Display Mode 1280,960,32
sync on : sync rate 30 : Color Backdrop rgb(0,0,0)
set camera range 0,1,7000
Position Camera 0,0,0,0
Autocam off
Set Image Colorkey 0,0,0

CreateStarField(16)
Make Object Sphere 2, 10000
Texture Object 2,16
Scale Object Texture 2,4,4
Position Object 2,0,0,0
Set Object Light 2,0
Set Object Cull 2,0
Fade Object 2,1000


Dim Modules#(1000,4)
Module(1)
`Load Image "Stars3.bmp",2
DryDock(3)
CreatePlanet(4)
CreateClouds(5)

ink rgb(255,255,255),0

`Images
Const_Skin1(6)
Const_Skin2(7)
Fire(8)
Beam_Effect1(9)
Grid1(11)
Beam_Effect1(12)
BaySide(13)
Star(15)

Set Ambient Light 1
Rem Fog On
Rem Fog Color 0
Rem Fog Distance 3000
Autocam Off
Make Light 2
Position Light 2,460,0,460
Set Directional Light 2,-1,0,0
Set Light Range 2,200
Color Light 2,RGB(0,0,250)

Rem <<< Base Module >>>
Make Object Cube 1,50
Position Object 1,450,0,460
Texture Object 1,1
Scale Object Texture 1,.25,.25

Make Object Cube 750,5
Position Object 750,-20,15,40
Texture Object 750,1
Scale Object Texture 750,.25,.25
Ghost Object On 750
Lock Object On 750
Hide Object 750
Disable Object ZDepth 750

Rem <<< Bright Star >>>
Make Object Plain 11,600,600
Texture Object 11,15
Set Object 11,1,1,0
Ghost Object On 11
Position Object 11,1800,100,100
Turn Object Right 11,90
Fade Object 11,1000
Make Light 1
Set Point Light 1, 1800,100,100
Color Light 1,240,240,255
Set Light Range 1, 10000

Rem <<< Planet >>>

PlanX = (rnd(1000)+1500)*(rnd(1)*2-1)
PlanY = 0
PLanZ = (rnd(1000)+1500)*(rnd(1)*2-1)

Make Object Sphere 502,1000,30,30
Position Object 502,PlanX,PlanY,PlanZ
Roll Object Left 502,38
Texture Object 502,5
Ghost Object On 502
Set Object 502,1,0,1,1,1,0,1
Fade Object 502,150


Make Object Sphere 507,970,30,30
Position Object 507,PlanX,PlanY,PlanZ
Texture Object 507,4
Roll Object Left 507,40
Set Object Smoothing 507,100

Make Object Sphere 508,1030,30,30
Position Object 508,PlanX,PlanY,PlanZ
Texture Object 508,5
Ghost Object On 508
Fade Object 508,60

Rem <<< Dry Dock >>>

Make Object Cube 503,0
Make Object Box 504,1000,3,1000

Make Mesh From Object 503,504
Add Limb 503,1,503
Offset Limb 503,1,0,0,500
Texture Limb 503,1,3
Rotate Limb 503,1,90,0,0
Scale Limb Texture 503,1,11,11

Make Mesh From Object 504,504
Add Limb 503,2,504
Offset Limb 503,2,0,0,-500
Texture Limb 503,2,3
Rotate Limb 503,2,90,0,0
Scale Limb Texture 503,2,11,11

Make Mesh From Object 505,504
Add Limb 503,3,505
Offset Limb 503,3,0,500,0
Texture Limb 503,3,3
Scale Limb Texture 503,3,11,11

Make Mesh From Object 506,504
Add Limb 503,4,506
Offset Limb 503,4,0,-500,0
Texture Limb 503,4,3
Scale Limb Texture 503,4,11,11
Fade Object 503,200

Delete Object 504
Set Object 503,1,1,0
Make Object Cube 2001,50
Texture Object 2001,11
Set Object 2001,1,0,0
Ghost Object On 2001
Fade Object 2001,250

Rem <<< Construction Bay >>>

Make Object Box 700,.5,.5,.5
Color Object 700,0
Make Object Box 701,104,79,8
For i = 1 to 4
   Make Mesh From Object 700+i,701
   Add Limb 700,i,700+i
   Texture Limb 700,i,13
Next i
Delete Object 701
Offset Limb 700,1,0,0,42
Offset Limb 700,2,0,0,-42
Offset Limb 700,3,0,42,0
Offset Limb 700,4,0,-42,0
Rotate Limb 700,3,90,0,0
Rotate Limb 700,4,90,0,0
Position Object 700,460,0,460
Set Object 700,1,1,1
Fix Object Pivot 700
Fade Object 700,200

Make Object Cylinder 701,70
Set Object 701,1,0,0,1,0,0,1
Scale Object 701,100,400,100
Texture Object 701,12
Scale Object Texture 701,4,1
Ghost Object On 701
Roll Object Right 701,90
Position Object 701,350,0,460
Fade Object 701,200
Make Particles 1,12,80,20
Position Particles 1,510,0,460
Color Particles 1,0,10,200
Rotate Particles 1,0,0,90
Set Particle Gravity 1,0
Set Particle Velocity 1,100
Set Particle Life 1,5

Make Object Box 702,280,60,60
Position Object 702,350,0,460
Set Object 702,1,1,0
Color Object 702,0

Rem <<< Constructor >>>

Make Object Sphere 600,25,20,20
Position Object 600,0,0,50
Make Object Box 601,25,10,25
Make Mesh From Object 601,601
Add Limb 600,1,601
Offset Limb 600,1,0,0,-15
Delete Object 601
Make Object Cylinder 602,3
Scale Object 602,100,1500,100
Pitch Object Up 602,90
Make Mesh From Object 602,602
Add Limb 600,2,602
Offset Limb 600,2,10.9,0,15
Make Mesh From Object 603,602
Add Limb 600,3,603
Offset Limb 600,3,-10.9,0,15
Scale Object 602,200,60,200
Make Mesh From Object 604,602
Add Limb 600,4,604
Offset Limb 600,4,-9,0,-28
Make Mesh From Object 605,602
Add Limb 600,5,605
Offset Limb 600,5,9,0,-28
Scale Object 602,190,65,190
Make Object Sphere 603,3
Scale Object 603,195,195,65
Make Mesh From Object 606,603
Add Limb 600,6,606
Offset Limb 600,6,-9,0,-28
Make Mesh From Object 607,603
Add Limb 600,7,607
Offset Limb 600,7,9,0,-28
Delete Object 603
Make Object Cube 604,1
Make Mesh From Object 608,604
Add Limb 600,8,608
Offset Limb 600,8,0,0,70
Hide Limb 600,8
Delete Object 604

Delete Object 602



Rem Hide Object 600

For I = 604 to 605
   Make Object Cylinder I,3
   Scale Object I,95,1800,95
   Texture Object I,9
   Ghost Object On I
   Pitch Object Up I,90
   Fade Object I,400
Next I
Glue Object to Limb 604,600,2
Glue Object to Limb 605,600,3

Texture Limb 600,0,7
Scroll Limb Texture 600,0,.5,-.1
For i = 1 to 5
   Texture Limb 600,i,6
Next I
Texture Limb 600,6,8
Texture Limb 600,7,8
Disable Object ZDepth 600

For I = 0 to 7
   Set Limb Smoothing 600,i,20
Next I

Make Object Sphere 610,80
Texture Object 610,12
Ghost Object On 610
Glue Object to Limb 610,600,0

Rem <<< Set Initial Camera Position and Variables >>>
Position Camera 0,0,0
Speed# = 0
yRot# = 0
AyRot# = 0
spin# = 0
spin2#= 0
AutoDock = 0
ySpeed#=0
Modnum=0
Grids = 1
ShieldOn=0
LastSaved=2

Do
Select AutoDock
Case 0,4
Rem <<< Control input for Constructor Movement >>>
   a$=""
   CX=Object Position X(600):CY=Object Position Y(600):CZ=Object Position Z(600)
   If Upkey()=1
      Speed# = Speed#+.2
   Else
      Speed#=Speed#-.1
   Endif
   If LeftKey()=1
      yRot# = yRot#-.2
   Else
      If yRot#<0 Then yRot#=yRot#+.1
   Endif
   If RightKey()=1
      yRot# = yRot#+.2
   Else
      If yRot#>0 Then yRot#=yRot#-.1
   Endif
   If yRot#<.2 And yRot#>-.2 Then yRot#=0
   If DownKey()=1 Then Speed# = Speed#-.2
   IF Speed# >10 Then Speed# = 10
   If Speed# <0 Then Speed# = 0
   If yRot# > 5 then yRot# = 5
   If yRot# <-5 then yRot# = -5
   AyRot#=0

Rem <<< Auto Align >>>
   If yRot# = 0
      Limb0X# = Int(Limb Position X(600,0)*10)/10
      Limb0Z# = Int(Limb Position Z(600,0)*10)/10
      Limb1X# = Int(Limb Position X(600,1)*10)/10
      Limb1Z# = Int(Limb Position Z(600,1)*10)/10
      DiffX# = Limb0X#-Limb1X#: DiffZ# = Limb0Z#-Limb1Z#
      If DiffX#*DiffZ# <> 0
         If Abs(DiffX#)>Abs(DiffZ#)
            If DiffX#*DiffZ#>0 Then AyRot#=.1
            If DiffX#*DiffZ#<0 Then AyRot#=-.1
         Else
            If DiffX#*DiffZ#>0 Then AyRot#=-.1
            If DiffX#*DiffZ#<0 Then AyRot#=.1
         Endif
      Endif
   Endif

Rem <<< Control Contstructor Vertical Movement >>>
   a$ = Inkey$()
   If a$="a"
      ySpeed#=1
   Endif
   If a$="z"
      ySpeed#=-1
   Endif

Rem Save Ship
   If AutoDock=0 and a$="s" and ModNum-LastSaved>0
      Gosub SaveShip
   Endif

Rem <<< Keep Constructor in Dry Dock >>>
   If Object Position Y(600) <-460
      Position Object 600,Object Position X(600),-458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Y(600) >460
      Position Object 600,Object Position X(600),458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) <-460
      Position Object 600,Object Position X(600),Object Position Y(600),-458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) >460
      Position Object 600,Object Position X(600),Object Position Y(600),458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position X(600) <-460
      Position Object 600,-458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If Object Position X(600) >460
      Position Object 600,458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If CheckLimbHit(600,0,80,700)=1
      Move Object 600,Speed#*-2
      Speed#=Int(Speed#/2)
      ShieldOn = 10
   Endif
   If ModNum>1
      LS=80:CLimb=0
      If Autodock=4
         LS=50
         CLimb=8
      Endif
      For i = 1 to ModNum-1
         cHit=CheckLimbhit(600,CLimb,LS,1000+i)
         If cHit=1
            Move Object 600,Speed#*-2
            Speed#=Int(Speed#/2)
            ySpeed#=OldySpeed#*-1
            yRot#=yRot#*-1
            IF LS=80 Then ShieldOn=10
         Endif
      Next i
   Endif

Rem <<< Check for Autodock >>>
   cHit = Checkhit(600,702)
   If cHit=1 And AutoDock<>4
      AutoDock = 1
      Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
      Enable Object ZDepth 600
   Endif

Rem <<< Check for Dropping Module Off And Drop >>>
   Rem <Check Grid Overlap>
   GridFlag = 0: GridHit = 0:TGridHit=0:Dist=2000
   If Autodock = 4 and asc(a$) = 13
      For i = 1 to Grids
         If CheckLimbHit(600,8,50,2000+i)=1
            GridFlag = 1
            TGridHit = 2000+i
            TDist=GetLimbDistance(600,8,2000+i)
            If TDist<Dist
               GridHit=TGridHit
               Dist=TDist
            Endif
         Endif
      Next i
   Endif

   Set Cursor 0,100: Print CheckLimbHit(1000+ModNum,8,50,2000+Grids);" ";Limb Position X(600,8);" ";Limb Position Z(600,8):Print Grids:Print ModNum
   If Autodock = 4 and asc(a$) = 13 and GridFlag=1
      Unglue Object 1000+ModNum
      Modules#(ModNum,1)=ModuleNum
      Show Object 1
      Position Object 1000+ModNum,Object Position X(GridHit), Object Position Y(GridHit),Object Position Z(GridHit)
      Modules#(ModNum,2) =Object Position X(1000+ModNum)
      Modules#(ModNum,3) =Object Position Y(1000+ModNum)
      Modules#(ModNum,4) =Object Position Z(1000+ModNum)
      Rotate Object 1000+ModNum,Object Angle X(1),Object Angle Y(1),Object Angle Z(1)
      AutoDock =0
      Hide Object 750
      Rem <Create New Grids>
      Restore GridOffset
      OldGrid = 2000+Grids
      For i = 1 to 6
         Read GX,GY,GZ
         Grids=Grids+1
         CopyObject(2000+Grids,2001)
         Position Object 2000+Grids,Object Position X(GridHit)+GX,Object Position Y(GridHit)+GY,Object Position Z(GridHit)+GZ
         TGrids=Grids
         Overlap=0
         For j = 2001 to OldGrid
            If CheckHit(2000+Grids,j) = 1
               Overlap=1
            Endif
         Next j
         If Overlap=1
            Delete Object 2000+Grids
            Grids=Grids-1
         Endif
         If TGrids=Grids
            Texture Object 2000+Grids,11
            Set Object 2000+Grids,1,0,0
            Ghost Object On 2000+Grids
            Fade Object 2000+Grids,250
         Endif
      Next i
      Hide Object GridHit
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      ModNum=ModNum+1
   Endif
   If ShieldOn>0
      ShieldOn = ShieldOn-1
      Show Object 610
   Else
      Hide Object 610
   Endif
EndCase
Case 1

Rem <<< Autodock >>>
Rem <<< Turn Constructor Toward Bay>>>
   Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
   If Int(Limb Position Z(600,0)*10)>Int(Limb Position Z(600,1)*10)
      aYRot#=.2
   Endif
   If Int(Limb Position Z(600,0)*10)<Int(Limb Position Z(600,1)*10)
      aYRot#=-.2
   Endif
Rem <<< Raise or Lower Constructor >>>
   If Int(Object Position Y(600)*10)<0 Then ySpeed# =.5
   If Int(Object Position Y(600)*10)>0 Then ySpeed# =-.5
Rem <<< Move Contructor Towards Bay >>>
   MoveX#=0
   If Int(Object Position X(600)*20)/20<380 Then MoveX#=.5
   If Int(Object Position X(600)*20)/20>380 Then MoveX#=-.5
   MoveZ#=0
   If Int(Object Position Z(600)*20)/20<460 Then MoveZ#=.2
   If Int(Object Position Z(600)*20)/20>460 Then MoveZ#=-.2
   Position Object 600,Object Position X(600)+MoveX#,Object Position Y(600),Object Position Z(600)+MoveZ#
   If MoveX#+MoveZ#+ySpeed#+AyRot#=0
      AutoDock=2
      Show Object 750
      ModuleNum=0
      OldModuleNum=0
      KeyDelay=0
      OldRow=0
      OldCol=0

      If ModNum=0 Then Modnum=Modnum+1
      CopyObject(1000+ModNum,1)
      Hide Object 1
      Hide Object 1000+ModNum
      Position Object 1,450,0,460
      Texture Object 1000+ModNum,1
      Position Object 1000+ModNum,450,0,460
      Show Object 1000+ModNum
   Endif
EndCase


` <<< Docked: Select Module >>>
Case 2
   a$ = ""
   Restore ModuleList
   For i = 0 to ModuleNum
      Read ModName$
   Next I
   If KeyDelay<1
      a$=Inkey$()
      KeyDelay = 10
   Else
      a$=""
      KeyDelay=KeyDelay-1
   Endif
   If a$="," Then ModuleNum=ModuleNum-1
   If a$="." Then ModuleNum=ModuleNum+1
   Set Cursor 0,100: Print ModuleNum
   If ModuleNum<>OldModuleNum
      If ModuleNum<0 Then ModuleNum=15
      If ModuleNum>15 Then   ModuleNum=0
      Col=Int(ModuleNum/4)
      Row=ModuleNum-(Col*4)
      OldModuleNum=ModuleNum
` <<< Unscroll Last Texture Scroll >>>
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
` <<< Scroll New Texture Scroll >>>
      ScrollRow#=.25*Row
      ScrollCol#=.25*Col
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      OldRow = Row:OldCol = Col
   Endif
   Set Cursor 100,100:Print ModName$
   If asc(a$)=13
      Autodock = 3
      ReleaseWait=0
   Endif
EndCase
` <<< Release From Autodock with Module in tow >>>
Case 3
   POsition Object 1000+ModNum,0,0,0
   Glue Object To Limb 1000+ModNum,600,8
   Speed#=-.3
   If Checkhit(600,702)=0
      ReleaseWait = ReleaseWait+1
      If ReleaseWait>10
         Speed#=0
         Autodock =4
      Endif
   Endif
EndCase

EndSelect
Set Cursor 0,0
Print Autodock
Print Asc(Inkey$())

` <<< Clean Up Movement and Camera >>>
   Move Object 600, Speed#
   Rem Scale Object 602,190,200+(Speed#*20),190
   Rem Scale Object 603,190,200+(Speed#*20),190
   Turn Object Right 600, yRot#+AyRot#
   Position Object 600, Object Position X(600),Object Position Y(600) + ySpeed#,Object Position Z(600)
   OldySpeed#=ySpeed#
   ySpeed#=0
   spin# = spin#+.2
   spin2# = spin2#+.3
   Turn Object Left 502,-.02
   Turn Object Left 507,-.02
   Turn Object Right 750, 3
   Scroll Limb Texture 600,6,.2,.3
   Scroll Limb Texture 600,7,.3,.2
   Rem Scroll Object Texture 602,.3,.2
   Rem Scroll Object Texture 603,.2,.3
   Scroll Object Texture 604,0,.3
   Scroll Object Texture 605,0,.3
   Scroll Object Texture 610,.3,.2
   Scroll Object Texture 701,0,.2
   If Spin2#>10
      Spin#=Spin#*-1
      Spin2#=Spin2#*-1
      Scroll Limb Texture 600,6,Spin#,Spin2#
      Scroll Limb Texture 600,7,Spin2#,Spin#
      Rem Scroll Object Texture 602,Spin2#,Spin#
      Rem Scroll Object Texture 603,Spin#,Spin2#
      Scroll Object Texture 604,0,Spin2#
      Scroll Object Texture 605,0,Spin2#
      Scroll Object Texture 605,Spin2#,Spin#
      Scroll Object Texture 701,0,Spin#
      Spin#=0
      Spin2#=0
   Endif
   Turn Object Left 701,.25

   Move Object 600,-80
   Move Object Up 600,20
   Set Camera To Follow Object Position X(600), Object Position Y(600),Object Position Z(600),0,0,0,50,1
   Move Object Down 600,20
   Move Object 600,80
   Point Camera Object Position X(600),Object POsition Y(600),Object POsition Z(600)
   Sync

Loop

SaveShip:
Set Text Size 32
a$=""
Do
   Center Text 700,400,"Save and Exit: Are You Sure (Y/N)?";
   a$= inkey$()
   If a$="n" then Return
   If a$="y" then exit
   Sync
Loop

If ModNum<3 then Return
Rotate Object 1001,0,0,0
For i = LastSaved to ModNum-1
   Position Object 1000+i,0,0,0
   Make Mesh From Object 8000+i,1000+i
   Add Limb 1001,i-1,8000+i
   Offset Limb 1001,i-1,Modules#(i,2),Modules#(i,3),Modules#(i,4)
   Delete Object 1000+i
Next i
LastSaved=ModNum-1
Make Mesh from Object 9001,1001
If File Exist ("Starship")=1
   Delete File "Starship"
Endif
Save Mesh "Starship",9001
Delete Mesh 9001
Delete Object 1001
Save Array "ShipMods.ssm",Modules#(1000,4)
Load Mesh "Starship",9002
Make Object 1001,9002,6

For I = 1 to 20
   SET OBJECT SMOOTHING 1001,100
Next I

Do
   Sync
   Turn Object Left 1001,1
   Roll Object Right 1001,1.2
   Pitch Object Up 1001,.6
Loop

Return

End

Function CheckHit(Object1,Object2)
   If Object Exist(Object1)=0 or Object Exist(Object2)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Object Position X(Object1)
   Y1#=Object Position Y(Object1)
   Z1#=Object Position Z(Object1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=Object Size X(Object1)
   SY1#=Object Size Y(Object1)
   SZ1#=Object Size Z(Object1)
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CheckLimbHit(Object1,Limb1,LimbSize1,Object2)
   If Object Exist(Object1)=0 Then ExitFunction 0
   If Object Exist(Object2)=0 Then ExitFunction 0
   If Limb Exist(Object1,Limb1)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Limb Position X(Object1,Limb1)
   Y1#=Limb Position Y(Object1,Limb1)
   Z1#=Limb Position Z(Object1,Limb1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=LimbSize1
   SY1#=LimbSize1
   SZ1#=LimbSize1
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CopyObject(ObjectTo,ObjectFrom)
   Do
      MeshNum = Rnd(5000)+1
      If Mesh Exist(MeshNum)=0 Then Exit
   Loop
   OX=Object Position X(ObjectFrom):OY=Object Position Y(ObjectFrom):OZ=Object Position Z(ObjectFrom)
   AX=Object Angle X(ObjectFrom):AY=Object Angle Y(ObjectFrom):AZ=Object Angle Z(ObjectFrom)
   Position Object ObjectFrom,0,0,0
   Rotate Object ObjectFrom,0,0,0
   Make Mesh From Object MeshNum,ObjectFrom
   Make Object ObjectTo,MeshNum,0
   Delete Mesh MeshNum
   Position Object ObjectFrom,OX,OY,OZ
   Rotate Object ObjectFrom,AX,AY,AZ
EndFunction

Function GetDistance(O1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   DX=Object Position X(O1)-Object Position X(O2)
   DY=Object Position Y(O1)-Object Position Y(O2)
   DZ=Object Position Z(O1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function GetLimbDistance(O1,L1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   If Limb Exist(O1,L1)=0 Then ExitFunction -1
   DX=Limb Position X(O1,L1)-Object Position X(O2)
   DY=Limb Position Y(O1,L1)-Object Position Y(O2)
   DZ=Limb Position Z(O1,L1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function CreatePlanet(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,240),1
   For i = 0 to 480
      Line 0,i,640,i
   Next i

   For j = 1 to rnd(10)+7
      Ink rgb(10,rnd(100)+50,10),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 360
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         if x#>638 then x#=638
         if x#<0 then x#=0
         if y#>478 then y#=478
         if y#<0 then y#=0
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,639,479
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateClouds(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,10),1
   Box 0,0,639,479
   For j = 1 to rnd(10)+7
      w=rnd(50)+180
      Ink rgb(w,w,w),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 360
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         if x#>638 then x#=638
         if x#<0 then x#=0
         if y#>478 then y#=478
         if y#<0 then y#=0
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,639,479
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateStarField(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,1000,1000
   Lock Pixels
   For j = 1 to 3
      For i = 1 to 1500
         Dot Rnd(999),Rnd(999),rgb(200+rnd(55),200+rnd(55),200+rnd(55))
      Next i
      Blur Bitmap 1,1
   Next j
   Unlock Pixels
   Get Image image,0,0,999,999
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction


Function Const_Skin1(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,501,501
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Const_Skin2(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,501,501
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   Box 125,60,375,185
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Fire(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,65,65
   Lock Pixels
   Ink rgb(200,0,0),0
   Box 0,0,64,64
   For i = 0 to 200
      red =rnd(200)+55
      Dot rnd(64),rnd(64),rgb(red,red-50,red-50)
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,64,64,1
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Beam_Effect1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(0,0,170),0
   For i = 0 to 30
      lx=rnd(256)
      ly1=rnd(256)
      ly2=rnd(256)
      Line lx,ly1,lx,ly2
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Grid1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(100,100,0),0
   Box 0,0,256,3
   Box 0,0,3,256
   Box 252,0,256,256
   Box 0,252,256,256
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function BaySide(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,256,256
   Ink RGB(175,175,175),0
   Box 20,20,236,236
   Ink Rgb(255,255,0),0
   For i = 236 to 256
      line i,0,0,i
      line i,256,256,i
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Star(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink rgb(110,90,90),0
   For i = 1 to 200
      Ink rgb(200-i,100-(i/2),100-(i/2)),0
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Ink rgb(255,250,250),0
   For i = 1 to 20
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Blur Bitmap 1,1
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,512,512,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Drydock(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,512,512
   Ink 0,0
   Box 10,10,246,246
   Box 10,266,246,502
   Box 266,10,502,246
   Box 266,266,502,502
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Module(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink RGB(128,128,128),0
   Box 0,0,512,512
   Restore ModuleSymbols
   Ink rgb(200,200,0),0
   For y=0 to 3
      For x=0 to 3
         Read m$
         Center Text x*64+32,y*64+32,m$
      Next x
   Next y
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

ModuleList:
Data "Hull (Empty)","Bridge","Shields","Deflectors"
Data "Marine Quarters","Computer","Phasors","Officer Quarters"
Data "Torpedo Bay","Medical Bay","Crew Quarters","Transporters"
Data "Armor","Repair Bay","Engines (Thrusters)","Warp Engines"

ModuleSymbols:
Data "H","B","S","D"
Data "M","C","P","O"
Data "T","+","Q","X"
Data "A","R","E","W"

GridOffset:
Data 0,0,51
Data 0,51,0
Data 51,0,0
Data 0,0,-51
Data 0,-51,0
Data -51,0,0

Rem Project: Starship
Rem Created: 6/25/2004 8:18:22 PM

Rem ***** Main Source File *****


Set Display Mode 1280,960,32
sync on : sync rate 30 : Color Backdrop rgb(0,0,0)
set camera range 0,1,7000
Position Camera 0,0,0,0
Autocam off
Set Image Colorkey 0,0,0

CreateStarField(16)
Make Object Sphere 2, 10000
Texture Object 2,16
Scale Object Texture 2,4,4
Position Object 2,0,0,0
Set Object Light 2,0
Set Object Cull 2,0
Fade Object 2,1000


Dim Modules#(1000,4)


ink rgb(255,255,255),0

`Images
Module(1)
DryDock(3)
CreatePlanet(4)
CreateClouds(5)
Const_Skin1(6)
Const_Skin2(7)
Fire(8)
Beam_Effect1(9)
Grid1(11)
Beam_Effect1(12)
BaySide(13)
Star(15)

Set Ambient Light 1
Rem Fog On
Rem Fog Color 0
Rem Fog Distance 3000
Autocam Off
Make Light 2
Position Light 2,460,0,460
Set Directional Light 2,-1,0,0
Set Light Range 2,200
Color Light 2,RGB(0,0,250)

Rem <<< Base Module >>>
Make Object Cube 1,50
Position Object 1,450,0,460
Texture Object 1,1
Scale Object Texture 1,.25,.25

Make Object Cube 750,5
Position Object 750,-20,15,40
Texture Object 750,1
Scale Object Texture 750,.25,.25
Ghost Object On 750
Lock Object On 750
Hide Object 750
Disable Object ZDepth 750

Rem <<< Bright Star >>>
Make Object Plain 11,600,600
Texture Object 11,15
Set Object 11,1,1,0
Ghost Object On 11
Position Object 11,1800,100,100
Turn Object Right 11,90
Fade Object 11,1000
Make Light 1
Set Point Light 1, 1800,100,100
Color Light 1,240,240,255
Set Light Range 1, 10000

Rem <<< Planet >>>

PlanX = (rnd(1000)+1500)*(rnd(1)*2-1)
PlanY = 0
PLanZ = (rnd(1000)+1500)*(rnd(1)*2-1)

Make Object Sphere 502,1000,30,30
Position Object 502,PlanX,PlanY,PlanZ
Roll Object Left 502,38
Texture Object 502,5
Ghost Object On 502
Set Object 502,1,0,1,1,1,0,1
Fade Object 502,150


Make Object Sphere 507,970,30,30
Position Object 507,PlanX,PlanY,PlanZ
Texture Object 507,4
Roll Object Left 507,40
Set Object Smoothing 507,100

Make Object Sphere 508,1030,30,30
Position Object 508,PlanX,PlanY,PlanZ
Texture Object 508,5
Ghost Object On 508
Fade Object 508,60

Rem <<< Dry Dock >>>

Make Object Cube 503,0
Make Object Box 504,1000,3,1000

Make Mesh From Object 503,504
Add Limb 503,1,503
Offset Limb 503,1,0,0,500
Texture Limb 503,1,3
Rotate Limb 503,1,90,0,0
Scale Limb Texture 503,1,11,11

Make Mesh From Object 504,504
Add Limb 503,2,504
Offset Limb 503,2,0,0,-500
Texture Limb 503,2,3
Rotate Limb 503,2,90,0,0
Scale Limb Texture 503,2,11,11

Make Mesh From Object 505,504
Add Limb 503,3,505
Offset Limb 503,3,0,500,0
Texture Limb 503,3,3
Scale Limb Texture 503,3,11,11

Make Mesh From Object 506,504
Add Limb 503,4,506
Offset Limb 503,4,0,-500,0
Texture Limb 503,4,3
Scale Limb Texture 503,4,11,11
Fade Object 503,200

Delete Object 504
Set Object 503,1,1,0
Make Object Cube 2001,50
Texture Object 2001,11
Set Object 2001,1,0,0
Ghost Object On 2001
Fade Object 2001,250

Rem <<< Construction Bay >>>

Make Object Box 700,.5,.5,.5
Color Object 700,0
Make Object Box 701,104,79,8
For i = 1 to 4
   Make Mesh From Object 700+i,701
   Add Limb 700,i,700+i
   Texture Limb 700,i,13
Next i
Delete Object 701
Offset Limb 700,1,0,0,42
Offset Limb 700,2,0,0,-42
Offset Limb 700,3,0,42,0
Offset Limb 700,4,0,-42,0
Rotate Limb 700,3,90,0,0
Rotate Limb 700,4,90,0,0
Position Object 700,460,0,460
Set Object 700,1,1,1
Fix Object Pivot 700
Fade Object 700,200

Make Object Cylinder 701,70
Set Object 701,1,0,0,1,0,0,1
Scale Object 701,100,400,100
Texture Object 701,12
Scale Object Texture 701,4,1
Ghost Object On 701
Roll Object Right 701,90
Position Object 701,350,0,460
Fade Object 701,200
Make Particles 1,12,80,20
Position Particles 1,510,0,460
Color Particles 1,0,10,200
Rotate Particles 1,0,0,90
Set Particle Gravity 1,0
Set Particle Velocity 1,100
Set Particle Life 1,5

Make Object Box 702,280,60,60
Position Object 702,350,0,460
Set Object 702,1,1,0
Color Object 702,0

Rem <<< Constructor >>>

Make Object Sphere 600,25,20,20
Position Object 600,0,0,50
Make Object Box 601,25,10,25
Make Mesh From Object 601,601
Add Limb 600,1,601
Offset Limb 600,1,0,0,-15
Delete Object 601
Make Object Cylinder 602,3
Scale Object 602,100,1500,100
Pitch Object Up 602,90
Make Mesh From Object 602,602
Add Limb 600,2,602
Offset Limb 600,2,10.9,0,15
Make Mesh From Object 603,602
Add Limb 600,3,603
Offset Limb 600,3,-10.9,0,15
Scale Object 602,200,60,200
Make Mesh From Object 604,602
Add Limb 600,4,604
Offset Limb 600,4,-9,0,-28
Make Mesh From Object 605,602
Add Limb 600,5,605
Offset Limb 600,5,9,0,-28
Scale Object 602,190,65,190
Make Object Sphere 603,3
Scale Object 603,195,195,65
Make Mesh From Object 606,603
Add Limb 600,6,606
Offset Limb 600,6,-9,0,-28
Make Mesh From Object 607,603
Add Limb 600,7,607
Offset Limb 600,7,9,0,-28
Delete Object 603
Make Object Cube 604,1
Make Mesh From Object 608,604
Add Limb 600,8,608
Offset Limb 600,8,0,0,70
Hide Limb 600,8
Delete Object 604

Delete Object 602



Rem Hide Object 600

For I = 604 to 605
   Make Object Cylinder I,3
   Scale Object I,95,1800,95
   Texture Object I,9
   Ghost Object On I
   Pitch Object Up I,90
   Fade Object I,400
Next I
Glue Object to Limb 604,600,2
Glue Object to Limb 605,600,3

Texture Limb 600,0,7
Scroll Limb Texture 600,0,.5,-.1
For i = 1 to 5
   Texture Limb 600,i,6
Next I
Texture Limb 600,6,8
Texture Limb 600,7,8
Disable Object ZDepth 600

For I = 0 to 7
   Set Limb Smoothing 600,i,20
Next I

Make Object Sphere 610,80
Texture Object 610,12
Ghost Object On 610
Glue Object to Limb 610,600,0

Rem <<< Set Initial Camera Position and Variables >>>
Position Camera 0,0,0
Speed# = 0
yRot# = 0
AyRot# = 0
spin# = 0
spin2#= 0
AutoDock = 0
ySpeed#=0
Modnum=0
Grids = 1
ShieldOn=0
LastSaved=2

Do
Select AutoDock
Case 0,4
Rem <<< Control input for Constructor Movement >>>
   a$=""
   CX=Object Position X(600):CY=Object Position Y(600):CZ=Object Position Z(600)
   If Upkey()=1
      Speed# = Speed#+.2
   Else
      Speed#=Speed#-.1
   Endif
   If LeftKey()=1
      yRot# = yRot#-.2
   Else
      If yRot#<0 Then yRot#=yRot#+.1
   Endif
   If RightKey()=1
      yRot# = yRot#+.2
   Else
      If yRot#>0 Then yRot#=yRot#-.1
   Endif
   If yRot#<.2 And yRot#>-.2 Then yRot#=0
   If DownKey()=1 Then Speed# = Speed#-.2
   IF Speed# >10 Then Speed# = 10
   If Speed# <0 Then Speed# = 0
   If yRot# > 5 then yRot# = 5
   If yRot# <-5 then yRot# = -5
   AyRot#=0

Rem <<< Auto Align >>>
   If yRot# = 0
      Limb0X# = Int(Limb Position X(600,0)*10)/10
      Limb0Z# = Int(Limb Position Z(600,0)*10)/10
      Limb1X# = Int(Limb Position X(600,1)*10)/10
      Limb1Z# = Int(Limb Position Z(600,1)*10)/10
      DiffX# = Limb0X#-Limb1X#: DiffZ# = Limb0Z#-Limb1Z#
      If DiffX#*DiffZ# <> 0
         If Abs(DiffX#)>Abs(DiffZ#)
            If DiffX#*DiffZ#>0 Then AyRot#=.1
            If DiffX#*DiffZ#<0 Then AyRot#=-.1
         Else
            If DiffX#*DiffZ#>0 Then AyRot#=-.1
            If DiffX#*DiffZ#<0 Then AyRot#=.1
         Endif
      Endif
   Endif

Rem <<< Control Contstructor Vertical Movement >>>
   a$ = Inkey$()
   If a$="a"
      ySpeed#=1
   Endif
   If a$="z"
      ySpeed#=-1
   Endif

Rem Save Ship
   If AutoDock=0 and a$="s" and ModNum-LastSaved>0
      Gosub SaveShip
   Endif

Rem <<< Keep Constructor in Dry Dock >>>
   If Object Position Y(600) <-460
      Position Object 600,Object Position X(600),-458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Y(600) >460
      Position Object 600,Object Position X(600),458,Object Position Z(600)
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) <-460
      Position Object 600,Object Position X(600),Object Position Y(600),-458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position Z(600) >460
      Position Object 600,Object Position X(600),Object Position Y(600),458
      Speed#=0:ShieldOn=10
   Endif
   If Object Position X(600) <-460
      Position Object 600,-458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If Object Position X(600) >460
      Position Object 600,458,Object Position Y(600),Object Position Z(600)
      Speed#=0
   Endif
   If CheckLimbHit(600,0,80,700)=1
      Move Object 600,Speed#*-2
      Speed#=Int(Speed#/2)
      ShieldOn = 10
   Endif
   If ModNum>1
      LS=80:CLimb=0
      If Autodock=4
         LS=50
         CLimb=8
      Endif
      For i = 1 to ModNum-1
         cHit=CheckLimbhit(600,CLimb,LS,1000+i)
         If cHit=1
            Move Object 600,Speed#*-2
            Speed#=Int(Speed#/2)
            ySpeed#=OldySpeed#*-1
            yRot#=yRot#*-1
            IF LS=80 Then ShieldOn=10
         Endif
      Next i
   Endif

Rem <<< Check for Autodock >>>
   cHit = Checkhit(600,702)
   If cHit=1 And AutoDock<>4
      AutoDock = 1
      Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
      Enable Object ZDepth 600
   Endif

Rem <<< Check for Dropping Module Off And Drop >>>
   Rem <Check Grid Overlap>
   GridFlag = 0: GridHit = 0:TGridHit=0:Dist=2000
   If Autodock = 4 and asc(a$) = 13
      For i = 1 to Grids
         If CheckLimbHit(600,8,50,2000+i)=1
            GridFlag = 1
            TGridHit = 2000+i
            TDist=GetLimbDistance(600,8,2000+i)
            If TDist<Dist
               GridHit=TGridHit
               Dist=TDist
            Endif
         Endif
      Next i
   Endif

   Set Cursor 0,100: Print CheckLimbHit(1000+ModNum,8,50,2000+Grids);" ";Limb Position X(600,8);" ";Limb Position Z(600,8):Print Grids:Print ModNum
   If Autodock = 4 and asc(a$) = 13 and GridFlag=1
      Unglue Object 1000+ModNum
      Modules#(ModNum,1)=ModuleNum
      Show Object 1
      Position Object 1000+ModNum,Object Position X(GridHit), Object Position Y(GridHit),Object Position Z(GridHit)
      Modules#(ModNum,2) =Object Position X(1000+ModNum)
      Modules#(ModNum,3) =Object Position Y(1000+ModNum)
      Modules#(ModNum,4) =Object Position Z(1000+ModNum)
      Rotate Object 1000+ModNum,Object Angle X(1),Object Angle Y(1),Object Angle Z(1)
      AutoDock =0
      Hide Object 750
      Rem <Create New Grids>
      Restore GridOffset
      OldGrid = 2000+Grids
      For i = 1 to 6
         Read GX,GY,GZ
         Grids=Grids+1
         CopyObject(2000+Grids,2001)
         Position Object 2000+Grids,Object Position X(GridHit)+GX,Object Position Y(GridHit)+GY,Object Position Z(GridHit)+GZ
         TGrids=Grids
         Overlap=0
         For j = 2001 to OldGrid
            If CheckHit(2000+Grids,j) = 1
               Overlap=1
            Endif
         Next j
         If Overlap=1
            Delete Object 2000+Grids
            Grids=Grids-1
         Endif
         If TGrids=Grids
            Texture Object 2000+Grids,11
            Set Object 2000+Grids,1,0,0
            Ghost Object On 2000+Grids
            Fade Object 2000+Grids,250
         Endif
      Next i
      Hide Object GridHit
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      ModNum=ModNum+1
   Endif
   If ShieldOn>0
      ShieldOn = ShieldOn-1
      Show Object 610
   Else
      Hide Object 610
   Endif
EndCase
Case 1

Rem <<< Autodock >>>
Rem <<< Turn Constructor Toward Bay>>>
   Speed#=0:yRot#=0:AyRot#=0:ySpeed#=0
   If Int(Limb Position Z(600,0)*10)>Int(Limb Position Z(600,1)*10)
      aYRot#=.2
   Endif
   If Int(Limb Position Z(600,0)*10)<Int(Limb Position Z(600,1)*10)
      aYRot#=-.2
   Endif
Rem <<< Raise or Lower Constructor >>>
   If Int(Object Position Y(600)*10)<0 Then ySpeed# =.5
   If Int(Object Position Y(600)*10)>0 Then ySpeed# =-.5
Rem <<< Move Contructor Towards Bay >>>
   MoveX#=0
   If Int(Object Position X(600)*20)/20<380 Then MoveX#=.5
   If Int(Object Position X(600)*20)/20>380 Then MoveX#=-.5
   MoveZ#=0
   If Int(Object Position Z(600)*20)/20<460 Then MoveZ#=.2
   If Int(Object Position Z(600)*20)/20>460 Then MoveZ#=-.2
   Position Object 600,Object Position X(600)+MoveX#,Object Position Y(600),Object Position Z(600)+MoveZ#
   If MoveX#+MoveZ#+ySpeed#+AyRot#=0
      AutoDock=2
      Show Object 750
      ModuleNum=0
      OldModuleNum=0
      KeyDelay=0
      OldRow=0
      OldCol=0

      If ModNum=0 Then Modnum=Modnum+1
      CopyObject(1000+ModNum,1)
      Hide Object 1
      Hide Object 1000+ModNum
      Position Object 1,450,0,460
      Texture Object 1000+ModNum,1
      Position Object 1000+ModNum,450,0,460
      Show Object 1000+ModNum
   Endif
EndCase


` <<< Docked: Select Module >>>
Case 2
   a$ = ""
   Restore ModuleList
   For i = 0 to ModuleNum
      Read ModName$
   Next I
   If KeyDelay<1
      a$=Inkey$()
      KeyDelay = 10
   Else
      a$=""
      KeyDelay=KeyDelay-1
   Endif
   If a$="," Then ModuleNum=ModuleNum-1
   If a$="." Then ModuleNum=ModuleNum+1
   Set Cursor 0,100: Print ModuleNum
   If ModuleNum<>OldModuleNum
      If ModuleNum<0 Then ModuleNum=15
      If ModuleNum>15 Then   ModuleNum=0
      Col=Int(ModuleNum/4)
      Row=ModuleNum-(Col*4)
      OldModuleNum=ModuleNum
` <<< Unscroll Last Texture Scroll >>>
      ScrollRow#=-.25*OldRow
      ScrollCol#=-.25*OldCol
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
` <<< Scroll New Texture Scroll >>>
      ScrollRow#=.25*Row
      ScrollCol#=.25*Col
      Scroll Object Texture 1000+ModNum,ScrollRow#,ScrollCol#
      Scroll Object Texture 750,ScrollRow#,ScrollCol#
      OldRow = Row:OldCol = Col
   Endif
   Set Cursor 100,100:Print ModName$
   If asc(a$)=13
      Autodock = 3
      ReleaseWait=0
   Endif
EndCase
` <<< Release From Autodock with Module in tow >>>
Case 3
   POsition Object 1000+ModNum,0,0,0
   Glue Object To Limb 1000+ModNum,600,8
   Speed#=-.3
   If Checkhit(600,702)=0
      ReleaseWait = ReleaseWait+1
      If ReleaseWait>10
         Speed#=0
         Autodock =4
      Endif
   Endif
EndCase

EndSelect
Set Cursor 0,0
Print Autodock
Print Asc(Inkey$())

` <<< Clean Up Movement and Camera >>>
   Move Object 600, Speed#
   Rem Scale Object 602,190,200+(Speed#*20),190
   Rem Scale Object 603,190,200+(Speed#*20),190
   Turn Object Right 600, yRot#+AyRot#
   Position Object 600, Object Position X(600),Object Position Y(600) + ySpeed#,Object Position Z(600)
   OldySpeed#=ySpeed#
   ySpeed#=0
   spin# = spin#+.2
   spin2# = spin2#+.3
   Turn Object Left 502,-.02
   Turn Object Left 507,-.02
   Turn Object Right 750, 3
   Scroll Limb Texture 600,6,.2,.3
   Scroll Limb Texture 600,7,.3,.2
   Rem Scroll Object Texture 602,.3,.2
   Rem Scroll Object Texture 603,.2,.3
   Scroll Object Texture 604,0,.3
   Scroll Object Texture 605,0,.3
   Scroll Object Texture 610,.3,.2
   Scroll Object Texture 701,0,.2
   If Spin2#>10
      Spin#=Spin#*-1
      Spin2#=Spin2#*-1
      Scroll Limb Texture 600,6,Spin#,Spin2#
      Scroll Limb Texture 600,7,Spin2#,Spin#
      Rem Scroll Object Texture 602,Spin2#,Spin#
      Rem Scroll Object Texture 603,Spin#,Spin2#
      Scroll Object Texture 604,0,Spin2#
      Scroll Object Texture 605,0,Spin2#
      Scroll Object Texture 605,Spin2#,Spin#
      Scroll Object Texture 701,0,Spin#
      Spin#=0
      Spin2#=0
   Endif
   Turn Object Left 701,.25

   Move Object 600,-80
   Move Object Up 600,20
   Set Camera To Follow Object Position X(600), Object Position Y(600),Object Position Z(600),0,0,0,50,1
   Move Object Down 600,20
   Move Object 600,80
   Point Camera Object Position X(600),Object POsition Y(600),Object POsition Z(600)
   Sync

Loop

SaveShip:
Set Text Size 32
a$=""
Do
   Center Text 700,400,"Save and Exit: Are You Sure (Y/N)?";
   a$= inkey$()
   If a$="n" then Return
   If a$="y" then exit
   Sync
Loop

If ModNum<3 then Return
Rotate Object 1001,0,0,0

`Combine all the individual module objects together to make a single object with limbs.
For i = LastSaved to ModNum-1
   Position Object 1000+i,0,0,0
   Make Mesh From Object 8000+i,1000+i
   Add Limb 1001,i-1,8000+i
   Offset Limb 1001,i-1,Modules#(i,2),Modules#(i,3),Modules#(i,4)
   Texture Limb 1001,i-1,1
   Scale Limb Texture 1001,i-1,.25,.25
   ModuleNum=Modules#(i,1)
   Col=Int(ModuleNum/4)
   Row=ModuleNum-(Col*4)
   ScrollRow#=.25*Row
   ScrollCol#=.25*Col
   Scroll Limb Texture 1001,i-1,ScrollRow#,ScrollCol#
   Delete Object 1000+i
Next i
LastSaved=ModNum-1
If File Exist ("Starship.dbo")=1
   Delete File "Starship.dbo"
Endif
Save Object "Starship.dbo",1001
Delete Object 1001
Save Array "ShipMods.ssm",Modules#(1000,4)
Load Object "Starship.dbo",1001


For I = 1 to 20
   SET OBJECT SMOOTHING 1001,100
Next I

Do
   Sync
   Turn Object Left 1001,1
   Roll Object Right 1001,1.2
   Pitch Object Up 1001,.6
Loop

Return

End

Function CheckHit(Object1,Object2)
   If Object Exist(Object1)=0 or Object Exist(Object2)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Object Position X(Object1)
   Y1#=Object Position Y(Object1)
   Z1#=Object Position Z(Object1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=Object Size X(Object1)
   SY1#=Object Size Y(Object1)
   SZ1#=Object Size Z(Object1)
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CheckLimbHit(Object1,Limb1,LimbSize1,Object2)
   If Object Exist(Object1)=0 Then ExitFunction 0
   If Object Exist(Object2)=0 Then ExitFunction 0
   If Limb Exist(Object1,Limb1)=0 Then ExitFunction 0
   XH=0:YH=0:ZH=0:Hit=0
   X1#=Limb Position X(Object1,Limb1)
   Y1#=Limb Position Y(Object1,Limb1)
   Z1#=Limb Position Z(Object1,Limb1)
   X2#=Object Position X(Object2)
   Y2#=Object Position Y(Object2)
   Z2#=Object Position Z(Object2)
   SX1#=LimbSize1
   SY1#=LimbSize1
   SZ1#=LimbSize1
   SX2#=Object Size X(Object2)
   SY2#=Object Size Y(Object2)
   SZ2#=Object Size Z(Object2)
   XH=((X1#+(SX1#/2))>(X2#-(SX2#/2))) * ((X1#-(SX1#/2))<(X2#+(SX2#/2)))
   YH=((Y1#+(SY1#/2))>(Y2#-(SY2#/2))) * ((Y1#-(SY1#/2))<(Y2#+(SY2#/2)))
   ZH=((Z1#+(SZ1#/2))>(Z2#-(SZ2#/2))) * ((Z1#-(SZ1#/2))<(Z2#+(SZ2#/2)))
   Hit = XH*YH*ZH
Endfunction Hit

Function CopyObject(ObjectTo,ObjectFrom)
   Do
      MeshNum = Rnd(5000)+1
      If Mesh Exist(MeshNum)=0 Then Exit
   Loop
   OX=Object Position X(ObjectFrom):OY=Object Position Y(ObjectFrom):OZ=Object Position Z(ObjectFrom)
   AX=Object Angle X(ObjectFrom):AY=Object Angle Y(ObjectFrom):AZ=Object Angle Z(ObjectFrom)
   Position Object ObjectFrom,0,0,0
   Rotate Object ObjectFrom,0,0,0
   Make Mesh From Object MeshNum,ObjectFrom
   Make Object ObjectTo,MeshNum,0
   Delete Mesh MeshNum
   Position Object ObjectFrom,OX,OY,OZ
   Rotate Object ObjectFrom,AX,AY,AZ
EndFunction

Function GetDistance(O1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   DX=Object Position X(O1)-Object Position X(O2)
   DY=Object Position Y(O1)-Object Position Y(O2)
   DZ=Object Position Z(O1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function GetLimbDistance(O1,L1,O2)
   If Object Exist(O1)=0 Or Object Exist(O2)=0 Then ExitFunction -1
   If Limb Exist(O1,L1)=0 Then ExitFunction -1
   DX=Limb Position X(O1,L1)-Object Position X(O2)
   DY=Limb Position Y(O1,L1)-Object Position Y(O2)
   DZ=Limb Position Z(O1,L1)-Object Position Z(O2)
   Distance=SQRT(DX^2+DY^2+DZ^2)
EndFunction Distance

Function CreatePlanet(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,240),1
   For i = 0 to 480
      Line 0,i,640,i
   Next i

   For j = 1 to rnd(10)+7
      Ink rgb(10,rnd(100)+50,10),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 360
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         if x#>638 then x#=638
         if x#<0 then x#=0
         if y#>478 then y#=478
         if y#<0 then y#=0
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,639,479
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateClouds(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,640,480
   Lock Pixels
   Ink rgb(10,10,10),1
   Box 0,0,639,479
   For j = 1 to rnd(10)+7
      w=rnd(50)+180
      Ink rgb(w,w,w),1
      Radius = Rnd(50)+25
      cx=rnd(530)+55
      cy=rnd(370)+55
      For i = 0 to 360
         Radius=Radius+(Rnd(4)-2)
         x#=Cos(i/2)*(Radius)+cx
         y#=Sin(i/2)*(Radius)+cy
         if x#>638 then x#=638
         if x#<0 then x#=0
         if y#>478 then y#=478
         if y#<0 then y#=0
         Line cx,cy,x#,y#
         Line cx,cy,x#+1.0,y#
         Line cx,cy,x#,y#+1.0
      Next i
   Next j
   Unlock Pixels
   Blur Bitmap 1,6
   Get Image image,1,1,639,479
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction

Function CreateStarField(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   create bitmap 1,1000,1000
   Lock Pixels
   For j = 1 to 3
      For i = 1 to 1500
         Dot Rnd(999),Rnd(999),rgb(200+rnd(55),200+rnd(55),200+rnd(55))
      Next i
      Blur Bitmap 1,1
   Next j
   Unlock Pixels
   Get Image image,0,0,999,999
   Set Current Bitmap 0
   Delete Bitmap 1
EndFunction


Function Const_Skin1(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,501,501
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Const_Skin2(Image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,501,501
   Lock Pixels
   Ink rgb(255,255,255),0
   Box 0,0,500,500
   Ink RGB(128,128,128),0
   For i = 0 to 500 step 500/8
      Line i,0,i,500
      Line i+1,0,i+1,500
      Line 0,i,500,i
      Line 0,i+1,500,i+1
   Next i
   Box 125,60,375,185
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,500,500
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Fire(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,65,65
   Lock Pixels
   Ink rgb(200,0,0),0
   Box 0,0,64,64
   For i = 0 to 200
      red =rnd(200)+55
      Dot rnd(64),rnd(64),rgb(red,red-50,red-50)
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,64,64,1
   Set Current Bitmap 0
   Delete BItmap 1
Endfunction

Function Beam_Effect1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(0,0,170),0
   For i = 0 to 30
      lx=rnd(256)
      ly1=rnd(256)
      ly2=rnd(256)
      Line lx,ly1,lx,ly2
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Grid1(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(0,0,50),0
   Box 0,0,256,256
   Ink RGB(100,100,0),0
   Box 0,0,256,3
   Box 0,0,3,256
   Box 252,0,256,256
   Box 0,252,256,256
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function BaySide(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,257,257
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,256,256
   Ink RGB(175,175,175),0
   Box 20,20,236,236
   Ink Rgb(255,255,0),0
   For i = 236 to 256
      line i,0,0,i
      line i,256,256,i
   Next i
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Star(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink rgb(110,90,90),0
   For i = 1 to 200
      Ink rgb(200-i,100-(i/2),100-(i/2)),0
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Ink rgb(255,250,250),0
   For i = 1 to 20
      Circle 256,256,i
      Circle 256+1,256,i
   Next i
   Blur Bitmap 1,1
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,512,512,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Drydock(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink rgb(100,100,100),0
   Box 0,0,512,512
   Ink 0,0
   Box 10,10,246,246
   Box 10,266,246,502
   Box 266,10,502,246
   Box 266,266,502,502
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

Function Module(image)
   If Bitmap Exist(1)
      Delete Bitmap 1
   Endif
   Create Bitmap 1,513,513
   Lock Pixels
   Ink RGB(128,128,128),0
   Box 0,0,512,512
   Restore ModuleSymbols
   Ink rgb(200,200,0),0
   For y=0 to 3
      For x=0 to 3
         Read m$
         Center Text x*64+32,y*64+32,m$
      Next x
   Next y
   If Image Exist(image)
      Delete Image image
   Endif
   Unlock Pixels
   Get Image image,0,0,256,256,1
   Set Current Bitmap 0
   Delete Bitmap 1
Endfunction

ModuleList:
Data "Hull (Empty)","Bridge","Shields","Deflectors"
Data "Marine Quarters","Computer","Phasors","Officer Quarters"
Data "Torpedo Bay","Medical Bay","Crew Quarters","Transporters"
Data "Armor","Repair Bay","Engines (Thrusters)","Warp Engines"

ModuleSymbols:
Data "H","B","S","D"
Data "M","C","P","O"
Data "T","+","Q","X"
Data "A","R","E","W"

GridOffset:
Data 0,0,51
Data 0,51,0
Data 51,0,0
Data 0,0,-51
Data 0,-51,0
Data -51,0,0

set display mode 800,600,32
backdrop on
color backdrop 0
autocam off
sync on
position camera 64,30,-64
hide light 0
make light 1
position light 1,0,30,0
make object cube 1,1
hide object 1
Make Object plain 2,128,128
Position Object 2,64,0,64
`set object light 2,0
xrotate object 2,-90
grid=free_image()
ink rgb(255,255,255),0
box 0,0,500,500
ink rgb(100,100,100),0
for x=0 to 500 step 20
line x,0,x,500
next x
for y=0 to 500 step 20
line 0,y,500,y
next y
get image grid,0,0,500,500
texture object 2,grid
`scale object texture 2,10,10

type objecttype
 scalex as float
 scaley as float
 scalez as float
 endtype

type TYPE_XYZfloat
   x as float
   y as float
   z as float
endtype

global GU_XYZReturn as TYPE_XYZfloat

make camera 1
color backdrop 1,rgb(0,0,0)
position camera 1,64,64,64
point camera 1,64,0,64
set camera view 1,40,40,screen width()/2.5,190

make camera 2
color backdrop 2,rgb(200,200,250)
position camera 2,64,0,0
point camera 2,64,0,64
set camera view 2,screen width()/2+40,40,screen width()-40,190

set current camera 0

cube=free_sprite()
make_button(cube,"cube",50,20,50,10)
box_=free_sprite()
make_button(box_,"box",50,20,102,10)
sphere=free_sprite()
make_button(sphere,"sphere",50,20,154,10)
cone=free_sprite()
make_button(cone,"cone",50,20,206,10)
cylinder=free_sprite()
make_button(cylinder,"cylinder",50,20,258,10)
lights=free_sprite()
make_button(lights,"lights",50,20,310,10)
shadows=free_sprite()
make_button(shadows,"shadows",50,20,362,10)
position=free_sprite()
make_button(position,"position",50,20,414,10)
scale=free_sprite()
make_button(scale,"scale",50,20,466,10)
rotate=free_sprite()
make_button(rotate,"rotate",50,20,518,10)
`make matrix 1,100,100,20,20

set sprite diffuse position,200,200,200
operation=position
positionon=1


ink rgb(0,255,0),0

do

3dmouse()
3dcamera()
line 0,200,screen width(),200
gosub process_events

text 0,0,str$(pick)

sync
loop

function make_button(spritenumber,btext$,bwidth#,bheight#,bx,by)


create bitmap 1,screen width(),screen height()
for n#=0.0 to bheight#
grey#=(140*n#/bheight#)+100
ink rgb(grey#,grey#,grey#),0
line 0,n#,bwidth#,n#
next n#
for n#=2.0 to bheight#-2
grey#=(140-140*n#/bheight#)+100
ink rgb(grey#,grey#,grey#),0
line 2,n#,bwidth#-2,n#
next n#
ink rgb(255,255,255),0
set text font "arial"
set text size 12
text bwidth#/2.0-text width(btext$)/2,bheight#/2.0-text height(btext$)/2.0,btext$

get image spritenumber,0,0,bwidth#,bheight#,1
delete bitmap 1

sprite spritenumber,bx,by,spritenumber

endfunction

function free_sprite

repeat
inc n
until sprite exist(n)=0 and image exist(n)=0

endfunction n

function pick_sprite(lower,upper)

for spritenumber=lower to upper
if mousex()>=sprite x(spritenumber) and mousex()<=sprite x(spritenumber)+sprite width(spritenumber) and mousey()>=sprite y(spritenumber) and mousey()<=sprite y(spritenumber)+sprite height(spritenumber)
pick=spritenumber

endif
next spritenumber

endfunction pick

process_events:

`button click events
pick=pick_sprite(cube,shadows)
if pick>0 and pick<=lights and mouseclick()=1
  selection=pick
  gosub reset_buttons
  set sprite diffuse selection,200,200,200
  create=1
endif

if create=1 then gosub create_object
if setposition=1 then gosub position_object

if pick=shadows and mouseclick()=1
 gosub reset_buttons
 gosub calculate_shadows
endif

if mouseclick()=1
operation=pick_sprite(position,rotate)
if operation>0
gosub reset_operations
set sprite diffuse operation,200,200,200
if operation=position then positionon=1
if operation=scale then scaleon=1
if operation=rotate then rotateon=1
endif
endif


`object click events
pickobject=pick object(mousex(),mousey(),3,numberofobjects+2)
if mouseclick()>0 and exclude=0 then picked=pickobject:exclude=1
if mouseclick()=0 then exclude=0
if picked>2
  if positionon=1 then gosub reposition_object
  if rotateon=1 then gosub rotate_object
  if scaleon=1 then gosub scale_object
endif

return

reset_operations:

scaleon=0
rotateon=0
positionon=0
for n=position to rotate
set sprite diffuse n,255,255,255
next n

return


reset_buttons:

for spritenumber=cube to shadows
set sprite diffuse spritenumber,255,255,255
next spritenumber

return

rotate_object:


return

function free_object

repeat
inc n
until object exist(n)=0

endfunction n

Function 3dmouse()


 `left mouse moves in the XZ direction
   if mouseclick() = 1
      SYS_screenToXZ(mousex(), mousey(), 0, object position y(1))
      position object 1, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
   else
   `right mouse moves in the Y direction
      if mouseclick() = 2
         tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(1), object position z(1))
         position object 1, object position x(1), tmp#, object position z(1)
      endif
   endif


EndFunction

function 3dcamera

mx#=mousemovex()
my#=mousemovey()
if upkey()=1 then move camera 0.2
if downkey()=1 then move camera -0.2
if leftkey()=1 then turn camera left 90:move camera 0.2:turn camera right 90
if rightkey()=1 then turn camera right 90:move camera 0.2:turn camera left 90
if mouseclick()=4 then turn camera right mx#/2.0

endfunction

create_object:

if mousey()>200

`hide mouse
setposition=1

object=free_object()
if selection=cube then make object cube object,5
if selection=box_ then make object box object,7,5,3
if selection=sphere then make object sphere object,5,10,10
if selection=cone then make object cone object,5
if selection=cylinder then make object cylinder object,5
if selection=lights then make object sphere object,2,10,10
color object object,rgb(rnd(255),rnd(255),rnd(255))
if selection=lights then color object object,rgb(255,255,0):set object light object,0:light1=object
create=0
inc numberofobjects
dim object(numberofobjects+3) as objecttype
gosub reset_buttons

endif

return

position_object:
if excludepo=0
 excludepo=1
 position object 1,object position x(1),0,object position z(1)
endif
position object object,object position x(1),object position y(1),object position z(1)
if object=light1 then position light 1,object position x(1),0,object position z(1)
if mouseclick()=1
  setposition=0:excludepo=0
endif

return

reposition_object:
object=picked
if create=0

`set cursor to object position first time only
if excludero=0
 excludero=1
 position object 1,object position x(object),object position y(object),object position z(object)
endif

position object object,object position x(1),object position y(1),object position z(1)
if mouseclick()=0
  excludero=0
  if object<>light1 then set object light object,1
endif
if object=light1 then position light 1,object position x(light1),object position y(light1),object position z(light1)
endif

return

scale_object:
object=picked
if create=0
text 0,20,"scaling"
`set cursor to object position first time only
if excludeso=0
 excludeso=1
 position object 1,object position x(object),object position y(object),object position z(object)
endif

if mouseclick()=1
if mousemovex()>0 then inc object(object).scalex,1
if mousemovex()<0 then dec object(object).scalex,1
if mousemovey()<0 then inc object(object).scalez,1
if mousemovey()>0 then dec object(object).scalez,1
endif

if mouseclick()=2
if mousemovey()<0 then inc object(object).scaley,1
if mousemovey()>0 then dec object(object).scaley,1
endif

scale object object,100+object(object).scalex,100+object(object).scaley,100+object(object).scalez

if mouseclick()=0
  scaleobject=0
  excludeso=0
  if object<>light1 then set object light object,1
endif
endif

return

calculate_shadows:
if object exist(light1)
create bitmap 1,128,128
set current bitmap 1
ink rgb(205,205,225),0
box 0,0,128,128
ink rgb(100,100,100),0
for y=0 to 128
for x=0 to 128
for object=3 to numberofobjects+2
if object<>light1
ray=intersect object(object,x,0,y,object position x(light1),object position y(light1),object position z(light1))
if ray=0 then ray=100
if ray<20
  dot x,128-y
endif
endif
next object
next x
next y
blur bitmap 1,3
shadowmap=free_image()
get image shadowmap,0,0,128,128
delete bitmap 1
set light mapping on 2,shadowmap
endif `(light1 exist)

return

function free_image

repeat
 inc image
until image exist(image)=0

endfunction image

function SYS_screenToXZ(screenx as integer, screeny as integer, camera as integer, Yplain as float)
   local pick as TYPE_XYZfloat
   local height as float
   local scalar as float
   if camera <> 0
      set current camera camera
   endif
   height = camera position y()
   pick screen screenx, screeny, 1.0
   pick.x = get pick vector x()
   pick.y = get pick vector y()
   pick.z = get pick vector z()
   `scalar = Yplain - (height/pick.y)
   scalar = -1*((height - Yplain)/pick.y)

   `since it is impossible
   GU_XYZReturn.x = (camera position x() + scalar*pick.x)
   GU_XYZReturn.y = Yplain
   GU_XYZReturn.z = (camera position z() + scalar*pick.z)
   if camera <> 0
      set current camera 0
   endif
endfunction

function SYS_screenToY(screenx as integer, screeny as integer, camera as integer, Xpos as float, Zpos as float)
   local vec0A as integer = 1
   local vec1A as integer = 2
   local vecB as integer = 3
   local vecC as integer = 4
   local tmp as float
   local rtrn as float

   tmp = make vector3(vec0A)
   tmp = make vector3(vec1A)
   tmp = make vector3(vecB)
   tmp = make vector3(vecC)

   rem after we make the vectors perform math...
   pick screen screenx, screeny, 1.0
   set vector3 vec0A, Xpos, 0, Zpos
   set vector3 vec1A, 0, 1, 0
   set vector3 vecB,  get pick vector x(), get pick vector y(), get pick vector z()

   cross product vector3 vecC, vec1A, vecB
   cross product vector3 vecC, vecC, vecB
   normalize vector3 vecC, vecC

   tmp = X Vector3(vecC)*camera position x() + Y Vector3(vecC)*camera position y() + Z Vector3(vecC)*camera position z()
   rtrn = (tmp - dot product vector3(vec0A, vecC)) / dot product vector3(vec1A, vecC)

   tmp = delete vector3(vec0A)
   tmp = delete vector3(vec1A)
   tmp = delete vector3(vecB)
   tmp = delete vector3(vecC)
endfunction rtrn

Sync On: Sync Rate 60:Autocam Off

Make Object Plain 1,20,20
Position Object 1,0,-10,30
Pitch Object Down 1,90
Make Object Plain 2,7,7
Position Object 2,12,-6,35
Set Object Cull 2,0
Make Object PLain 3,15,15
Position Object 3,10,10,30
Pitch Object Up 3,90

Make Object Cube 4,1

Do
   Control Camera Using Arrowkeys 0,.3,.8
   i=Pick Object(MouseX(),MOuseY(),1,3)
   if i>0
      Position Object 4,Get Pick Vector X()+Camera Position X(),Get Pick Vector Y()+Camera Position Y(),Get Pick Vector Z()+Camera Position Z()
   Endif
   Pitch OBject Down 2,.5
   Sync
Loop

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

TDK3D Object Group File V0.1
13
1
169
86
0
1400
460
70
0
-40.8012390137
115.203338623
262.811645508
0
0
0

0
162
93
0
0
0
0
0
-368.491699219
113.761688232
-103.984436035
0
269
0

1
169
86
0
1400
460
70
0
-373.639221191
115.366287231
-104.177093506
0
270
0

1
169
86
0
1400
460
70
0
-41.2073173523
115.366287231
-471.496917725
0
0
0

1
169
86
0
1400
460
70
0
291.817321777
115.366287231
-104.373580933
0
270
0

1
179
76
0
310
490
330
0
-358.754089355
121.555297852
256.759002686
0
0
0

1
179
76
0
310
490
330
0
280.200683594
121.555297852
253.703796387
0
0
0

1
179
76
0
310
490
330
0
-366.078918457
121.555297852
-461.050537109
0
0
0

1
179
76
0
310
490
330
0
290.606292725
121.555297852
-473.261688232
0
0
0

4
255
212
61
270
460
300
0
-360.226928711
359.161621094
256.389160156
0
0
0

4
255
212
61
270
460
300
0
281.399658203
359.161621094
257.705322266
0
0
0

4
255
212
61
270
460
300
0
291.779937744
359.161621094
-471.967132568
0
0
0

4
255
212
61
270
460
300
0
-366.022216797
359.161621094
-460.269775391
0
0
0

sync on
sync rate 0

position camera 20,20,20
point camera 0,0,0
autocam off

type TYPE_XYZfloat
	x as float
	y as float
	z as float
endtype

global GU_XYZReturn as TYPE_XYZfloat

`3D backdrop 
make matrix 1, 100,100,10,10
position matrix 1, -50,0,-50
set matrix wireframe on 1
update matrix 1

`object for demonstration
make object box 1, 5,5,5

`used for moving the camera
global camAngle as float = 35.0
global camDist as float = 15.0
global camPitch as float

`loop
do
	`left mouse moves in the XZ direction
	if mouseclick() = 1
		SYS_screenToXZ(mousex(), mousey(), 0, object position y(1))
		position object 1, GU_XYZReturn.x, GU_XYZReturn.y, GU_XYZReturn.z
	else
	`right mouse moves in the Y direction
		if mouseclick() = 2
			tmp# = SYS_screenToY(mousex(), mousey(), 0, object position x(1), object position z(1))
			position object 1, object position x(1), tmp#, object position z(1)
		endif
	endif
	
	`reset check
	if spacekey() = 1
		camAngle = 35.0
		camDist = 15.0
		camPitch = 0
		position object 1, 0, 0, 0
	endif
	
	`camera movement
	if upkey() = 1 then dec camDist, 0.1
	if downkey() = 1 then inc camDist, 0.1
	if rightkey() = 1 then inc camAngle,0.2
	if leftkey() = 1 then dec camAngle,0.2
	
	if controlkey() = 1 then dec camPitch,0.1
	if shiftkey() = 1 then inc camPitch,0.1
	
	position camera sin(camAngle)*camDist, 15, cos(camAngle)*camDist
	point camera 0,0,0
	pitch camera up camPitch
	
	`onscreen prompts
	center text screen width()/2, 10, "3D Mouse Control"
	
	text 5,5, "Box X:" + str$(object position x(1))
	text 5,20,"Box Y:" + str$(object position y(1))
	text 5,35,"Box Z:" + str$(object position z(1))
	
	text 5,screen height()-65,"Reset demo with spacekey"
	
	text 5,screen height()-50,"Left mouse button moves in the XZ direction"
	text 5,screen height()-35,"Right mouse button moves in the Y direction"
	
	text 5,screen height()-20,"Adjust camera with arrowkeys, shift & control keys"
	
	
	sync
loop

`note that y plain is used so that if your default build plain is higher than 0 you can specify it
function SYS_screenToXZ(screenx as integer, screeny as integer, camera as integer, Yplain as float)	
	local pick as TYPE_XYZfloat
	local height as float
	local scalar as float
	if camera <> 0
		set current camera camera
	endif
	height = camera position y()
	pick screen screenx, screeny, 1.0
	pick.x = get pick vector x()
	pick.y = get pick vector y()
	pick.z = get pick vector z()
	`scalar = Yplain - (height/pick.y)
	scalar = -1*((height - Yplain)/pick.y)
	
	`since it is impossible 
	GU_XYZReturn.x = (camera position x() + scalar*pick.x)
	GU_XYZReturn.y = Yplain
	GU_XYZReturn.z = (camera position z() + scalar*pick.z)
	if camera <> 0
		set current camera 0
	endif
endfunction

function SYS_screenToY(screenx as integer, screeny as integer, camera as integer, Xpos as float, Zpos as float)
	local vec0A as integer = 1
	local vec1A as integer = 2
	local vecB as integer = 3
	local vecC as integer = 4
	local tmp as float
	local rtrn as float
	
	tmp = make vector3(vec0A)
	tmp = make vector3(vec1A)
	tmp = make vector3(vecB)
	tmp = make vector3(vecC)
	
	rem after we make the vectors perform math...
	pick screen screenx, screeny, 1.0
	set vector3 vec0A, Xpos, 0, Zpos
	set vector3 vec1A, 0, 1, 0
	set vector3 vecB,  get pick vector x(), get pick vector y(), get pick vector z()
	
	cross product vector3 vecC, vec1A, vecB
	cross product vector3 vecC, vecC, vecB
	normalize vector3 vecC, vecC
	
	tmp = X Vector3(vecC)*camera position x() + Y Vector3(vecC)*camera position y() + Z Vector3(vecC)*camera position z()
	rtrn = (tmp - dot product vector3(vec0A, vecC)) / dot product vector3(vec1A, vecC)
	
	tmp = delete vector3(vec0A)
	tmp = delete vector3(vec1A)
	tmp = delete vector3(vecB)
	tmp = delete vector3(vecC)
endfunction rtrn

set display mode 800,600,32
sync on
backdrop on
autocam off

gosub get_media

type cAspect
   x as float
   y as float
endtype

type cFocus
   x1 as integer
   y1 as integer
   x2 as integer
   y2 as integer
endtype

Global cameraAspects as cAspect : cameraAspects.x = 400 : cameraAspects.y = 300
Global cameraFocus as cFocus

Global cTopLeft      = 1
Global cTopRight     = 2
Global cBottomLeft   = 3
Global cBottomRight  = 4
Global activeCamera  = cBottomRight
Global MC = 0
Global MX = 0
Global MY = 0
Global MFlag = 0
Global backgroundColor as dword : backgroundColor = rgb(135,135,135)

make camera cTopLeft       : set camera view cTopLeft,0,0,400,300          : position camera cTopLeft,0,400,0        : point camera cTopLeft,0,0,0
make camera cTopRight      : set camera view cTopRight,400,0,800,300       : position camera cTopRight,0,0,-500      : point camera cTopRight,0,0,0
make camera cBottomLeft    : set camera view cBottomLeft,0,300,400,600     : position camera cBottomLeft,-500,0,0    : point camera cBottomLeft,0,0,0
make camera cBottomRight   : set camera view cBottomRight,400,300,800,600  : position camera cBottomRight,0,400,-500 : point camera cBottomRight,0,0,0


color backdrop cTopLeft, backgroundColor
color backdrop cTopRight, backgroundColor
color backdrop cBottomLeft, backgroundColor
color backdrop cBottomRight, backgroundColor

rem set initial focus
set_camera_focus(cBottomRight)


make object plain 1,1000,1000
set object light 1, 0
xrotate object 1, 270
position object 1, 0,0,0
texture object 1,1000
scale object texture 1,10,10


make object cube 2, 50
position object 2, 0,25,0
color object 2, rgb(rnd(255),rnd(255),rnd(255))


set text font "Arial"
set text size 10


repeat

   MC = mouseclick()
   MX = mousex()
   MY = mousey()
   if MC = 0 then MFlag = 0

   handle_camera_focus()
   gosub handle_camera_resize
   draw_camera_sizes(cameraAspects.x,cameraAspects.y)
   handle_camera_focus()


   sync
until spacekey()



rem changes focus to clicked on viewport
function handle_camera_focus()
   x = cameraAspects.x
   y = cameraAspects.y
   if MC > 0 and MFlag = 0
      MFlag = 1
      if MX > 2 and MX < x-2 and MY > 2 and MY < y-2 then set_camera_focus(cTopLeft)
      if MX > x+2 and MX <= 798 and MY > 2 and MY < y-2 then set_camera_focus(cTopRight)
      if MX > 2 and MX < x-2 and MY > y+2 and MY < 598 then set_camera_focus(cBottomLeft)
      if MX > x+2 and MX <= 798 and MY > y+2 and MY < 598 then set_camera_focus(cBottomRight)
   endif
endfunction


rem handles resizing of the viewports through mouse input
handle_camera_resize:
   if MC = 1 and frameResizeFlag = 0
      if MX >= cameraAspects.x-2 and MX <= cameraAspects.x+2
         frameResizeFlag = 1
         resizeX = 1
      endif
      if MY >= cameraAspects.y-2 and MY <= cameraAspects.y+2
         frameResizeFlag = 1
         resizeY = 1
      endif
   endif
   if frameResizeFlag = 1
      if resizeX = 1 then cameraAspects.x = MX
      if resizeY = 1 then cameraAspects.y = MY

      set_camera_focus(activeCamera)

      if MC = 0
         frameResizeFlag = 0
         resizeX = 0
         resizeY = 0
      endif
   endif
RETURN


rem sets viewport focus
function set_camera_focus(cam as integer)
   activeCamera = cam
   set current camera cam
   if cam = cTopLeft
      x1 = 0
      y1 = 0
      x2 = cameraAspects.x
      y2 = cameraAspects.y
   endif
   if cam = cTopRight
      x1 = cameraAspects.x
      y1 = 0
      x2 = 800
      y2 = cameraAspects.y
   endif
   if cam = cBottomLeft
      x1 = 0
      y1 = cameraAspects.y
      x2 = cameraAspects.x
      y2 = 600
   endif
   if cam = cBottomRight
      x1 = cameraAspects.x
      y1 = cameraAspects.y
      x2 = 800
      y2 = 600
   endif
   cameraFocus.x1 = x1
   cameraFocus.y1 = y1
   cameraFocus.x2 = x2
   cameraFocus.y2 = y2
endfunction


rem draws dividers and titles of the 4 camera viewports
rem handles camera view sizes and aspect ratios
function draw_camera_sizes(x as float, y as float)
   ink rgb(197,197,197),0
   rem center
   box x-2,0,x+2,600
   box 0,y-2,800,y+2
   rem edges
   box 0,0,2,600
   box 0,0,800,2
   box 798,0,800,600
   box 0,598,800,600

   ink 0,0
   text 3,3,"Top"
   text x+3,3,"Front"
   text 3,y+3,"Left"
   text x+3,y+3,"Perspective"

   set camera view cTopLeft, 0,0,x,y
   set camera view cTopRight, x,0,800,y
   set camera view cBottomLeft, 0,y,x,600
   set camera view cBottomRight, x,y,800,600

   set camera aspect cTopLeft, x/y
   set camera aspect cTopRight, (800-x)/y
   set camera aspect cBottomLeft, x/(600-y)
   set camera aspect cBottomRight, (800-x)/(600-y)

   ink rgb(255,246,0),0
   drawBoxOutline(cameraFocus.x1+2,cameraFocus.y1+2,cameraFocus.x2-2,cameraFocus.y2-2)

endfunction


rem draws an outlined box
function drawBoxOutline(x1 as integer, y1 as integer, x2 as integer, y2 as integer)
   line x1,y1,x2,y1
   line x1,y1,x1,y2
   line x2,y1,x2,y2
   line x1,y2,x2,y2
endfunction



rem
get_media:
   cls 0
   rem floor texture
   ink rgb(255,255,255),0 : box 0,0,64,64 : box 64,64,128,128
   ink rgb(170,170,170),0 : box 64,0,128,64 : box 0,64,64,128
   get image 1000,0,0,128,128,1
RETURN

Rem Project: 3d Moddellere NO MEDIA!!!!
Rem Created: 18/11/2005 20:18:08
AutoCam Off
Rem ***** Main Source File *****
make matrix 1, 1000, 1000, 100, 100
position camera 0, 10, 0
position matrix 1, 0, 0, 0
set camera aspect 0.75
do
if keystate(2) then input "Number of cube",num$ : Input "size of cube",size$:input "Positionx", posx$:input "Positiony", posy$:input "Positionz",posz$:make object cube val(num$),val(size$):position object val(num$), val(posx$), val(posy$), val(posz$)
if keystate(3) then input "Number of cone", num2$:Input "size of Cone",size2$:input "Positionx", posx2$:input "Positiony", posy2$:input "Positionz",posz2$:make object Cone val(num2$),val(size2$):position object val(num2$), val(posx2$), val(posy2$), val(posz2$)
if rightkeY()=1 then turn camera right 2
if leftkeY()=1 then turn camera left 2
if upkey()=1 then pitch camera up 2
if downkey()=1 then pitch camera down 2
loop

   pick screen MX, MY, 0.0
   px1# = camera position x(activeCamera) + get pick vector x()
   py1# = camera position y(activeCamera) + get pick vector y()
   pz1# = camera position z(activeCamera) + get pick vector z()

   pick screen MX, MY, 10.0
   px2# = camera position x(activeCamera) + get pick vector x()
   py2# = camera position y(activeCamera) + get pick vector y()
   pz2# = camera position z(activeCamera) + get pick vector z()

   dist# = (py1#*10.0)/(py1#-py2#)

   pick screen MX, MY, dist#
   px# = camera position x(activeCamera) + get pick vector x()
   py# = camera position y(activeCamera) + get pick vector y()
   pz# = camera position z(activeCamera) + get pick vector z()


   position object 2,px#,py#+50,pz#