Written in COMAL in 1998, MatheMatoFix was a textmode GUI for rudimentary mathematical functions.

MatheMatoFix.COD

// MatheMatoFix 1.2D by Bjoern Hoehrmann in Nov 1998. All rights reserved
// ----------------------------------------------------------------------
// Dem etwaigen Leser dieser und der folgenden Zeilen sei gesagt, daß es
// an sich schier unmöglich ist, QuellCode eines anderen vollständig zu
// verstehen, daher sollte man auch nicht anfangen zu verzweifeln, falls
// einem einige Zeilen absolut sinnlos vorkommen. Desweiteren wäre zu er-
// wähnen, daß dieses arme unschuldige Programm dazu gezwugen wurde, in
// COMAL geschrieben zu werden und nicht etwa in einer, wie sagt man so
// schön auf Deutsch, Hochsprache, wie z.B. Asm, Pascal oder C bzw. C++.
// Nichtsdestotrotz erfüllt auch dieses Programm seine Aufgabe, wenn man
// auch viele Zeilen besser, schneller, effektiver und verständlicher
// hätte gestalten können.
// ----------------------------------------------------------------------
// MatheMatoFix ist in seinen Ursprüngen zwar als Lernbeispiel enstanden,
// erfüllt aber dennoch seinen Zweck als Mathehilfe. In der momentanen
// Version bietet es ein paar mathematische Alltäglichkeiten wie zum
// Beispiel das lösen einer Quadratischen Gleichung.
// ----------------------------------------------------------------------

//-globale Variablen und Konstanten---
  windowbg:=4  // FensterHintergrund
  windowfg:=15 // FensterVordergrund
  mainbg:=1    // HauptHintergrund
  mainfg:=15   // HauptVordergrund
  BalkenbG:=0  // BalkenHintergrund
  BalkenfG:=15 // BalkenVordergrund
  exitkey$:="" // ExitKey
//----------------------------------**

use system   // Für die Ein/Ausgabe
use unimouse // Für die, wie der Name schon sagt, Mausunterstützung

//-WriteXY()-------------------------*
//  Gibt an x,y den angegebenen String aus. Funktioniert auch an 80/25
//------------------------------------
proc writexy(x,y,s$)       // schreibt an x,y s$
  if y=25 then             // für die Möglichkeit von 80/25
    for i:=1 to len(s$) do // Buchstabe für Buchstabe schreiben
      cursor y,x+i-1
      setattr(15)
      setchar(s$(:i:))
    endfor
  else
    print at y,x:s$,       // Sonst via print ohne Zeilenvorschub
  endif
endproc writexy
//-WriteXY() end--------------------**

//-Wait()----------------------------*
//  Wartet n Millisekunden
//------------------------------------
proc wait(n)
  t:=timer
  repeat until timer>t+n/1000
endproc wait
//-Wait() end-----------------------**

//-ColorPrint()----------------------*
//  Gibt einen String an x,y mit den angegebenen Farben aus.
//------------------------------------
proc ColorPrintXY(fgcolor,bgcolor,x,y,s$) // schreibt farbig an x,y s$
  for i:=1 to len(s$) do
    cursor y,x+i-1
    setattr(16*bgcolor+fgcolor)
    setchar(s$(:i:))
  endfor
endproc ColorPrintXY
//-ColorPrint() end-----------------**

//-ChColor()-------------------------*
//  Ändert ab x,y len mal die Farbe in bg,fg
//------------------------------------
proc chcolor(x,y,wide,bg,fg)
  for j:=1 to wide do
    cursor y,x+j
    setattr(16*bg+fg)
  endfor
endproc // chcolor
//-ChColor() end--------------------**

//-StatusLine()----------------------*
//  Schreibt einen neuen Text in die Statuszeile
//------------------------------------
proc statusline(msg$)
  colorprintxy(15,3,3,24,msg$+spc$(76-len(msg$)))
endproc statusline
//-StatusLine() end-----------------**

//-TitelLines()----------------------*
//  Gibt zwei Zeilen Text aus, die die momentane Funktion erklären.
//------------------------------------
proc TitelLines(msg$,msg2$)                            // StatusZeile
  colorprintxy(15,mainbg,4,3,msg$)
  colorprintxy(15,mainbg,4,4,msg2$)
  colorprintxy(15,mainbg,4,5,"──────────────────────────────────────────────────────────────────────────")
endproc Titellines
//-Titellines() end-----------------**

//-AppMask()-------------------------*
//  Schreibt die Anwendungsmaske neu
//------------------------------------
PROC appmask                            // zeichnet die Anwendungsmaske
  textcolor(mainfg,0,mainbg)            // Hintergrundfarben
  PAGE                                  // auf die ganze Seite
  textcolor(mainfg,0,0)
  writexy(1,1,"┌-[MatheMatoFix Ver 1.2D]──────────────-[Copyright (c) 1998 by Digital Design]─┐")
  FOR i:=2 TO 22 DO writexy(1,i,"│ ")
  FOR i:=2 TO 22 DO writexy(79,i," │")
  writexy(1,23,"├"+78*"─"+"┤")
  writexy(1,24,"│"+78*" "+"│")
  writexy(1,25,"└"+78*"─"+"┘")
ENDPROC appmask
//-AppMask() end--------------------**

//-WriteEntrysToScreen()-------------*
//  Schreibt an x,y die übergebenen Einträge untereinander.
//  Anschließend wird die Anzahl der Einträge zurückgegeben.
//  Beispiel: WriteEntrysToScreen(10,10,"1:Nummer 1,2:Nummer 2,3:Nummer 3")
//------------------------------------
func WriteEntrysToScreen(x,y,entrys$) // schreibt ab x,y die optionen
  textcolor(windowfg,0,windowbg)
  entnum:=1
  i:=3
  wordpos:=1
  repeat
    if entrys$(:i:)<>"," then
      writexy(x+wordpos,y+entnum,entrys$(:i:))
      wordpos:=wordpos+1
      i:=i+1
    else
      i:=i+3
      entnum:=entnum+1
      wordpos:=1
    endif
  until i>len(entrys$)
  return entnum
endfunc
//-end WriteEntrysToScreen()--------**

//-Selection()-----------------------*
//  Läßt den Benutzer eine Auswahl via Cursorbalken tätigen, bis dieser
//  die Return Taste betätigt. Dann wird die Eintragsnummer zurückgegeben.
//------------------------------------
func selection(x,y,wide,entryanz)
  num:=1
  taste$:=chr$(0)+chr$(72)
  repeat
    if taste$=chr$(0)+chr$(80) then
      chcolor(x,y+num+1,wide-1,windowbg,windowfg)
      if num<entryanz then num:=num+1
      chcolor(x,y+num+1,wide-1,balkenbg,balkenfg)
    endif
    if taste$=chr$(0)+chr$(72) then
      chcolor(x,y+num+1,wide-1,windowbg,windowfg)
      if num>1 then num:=num-1
      chcolor(x,y+num+1,wide-1,balkenbg,balkenfg)
    endif
    taste$:=key$
  until taste$=chr$(13)
  return num
endfunc selection
//-end Selection()------------------**

//-WindowB()-------------------------*
//  Malt ein schönes Fenster auf den Bildschirm
//------------------------------------
FUNC windowb(x,y,wide,high,title$,entrys$)
  textcolor(windowfg,0,windowbg)

  for i:=0 to wide+high-2 do
    if i<high then
      if i=0 then
        writexy(x,y+i,"Í")
      else
        writexy(x,y+i,"║")
      endif
    else
      if i=high then
        writexy(x+i-high,y+high,"╚")
      else
        writexy(x+i-high,y+high,"═")
      endif
    endif //big
    wait(0.5)

    if i<wide-2 then
      writexy(x+i+1,y,"─")
    else
      if i=wide-2 then
        writexy(x+wide-1,y+i-wide+2,"┐")
      else
        if i=wide+high-2 then
          writexy(x+wide-1,y+i-wide+2,"¥")
        else
          writexy(x+wide-1,y+i-wide+2,"│")
        endif
      endif
    endif
    wait(0.5)
  endfor
  FOR i:=1 TO high-1 DO
    writexy(x+1,y+i,(wide-2)*" ")
    wait(0.5)
  endfor

  textcolor(8,0,0)
  FOR i:=1 TO high+1 DO writexy(x+wide,y+i," ")      // Schatten rechts
  textcolor(mainbg,0,0)
  FOR i:=1 TO wide DO writexy(x+i,y+high+1,"▄")      // Schatten unten
  return WriteEntrysToScreen(x+1,y+1,entrys$)        // Einträge
ENDFUNC windowb
//-WindowB() end--------------------**

//-InputLine()-----------------------*
//  Generiert eine Eingabezeile, in der numerische Werte eingegeben werden
//  können. Zurückgeliefert wird die Eingabe und über die globale Variable
//  Exitkey$ die Abbruchtaste.
//------------------------------------
func InputLine$(x,y,wide,text$)
  eingabe$:=text$
  temp$:=""
  chcolor(x,y,wide,balkenbg,balkenfg)
  taste$:=chr$(0)
  repeat
    cursor y,x+1
    if taste$ in "1234567890.-" and len(eingabe$)<wide then eingabe$:=eingabe$+taste$
    if taste$=chr$(8) then
      temp$:=""
      for k:=1 to len(eingabe$)-1 do temp$(:k:):=eingabe$(:k:)
      eingabe$:=temp$
    endif
    for j:=1 to len(eingabe$) do
      cursor y,x+j
      setchar(eingabe$(:j:))
    endfor
    print at y,x+1+len(eingabe$):spc$(wide-len(eingabe$))
    chcolor(x,y,wide,balkenbg,balkenfg)
    repeat
      taste$:=key$
    until taste$<>"" or taste$=chr$(0)+chr$(72) or taste$=chr$(0)+chr$(80) or taste$=chr$(27) or taste$=chr$(13) or taste$=chr$(8)
  until ((taste$=chr$(0)+chr$(72) or taste$=chr$(0)+chr$(80) or taste$=chr$(13)) and len(eingabe$)>0)or taste$=chr$(27)
  chcolor(x,y,wide,windowbg,windowfg)

  if taste$=chr$(0)+chr$(72) then exitkey$:="UP"
  if taste$=chr$(0)+chr$(80) then exitkey$:="DOWN"
  if taste$=chr$(27) then exitkey$:="ESC"
  if taste$=chr$(13) then exitkey$:="RETURN"
  return eingabe$
endfunc
//-InputLine() end-------------------*

//******************************************
//-Main------------------------------/¿¿¿¿/
  oldfg:=curattr# mod 16  // Speichern der alten Farben
  oldbg:=int(curattr#/16) // um den Benutzer nicht zu irritieren.
  start:=timer
  TITEL
  Auswahl
  textcolor(oldfg,0,oldbg)
  page
  if timer-start<60 then
    print at 2,1:"Wenn dir dieses Programm nicht gefällt, dann sag es!"
  else
    print at 2,1:"...und nach ",int((timer-start)/60)," Minuten war es vorbei. Bis Bald, Dein MatheMatoFix."
  endif
//-Main end--------------------------\????\
//******************************************

/////////////////////////////////////////////////////////////////////////
// proc Titel     : Titelbildschirm          (Björn)                   //
// proc Auswahl   : Auswahlmenü              (Björn)                   //
// proc QGleich   : Quadratische Gleichung   (Björn)                   //
// proc biqgleich : BiQuadratische Gleichung (Jan)                     //
// proc PunktStg  : Punkt-Steigungs-Form     (Jan)                     //
// proc ZweiPkt   : Zwei-Punkt-Form          (Robert)                  //
// proc gleich2   : Gleichung 2. Grades      (Robert)                  //
// proc REST      : Programumgebung s.o.     (Björn)                   //
/////////////////////////////////////////////////////////////////////////

//-----------------------------------------------------------------------
proc Titel
  use graphics
  graphicscreen(6)
  //loadpcx("pcx1.pcx") // Anstatt die Palette manuell neu zu setzen
  //loadpcx("pcx.pcx")  // Das eigentliche Bild anzeigen
  pause
  textscreen
endproc titel
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc Auswahl
//  Das Hauptauswahlfenster von dem aus die Programmteile aufgerufen
//  werden.
//------------------------------------
  repeat
    appmask
    statusline("Bitte wählen sie mit den Cursortasten eine Option aus.")
    entryanz:=windowb(30,10,40,9,"Willkommen","1:Quadratische Gleichung,2:BiQuadratische Gleichung,3:Zwei-Punkte-Form,4:Punkt-Steigungs-Form,5:Gleichung mit 2 Unbekannten,6:Beenden")
    num:=selection(30,10,39,entryanz)
    case num of
      when 1
        qgleich(13,14,25,5,14) // x,y,breite,höhe,inputline länge
      when 2
        biqgleich
      when 3
        Zweipkt
      when 4
        punktstg
      when 5
        gleich2
      otherwise
    endcase
  until num=6
endproc auswahl
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc qgleich(winx,winy,winw,winh,ilen)
// Die quadratische Gleichung
//------------------------------------
  appmask
  statusline("Bitte geben sie die Parameter ein. Return - Errechnen | Escape - abbrechen")
  titellines("Quadratische Gleichung","Eine Quadratische Gleichung hat das Format x²+px+q=0.")
  entryanz:=windowb(winx,winy,winw,winh,"Parameter","1:P=[              ],2:Q=[              ]")

  num:=1        // erster eintrag
  p:=0          // formelvariable initialiseren
  q:=0          // dito

  repeat        // Hauptschleife bis ESCAPE
    case num of
      when 1
        p:=val(inputline$(winx+4,winy+2,ilen,str$(p)))
      when 2
        q:=val(inputline$(winx+4,winy+3,ilen,str$(q)))
      otherwise
    endcase

    if exitkey$="UP" and num>1 then num:=num-1
    if exitkey$="DOWN" and num<entryanz then num:=num+1
    if exitkey$="RETURN" and num<entryanz then num:=num+1

    if exitkey$="RETURN" then  // berechnung
      IF ((p^2)/4-q)<0 THEN
        xxx:=windowb(winx+winw+5,winy,winw,winh,"Ergebnisse","1:x1=Negative Wurzel,2:x2=Negative Wurzel")
      ELSE
        wurz:=SQR((p^2)/4-q)
        x1:=-p/2+wurz
        x2:=-p/2-wurz
        xxx:=windowb(winx+winw+5,winy,winw,winh,"Ergebnisse","1:x1="+str$("-###.##########",x1)+","+"2:x2="+str$("-###.##########",x2))
      endif
    endif

  until exitkey$="ESC"
endproc
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc biqgleich
  print "BiQUADRATISCHE GLEICHUNG"
endproc
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc punktstg
  print "PUNKT-STEIGUNGS-FORM"
endproc
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc zweipkt
  print "ZWEI-PUNKTE-FORM"
endproc
//-----------------------------------------------------------------------

//-----------------------------------------------------------------------
proc gleich2
  print "GLEICHUNG MIT 2 UNBEKANNTEN"
endproc
//-----------------------------------------------------------------------