QB64.org Forum

Active Forums => Programs => Topic started by: Richard Frost on January 31, 2019, 11:43:26 pm

Title: TI-58C calculator
Post by: Richard Frost on January 31, 2019, 11:43:26 pm

Code: QB64: [Select]

1. _TITLE "TI-58C by rfrost@mail.com"
2.  
3. DEFINT A-Z
4. DECLARE SUB DrawCalc ()
5. DECLARE SUB Init ()
6. DECLARE SUB Keyboard ()
7. DECLARE SUB Learn ()
8. DECLARE SUB MemOps ()
9. DECLARE SUB Mouse ()
10. DECLARE SUB NoPend ()
11. DECLARE SUB NumDisp ()
12. DECLARE SUB PlotNum (Text$)
13. DECLARE SUB ProcessEquals ()
14. DECLARE SUB ProcessKey ()
15. DECLARE SUB ProcessTrig ()
16. DECLARE SUB ColorSet ()
17. DECLARE SUB ShowText (x, y, Text$, kolor)
18. DECLARE SUB WriteProg ()
19.  
20. COMMON SHARED true, false, ddp
21. COMMON SHARED black, white, yellow, redi, redd
22. COMMON SHARED i$, lft, rgt, mkey$
23. COMMON SHARED Num#, expo, dp&
24. COMMON SHARED OperationPending, op$, MemOp$, Running, Prog
25. COMMON SHARED LearnFlag, ProgPos
26. COMMON SHARED y#, treg#, ShiftFlag, InvFlag, AngMode$, IsError
27. COMMON SHARED pi#, ator#
28. COMMON SHARED GetNum, GetNum$
29. COMMON SHARED psize, msize
30. COMMON SHARED minx, miny, maxx, maxy
31. COMMON SHARED up, down, left, right
32. COMMON SHARED noise
33.  
34. psize = 99: msize = 99
35. DIM SHARED MemReg#(msize), ProgStep(psize), pat(255, 13), garr(999)
36. DIM SHARED k$(100), kn(100), bx1(50), by1(50), bx2(50), by2(50)
37. Init
38. DO: _LIMIT 10
39.     Mouse
40.     Keyboard
41.     ProcessKey
42.     IF Running AND Prog = 5 THEN Num# = Num# + 1: NumDisp
43. LOOP
44.    
45. card:
46. DATA "DOW, DAYS BETWEEN DATES",ML-20
47. DATA (MMDD.YYYY),"","","",""
48. DATA DATE1,DATE2,#Days,D>DOW,""
49.  
50. '      key  key color keycode keycode
51. Keys:
52. DATA "A","A'",0,11,16
53. DATA "B","B'",0,12,17
54. DATA "C","C'",0,13,18
55. DATA "D","D'",0,14,19
56. DATA "E","E'",0,15,20
57.  
58. DATA "2nd","",6,0,0
59. DATA "INV","",0,22,0
60. DATA "lnx","log",0,23,28
61. DATA "CE","CP",0,24,29
62. DATA "CLR","",6,25,0
63.  
64. DATA "LRN","Pgm",0,31,36
65. DATA "xt","PR",0,32,37
66. DATA "xý","sin",0,33,38
67. DATA "ûx","cos",0,34,39
68. DATA "1/x","tan",0,35,30
69.  
70. DATA "SST","Ins",0,41,45
71. DATA "STO","CMs",0,42,46
72. DATA "RCL","Exc",0,43,47
73. DATA "SUM","Prd",0,44,48
74. DATA "yx","Ind",0,45,49
75.  
76. DATA "BST","Del",0,51,55
77. DATA "EE","Eng",0,52,56
78. DATA "(","Fix",0,52,57
79. DATA ")","Int",0,53,58
80. DATA "ö","³x³",6,54,59
81.  
82. DATA "GTO","Pause",0,61,66
83. DATA "7","x=t",15,7,67
84. DATA "8","Nop",15,8,68
85. DATA "9","Op",15,9,69
86. DATA "x","Deg",6,65,70
87.  
88. DATA "SBR","Lbl",0,71,76
89. DATA "4","xòt",15,4,77
90. DATA "5","ä+",15,5,78
91. DATA "6","x",15,6,79
92. DATA "-","Rad",6,75,80
93.  
94. DATA "RST","St flg",0,81,86
95. DATA "1","If flg",15,1,87
96. DATA "2","D.MS",15,2,88
97. DATA "3","ã",15,3,89
98. DATA "+","Grad",6,85,90
99.  
100. DATA "R/S","",0,91,0
101. DATA "0","Dsz",15,0,96
102. DATA ".","Adv",15,93,97
103. DATA "+/-","Prt",15,94,98
104. DATA "=","Lst",6,95,99
105.  
106. DATA "RTN","",0,92,0
107.  
108. Logo:
109. DATA ...XXX...X......
110. DATA ...XXXX.........
111. DATA ...XXXX..X.XXXXX
112. DATA ...XXXX..X.XXXXX
113. DATA ...XX....X....XX
114. DATA ...XX....X....XX
115. DATA XXXXXXX..X..XXXX
116. DATA XXXXXXX..X..XXXX
117. DATA .XXXXXX..X..XXX.
118. DATA ..XXXXX..X..X...
119. DATA ....XXX..X..X...
120. DATA ......X.....X...
121. DATA .......XXXXX....
122. DATA ........XXXX....
123. DATA .........XX.....
124. DATA "end"
125.  
126. Prog:
127. DATA 76,Lbl
128. DATA 15,E
129. DATA 85,+
130. DATA 1,1
131. DATA 66,Pause
132. DATA 81,RST
133. DATA 0,"end"
134.  
135. SUB ColorSet
136.     black = 0
137.     redi = 1
138.     redd = 2
139.     yellow = 6
140.     white = 10
141.     FOR i = 1 TO 15
142.         IF i = yellow THEN
143.             PALETTE i, 65536 * 20 + 256 * 30 + 40 ' yellow
144.         ELSEIF i = redi THEN
145.             PALETTE i, 65536 * 15 + 256 * 15 + 63 ' red intense
146.         ELSEIF i = redd THEN
147.             PALETTE i, 65536 * 5 + 256 * 5 + 13 ' red dim
148.         ELSEIF i = white THEN
149.             PALETTE i, 65536 * 35 + 256 * 35 + 35 ' white
150.         END IF
151.     NEXT i
152. END SUB
153.  
154. SUB DrawCalc
155.     CLS
156.     ColorSet
157.     LINE (177, 4)-(461, 475), white, B ' full machine
158.     LINE (183, 30)-(456, 88), white, B ' number window
159.     LINE (183, 88)-(456, 136), white, B ' card window
160.     LINE (183, 104)-(456, 104), yellow ' card window
161.     LINE (183, 119)-(456, 119), yellow ' card window
162.  
163.     LINE (183, 136)-(456, 470), yellow, B ' button window
164.     LINE (185, 138)-(454, 468), yellow, B ' button window
165.     PAINT (184, 140), yellow, yellow
166.  
167.     RESTORE Logo
168.     bx = 190: x = bx
169.     by = 10: y = by
170.     DO
171.         READ pat$
172.         IF pat$ = "end" THEN EXIT DO
173.         FOR t = 1 TO LEN(pat$)
174.             IF MID$(pat$, t, 1) = "X" THEN PSET (x, y), white
175.             x = x + 1
176.         NEXT t
177.         x = bx: y = y + 1
178.     LOOP
179.  
180.     ShowText 225, 32, "Texas Instruments", black
181.  
182.     IF LearnFlag THEN
183.         mkey$ = "xxx"
184.         Learn
185.     ELSE
186.         NumDisp
187.     END IF
188.  
189.     RESTORE card
190.     READ Card1$: ShowText 206, 110, Card1$, -1
191.     READ Card2$: ShowText 426, 110, Card2$, -1
192.     FOR row = 1 TO 2
193.         FOR col = 1 TO 5
194.             READ Text$
195.             IF Text$ = "D>DOW" THEN MID$(Text$, 2, 1) = CHR$(26)
196.             x = (col - 1) * 54 + 208
197.             y = (row - 1) * 16 + 140
198.             z = 31
199.             IF (Card2$ = "ML-20") AND (col = 1) THEN
200.                 LINE (x + z, 119)-(x + z, 136), yellow
201.             ELSEIF col < 5 THEN
202.                 LINE (x + z, 104)-(x + z, 136), yellow
203.             END IF
204.             ShowText x, y - 14, Text$, -1
205.         NEXT col
206.     NEXT row
207.  
208.     RESTORE Keys
209.     kn = 0
210.     FOR row = 1 TO 9
211.         FOR col = 1 TO 5
212.             kn = kn + 1
213.             READ k$(kn), k$(kn + 50), kolor, kn(kn), kn(kn + 50)
214.             IF kolor = 6 THEN kolor = yellow
215.             IF kolor = 15 THEN kolor = white
216.             IF k$(kn + 50) = "PR" THEN k$(kn + 50) = "P" + CHR$(26) + "R"
217.             x = (col - 1) * 54 + 208
218.             y = (row - 1) * 34 + 180
219.             ShowText x, y - 15, k$(kn + 50), -1
220.             IF kolor = 0 THEN
221.                 LINE (x - 13, y - 21)-(x + 21, y - 7), white, B
222.             ELSE
223.                 LINE (x - 13, y - 21)-(x + 21, y - 7), kolor, BF
224.             END IF
225.             bx1(kn) = x - 13: bx2(kn) = x + 21
226.             by1(kn) = y - 21: by2(kn) = y - 7
227.             ShowText x, y, k$(kn), kolor
228.         NEXT col
229.     NEXT row
230.     kn = kn + 1
231.     READ k$(kn), k$(kn + 50), kolor, kn(kn), kn(kn + 50)
232.     ShowText 311, 471, "TI Programmable 58C", -1
233. END SUB
234.  
235. SUB Init
236.     CLS
237.     true = -1
238.     false = 0
239.  
240.     noise = true
241.     pi# = ATN(1) * 4
242.     ator# = ATN(1) / 45
243.     AngMode$ = "D"
244.  
245.     s& = VARSEG(pat(0, 0))
246.     o& = VARPTR(pat(0, 0))
247.     DEF SEG = s&
248.     BLOAD "font.dat", o&
249.  
250.     SCREEN 12 ' 640*480*16
251.     minx = 196: maxx = 444
252.     miny = 161: maxy = 444
253.     msx = 334: msy = 234
254.     DrawCalc
255.  
256.     psize = 99
257.     OPEN "prog.txt" FOR APPEND AS #1
258.     CLOSE #1
259.     GetProg:
260.     OPEN "prog.txt" FOR INPUT AS #1
261.     IF EOF(1) THEN
262.         CLOSE #1
263.         RESTORE Prog
264.         DO
265.             READ ProgStep, Prog$
266.             IF Prog$ = "end" THEN EXIT DO
267.             ProgStep(ProgPos) = ProgStep
268.             ProgPos = ProgPos + 1
269.         LOOP
270.         WriteProg
271.         GOTO GetProg
272.     ELSE
273.         ProgPos = 0
274.         WHILE NOT (EOF(1))
275.             INPUT #1, pstep$
276.             IF LEFT$(pstep$, 1) = "M" THEN
277.                 INPUT #1, MemReg$, memval$
278.                 MemReg#(VAL(MemReg$)) = VAL(memval$)
279.             ELSE
280.                 INPUT #1, pcode$, palph$
281.                 ProgStep(ProgPos) = VAL(pcode$)
282.                 ProgPos = ProgPos + 1
283.             END IF
284.         WEND
285.     END IF
286.     CLOSE #1
287.     ProgPos = 0
288.     dp& = 1
289.     up = 72: down = 80: left = 75: right = 77
290. END SUB
291.  
292. SUB Keyboard
293.     IF mkey$ > "" THEN
294.         i$ = mkey$
295.         IF i$ = "CLR" THEN i$ = "c"
296.         mkey$ = ""
297.         IF noise THEN SOUND 3000, 1
298.     ELSE
299.         i$ = INKEY$
300.         IF i$ = "s" THEN noise = noise XOR 1
301.         IF noise AND LEN(i$) THEN SOUND 3000, 1
302.     END IF
303. END SUB
304.  
305. SUB Learn
306.     IF mkey$ = "Del" THEN
307.         FOR t = ProgPos TO psize - 1
308.             ProgStep(t) = ProgStep(t + 1)
309.         NEXT t
310.         ProgStep(psize) = 0
311.         mkey$ = ""
312.     END IF
313.  
314.     IF mkey$ = "Ins" THEN
315.         FOR t = psize TO ProgPos + 1 STEP -1
316.             ProgStep(t) = ProgStep(t - 1)
317.         NEXT t
318.         ProgStep(ProgPos) = 0
319.         mkey$ = ""
320.     END IF
321.  
322.     IF mkey$ > "" THEN
323.         FOR t = 1 TO 100
324.             IF mkey$ = k$(t) THEN
325.                 ProgStep(ProgPos) = kn(t)
326.                 ProgPos = ProgPos + 1
327.                 IF ProgPos > psize THEN
328.                     ProgPos = psize
329.                     LearnFlag = false
330.                 END IF
331.                 EXIT FOR
332.             END IF
333.         NEXT t
334.     END IF
335.  
336.     Text$ = SPACE$(7) + RIGHT$("00" + LTRIM$(STR$(ProgPos)), 3) + " "
337.     Text$ = Text$ + RIGHT$("00" + LTRIM$(STR$(ProgStep(ProgPos))), 2)
338.     IF mkey$ > "" THEN PlotNum Text$
339.     mkey$ = ""
340. END SUB
341.  
342. SUB MemOps
343.     MemReg = VAL(GetNum$)
344.     SELECT CASE MemOp$
345.         CASE IS = "STO"
346.             MemReg#(MemReg) = Num#
347.         CASE IS = "RCL"
348.             Num# = MemReg#(MemReg)
349.         CASE IS = "SUM"
350.             MemReg#(MemReg) = MemReg#(MemReg) + Num#
351.         CASE IS = "Exc"
352.             SWAP MemReg#(MemReg), Num#
353.         CASE IS = "Prd"
354.             MemReg#(MemReg) = MemReg#(MemReg) * Num#
355.     END SELECT
356.     MemOp$ = ""
357.     NumDisp
358.     OperationPending = true
359. END SUB
360.  
361. SUB Mouse
362.     DO WHILE _MOUSEINPUT
363.         mx = _MOUSEX
364.         my = _MOUSEY
365.         lft = _MOUSEBUTTON(1)
366.         rgt = _MOUSEBUTTON(2)
367.     LOOP
368.     msx = mx: msy = my
369.  
370.     IF NOT (lft OR rgt) THEN EXIT SUB
371.  
372.     FOR t = 1 TO 50
373.         hitx = (mx > bx1(t)) AND (mx < bx2(t))
374.         hity = (my > by1(t)) AND (my < by2(t))
375.         IF hitx AND hity THEN
376.             GET (bx1(t), by1(t))-(bx2(t), by2(t)), garr()
377.             LINE (bx1(t), by1(t))-(bx2(t), by2(t)), 15, B
378.             IF lft OR rgt THEN mkey$ = k$(t - ShiftFlag * 50)
379.             ShiftFlag = 0
380.             _DELAY .2
381.             PUT (bx1(t), by1(t)), garr(), PSET
382.             EXIT FOR
383.         END IF
384.     NEXT t
385.  
386.     IF Running AND (mkey$ <> "R/S") THEN mkey$ = "": EXIT SUB
387.     IF mkey$ = "BST" THEN ProgPos = ProgPos - 1 - (ProgPos = 0): mkey$ = "xxx"
388.     IF mkey$ = "SST" THEN
389.         ProgPos = ProgPos + 1
390.         IF ProgPos > psize THEN
391.             ProgPos = psize
392.             mkey$ = "LRN"
393.         ELSE
394.             mkey$ = "xxx"
395.         END IF
396.     END IF
397.     IF mkey$ = "LRN" THEN LearnFlag = NOT (LearnFlag): mkey$ = " "
398.     IF LearnFlag THEN Learn: EXIT SUB
399.     IF mkey$ = "RST" THEN ProgPos = 0: mkey$ = ""
400.     IF mkey$ = "GTO" THEN GetNum = 3: mkey$ = ""
401.     IF mkey$ = "R/S" THEN Running = NOT (Running): OperationPending = true
402.     IF mkey$ = "E" THEN Prog = 5: Running = true
403.     IF mkey$ = "2nd" THEN ShiftFlag = true
404.     IF mkey$ = "INV" THEN InvFlag = true
405.     IF mkey$ = "log" THEN
406.         IF InvFlag THEN
407.             IsError = true
408.             InvFlag = false
409.         ELSE
410.             Num# = LOG(Num#) / LOG(10): NoPend
411.         END IF
412.     END IF
413.     IF mkey$ = "lnx" THEN
414.         IF InvFlag THEN
415.             IsError = true
416.             InvFlag = false
417.         ELSE
418.             Num# = LOG(Num#): NoPend
419.         END IF
420.     END IF
421.     IF mkey$ = "CE" THEN Num# = 0: ShiftFlag = false: InvFlag = false
422.     IF mkey$ = "xt" THEN SWAP treg#, Num#: NoPend
423.     IF mkey$ = "xý" THEN Num# = Num# * Num#: NoPend
424.     IF LEN(mkey$) = 3 THEN
425.         IF INSTR("STO RCL SUM Exc Prd", mkey$) > 0 THEN MemOp$ = mkey$: GetNum = 2
426.         IF INSTR("SIN COS TAN", UCASE$(mkey$)) > 0 THEN ProcessTrig
427.     END IF
428.     IF mkey$ = "ûx" THEN Num# = SQR(Num#): NoPend
429.     IF mkey$ = "1/x" THEN Num# = 1 / Num#: NoPend
430.     IF mkey$ = "Int" THEN Num# = FIX(Num#): NoPend
431.     IF mkey$ = "CMs" THEN
432.         FOR MemReg = 0 TO 99
433.             MemReg#(MemReg) = 0
434.         NEXT MemReg
435.     END IF
436.     IF mkey$ = "yx" THEN
437.         IF y# = 0 THEN
438.             y# = Num#
439.             op$ = "^"
440.             OperationPending = true
441.         END IF
442.     END IF
443.     IF mkey$ = "³x³" THEN Num# = ABS(Num#): NoPend
444.     IF mkey$ = "Deg" THEN AngMode$ = "D": NoPend
445.     IF mkey$ = "Rad" THEN AngMode$ = "R": NoPend
446.     IF mkey$ = "Grad" THEN AngMode$ = "Grad": NoPend
447.     IF mkey$ = "ã" THEN Num# = pi#: NoPend
448.     IF mkey$ = "+/-" THEN Num# = -(Num#): NoPend
449. END SUB
450.  
451. SUB NoPend
452.     mkey$ = "="
453.     InvFlag = false
454.     ShiftFlag = false
455. END SUB
456.  
457. SUB NumDisp
458.     expo = 0
459.     exp$ = SPACE$(3)
460.  
461.     IF Num# = INT(Num#) THEN
462.         Num$ = RIGHT$(SPACE$(10) + STR$(Num#), 10)
463.         ddp = 0
464.     ELSE
465.         Num$ = LTRIM$(STR$(Num#))
466.         IF LEFT$(Num$, 1) = "." THEN Num$ = "0" + Num$
467.         IF LEN(Num$) > 11 THEN Num$ = LEFT$(Num$, 11)
468.         WHILE LEN(Num$) < 11
469.             Num$ = " " + Num$
470.         WEND
471.         ddp = INSTR(Num$, ".")
472.         Num$ = LEFT$(Num$, ddp - 1) + RIGHT$(Num$, LEN(Num$) - ddp)
473.     END IF
474.     GOTO woof
475.  
476.     Num$ = LTRIM$(STR$(Num#))
477.     IF (Num# > 0) AND (Num# < .000000001#) THEN
478.         tnum# = Num#
479.         WHILE tnum# < 1
480.             tnum# = tnum# * 10
481.             expo = expo + 1
482.         WEND
483.         Num$ = RIGHT$(SPACE$(10) + STR$(tnum#), 10)
484.         IF expo > 0 THEN exp$ = "-" + RIGHT$("00" + LTRIM$(STR$(expo)), 2)
485.     ELSEIF Num# > 9999999999# THEN
486.         tnum# = Num#
487.         WHILE tnum# > 10
488.             tnum# = tnum# / 10
489.             expo = expo + 1
490.         WEND
491.         Num$ = RIGHT$(SPACE$(10) + STR$(tnum#), 10)
492.         IF expo > 0 THEN exp$ = " " + RIGHT$("00" + LTRIM$(STR$(expo)), 2)
493.     ELSE
494.         IF LEN(Num$) > 10 THEN
495.             Num$ = LEFT$(Num$, 10)
496.         ELSE
497.             Num$ = RIGHT$(SPACE$(10) + STR$(Num#), 10)
498.         END IF
499.     END IF
500.  
501.     woof:
502.     IF expo > 99 THEN IsError = true
503.     Text$ = Num$ + exp$
504.     Text$ = RIGHT$(SPACE$(13) + Text$, 13)
505.     IF IsError THEN Text$ = "         E   "
506.     PlotNum Text$
507. END SUB
508.  
509. SUB PlotNum (Text$)
510.     LINE (184, 31)-(455, 87), black, BF ' erase number window
511.     LINE (183, 30)-(456, 88), white, B ' number window
512.  
513.     FOR i = 1 TO LEN(Text$)
514.         a = ASC(MID$(Text$, i, 1))
515.         dx = 196 + i * 18
516.         dy = 48
517.         FOR byte = 1 TO 10
518.             LINE (dx, dy)-(dx + 7, dy), redi, , pat(a, byte) * 128
519.             dy = dy + 2
520.         NEXT byte
521.     NEXT i
522.  
523.     IF NOT (LearnFlag) AND (ddp > 0) THEN
524.         dx = 188 + ddp * 18
525.         dy = 65
526.         LINE (dx, dy)-(dx + 1, dy + 1), redi, BF
527.     END IF
528. END SUB
529.  
530. SUB ProcessEquals
531.     SELECT CASE op$
532.         CASE IS = "+"
533.             Num# = y# + Num#
534.         CASE IS = "-"
535.             Num# = y# - Num#
536.         CASE IS = "*"
537.             Num# = y# * Num#
538.         CASE IS = "x"
539.             Num# = y# * Num#
540.         CASE IS = "ö"
541.             Num# = y# / Num#
542.         CASE IS = "/"
543.             Num# = y# / Num#
544.         CASE IS = "^"
545.             Num# = y# ^ Num#
546.             y# = 0
547.     END SELECT
548.     op$ = ""
549. END SUB
550.  
551. SUB ProcessKey
552.     IF LEN(i$) = 0 THEN EXIT SUB
553.     IF i$ = CHR$(27) THEN WriteProg: SYSTEM
554.     IF LearnFlag THEN EXIT SUB
555.     IF INSTR(".0123456789", i$) > 0 THEN
556.         IF (GetNum > 0) AND (i$ <> ".") THEN
557.             GetNum$ = GetNum$ + i$
558.             IF LEN(GetNum$) = GetNum THEN
559.                 GetNum = 0
560.                 IF LEN(MemOp$) > 0 THEN
561.                     MemOps
562.                 ELSE
563.                     NewPos = VAL(GetNum$)
564.                     IF NewPos <= psize THEN ProgPos = NewPos
565.                 END IF
566.                 GetNum$ = ""
567.             END IF
568.             EXIT SUB
569.         END IF
570.         IF OperationPending THEN
571.             Num# = 0
572.             dp& = 1
573.             OperationPending = false
574.         END IF
575.         IF i$ = "." THEN
576.             IF dp& = 1 THEN dp& = 10
577.         ELSE
578.             IF dp& > 1 THEN
579.                 log10 = LOG(dp&) / LOG(10)
580.                 IF log10 < 9 THEN
581.                     Num# = Num# + VAL(i$) / dp&
582.                     dp& = dp& * 10
583.                 END IF
584.             ELSE
585.                 IF Num# < 1000000000 THEN Num# = Num# * 10 + VAL(i$)
586.             END IF
587.         END IF
588.     END IF
589.  
590.     IF i$ = CHR$(8) THEN ' backspace
591.         IF dp& > 1 THEN
592.             tdp& = dp& \ 10
593.             tnum& = Num# * tdp&
594.             Num# = tnum& / tdp&
595.             dp& = dp& \ 10
596.         ELSE
597.             Num# = Num# \ 10
598.         END IF
599.     END IF
600.  
601.     IF i$ = "c" THEN ' clear
602.         IsError = false
603.         ShiftFlag = false
604.         InvFlag = false
605.         OperationPending = false
606.         MemOp$ = ""
607.         op$ = ""
608.         y# = 0
609.         Num# = 0
610.         dp& = 1
611.     END IF
612.  
613.     IF INSTR("öx+-/*", i$) > 0 THEN ' operation
614.         IF op$ <> "" THEN ProcessEquals
615.         op$ = i$
616.         y# = Num#
617.         OperationPending = true
618.     END IF
619.  
620.     IF i$ = CHR$(13) THEN i$ = "="
621.     IF i$ = "=" THEN
622.         ProcessEquals
623.         OperationPending = true
624.         y# = 0
625.     END IF
626.  
627.     NumDisp
628. END SUB
629.  
630. SUB ProcessTrig
631.     IF AngMode$ = "G" THEN IsError = true
632.     IF InvFlag THEN
633.         IF mkey$ = "sin" THEN IsError = true
634.         IF mkey$ = "cos" THEN IsError = true
635.         IF mkey$ = "tan" THEN Num# = ATN(Num#)
636.         InvFlag = false
637.     ELSE
638.         IF AngMode$ = "D" THEN Num# = Num# * ator#
639.         IF mkey$ = "sin" THEN Num# = SIN(Num#)
640.         IF mkey$ = "cos" THEN Num# = COS(Num#)
641.         IF mkey$ = "tan" THEN Num# = TAN(Num#)
642.     END IF
643.     mkey$ = "="
644. END SUB
645.  
646. SUB ShowText (x, y, Text$, kolor)
647.     Text$ = LTRIM$(RTRIM$(Text$))
648.     lt = LEN(Text$)
649.     xb = -16 - (lt = 1) * 16 - (lt = 2) * 12 - (lt = 3) * 7 - (lt = 4) * 4
650.     IF RIGHT$(Text$, 1) = "'" THEN xb = xb + 4
651.     yb = -8
652.     IF Text$ = "yx" THEN yb = -10
653.     IF Text$ = "." THEN yb = -12: xb = xb - 1
654.     FOR byte = 0 TO 13
655.         ty = yb + (y - 12) + byte + ((Text$ = "yx") AND (i = 2)) * 2
656.         FOR i = 1 TO LEN(Text$)
657.             tx = xb + x + (i - 1) * 8
658.             a = ASC(MID$(Text$, i, 1))
659.             IF kolor = -1 THEN
660.                 co = yellow
661.             ELSEIF kolor = black THEN
662.                 co = white
663.             ELSE
664.                 co = black
665.             END IF
666.             LINE (tx, ty)-(tx + 7, ty), co, , pat(a, byte) * 128
667.         NEXT i
668.     NEXT byte
669.  
670.     IF (Text$ = "x") AND (kolor = -1) THEN ' x bar
671.         LINE (x + xb, y - 20)-(x + xb + 8, y - 20), yellow
672.     END IF
673.     IF Text$ = "ûx" THEN ' square root
674.         LINE (x + xb, y - 20)-(x + xb + 8, y - 20), black
675.         LINE (x + xb + 5, y - 19)-(x + xb + 15, y - 19), white
676.     END IF
677.     IF Text$ = "³x³" THEN ' abs
678.         LINE (x + xb, y - 20)-(x + xb + 25, y - 20), black
679.         LINE (x + xb, y - 19)-(x + xb + 25, y - 19), black
680.         LINE (x + xb, y - 7)-(x + xb + 25, y - 7), black
681.     END IF
682. END SUB
683.  
684. SUB WriteProg
685.     OPEN "prog.txt" FOR OUTPUT AS #1
686.     FOR t = 0 TO psize ' program
687.         pstep$ = RIGHT$("000" + LTRIM$(STR$(t)), 3)
688.         pcode$ = RIGHT$("00" + LTRIM$(STR$(ProgStep(t))), 2)
689.         palph$ = "0"
690.         FOR i = 0 TO 100
691.             IF kn(i) = ProgStep(t) THEN
692.                 palph$ = k$(i)
693.                 EXIT FOR
694.             END IF
695.         NEXT i
696.         IF LEN(palph$) = 0 THEN palph$ = "0"
697.         PRINT #1, pstep$; ","; pcode$; ","; palph$
698.     NEXT t
699.     FOR t = 0 TO msize ' memory
700.         pstep$ = "M"
701.         pcode$ = RIGHT$("00" + LTRIM$(STR$(t)), 2)
702.         palph$ = LTRIM$(STR$(MemReg#(t)))
703.         PRINT #1, pstep$; ","; pcode$; ","; palph$
704.     NEXT t
705.     CLOSE #1
706. END SUB
707.  
708.  

Title: Re: TI-58C calculator
Post by: bplus on February 01, 2019, 12:13:12 am

Looks nice!

Title: Re: TI-58C calculator
Post by: Richard Frost on February 01, 2019, 02:20:25 am

Found the code tag thing by chance, then scrolled down and saw it pointed out for me.  Duh!

This code has undergone one update/replacement already - killed a font that was in DATA statements in favor of BLOADing it. 
I'd like to use _PRINTSTRING, but I have to expand the font in the vertical direction for the number display.

Title: Re: TI-58C calculator
Post by: bplus on February 01, 2019, 09:44:17 am

This might be good link to manual (not secure), unless Richard has better?
http://83.156.189.247/ti58c/download/doc/LRNen.pdf

Dang! can't save a program? Can you emulate a printout from calculator?

Following the first steps in programming manual above, looks like the keys aren't all working yet.

The program clear function doesn't seem to be, nor picking up 2nd and the PI in program. SST and BST look OK.

Nope, Lst not working either, eh?

This is cool and ambitious project of course it will take awhile to get right.

Title: Re: TI-58C calculator
Post by: Richard Frost on February 01, 2019, 04:13:42 pm

True, I didn't take the simulation all the way to the end.   The program that's in there, under label E, works.
The E for Error thing is wonky - getting some weird INF (infinity) display beyond 10^99 too.....

Text Only | Text with Attachments