home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / EPMATR.ZIP / EPMCALC.E < prev    next >
Text File  |  1989-06-29  |  14KB  |  356 lines
  1. /*
  2.   This file contains a demo of the use of attributes to implement text buttons.
  3.  
  4.  
  5.  
  6. Starting the Demo.
  7.        Simply linking EPMCALC will start this demo.
  8.    It is a simple calculator that only handles
  9.    positive numbers less than 65536. It uses reverse polish notation just like
  10.    Hewlett Packard calculators. The buttons are activated by placing the cursor
  11.    over the button to be pressed and invoking the ExecuteCursor command.
  12.    (ExecuteCursor can be found in the BUTTONS.E file.) The meaning of most
  13.    of the buttons is obvious, but the button with the < character in it is
  14.    a delete character.
  15.        I recommend that ExecuteCursor be bound to a keystroke or mouse action
  16.    to improve the useablility of this calculator.
  17.  
  18. How is it done.
  19.        This calculator is done by simply using the functions provided in
  20.    BUTTONS.E to create "buttons" in the text of the document linked to
  21.    commands defined in this file. For information about how buttons are
  22.    implemented browse the buttons.e file.
  23.  
  24.  
  25.    The following paragraph is no longer true, but it remains here for
  26.    illustrative purposes. The enhancement it suggests has been
  27.    implemented.
  28.  
  29.                 The calculator stack is kept as a bunch of
  30.               attribute records placed near the top left corner
  31.               of the calculator.  As presently implmented the
  32.               value field of each of these attribute records
  33.               represents a value within the calculator stack.
  34.               Since the value field of attribute records can only
  35.               contain values in the range 0..65535, our
  36.               calculator can only deal with values in this range.
  37.               A good enhancement to this calulator would be to
  38.               use the associated text attribute class to store
  39.               arbitrary values on the calculator heap.
  40.  
  41.        The button functions of this calculator are not bound to any
  42.    particular calculator stack. This means that a user could use the block
  43.    copy functions of E to duplicate the calculator. If several calculators
  44.    exist in the file, then the button action functions look for the nearest
  45.    calculator stack and perform their action on that stack. This means that
  46.    a user could use E's block copy function to move the keys around on the
  47.    calculator face... and even move the buttons any place in the document.
  48.    (Don't ask me why? But that is a neat Gee Whiz thing to do in demos.)
  49.  
  50.  
  51.  
  52. */
  53.  
  54. /*
  55.    FindCalc
  56.  
  57.      finds the location of the calculator's stack. The
  58.      calculator's stack consist's of a sequence of
  59.      CALCSTACK_CLASS attributes. (See ---- for the
  60.      allocation of this class.) If multiple calculators
  61.      exist, then the one closest to the cursor location
  62.      is returned.
  63. */
  64. /* return true if found one */
  65. defproc FindCalc(var BestLine, var BestColm, var BestFile)
  66.   universal CALCSTACK_CLASS
  67.   universal FIND_NEXT_ATTR_SUBOP
  68.   universal FIND_PREV_ATTR_SUBOP
  69.   VeryLarge1 = 1000000000
  70.   OldLine = .line; OldColm = .col; getfileid OldFileId
  71.   BestFit = VeryLarge1
  72.   TheOffset = 0
  73.   TheColm = OldColm
  74.   TheLine = OldLine
  75.   TheFile = OldFileId
  76.   TheClass = CALCSTACK_CLASS
  77.   attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine
  78.   while (TheClass<>0) do
  79.     Distance = ((TheLine-OldLine)*(TheLine-OldLine))
  80.     if TheColm>OldColm then Distance = Distance + ((TheColm-OldColm)*(TheColm-OldColm))
  81.     else                    Distance = Distance + ((OldColm-TheColm)*(OldColm-TheColm))
  82.     endif
  83.     if Distance<BestFit then
  84.       BestLine = TheLine; BestColm = TheColm; getfileid BestFileId; BestFit=Distance
  85.     endif
  86.     TheColm    = TheColm+1
  87.     TheOffset  = 0
  88.     TheClass = CALCSTACK_CLASS
  89.     attribute_action FIND_NEXT_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine
  90.   endwhile
  91.   TheOffset = 0
  92.   TheColm = OldColm
  93.   TheLine = OldLine
  94.   TheFile = OldFileId
  95.   TheClass = CALCSTACK_CLASS
  96.   attribute_action FIND_PREV_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine
  97.   while (TheClass<>0) do
  98.     Distance = ((OldLine-TheLine)*(OldLine-TheLine))
  99.     if TheColm>OldColm then Distance = Distance + ((TheColm-OldColm)*(TheColm-OldColm))
  100.     else                    Distance = Distance + ((OldColm-TheColm)*(OldColm-TheColm))
  101.     endif
  102.     if Distance<BestFit then
  103.       BestLine = TheLine; BestColm = TheColm; getfileid BestFileId; BestFit=Distance
  104.     endif
  105.     TheColm    = TheColm
  106.     TheOffset  = -300
  107.     TheClass = CALCSTACK_CLASS
  108.     attribute_action FIND_PREV_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine
  109.   endwhile
  110.   return BestFit<>VeryLarge1
  111.  
  112. /*
  113.    CalcPop
  114.  
  115.      This proc pops an entry off of the calculator's stack
  116.    and returns that value.
  117.  
  118. */
  119. defproc CalcPop(CalcLine, CalcColm, CalcFileId)
  120.   universal CALCSTACK_CLASS
  121.   universal FIND_PREV_ATTR_SUBOP
  122.   universal DELETE_ATTR_SUBOP
  123.   universal ASSOCCLASS
  124.   getfileid OldFileid
  125.   activatefile CalcFileid
  126.   call psave_pos(OldPos)
  127.   -- check for errors
  128.     TheOffset = 0
  129.     TheColm = CalcColm
  130.     TheLine = CalcLine
  131.     TheFile = CalcFileId
  132.     TheClass = CALCSTACK_CLASS
  133.     attribute_action FIND_PREV_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine
  134.     if (TheClass==0) or (TheColm<>CalcColm) or (TheLine<>CalcLine) or (TheOffset<>-2) then
  135.       call prestore_pos(OldPos)
  136.       return 0
  137.     endif
  138.   -- get value at top of stack
  139.     CalcLine
  140.     .col  = CalcColm
  141.     TheValue = Associated_Phrase(CALCSTACK_CLASS)
  142.   -- delete the top of the calc stack
  143.     TheOffset = -1
  144.     attribute_action DELETE_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine   -- delete association
  145.     attribute_action DELETE_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine   -- delete push calc
  146.     TheOffset = 1
  147.     attribute_action DELETE_ATTR_SUBOP, TheClass, TheOffset, TheColm, TheLine   -- delete pop  calc
  148.   call prestore_pos(OldPos)
  149.   return TheValue
  150.  
  151. /*
  152.    CalcPush
  153.       Pushs the given value onto the calculator's stack
  154.    at a given location.
  155. */
  156. defproc CalcPush(ThePhrase, CalcLine, CalcColm, CalcFileId)
  157.   universal CALCSTACK_CLASS
  158.   universal ASSOCCLASS
  159.   TheValue = StashPhrase(ThePhrase)
  160.   insert_attribute  CALCSTACK_CLASS, TheValue, /*ispush:=push*/ 1,  -1, CalcColm, CalcLine, CalcFileId
  161.   insert_attribute  CALCSTACK_CLASS, TheValue, /*ispush:=pop */ 0,   1, CalcColm, CalcLine, CalcFileId
  162.   insert_attribute  ASSOCCLASS,      TheValue, /*ispush:=tag */ 2,  -1, CalcColm, CalcLine, CalcFileId
  163.  
  164. /*
  165.    UpdateCalcScreen
  166.  
  167.       Draw the value at the top of the calculator's stack
  168.    onto the screen of the calculator.
  169. */
  170. defproc UpdateCalcScreen(CalcLine, CalcColm, CalcFileId)
  171.   universal CALCSTACK_CLASS
  172.   universal FIND_NEXT_ATTR_SUBOP
  173.   universal FIND_PREV_ATTR_SUBOP
  174.   compile if EVERSION < 5
  175.      cursordata
  176.   compile endif
  177.   getfileid OldFileid
  178.    activatefile CalcFileid
  179.    call psave_pos(OldPos)
  180.      CalcLine
  181.     .col  = CalcColm
  182.     TheValue = Associated_phrase(CALCSTACK_CLASS)
  183.     .col = CalcColm + 3
  184.     CalcLine
  185.     if insertstate() then
  186.        inserttoggle
  187.     endif
  188.     keyin substr(TheValue, 1, 15)
  189.    call prestore_pos(OldPos)
  190.   activatefile OldFileid
  191.  
  192.  
  193. /*
  194.   StartCalc
  195.  
  196.      Build a calculator from scratch.
  197. */
  198. defc StartCalc
  199.   universal CALCSTACK_CLASS
  200.   universal ASSOCCLASS
  201.   universal BUTTONCLASS
  202.   "e /c jcalcxxx.tst"
  203.   getfileid CalcFileid
  204.   .filename = "EPM Calculator Demo"
  205.   .autosave = 0
  206.   insertline "╔══════════════════════╗", 1,CalcFileid
  207.   insertline "║-| 5                |-║", 2,CalcFileid
  208.   insertline "║EPM      ┌─┐┌─┐┌─┐┌─┐ ║", 3,CalcFileid
  209.   insertline "║Calc     │0││1││2││3│ ║", 4,CalcFileid
  210.   insertline "║    ┌───┐└─┘└─┘└─┘└─┘ ║", 5,CalcFileid
  211.   insertline "║ ┌─┐│ E │┌─┐┌─┐┌─┐┌─┐ ║", 6,CalcFileid
  212.   insertline "║ │+││ N ││4││5││6││7│ ║", 7,CalcFileid
  213.   insertline "║ └─┘│ T │└─┘└─┘└─┘└─┘ ║", 8,CalcFileid
  214.   insertline "║ ┌─┐│ E │┌─┐┌─┐┌─┐┌─┐ ║", 9,CalcFileid
  215.   insertline "║ │-││ R ││8││9││.││<│ ║",10,CalcFileid
  216.   insertline "║ └─┘└───┘└─┘└─┘└─┘└─┘ ║",11,CalcFileid
  217.   insertline "╚══════════════════════╝",12,CalcFileid
  218.   insertline "Use alt-dblclick-button1",13,CalcFileid
  219.  
  220.   insert_attribute CALCSTACK_CLASS, 0,                1/*ispush*/, -1, /*col:*/2, /*line:*/ 2 ;
  221.   insert_attribute ASSOCCLASS,      StashPhrase("0"), 2/*ispush*/, -1, /*col:*/2, /*line:*/ 2 ;
  222.   insert_attribute CALCSTACK_CLASS, 0,                0/*ispush*/,  1, /*col:*/2, /*line:*/ 2 ;
  223.  
  224.   call pset_mark(1, 12, 1, 24, "BLOCK", CalcFileid)
  225.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed HELP"
  226.  
  227.   call pset_mark(6, 8, 3, 5, "BLOCK", CalcFileid)
  228.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed +"
  229.   call pset_mark(9, 11, 3, 5, "BLOCK", CalcFileid)
  230.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed -"
  231.   call pset_mark(5, 11, 6, 10, "BLOCK", CalcFileid)
  232.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed ENTER"
  233.  
  234.   call pset_mark(3, 5, 11, 13, "BLOCK", CalcFileid)
  235.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 0"
  236.   call pset_mark(3, 5, 14, 16, "BLOCK", CalcFileid)
  237.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 1"
  238.   call pset_mark(3, 5, 17, 19, "BLOCK", CalcFileid)
  239.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 2"
  240.   call pset_mark(3, 5, 20, 22, "BLOCK", CalcFileid)
  241.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 3"
  242.  
  243.   call pset_mark(6, 8, 11, 13, "BLOCK", CalcFileid)
  244.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 4"
  245.   call pset_mark(6, 8, 14, 16, "BLOCK", CalcFileid)
  246.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 5"
  247.   call pset_mark(6, 8, 17, 19, "BLOCK", CalcFileid)
  248.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 6"
  249.   call pset_mark(6, 8, 20, 22, "BLOCK", CalcFileid)
  250.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 7"
  251.  
  252.   call pset_mark(9, 11, 11, 13, "BLOCK", CalcFileid)
  253.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 8"
  254.   call pset_mark(9, 11, 14, 16, "BLOCK", CalcFileid)
  255.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed 9"
  256.   call pset_mark(9, 11, 17, 19, "BLOCK", CalcFileid)
  257.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed ."
  258.   call pset_mark(9, 11, 20, 22, "BLOCK", CalcFileid)
  259.   "associate_phrase_with_mark "BUTTONCLASS" CalcKeyed <"
  260.   unmark
  261.  
  262.   call UpdateCalcScreen(2, 2, CalcFileId)
  263.   call prestore_pos("4 12 12 4");  -- .line .col .cursorx .cursory
  264.   "enable_attr_keys"
  265.  
  266.  
  267. /*
  268.   CalcKeyed
  269.  
  270.      The arithmetic guts of the calculator. It takes its
  271.   argument, applies the argument to the calculator stack,
  272.   and redisplays the screen of the calculator. This
  273.   command is generally invoked by pressing calculator
  274.   buttons, but it can also be called from the command
  275.   line.
  276. */
  277. defc CalcKeyed
  278.   compile if EVERSION < 5
  279.      cursordata
  280.   compile endif
  281.   call psave_pos(OldPos)
  282.   CalcLine = .line; CalcCol = .col; getfileid CalcFile
  283.   FoundCalc = FindCalc(CalcLine, CalcCol, CalcFile)
  284.   if (FoundCalc==0) and (arg(1)<>"HELP") then
  285.     call showmessage(" Sorry, the calculator could not be found.")
  286.     return
  287.   else
  288.   endif
  289.   if arg(1)=="ENTER" then
  290.     call CalcPush(0, CalcLine, CalcCol, CalcFile)
  291.   elseif arg(1)=="HELP" then
  292.      call showmessage(" EPM Calc Help: ",
  293.                       "   This is a trivial reverse-Polish ",
  294.                       "   notation calculator. Just        ",
  295.                       "   alt-doubleclick with button 1.   ")
  296.   elseif arg(1)=="+" then
  297.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  298.      Arg2 = CalcPop(CalcLine, CalcCol, CalcFile)
  299.      call   CalcPush(Arg1+Arg2, CalcLine, CalcCol, CalcFile)
  300.   elseif arg(1)=="-" then
  301.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  302.      Arg2 = CalcPop(CalcLine, CalcCol, CalcFile)
  303.      call   CalcPush(Arg2-Arg1, CalcLine, CalcCol, CalcFile)
  304.   elseif arg(1)=="/" then
  305.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  306.      if Arg1=0 then
  307.         call messagenwait("Division by zero not supported.")
  308.         call   CalcPush(Arg1, CalcLine, CalcCol, CalcFile)
  309.      else
  310.         Arg2 = CalcPop(CalcLine, CalcCol, CalcFile)
  311.         call   CalcPush(Arg2/Arg1, CalcLine, CalcCol, CalcFile)
  312.      endif
  313.   elseif arg(1)=="%" then
  314.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  315.      if Arg1=0 then
  316.         call messagenwait("Division by zero not supported.")
  317.         call   CalcPush(Arg1, CalcLine, CalcCol, CalcFile)
  318.      else
  319.         Arg2 = CalcPop(CalcLine, CalcCol, CalcFile)
  320.         call   CalcPush(Arg2%Arg1, CalcLine, CalcCol, CalcFile)
  321.      endif
  322.   elseif arg(1)=="//" then
  323.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  324.      if Arg1=0 then
  325.         call messagenwait("Division by zero not supported.")
  326.         call   CalcPush(Arg1, CalcLine, CalcCol, CalcFile)
  327.      else
  328.         Arg2 = CalcPop(CalcLine, CalcCol, CalcFile)
  329.         call   CalcPush(Arg2//Arg1, CalcLine, CalcCol, CalcFile)
  330.      endif
  331.   elseif (arg(1)=="+-") or (arg(1)=="-+") then
  332.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  333.      call   CalcPush(-1 * Arg1, CalcLine, CalcCol, CalcFile)
  334.   elseif arg(1)=="." then
  335.      call showmessage(" Sorry, non natural numbers are not yet officially supported.");
  336.   elseif arg(1)=="<" then
  337.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  338.      call   CalcPush(Arg1%10, CalcLine, CalcCol, CalcFile)
  339.   elseif (arg(1)>="0") and (arg(1)<="9") then
  340.      Arg1 = CalcPop(CalcLine, CalcCol, CalcFile)
  341.      Result = ( Arg1||arg(1) ) + 0   -- handles zero, positive and negatives.
  342.      call   CalcPush(Result, CalcLine, CalcCol, CalcFile)
  343.   else
  344.      call showmessage(" Sorry, I don't understand that key.")
  345.   endif
  346.   call UpdateCalcScreen(CalcLine, CalcCol, CalcFile)
  347.   call prestore_pos(OldPos)
  348.  
  349.  
  350. definit
  351.   sayerror "bozoxo1"
  352.   "link buttons"
  353.   sayerror "bozoxo2"
  354.   "startcalc"
  355.  
  356.