home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 601-625 / apd620 / amos_pro_only / wireframe_cube.amos / wireframe_cube.amosSourceCode
AMOS Source Code  |  1986-08-03  |  2KB  |  71 lines
  1. Rem *** Wireframe Graphics *** 
  2. '
  3. ' note: needs AMOS 3D Extension
  4. '
  5. ' keys:
  6. '
  7. '        ,   zoom in 
  8. '        .   zoom out
  9. '        [   rotate clockwise  
  10. '        ]   rotate anticlockwise  
  11. '
  12. Double Buffer : Autoback 0
  13. Curs Off : Cls 0 : Hide 
  14.  Extension_4_0054 200
  15. Dim CUBE(23),CUBEX(23)
  16. Global CUBE(),CUBEX()
  17. SPEED=5
  18. '
  19. Degree 
  20. '
  21. Proc SETUPCUBE
  22. '
  23. Do 
  24.    If Key State(69) Then FINISH
  25.    A$=Inkey$
  26.    If A$="," Then Add ZM,-10
  27.    If A$="." Then Add ZM,10
  28.    If A$="[" Then Add SPEED,-1
  29.    If A$="]" Then Add SPEED,1
  30.    Add N,SPEED,0 To 360
  31.     Extension_4_00EC 0,Sin(N)*(550+ZM),0,Cos(N)*(550+ZM)+550
  32.     Extension_4_020A 0,0,0,550
  33.    Proc DRCUBE
  34. Loop 
  35. '
  36. Wait Key 
  37. '
  38. Procedure DRCUBE
  39.    '
  40.    For N=0 To 23 Step 3
  41.       CUBEX(N)= Extension_4_0474(CUBE(N),CUBE(N+1),CUBE(N+2))
  42.       CUBEX(N+1)= Extension_4_0480 
  43.    Next N
  44.    '
  45.     Extension_4_053C 
  46.    Polyline CUBEX(0),CUBEX(1) To CUBEX(3),CUBEX(4) To CUBEX(6),CUBEX(7) To CUBEX(9),CUBEX(10) To CUBEX(0),CUBEX(1)
  47.    Polyline CUBEX(12),CUBEX(13) To CUBEX(15),CUBEX(16) To CUBEX(18),CUBEX(19) To CUBEX(21),CUBEX(22) To CUBEX(12),CUBEX(13)
  48.    Draw CUBEX(0),CUBEX(1) To CUBEX(12),CUBEX(13)
  49.    Draw CUBEX(3),CUBEX(4) To CUBEX(15),CUBEX(16)
  50.    Draw CUBEX(6),CUBEX(7) To CUBEX(18),CUBEX(19)
  51.    Draw CUBEX(9),CUBEX(10) To CUBEX(21),CUBEX(22)
  52.    Screen Swap 
  53.    '
  54. End Proc
  55. Procedure SETUPCUBE
  56.    '
  57.    For N=0 To 23
  58.       Read CUBE(N)
  59.    Next N
  60.    '
  61.    CUBEDATA:
  62.    Data -50,-50,500,50,-50,500,50,50,500,-50,50,500
  63.    Data -50,-50,600,50,-50,600,50,50,600,-50,50,600
  64.    '
  65. End Proc
  66. Procedure FINISH
  67.    '
  68.    Default 
  69.    Edit 
  70.    '
  71. End Proc