Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Written in COMAL in 1998, MatheMatoFix was a textmode GUI for rudimentary mathematical functions.
// 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
//-----------------------------------------------------------------------
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment