home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / self / contrib.lha / contrib / 491 / aa / poly.self < prev    next >
Encoding:
Text File  |  1993-07-22  |  9.5 KB  |  366 lines
  1. " basic polynomial types "
  2. " 
  3. * poly.self,v
  4. * Revision 1.13  1993/07/22  00:15:19  richards
  5. * Moved back to having event handlers per operation.
  6. * eventHandler/buttons now support substitution.
  7. * poly.self has primitive substitution handler, except that it has
  8. * no concept of context.
  9. *
  10. * Revision 1.12  1993/07/18  20:22:31  richards
  11. * Added substitution of polynomials (not quite working properly yet).
  12. * Some tests for this added to test4.
  13. * Buttons work, selections work, and eventHandling is coming along.
  14. *
  15. * Revision 1.11  1993/07/13  21:47:02  richards
  16. * July 13 checkin.
  17. *
  18. * Revision 1.10  1993/06/18  21:25:39  richards
  19. * Moved font support into viewManager.
  20. * Starting to add selection stuff into window and boite.
  21. * Boites refer properly back to the polynomial structures.
  22. *
  23. * Revision 1.9  1993/06/03  21:33:14  richards
  24. * Fixed up the redrawing of the subviews. Turned out they were being drawn off the screen
  25. * due to faulty thinking about where the areas really were.
  26. *
  27. * Revision 1.8  1993/05/31  20:27:53  richards
  28. * symbols has the whole greek alphabet, but some letters are not named right.
  29. * window.self noww uses two sub-classes of compoundView, one inside the other.
  30. * (Still have problem identifying them...)
  31. * test7 obsolete.
  32. * Fixed some problems with font positioning in boites and poly.
  33. *
  34. * Revision 1.7  1993/05/31  00:12:14  richards
  35. * May 30 checkin. Font support is nearly debugged.
  36. * Make use of glue now.
  37. * Added rational (fraction) types.
  38. *
  39. * Revision 1.6  1993/05/30  21:41:14  richards
  40. * Add rational type.
  41. *
  42. * Revision 1.5  1993/05/23  23:16:47  richards
  43. * No longer puts polynomials under globals, but rather aa.
  44. *
  45. * Revision 1.4  1992/08/19  02:42:21  richards
  46. * Added makeBoite to start the polynomial -> boite conversion. No font support yet.
  47. *
  48. * Revision 1.3  1992/07/05  22:38:37  richards
  49. * Added support for properly parenthesizing infix operators.
  50. * Each infix operator has an infixPriority, and if a lower priority
  51. * operation is printed as part of a higher priority binding (e.g. an
  52. * addition in the middle of a multiplication) then parenthesis are
  53. * added.
  54. *
  55. * Revision 1.2  1992/07/05  22:08:05  richards
  56. * Added and testing scalars and the plus operator.
  57. * The slot `thisObjectPrints' must be on the actual object --- it can't
  58. * be inherited. (This makes sense though...)
  59. *
  60. * Revision 1.1  1992/06/28  15:07:43  richards
  61. * Initial revision
  62. *
  63. *
  64. * /home/2user2/richards/cvs/491/aa/poly.self,v 1.13 1993/07/22 00:15:19 richards Exp 
  65. *
  66. "
  67.  
  68. aa traits _AddSlotsIfAbsent: ( |
  69.     vector = ().
  70.     scalar = ().
  71.     addition = ().
  72.     product = ().
  73.     rational = ().
  74.     exponent = ().
  75.     differentiation = ().
  76.     integration = ().
  77.     operator = ().
  78.     unaryop = (). 
  79.     binop = (). 
  80.     naryop = ()
  81. |)
  82.  
  83. aa mixins _AddSlotsIfAbsent: ( |
  84.     infixop = ().
  85.     poly = ().
  86. |)
  87.  
  88. aa traits operator _Define: (|
  89.     ^ parent* = traits clonable.
  90. |)
  91.  
  92. aa traits vector _Define: (|
  93.     ^ parent* = traits clonable.
  94. |)             
  95.  
  96. aa mixins infixop _Define: (|
  97.     printString: n = ( |output|
  98.     output: ''.
  99.     ( n > infixPriority ) ifTrue: [ output: '(' ].
  100.     doFirst: [ |:firstArg| output: output,
  101.         (firstArg printString: infixPriority) ] 
  102.         Middle:  [ |:anArg|    output: (output,' ',infixSymbol,' ',
  103.             (anArg printString: infixPriority))]
  104.         Last:    [ |:lastArg|  output: (output,' ',infixSymbol,' ',
  105.             (lastArg printString: infixPriority))]
  106.         IfEmpty: [ error: infixSymbol, 
  107.         ' requires at least two arguments'].
  108.     ( n > infixPriority) ifTrue: [ output: output,')'].
  109.     output).
  110.     printString = ( printString: infixPriority ).
  111.  
  112.     makeBoite: n   = ( | myHBoite. |
  113.     myHBoite: aa boites hboite copy.
  114.     myHBoite polyObject: self.
  115.     ( n > infixPriority ) ifTrue: [ myHBoite addEnd: (aa boites htext make: '('). ].
  116.     
  117.     doFirst: [| :firstArg | 
  118.         myHBoite addEnd: firstArg makeBoite: infixPriority.
  119.         myHBoite addEnd: (aa boites htext make: infixSymbol).
  120.     ]
  121.         Middle:  [| :anArg | 
  122.         myHBoite addEnd: anArg makeBoite: infixPriority.
  123.         myHBoite addEnd: (aa boites htext make: infixSymbol).
  124.     ]
  125.         Last:    [| :lastArg| 
  126.         myHBoite addEnd: lastArg makeBoite: infixPriority.
  127.     ]
  128.         IfEmpty: [ error: infixSymbol, 
  129.         ' requires at least two arguments'].
  130.     
  131.     ( n > infixPriority ) ifTrue: [ 
  132.         myHBoite addEnd: (aa boites htext make: ')').
  133.     ].
  134.     myHBoite
  135.     ).
  136.     makeBoite   = ( makeBoite: infixPriority ).
  137.  
  138. |)
  139.  
  140. aa mixins poly _Define: (|
  141.     ^ + aVar = ( |new|
  142.     new: aa prototypes addition copy.
  143.     new buildAddition: self.
  144.     new buildAddition: aVar.
  145.     new
  146.     ).
  147.     ^ * aVar = ( |new|
  148.     new: aa prototypes product copy.
  149.     new buildProduct: self.
  150.     new buildProduct: aVar.
  151.     new
  152.     ).
  153.     ^ / aVar = (| new |
  154.     new: aa prototypes rational copy.
  155.     new numerator: self.
  156.     new denominator: aVar.
  157.     new
  158.     ).
  159.  
  160. |)
  161.  
  162.           
  163. aa traits binop _Define: (|
  164.     ^ parent* = aa traits operator.
  165.     size      = 2.
  166.     doFirst: firstBlock Middle: middleBlock Last: lastBlock IfEmpty: emptyBlock = (
  167.     firstBlock value: leftTerm.
  168.     lastBlock  value: rightTerm.
  169.     ).
  170.     substitute: eqn1 For: eqn2 = (| nb. |
  171.     'substitute: ' print. printLine. eqn1 printLine. eqn2 printLine.
  172.     (equals: eqn2) ifTrue: [ ^(eqn1 copy) ].
  173.     nb: copy.
  174.     nb leftTerm: leftTerm substitute: eqn1 For: eqn2.
  175.     nb rightTerm: rightTerm substitute: eqn1 For: eqn2.
  176.     nb
  177.     ).
  178.     equals: eqn = (
  179.     ((parent = eqn parent) &&                      " MUST BE SAME TYPE "
  180.           [(leftTerm equals: eqn leftTerm) &&
  181.               (rightTerm equals: eqn rightTerm)])
  182.     ).
  183.           
  184. |)
  185.  
  186. aa traits naryop _Define: (|
  187.     ^ parent* = aa traits operator. 
  188.     doFirst: firstBlock Middle: middleBlock Last: lastBlock IfEmpty: emptyBlock = (
  189.     ^(arguments doFirst: firstBlock
  190.         Middle:      middleBlock
  191.         Last:        lastBlock
  192.         IfEmpty:     emptyBlock)
  193.     ).
  194.     substitute: eqn1 For: eqn2 = (| n. |
  195.     'substitute: ' print. printLine. eqn1 printLine. eqn2 printLine.
  196.     (equals: eqn2) ifTrue: [ ^eqn1 copy ].
  197.     n: copy.
  198.     n arguments removeAll.
  199.     arguments do: [|:arg |
  200.         n arguments addLast: (arg substitute: eqn1 For: eqn2).
  201.     ].
  202.     n
  203.     ).
  204.     equals: eqn = (| res. |
  205.     res: (parent = eqn parent) && [arguments size = eqn arguments size].
  206.     res ifTrue: [
  207.         0 to: (arguments size - 1) Do: [|:pos|
  208.         res: res && [(arguments at: pos) equals: (eqn arguments at: pos)].
  209.         ].
  210.     ].
  211.     res
  212.     ).          
  213. |)
  214.  
  215. aa traits addition _Define: (|
  216.     ^ parent** = aa traits naryop.
  217.     ^ infixparent* = aa mixins infixop.
  218.     ^ varparent*   = aa mixins poly.
  219.     infixSymbol = '+'.
  220.     infixPriority = 16.
  221.     arguments = ( terms ).
  222.     copy      = ( |new| 
  223.     new: clone.
  224.     new terms: terms copy.
  225.     new
  226.     ).
  227.     ^ buildAddition: var = (
  228.     terms addLast: var.
  229.     self
  230.     )
  231. |)                              
  232.  
  233. aa traits product _Define: (|
  234.     ^ parent** = aa traits naryop.
  235.     ^ infixparent* = aa mixins infixop.
  236.     ^ varparent*   = aa mixins poly.
  237.     infixSymbol = '*'.
  238.     infixPriority = 32.
  239.     arguments = ( terms ).
  240.     copy      = ( |new| 
  241.     new: clone.
  242.     new terms: terms copy.
  243.     new
  244.     ).
  245.     ^ buildProduct: var = (
  246.     terms addLast: var.
  247.     self
  248.     )
  249. |)                              
  250.  
  251. aa traits rational _Define: (|
  252.     ^ parent**     = aa traits binop.
  253.     ^ infixparent* = aa mixins infixop.
  254.     ^ varparent*   = aa mixins poly.
  255.     infixSymbol    = '/'.
  256.     infixPriority  = 20.
  257.     leftTerm       = ( numerator ).
  258.     leftTerm: n    = ( numerator: n ).
  259.     rightTerm      = ( denominator ).
  260.     rightTerm: n   = ( denominator: n ). 
  261.     copy           = (| new |
  262.     new: clone.
  263.     new
  264.     ).
  265.     makeBoite: n   = ( | vb. hb. line. |
  266.     vb: aa boites vboite copy.       vb polyObject: self.
  267.     hb: aa boites hboite copy.      hb polyObject: numerator.
  268.     
  269.     hb addEnd: aa boites hglue copy.  
  270.     hb addEnd: (numerator makeBoite: infixPriority).
  271.     hb addEnd: aa boites hglue copy.
  272.     vb addEnd: hb.
  273.     
  274.     line: aa boites hline copy.
  275.     vb addEnd: line.
  276.     vb baseLineBoite: line.
  277.     
  278.     hb: aa boites hboite copy.       hb polyObject: denominator.
  279.     hb addEnd: aa boites hglue copy.
  280.     hb addEnd: (denominator makeBoite: infixPriority).
  281.     hb addEnd: aa boites hglue copy.
  282.     vb addEnd: hb.
  283.  
  284.     vb
  285.     ).
  286. |)
  287.         
  288.  
  289. aa traits scalar _Define: (|
  290.     ^ parent** = aa traits vector.
  291.     ^ varparent* = aa mixins poly.
  292.     printString = ( asciiRepresentation ).
  293.     printString: n = ( asciiRepresentation ).
  294.     makeBoite: n = (| nb. |
  295.     nb: boiteRepresentation copy.
  296.     nb polyObject: self.
  297.     nb
  298.     ).
  299.     makeBoite = ( makeBoite: infixPriority ).
  300.     commutes   = true.
  301.     associates = true.
  302.     distributes = true.
  303.     infixPriority = 64.  " () never needed "
  304.     create: name = ( |new|
  305.     new: clone.
  306.     new asciiRepresentation: name.
  307.     new boiteRepresentation: (aa boites htext make: name).
  308.     new
  309.     ).
  310.     create: name Boite: b = ( |new|
  311.     new: clone.
  312.     new asciiRepresentation: name.
  313.     new boiteRepresentation: b.
  314.     new
  315.     ).
  316.     equals: eqn = (
  317.     = eqn
  318.     ).
  319.     substitute: eqn1 For: eqn2 = (
  320.     'substitute: ' print. printLine. eqn1 printLine. eqn2 printLine.
  321.     (equals: eqn2) ifTrue: [ ^eqn1 ].   " SCALARs aren't copied "
  322.     self
  323.     ).
  324. |)
  325.  
  326. " -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- "
  327. "   PROTOTYPES FOR ABOVE OBJECTS  "
  328. " -+-+-+-+-+-+-+-+-+-+-+-+-+-+-+- "
  329.  
  330. aa prototypes _AddSlotsIfAbsent: (|
  331.     addition  = ().
  332.     product   = ().
  333.     rational  = ().
  334.     scalar    = ().
  335. |)
  336.  
  337. aa prototypes addition _Define: (|
  338.     ^ parent* = aa traits addition.
  339.     thisObjectPrints = true.
  340.     _^ terms <- list copy.
  341. |)
  342.  
  343. aa prototypes product _Define: (|
  344.     ^ parent* = aa traits product.
  345.     thisObjectPrints = true.
  346.     _^ terms <- list copy.
  347. |)
  348.  
  349. aa prototypes rational _Define: (|
  350.     ^ parent* = aa traits rational.
  351.     thisObjectPrints = true.
  352.     ^ numerator <- nil.
  353.     ^ denominator <- nil.
  354. |)
  355.  
  356. aa prototypes scalar _Define: (|
  357.     ^ parent* = aa traits scalar.
  358.     thisObjectPrints = true.
  359.     _ asciiRepresentation.
  360.     _ boiteRepresentation.
  361. |)
  362.  
  363.  
  364.  
  365.  
  366.