home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 3 / ACE CD 3.iso / files / utils / real3d32.dms / in.adf / GUI.LZH / GUI / surface.gui < prev   
Encoding:
Text File  |  1995-05-04  |  6.1 KB  |  247 lines
  1.  
  2. ( 
  3. ( Interface for creating 'SURFACE' animation method applications
  4. (
  5.  
  6. ?& SURFACE_GUI NOT ?IF
  7. 1 CONSTANT SURFACE_GUI
  8.  
  9. "ui.rpl" LOAD
  10. "locks.rpl" LOAD
  11.  
  12. ( Global variables
  13.  
  14. VARIABLE asuWindow
  15. VARIABLE asuTarget
  16. VARIABLE asuGravity
  17. VARIABLE asuGround
  18. VARIABLE asuApply
  19. VARIABLE asuHelp
  20. VARIABLE asuCancel
  21. VARIABLE isuFlags
  22. VARIABLE asuText
  23. VARIABLE asuTxtTarget
  24. VARIABLE asuTxtGravity
  25. VARIABLE asuTxtGround
  26. VARIABLE isuStampIndex
  27.  
  28. ( these variables points to selected objects
  29. 400 STRING ssuTarget
  30. 400 STRING ssuGravity
  31. 400 STRING ssuGround
  32.  
  33. ( flags for disabling buttons
  34. 1 CONSTANT fsuTarget
  35. 2 CONSTANT fsuGravity
  36. 4 CONSTANT fsuGround
  37.  
  38. fsuTarget fsuGravity fsuGround BOR BOR CONSTANT fsuAll
  39.  
  40. 1 CONSTANT TRUE
  41. 0 CONSTANT FALSE
  42. 0 CONSTANT NULL
  43.  
  44. ( this enables apply when isuFlags is equal to fsuAll
  45.  
  46. : suEnableApply
  47.     isuFlags FETCH fsuAll =
  48.     IF
  49.         UI_Done "Select friction points and click Apply" UITX_Text asuText FETCH UI_SETATTRS
  50.         UI_Done FALSE UI_Disabled asuApply FETCH UI_SETATTRS
  51.     ENDIF
  52. ;
  53.  
  54. ( saves the name of selected object to given string buffer
  55.  
  56. : suStoreSelected 
  57.     PARAM 
  58.         VARIABLE ssuName 
  59.     ENDPARAM
  60.  
  61.     iLOCK_SHARED O_LOCK
  62.     O_GETSEL DUP IF
  63.         ssuName FETCH O_MAKENAME
  64.         DROP
  65.         1
  66.     ENDIF
  67.     iLOCK_REMOVE O_LOCK
  68. ;
  69.  
  70. ( Callbacks for Gadgets
  71.  
  72. : sucbTarget
  73.     ssuTarget suStoreSelected 
  74.     IF
  75.         UI_Done TRUE UI_Disabled asuTarget FETCH UI_SETATTRS
  76.         UI_Done ssuTarget UITX_Text asuTxtTarget FETCH UI_SETATTRS
  77.         UI_Done "Target defined" UITX_Text asuText FETCH UI_SETATTRS
  78.         isuFlags FETCH fsuTarget BOR isuFlags STORE
  79.         suEnableApply
  80.     ELSE
  81.         UI_Done "No target object selected" UITX_Text asuText FETCH UI_SETATTRS
  82.     ENDIF
  83. ;
  84.  
  85. : sucbGravity
  86.     ssuGravity suStoreSelected 
  87.     IF
  88.         UI_Done TRUE UI_Disabled asuGravity FETCH UI_SETATTRS
  89.         UI_Done ssuGravity UITX_Text asuTxtGravity FETCH UI_SETATTRS
  90.         UI_Done "Gravity defined" UITX_Text asuText FETCH UI_SETATTRS
  91.         isuFlags FETCH fsuGravity BOR isuFlags STORE
  92.         suEnableApply
  93.     ELSE
  94.         UI_Done "No gravity object selected" UITX_Text asuText FETCH UI_SETATTRS
  95.     ENDIF
  96. ;
  97.  
  98. : sucbGround
  99.     ssuGround suStoreSelected 
  100.     IF
  101.         UI_Done TRUE UI_Disabled asuGround FETCH UI_SETATTRS
  102.         isuFlags FETCH fsuGround BOR isuFlags STORE
  103.         UI_Done ssuGround UITX_Text asuTxtGround FETCH UI_SETATTRS
  104.         UI_Done "Ground defined" UITX_Text asuText FETCH UI_SETATTRS
  105.         suEnableApply
  106.     ELSE
  107.         UI_Done "No ground object selected" UITX_Text asuText FETCH UI_SETATTRS
  108.     ENDIF
  109. ;
  110.  
  111. : sucbHelp
  112.     "emacs r3d3:gui/surface.gui" SYSTEM
  113. ;
  114.  
  115. : suCreateLink
  116.     PARAM 
  117.         VARIABLE aObject
  118.     ENDPARAM
  119.     100 STRING sStamp
  120.  
  121.     ( build up date stamp used for linking objects
  122.     isuStampIndex FETCH DUP 1 + isuStampIndex STORE
  123.     DATETIME "%d %d:%d:%d %d-%d-%d" sStamp SPRINTF
  124.  
  125.     ( create a link object with the time stamp
  126.     "link" 0 "CEND" sStamp "SIDE" C_LINK DROP
  127.  
  128.     ( add time stamp to target object
  129.     aObject FETCH "CEND" sStamp "SIDE" O_CREATAG DROP
  130. ;
  131.  
  132. : suCreateMethod 
  133.     400 STRING sTmpName
  134.  
  135.     iLOCK_EXCL O_LOCK
  136.  
  137.     ssuTarget O_FIND O_GETPAR O_CURRENT DROP
  138.  
  139.     ( create the actual surface method
  140.     2 "DRAG" 0 "CEND" "DRAG" "SMTH" C_LEVEL O_CURRENT DROP
  141.  
  142.     ( push currently selected objects on the stack
  143.     O_GETSEL
  144.  
  145.     ( gravity is the first parameter object
  146.     0 ssuGravity O_FIND M_CUT 
  147.     O_GETCURR 0 M_PASTE
  148.  
  149.     ( ground is the second param object
  150.     0 ssuGround O_FIND M_CUT 
  151.     O_GETCURR 0 M_PASTE
  152.  
  153.     ( third parameter object is a level consisting of links to friction points
  154.     2 "links" 0 "CEND" C_LEVEL O_CURRENT DROP
  155.  
  156.     ( scan through selected objects and create links
  157.     BEGIN 
  158.     DUP 
  159.     WHILE
  160.         suCreateLink
  161.     REPEAT
  162.     DROP
  163.  
  164.     iLOCK_REMOVE O_LOCK
  165. ;
  166.  
  167. : sucbApply
  168.  
  169.     ( enable other buttons
  170.     UI_Done FALSE UI_Disabled asuTarget  FETCH UI_SETATTRS
  171.     UI_Done FALSE UI_Disabled asuGravity FETCH UI_SETATTRS
  172.     UI_Done FALSE UI_Disabled asuGround  FETCH UI_SETATTRS
  173.  
  174.     ( clear object names
  175.     UI_Done "" UITX_Text asuTxtTarget FETCH UI_SETATTRS
  176.     UI_Done "" UITX_Text asuTxtGravity FETCH UI_SETATTRS
  177.     UI_Done "" UITX_Text asuTxtGround FETCH UI_SETATTRS
  178.  
  179.     ( disable apply
  180.     UI_Done TRUE UI_Disabled asuApply FETCH UI_SETATTRS
  181.  
  182.     ( clear flags
  183.     0 isuFlags STORE
  184.  
  185.     ( do the actual job
  186.     UI_Done "Creating surface method ..." UITX_Text asuText FETCH UI_SETATTRS
  187.  
  188.     suCreateMethod
  189.  
  190.     UI_Done "Done" UITX_Text asuText FETCH UI_SETATTRS
  191. ;
  192.  
  193. : sucbCancel
  194.     asuWindow FETCH UI_DELETE
  195.     NULL asuWindow STORE
  196. ;
  197.  
  198. : sucbWindow 
  199.     PARAM
  200.         VARIABLE iMouseY
  201.         VARIABLE iMouseX
  202.         VARIABLE iEvent
  203.     ENDPARAM
  204.  
  205.     iEvent FETCH UIWM_Close = 
  206.     IF
  207.         asuWindow FETCH UI_DELETE
  208.         NULL asuWindow STORE
  209.     ENDIF
  210. ;
  211.  
  212. ?ENDIF 
  213.  
  214. asuWindow FETCH 
  215. ?IF
  216.     "Alright" "Window is already open" GET_KEY DROP
  217. ?ELSE
  218.     ( create a window 
  219.     UI_Done & sucbWindow 0 0 520 120 "Create Surface Animation Object" UI_WINDOW asuWindow STORE
  220.  
  221.     ( create text gadgets
  222.     UI_Done TRUE UITX_Border asuWindow FETCH 0 100 20 300 12 "Target"  UI_TEXT asuTxtTarget STORE
  223.     UI_Done TRUE UITX_Border asuWindow FETCH 0 100 35 300 12 "Gravity" UI_TEXT asuTxtGravity STORE
  224.     UI_Done TRUE UITX_Border asuWindow FETCH 0 100 50 300 12 "Ground"  UI_TEXT asuTxtGround STORE
  225.  
  226.     ( create buttons
  227.     UI_Done asuWindow FETCH & sucbTarget  400 20 100 12 "Target"  UI_BUTTON asuTarget STORE
  228.     UI_Done asuWindow FETCH & sucbGravity 400 35 100 12 "Gravity" UI_BUTTON asuGravity STORE
  229.     UI_Done asuWindow FETCH & sucbGround  400 50 100 12 "Ground"  UI_BUTTON asuGround STORE
  230.  
  231.     UI_Done asuWindow FETCH & sucbApply   5 100 100 12 "Apply"    UI_BUTTON asuApply STORE
  232.     UI_Done asuWindow FETCH & sucbHelp    200 100 100 12 "Help"   UI_BUTTON asuHelp STORE
  233.     UI_Done asuWindow FETCH & sucbCancel  400 100 100 12 "Cancel" UI_BUTTON asuCancel STORE
  234.  
  235.     UI_Done 
  236.     TRUE UITX_Border 
  237.     "Use select window and buttons above to select four objects" UITX_Text
  238.     asuWindow FETCH 0 100 80 400 12 "Status" UI_TEXT asuText STORE
  239.  
  240.     ( realize gadgets
  241.     asuWindow FETCH UI_REALIZE
  242.  
  243.     ( disable apply 
  244.     UI_Done TRUE UI_Disabled asuApply FETCH UI_SETATTRS
  245.  
  246. ?ENDIF ( SURFACE_GUI
  247.