* CALC241  - Taschenrechner in dbase II
*
SET TALK OFF
SET COLON OFF
*
*------Aktuelle Variable werden in die Datei ZLAUF.MEM gespeichert
SAVE TO ZLAUF
*------Loeschen des Speicherplatzes
RELE ALL
*------Bildschirmaufbereitung (Maske)
@ 1,0
@ 1,1 SAY '------------------------T A S C H E N R E C H N E R---------------;
--------------'
@ 5,0
@ 5,1 SAY '(c) WPG Neustrelitz           J.T.   Januar 1987               ;
Beenden mit >STOP<'
@ 2,0
@ 2,0 SAY 'Eingabe   :                                             Ergebnis:'
@ 3,0
@ 4,0
@ 6,0
@ 6,1 SAY '-------------------------------------------------------------------;
------------'
*-------Vorbesetzen der Register und des Akkumulators
STOR 0.000 TO akku,a,b,c,d,e
*-------Vorbesetzen des Rechenfeldes
STOR '                             ' TO term
*-------Beginn der Endlosschleife - Abbruch durch STOP
DO WHIL T

   *----Bidschirmaufbereitung
   @ 3,0 SAY 'Speicher A:            B:            C:            D:          ;
  E:'
   @ 2,67 GET akku PICT '99999999.99'
   @ 3,11 GET a PICT '99999999.99'
   @ 3,25 GET b PICT '99999999.99'
   @ 3,39 GET c PICT '99999999.99'
   @ 3,53 GET d PICT '99999999.99'
   @ 3,67 GET e PICT '99999999.99'
   *----Alle durch @ - Befehle aktivierten GET - Klauseln werden deaktiviert
   CLEA GETS
   *---- Lesen der Eingabezeile
   @ 2,11 GET term
   READ
   @ 2,78
   *------ Fallunterscheidung bei Sonderfaellen
   DO CASE
      *------ Leere Eingabe
      CASE term = '                             '
           STOR '0' TO term
      *------ Beenden des Programms
      CASE !($(term,1,4))='STOP'
           REST FROM ZLAUF
           DELE FILE ZLAUF.MEM
           RETU
      *------ Abspeichern der Ergebnisse in die gewuenschten Register
      CASE $(term,1,1) $'Ss' .AND. TRIM($(term,2,29)) $'ABCDEabcde'
           STOR $(term,2,1) TO vreg
           STOR akku TO &vreg
           STOR STR(akku,11,2) TO term
      *------ Falls Eingabezeile ungleich Wert der Registerbezeichnung,
      *------ so wird mit dem Inhalt des 'akku' weitergerechnet
      CASE $(term,1,1) $'-+*/'
           STOR 'AKKU '+term TO term
   *--------- Ende der Fallunterscheidungen (Sonderfaelle)
   ENDC
   *----- Syntaxchek (Klammertest)
   STOR 1 TO vkla,vklas
   DO WHIL vklas < LEN(TRIM(term))+1
      IF $(term,vklas,1) = '('
         STOR vkla + 1 TO vkla
      ENDIF
      IF $(term,vklas,1) = ')'
         STOR vkla - 1 TO vkla
      ENDIF
      STOR vklas + 1 TO vklas
   ENDD
   *----- Eigentl. Syntaxtest (erst ab Version 2.41. moeglich)
   IF vkla = 1
      IF TEST (&term) <> 0
         STOR &term TO akku
         STOR '                                 ' TO term
      ELSE
         STOR 0 TO vkla
      ENDI
   ENDI
   *----- Antwort bei ungueltiger Eingabe
   IF vkla <> 1
      @ 2,11 SAY 'UNGUELTIG !!!!                 '+chr(7)+chr(7)+chr(7)+chr(7)
      IF $(term,1,5)='AKKU '
         STOR $(term,6,35) TO term
      ENDI
   ENDI
*-------- Ende der Schleife
ENDD
*-----------------------------------------------------------------
*Ende Programm
*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

                         ' TO term
      ELSE
         STOR 0 TO vkla
      ENDI
   ENDI
   *----- Antwort bei ungueltiger Eingabe
   IF vkla <> 1
      @ 2,11 SAY 'UNGUELTIG !!!!                 '+chr(7)+chr(7)+chr(7)+chr(7)
      IF $(term,1,5)='AKKU '
         STOR $(term,6,35) TO term
      ENDI
   ENDI
*-------- Ende der Schleife
ENDD
*----------------------