06.11.2014, 09:20 | #1 (permalink) |
Member
Регистрация: 20.02.2012
Сообщений: 27
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
RPN калькулятор
Код рабочий. Была бы очееень благодарна откликнувшимся...: tehnari_ru_088: 1. program rpncalc(input,output); 2. type pnum = ^num; 3. num = record x: real; next: pnum end; 4. var nums: pnum; 5. digits: packed array [1..10] of char; 6. tktype: (nm,ad,sb,mp,dv); 7. error: boolean; 8. z: real; 9. procedure push(x: real); 10. var p: pnum; 11. begin new(p); p^.x := x; p^.next := nums; nums := p end; 12. function pop: real; 13. var p: pnum; 14. begin 15. if nums <> nil then begin 16. p := nums; 17. nums := nums^.next; 18. pop := p^.x; 19. dispose(p) 20. end else begin 21. error := true; 22. pop := 0 23. end 24. end; 25. procedure skipws; 26. begin while (input^ = ' ') and (not eoln) do get(input) end; 27. procedure processtoken; 28. var c,cn: char; 29. f,e,x,y: real; 30. sgn,d,i: integer; 31. procedure getnumber; 32. begin 33. while (c <> ' ') and (not error) do begin 34. d := -1; i := 1; 35. while i < 11 do 36. if digits[i] = c then 37. begin d := i-1; i := 11 end 38. else i := i+1; 39. if c = '.' then 40. if f = -1 then f := 0 else error := true 41. else if d > -1 then begin 42. if z = -1 then z := 0; 43. if f = -1 then z := 10*z+d 44. else begin e := e/10; f := f+d*e end 45. end else error := true; 46. if eoln then c := ' ' else read(c) 47. end; 48. if z = -1 then error := true; 49. if not error then begin 50. if f = -1 then f := 0; 51. z := sgn*(z+f) 52. end 53. end; 54. begin { processtoken } 55. tktype := nm; 56. sgn := 1; 57. z := -1; f := -1; e := 1; 58. read(c); 59. if c in ['+', '-', '*', '/'] then begin 60. if eoln then cn := ' ' else read(cn); 61. if cn = ' ' then 62. case c of 63. '+': tktype := ad; '-': tktype := sb; 64. '*': tktype := mp; '/': tktype := dv 65. end 66. else begin 67. if c = '-' then sgn := -1 else error := c <> '+'; 68. c := cn 69. end 70. end; 71. if (not error) and (tktype = nm) then getnumber; 72. if not error then begin 73. if tktype <> nm then begin 74. y := pop; x := pop; 75. if not error then 76. case tktype of 77. ad: z := x+y; sb: z := x-y; 78. mp: z := x*y; dv: z := x/y 79. end 80. end; 81. push(z); 82. skipws 83. end 84.end; 85. procedure init; 86. var t: real; 87. begin 88. while nums <> nil do t := pop; 89. error := false; 90. if not eof then skipws 91.end; 92. begin { main } 93. digits := '0123456789'; 94. nums := nil; 95. init; 96. while not eof do begin 97. if not eoln then begin 98. repeat 100. processtoken; 101. if error then while not eoln do get(input) 102. until eoln; 103. if not error then begin 104. z := pop; 105. if nums = nil then writeln(z:1:4) else error := true 106. end; 107. if error then writeln('error') 108. end; 109. readln; init 110. end 111. end. |
06.11.2014, 09:20 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Ваш вопрос уже обсуждался на нашем форуме Помогите исправить калькулятор Make Your Calc - настраиваемый калькулятор EasyCalcPro - мощный калькулятор |
06.11.2014, 13:57 | #2 (permalink) |
VIP user
Регистрация: 15.01.2014
Сообщений: 1,828
Сказал(а) спасибо: 242
Поблагодарили 15 раз(а) в 11 сообщениях
Репутация: 26010
|
Я могу, но не все строчки.
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|