'ein kleiner einfacher Taschenrechner
'keine Gewähr auf die Richtigkeit der Berechnungen und Ergebnisse

'Features:
'- maximale Eingabelänge 10 Stellen
'- grösster Wert: 9999999999
'- kleinster Wert:-9999999999
'- bis zu 2 Nachkommastellen
'- 4 Grundrechenarten (wow)
'- 3 Funktionstasten Negation, Quadratwurzel, Quadrieren
'- Tastatursteuerung möglich
'
'    CA  >> c  C
'    =   >> Return  Enter
'    NEG >> n  N
'    SQR >> w  W
'    X^2 >> q  Q
'    .   >> .  ,
'
'das Präzisions- u. Rundungsproblem beim Rechnen mit Nachkommastellen
'und warum sich ein PC dabei äusserst mittelprächtig anstellt - wird
'auf folgender Seite mal näher beleuchtet:
'http://www.dreael.ch/Deutsch/BASIC-Knowhow-Ecke/Gleitkommazahlen.html



'Compileroption -s gui
#include "sGUI\sGUI.bas"
#include once "sGUI\SimpleGadget.bas"

'******************************************************************************
'******************************************************************************
'die "Klasse" Taschenrechner **************************************************

type calculator
  'die Klasseneigenschaften
  buffer    as string 'Zeichenpuffer für die Eingabe

  op        as string 'Operator(Rechenzeichen)

  valueA    as double 'Wert A
  valueB    as double 'Wert B

  display   as string '"Videospeicher", das was auf dem Display des Taschenrechners zu sehen ist

  errorlock as integer    'Verriegelung bei Fehler
  rewritebuffer as integer'Schalter ob aktueller Zeichenpuffer gelöscht und neu
                          'beschrieben werden kann (zb nach den F-Tasten)
                          'ohne die oplogic durcheinander zubringen

  'Konstruktor deklarieren
  declare constructor

  'Methoden deklarieren
  declare sub initvalues                       'setzt alles in den Ausgangszustand zurück (=Button CA)
  declare sub AddDigitToBuffer(digit as string)'hängt ein Zeichen(0-9 .) an den Zeichenpuffer
  declare function FindDotPos as integer       'liefert KommaPosition bzw Anzahl der Nachkommastellen
  declare sub show                             'Zeigt den "Videospeicher" an
  declare sub oplogic(newop as string)         'Variablenzuweisung,Berechnung,Ablauflogik
  declare sub flogic(func as string)           'Funktionstastenlogik
  declare function Float2string(value as double) as string 'Konvertiert eine Zahl zu einem String
                                                           'mit einer Rundung auf 2 Nachkommastellen
end type

'Konstruktor
constructor calculator
end constructor

'Methoden
sub calculator.initvalues
  op=""
  valueA=0
  valueB=0
  buffer=float2String(valueA)
  display=buffer
  errorlock=0
  rewritebuffer=0
  show                                        'Anzeige
end sub

sub calculator.AddDigitToBuffer(digit as string)
  if errorlock then exit sub

  if rewritebuffer then 'Neubeschreiben des Zeichenpuffers
    buffer="0"          'ähnlich der (hier nicht eingebauten) C oder CE Taste beim realen Taschenrechner
    rewritebuffer=0     'deaktivieren
  end if

  if buffer="0" then buffer=""
  if len(buffer)<10 then                       'Eingabe auf 10 Stellen limitiert
    if digit="." then                          'Komma(Punkt)
      if FindDotPos=0 then buffer +=digit 'wenn noch kein Komma(Punkt) vorhanden dann eins setzen
    else                                       'Ziffern
      if FindDotPos<=2 then buffer +=digit'maximal 2 Nachkommastellen erlaubt
    end if
  end if
  display=buffer
  show                                        'Anzeige
end sub

function calculator.FindDotPos as integer
  function=0
  dim as integer i
  if len(buffer)>0 then
    for i=len(buffer) to 1 step -1
      if mid(buffer,i,1)="." then function=len(buffer)-i+1
    next i
  end if
end function

sub calculator.show
  FillA(25,6,11*8+4,fontheight+4,&HDDDDDD,1)'<--Routine aus sGUI, auch durch Line ()-(),,BF ersetzbar
  draw string(25+2,6+2),right(space(11) + display,11)'11stellig rechtsbündig
end sub

sub calculator.oplogic (newop as string)
  if errorlock then exit sub
  if buffer<>"" then                          'wenn der Zeichenpuffer nicht leer ist
    if op="" then                             'und noch keine Rechenart ausgewählt wurde
      valueA=val(buffer)                      'dann übergib den Zeichenpuffer an die erste Zahl valueA
      display=float2String(valueA)
    else                                      'gibts einen Operator(n i c h t der grad übergebene newop)
      valueB=val(buffer)                      'dann übergib den Zeichenpuffer an die zweite Zahl valueB
      select case op                          'entsprechend dem Operator werden jetzt beide Werte verknüpft
      case "+"                                'gespeichert wird der berechnete Wert in valueA
        valueA=valueA + valueB                'valueB wird dann für die Folgeoperation benutzt
        display=float2String(valueA)
      case "-"
        valueA=valueA - valueB
        display=float2String(valueA)
      case "*"
        valueA=valueA * valueB
        display=float2String(valueA)
      case "/"
        if valueB=0 then                      'Abfangen des "geteilt durch null"-Problems
          errorlock=1                         'errorlock verriegelt dann alle Tasten ausser CA
          display="Error"                     'Fehlermeldung in den "Videospeicher" schreiben
        else
          valueA=valueA / valueB
          display=float2String(valueA)
        end if
      end select
    end if
    if abs(valueA)>9999999999 then            'absoluten Überlauf abfangen
      errorlock=1
      display="Overflow"                      'Fehlermeldung
    end if

    buffer=""                                'Zeichenpuffer löschen
    rewritebuffer=0                          'Bufferüberschreiben deaktivieren
  end if
  op=newop                                    'Neusetzen des Operators durch den grad übergebenden "newop"
  show                                        'Anzeige
end sub

sub calculator.flogic (func as string)
  if errorlock then exit sub
  dim tempvalue as double
  if buffer<>"" then       'wenn was im Zeichenpuffer ist
    tempvalue=val(buffer)  'dann holen
  else                     'sollte der Zeichenpuffer leer sein
    tempvalue=valueA       'den Wert von valueA holen
  end if

  select case func          'Aktion entsprechend der F-Taste ausführen
  case "neg"
    tempvalue=tempvalue*-1
    display=float2String(tempvalue)
  case "sqr"
    if sgn(tempvalue)=-1 then
      errorlock=1
      tempvalue=0
      display="Error"
    else
      tempvalue=sqr(tempvalue)
      display=float2String(tempvalue)
    end if
  case "x^2"
    tempvalue=tempvalue^2
    if tempvalue>9999999999 then
      errorlock=1
      display="Overflow"
    else
      display=float2String(tempvalue)
    end if
  end select

  if buffer<>"" then            'wenn der Wert aus dem Zeichenpuffer war
    buffer=float2String(tempvalue) 'dann zurückschreiben
    rewritebuffer=1             'das Neuschreiben des Zeichenpuffers ermöglichen
  else                          'anderenfalls war es valueA
    valueA=tempvalue            'dann dorthin schreiben
  end if
  show
end sub

function calculator.Float2String(value as double) as string
  'Versuch einer kleinen Rundungsroutine
  'nicht das was dr.dre(ael) vorschreibt,
  'aber in Anlehnung an die "Variante 3: Rückdivisionsfreie Rundung"
  function="0"
  dim as integer l
  dim as string vstring,newstring
  vstring = str(int(100! * abs(value) + .5)) 'value wird erweitert,gerundet und zum "INTEGERSTRING"(öhhm... jahh) XD
  l=len(vstring)'entsprechend der Länge des Strings wird das Komma(Punkt) nach 3 zu unterscheidenen Fällen gesetzt
  if l=1 then newstring ="0.0" & vstring                           '1.Fall
  if l=2 then newstring ="0." & vstring                            '2.Fall
  if l>2 then newstring =left(vstring,l-2) & "." & right(vstring,2)'3.Fall
  if right(newstring,3)=".00" then newstring=left(newstring,len(newstring)-3)'wenn Nachkommateil =".00" dann wech damit
  if sgn(value)=-1 then newstring ="-" & newstring                           'zum Schluss eventuell ermitteltes negatives Vorzeichen einfügen
  function=newstring
end function
'Ende der Klassendefinition****************************************************
'******************************************************************************
'******************************************************************************

dim shared calc as calculator ptr 'Erzeugen eines Calculators
calc=new calculator

if calc then
  screenres 145,225,32,,&H04
  width 145\8,225\16
  InitGFX
  windowtitle "Calc"

  dim as EventHandle ptr event
  event=CreateEventHandle

  dim as Gadget ptr ca,neg,sqrt,x2,null,eins,zwei,drei,vier,fuenf,sechs
  dim as Gadget ptr sieben,acht,neun,punkt,plus,minus,mal,geteilt,gleich

  neg=AddSimpleGadget (event,5,30,30,15,"+/-")
  sqrt=AddSimpleGadget (event,40,30,30,15,"sqr")
  x2=AddSimpleGadget (event,75,30,30,15,"x^2")

  ca=AddSimpleGadget (event,5,50,30,30,"CA")
  geteilt=AddSimpleGadget (event,40,50,30,30,"/")
  mal=AddSimpleGadget (event ,75,50,30,30,"*")
  minus=AddSimpleGadget (event,110,50,30,30,"-")

  sieben=AddSimpleGadget (event,5,85,30,30,"7")
  acht=AddSimpleGadget (event,40,85,30,30,"8")
  neun=AddSimpleGadget (event,75,85,30,30,"9")
  plus=AddSimpleGadget (event,110,85,30,65,"+")

  vier=AddSimpleGadget (event,5,120,30,30,"4")
  fuenf=AddSimpleGadget (event,40,120,30,30,"5")
  sechs=AddSimpleGadget (event,75,120,30,30,"6")

  eins=AddSimpleGadget (event,5,155,30,30,"1")
  zwei=AddSimpleGadget (event,40,155,30,30,"2")
  drei=AddSimpleGadget (event,75,155,30,30,"3")
  gleich=AddSimpleGadget (event,110,155,30,65,"=")

  null=AddSimpleGadget (event,5,190,65,30,"0")
  punkt=AddSimpleGadget (event,75,190,30,30,".")

  GadgetOn(neg)
  GadgetOn(sqrt)
  GadgetOn(x2)
  GadgetOn(ca)
  GadgetOn(geteilt)
  GadgetOn(mal)
  GadgetOn(minus)
  GadgetOn(sieben)
  GadgetOn(acht)
  GadgetOn(neun)
  GadgetOn(plus)
  GadgetOn(vier)
  GadgetOn(fuenf)
  GadgetOn(sechs)
  GadgetOn(eins)
  GadgetOn(zwei)
  GadgetOn(drei)
  GadgetOn(gleich)
  GadgetOn(null)
  GadgetOn(punkt)

  calc->initvalues

  'Ereignis-Schleife***********************************************************
  do
    event->xSleep (1)
    if event->GADGETMESSAGE then
      select case event->GADGETMESSAGE
      case null
        calc->AddDigitToBuffer("0")
      case eins
        calc->AddDigitToBuffer("1")
      case zwei
        calc->AddDigitToBuffer("2")
      case drei
        calc->AddDigitToBuffer("3")
      case vier
        calc->AddDigitToBuffer("4")
      case fuenf
        calc->AddDigitToBuffer("5")
      case sechs
        calc->AddDigitToBuffer("6")
      case sieben
        calc->AddDigitToBuffer("7")
      case acht
        calc->AddDigitToBuffer("8")
      case neun
        calc->AddDigitToBuffer("9")
      case punkt
        calc->AddDigitToBuffer(".")
      case plus
        calc->oplogic("+")
      case minus
        calc->oplogic("-")
      case mal
        calc->oplogic("*")
      case geteilt
        calc->oplogic("/")
      case gleich
        calc->oplogic("")
      case ca
        calc->initvalues
      case neg
        calc->flogic("neg")
      case sqrt
        calc->flogic("sqr")
      case x2
        calc->flogic("x^2")
      end select
    end if

    'Tastatursteuerung
    if event->ASCCODE>0 then
      select case event->ASCCODE
      case 48
        calc->AddDigitToBuffer("0")
      case 49
        calc->AddDigitToBuffer("1")
      case 50
        calc->AddDigitToBuffer("2")
      case 51
        calc->AddDigitToBuffer("3")
      case 52
        calc->AddDigitToBuffer("4")
      case 53
        calc->AddDigitToBuffer("5")
      case 54
        calc->AddDigitToBuffer("6")
      case 55
        calc->AddDigitToBuffer("7")
      case 56
        calc->AddDigitToBuffer("8")
      case 57
        calc->AddDigitToBuffer("9")
      case 44,46
        calc->AddDigitToBuffer(".") '. ,(Punkt oder Komma)
      case 43
        calc->oplogic("+")
      case 45
        calc->oplogic("-")
      case 42
        calc->oplogic("*")
      case 47
        calc->oplogic("/")
      case 13               'Return Enter
        calc->oplogic("")
      case 67,99            'C c
        calc->initvalues
      case 78,110            'n N
        calc->flogic("neg")
      case 87,119            'W w
        calc->flogic("sqr")
      case 81,113            'Q q
        calc->flogic("x^2")
      end select
    end if
  loop until event->EXITEVENT
  'Ende Ereignis-Schleife******************************************************

  DestroyEventHandle (event)
  delete calc 'Löschen des Calculators
end if
end
