HIDEM
OPTION BASE 0
GOSUB datenordner
CLR bitmuster$
FOR i=1 TO 37
  READ zeilenmuster
  bitmuster$=bitmuster$+MKI$(zeilenmuster)
NEXT i
DEFMOUSE bitmuster$
DATA 7,7,1,0,1
' MASKENMUSTER
DATA &X0000001000000000
DATA &X0000011100000000
DATA &X0000111110000000
DATA &X0000111110000000
DATA &X0001111111000000
DATA &X0001111111000000
DATA &X0011111111000000
DATA &X1111101111000111
DATA &X1111001111011111
DATA &X0000001111111100
DATA &X0000001111111000
DATA &X0000001111111000
DATA &X0000000111110000
DATA &X0000000111110000
DATA &X0000000011100000
DATA &X0000000001000000
' CURSOR MUSTER
'      1234567890123456
DATA &X0000000000000000
DATA &X0000001000000000
DATA &X0000011100000000
DATA &X0000011100000000
DATA &X0000110110000000
DATA &X0000110110000000
DATA &X0001100110000000
DATA &X0111000110000110
DATA &X0110000110001110
DATA &X0000000110011000
DATA &X0000000110110000
DATA &X0000000110110000
DATA &X0000000011100000
DATA &X0000000011100000
DATA &X0000000001000000
DATA &X0000000000000000
esrordner:
CHDIR "\ESR"
IF EXIST("SYSIPHUS.PIC")
  bild_da!=TRUE
  OPEN "I",#1,"SYSIPHUS.PIC"
  BLOAD "SYSIPHUS.PIC",XBIOS(2)
  CLOSE #1
ELSE
  ALERT 1," |   WER HAT DENN DA | SCHON WIEDER KOPIERT ? ",1,"DAS WARS | WEITER",looser%
  IF looser%=1
    END
  ELSE
    CHDIR "\"
    IF EXIST("SYSIPHUS.PIC")
      NAME "SYSIPHUS.PIC" AS "\ESR\SYSIPHUS.PIC"
      bild_da!=TRUE
      GOTO esrordner
    ENDIF
  ENDIF
ENDIF
IF bild_da!=TRUE
  DO
    IF MOUSEK>0
      maus=1
    ENDIF
    IF INKEY$>""
      maus=1
    ENDIF
    EXIT IF maus=1
  LOOP
ENDIF
'
' **********************************************************************
' ******************        SYSIPHUS 1.2         ***********************
' ******************   ESR-SIMULATIONSPROGRAMM   ***********************
' ******************  MIT VIEL MšHE GESCHRIEBEN  ***********************
' ******************    VON Dr. GREGOR KRAFT     ***********************
' ******************       ANNO DOMINI 1989      ***********************
' **********************************************************************
SHOWM
ON BREAK GOSUB ende
'
CHDIR "\DATEN\"
'
OPENW 0                              ! Pull down - Menue erstellen
DIM eintrag$(55)
DO
  READ eintrag$(i%)
  EXIT IF eintrag$(i%)="****"
  INC i%
LOOP
'
DATA SYSIPHUS, INFO,------------------------,1,2,3,4,5,6,""
DATA DATEI,LADEN,SPEICHERN,LOESCHEN,""
DATA PARAMETER,ATOMGRUPPEN,KERNPARAMETER,SPEKTRUMPARAMETER,""
DATA SPEKTRUM,SIMULATION,STICKLINE,HšLLKURVE,""
DATA OPTIONEN,FILENAME,ANDERE SWEEPWIDTH,AUSSCHNITT,STUPID,FORMATIEREN,VERGR™žERN,g-WERT,""
DATA BILDER,SCREENCOPY,HARDCOPY,PLOTTER,SIGNUM,""
DATA ARBEIT,ANSCHAUEN,AUFSCHREIBEN,SPEKBEREICH,VERGLEICH,DIFFERENZ,""
DATA INPUT,ESP300,MESS-SPEKTREN,""
DATA ENDE,QUIT,"",""
DATA ****
MENU eintrag$()
'
auf=1024
'
ON MENU KEY GOSUB tasten
ON MENU GOSUB auswahl
'
MENU 11,3
MENU 12,3
MENU 17,2
MENU 21,2
MENU 22,2
MENU 23,2
MENU 27,2
MENU 28,2
MENU 30,3
MENU 31,2
MENU 36,2
MENU 37,2
MENU 35,2
MENU 38,2
MENU 41,2
MENU 42,2
MENU 43,2
MENU 44,2
MENU 45,2
'
'
neustart:
rettung!=0
ON ERROR GOSUB fehlerbehandlung
'
DO
  ON MENU
  '
  GOSUB maus_abschalten
  GOSUB maus_einschalten
LOOP
'
'
PROCEDURE auswahl                                ! Auswahl der Menues
  DEFMOUSE bitmuster$
  '
  DEFFILL 0
  PBOX 0,0,640,400
  IF INSTR(eintrag$(MENU(0)),"INFO")
    GOSUB information
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"ATOMGRUPPEN")
    GOSUB atom
  ENDIF
  ' '
  '
  IF INSTR(eintrag$(MENU(0)),"KERNPARAMETER")
    GOSUB eingabe
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SPEKTRUMPARAMETER")
    GOSUB spektrenparameter
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SIMULATION")
    GOSUB hyper
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"STICKLINE")
    GOSUB bild
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"ANDERE SWEEPWIDTH")
    GOSUB messbereich
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"HšLLKURVE")
    GOSUB linienform
  ENDIF
  '
  IF INSTR(eintrag$(MENU(o)),"QUIT")
    GOSUB ende
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"LADEN")
    GOSUB lese
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SPEICHERN")
    GOSUB schreibe
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"LOESCHEN")
    GOSUB loesche
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"FILENAME")
    GOSUB namensgebung
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"AUSSCHNITT")
    GOSUB bereich
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"STUPID")
    GOSUB robot
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"FORMATIEREN")
    GOSUB format
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"HARDCOPY")
    GOSUB hardcopy
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"VERGR™žERN")
    GOSUB aufblasen
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"PLOTTER")
    GOSUB hp7475a
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"g-WERT")
    GOSUB gwert
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SCREENCOPY")
    GOSUB pixel
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SIGNUM")
    GOSUB sichnum
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"ANSCHAUEN")
    GOSUB espspektrum
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"AUFSCHREIBEN")
    GOSUB messchreiben
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"SPEKBEREICH")
    GOSUB spekmessbereich
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"VERGLEICH")
    GOSUB simmess
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"DIFFERENZ")
    GOSUB differenz
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"ESP300")
    GOSUB esp300
  ENDIF
  '
  IF INSTR(eintrag$(MENU(0)),"MESS-SPEKTREN")
    GOSUB messlese
  ENDIF
  '
  '
  MENU OFF
RETURN
'
'
PROCEDURE maus_abschalten
  DPOKE GINTIN,3
  GEMSYS 107
  maus_ist_aus!=TRUE
RETURN
'
PROCEDURE maus_einschalten
  DPOKE GINTIN,2
  GEMSYS 107
  maus_ist_aus!=FALSE
RETURN
'
PROCEDURE ende
  IF maus_ist_aus!=TRUE
    GOSUB maus_einschalten
  ENDIF
  ALERT 2," | PROGRAMM WIRKLICH | BEENDEN ? ",1," S'LANGT | OH GOTT!",anfra%
  IF anfra%=2
    GOTO heschel
  ENDIF
  MENU KILL
  END
  heschel:
RETURN
'
PROCEDURE information
  MENU OFF
  LOCAL maus%
  BOX 100,50,540,350
  BOX 105,55,535,345
  DEFTEXT 1,17,0,16
  TEXT 150,80,340,"PROVINZ-SOFT PRESENT"
  DEFTEXT 1,11,0,24
  TEXT 180,120,280,"SYSIPHUS 1.2"
  DEFTEXT 1,0,0,13
  TEXT 150,160,340," EIN BRAUCHBARES ESR-SIMULATIONSPROGRAMM "
  TEXT 150,180,340,"      FšR EINEN BRAUCHBAREN COMPUTER     "
  TEXT 150,200,340,"         GESCHRIEBEN IN GFA-BASIC        "
  DEFTEXT 1,16,0,13
  TEXT 150,220,340,"         ANNO DOMINI 1989        "
  DEFTEXT 1,0,0,13
  TEXT 150,240,340," VON DR.GREGOR KRAFT; JAHNSTR.2,6701 MAXDORF "
  TEXT 150,260,340,"DIESES PROGRAMM IST FREEWARE UND DARF FREI"
  TEXT 150,280,340,"KOPIERT WERDEN ! M™GE ES VON NUTZEN SEIN !"
  BOX 250,290,390,320
  TEXT 270,310,100," SO ISSES "
  DO
    IF MOUSEX>250 AND MOUSEX<390 AND MOUSEY>290 AND MOUSEY<320 AND MOUSEK=1
      maus%=1
    ENDIF
    IF INKEY$=CHR$(13)
      maus%=1
    ENDIF
    EXIT IF maus%=1
  LOOP
  CLS
  ' ********************************************************************
  BOX 100,50,540,350
  BOX 105,55,535,345
  DEFTEXT 1,8,0,13
  TEXT 150,80,340,"UNTERSAGT IST DIE GEWERBLICHE NUTZUNG !!"
  TEXT 150,120,340," AUSDRšCKLICH UNTERSAGT IST DIE NUTZUNG "
  TEXT 150,140,340,"DES PROGRAMMS DURCH DIE FIRMA BRUKER GMBH"
  DEFTEXT 1,0,0,13
  TEXT 150,160,340,"VERŽNDERUNGEN AN DIESEM PROGRAMM BEDšRFEN"
  TEXT 150,180,340,"   MEINER AUSDRšCKLICHEN GENEHMIGUNG     "
  TEXT 150,220,340," DIE WEITERGABE DIESES PROGRAMMS IST NUR MIT"
  TEXT 150,240,340," DEN DATEIEN SYSIPHUS.TXT UND SYSIPHUS.SDO  "
  TEXT 150,260,340,"       GESTATTET (UND AUCH SINNVOLL)        "
  BOX 250,290,390,320
  TEXT 270,310,100," NA KLAR "
  maus%=0
  DO
    IF MOUSEX>250 AND MOUSEX<390 AND MOUSEY>290 AND MOUSEY<320 AND MOUSEK=1
      maus%=1
    ENDIF
    IF INKEY$=CHR$(13)
      maus%=1
    ENDIF
    EXIT IF maus%=1
  LOOP
  CLS
RETURN
'
'
PROCEDURE messbereich                   ! Eingabe der Sweep-Width (wenn andere
  MENU OFF
  LOCAL s,maus%
  DEFTEXT 1,0,0,13                      ! sweep-width im Prog.-ablauf gew�nscht
  PRINT AT(20,10);"SWEEP-WIDTH :___________|____________"  !wird
  PRINT AT(35,10);sweep
  BOX 250,300,350,330
  PRINT AT(36,20);"OK?"
  BOX 250,143,450,160
  DO
    IF ((250<MOUSEX AND 450>MOUSEX) AND (143<MOUSEY AND 160>MOUSEY) AND MOUSEK=1)
      maus%=1
    ENDIF
    IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 350>MOUSEY) AND MOUSEK=1)
      maus%=2
    ENDIF
    EXIT IF maus%<>0
  LOOP
  IF maus%=1
    PRINT AT(47,10);
    INPUT s
    sweep=ABS(s)
    PRINT AT(35,10);sweep
  ENDIF
  CLS
  IF spektrum!=TRUE
    GOSUB bild
  ELSE
    GOSUB zeichnung
  ENDIF
RETURN
'
PROCEDURE spektrenparameter              ! Eingabe der Aufl”sung,
  MENU OFF
  BOX 40,20,600,360                      ! der Halbwerstbreite und
  DEFFILL 1,1                            ! der Sweep-Width
  PBOX 250,60,350,90
  PBOX 250,300,350,330
  LOCAL sw$,halbwert$,sw1,auf1,halbwertsbreite,maus%,button%,bu%,butt%
  auf1=auf
  sw1=sw
  halbwertsbreite=halbwert
  GRAPHMODE 2
  DEFTEXT 0,0,0,13
  TEXT 180,50,250,"AUFL™SUNG"
  TEXT 270,320,60,"OK?"
  GRAPHMODE 1
  DEFTEXT 1,0,0,13
  BOX 60,125,160,155
  TEXT 70,145,80,"1024"
  BOX 204,125,304,155
  TEXT 214,145,80,"2048"
  BOX 344,125,444,155
  TEXT 355,145,80,"4096"
  BOX 490,125,590,155
  TEXT 500,145,80,"8192"
  PRINT AT(36,5);auf1
  BOX 265,207,455,227
  BOX 265,237,455,258
  PRINT AT(10,13);"SIMULATIONS"
  PRINT AT(10,14);"SWEEP-WIDTH IN GAUž     :___________|___________"
  PRINT AT(10,16);"HALBWERTSBREITE IN GAUž :___________|___________"
  PRINT AT(37,14);sw1
  PRINT AT(37,16);halbwertsbreite
  mehr:
  maus%=0
  DO
    IF ((265<MOUSEX AND 455>MOUSEX) AND (207<MOUSEY AND 227>MOUSEY) AND MOUSEK=1)
      maus%=3
    ENDIF
    IF ((265<MOUSEX AND 455>MOUSEX) AND (237<MOUSEY AND 258>MOUSEY) AND MOUSEK=1)
      maus%=4
    ENDIF
    IF INKEY$=CHR$(13)
      maus%=2
    ENDIF
    IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 330>MOUSEY) AND MOUSEK=1)
      maus%=2
    ENDIF
    IF ((60<MOUSEX AND 160>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
      maus%=1
      auf=1024
    ENDIF
    IF ((204<MOUSEX AND 304>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
      maus%=1
      auf=2048
    ENDIF
    IF ((344<MOUSEX AND 444>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
      maus%=1
      auf=4096
    ENDIF
    IF ((490<MOUSEX AND 590>MOUSEX) AND (125<MOUSEY AND 155>MOUSEY) AND MOUSEK=1)
      maus%=1
      auf=8192
    ENDIF
    EXIT IF maus%>0
  LOOP
  IF maus%=1
    IF auf1<>auf
      IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
        ALERT 3," ŽNDERUNG DER AUFL™SUNG | BEDINGT DAS L™SCHEN DER | SIMULIERTEN GAUž-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",button%
        IF button%=2
          auf1=auf
          simgauss%=0
          simlorentz%=0
          simgauss_lorentz%=0
          ERASE huelk%()
          MENU 27,2
          MENU 28,2
        ELSE
          auf=auf1
        ENDIF
      ELSE
        auf1=auf
      ENDIF
    ENDIF
    PRINT AT(36,5);auf1
    GOTO mehr
  ENDIF
  IF maus%=3
    PRINT AT(48,14);
    FORM INPUT 7,sw$
    sw=ABS(VAL(sw$))
    IF sw1<>sw
      IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
        ALERT 3," ŽNDERUNG DER SWEEP-WIDTH | BEDINGT DAS L™SCHEN DER | SIMULIERTEN GAUž-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",butt%
        IF butt%=2
          sw1=sw
          ERASE huelk%()
          simgauss%=0
          simlorentz%=0
          simgauss_lorentz%=0
          MENU 27,2
          MENU 28,2
          MENU 31,2
          MENU 36,2
          MENU 37,2
          MENU 38,2
          MENU 44,2
        ELSE
          sw=sw1
        ENDIF
      ELSE
        sw1=sw
        sweep=sw
      ENDIF
    ENDIF
    PRINT AT(37,14);"_________";
    PRINT AT(37,14);sw1;
    GOTO mehr
  ENDIF
  IF maus%=4
    PRINT AT(48,16);
    FORM INPUT 7,halbwert$
    halbwert=ABS(VAL(halbwert$))
    IF halbwertsbreite<>halbwert
      IF (simgauss%+simlorentz%+simgauss_lorentz%)>0
        ALERT 3," ŽNDERUNG DES HALBWERTSBREITE | BEDINGT DAS L™SCHEN DER | SIMULIERTEN GAUž-  UND | LORENTZKURVE ",1," ABBRUCH | WEITER ",bu%
        IF bu%=2
          halbwertsbreite=halbwert
          ERASE huelk%()
          simgauss%=0
          simlorentz%=0
          simgauss_lorentz%=0
          MENU 28,2
          MENU 27,2
          MENU 31,2
          MENU 36,2
          MENU 37,2
          MENU 38,2
          MENU 44,2
        ELSE
          halbwert=halbwertsbreite
        ENDIF
      ELSE
        halbwertsbreite=halbwert
      ENDIF
    ENDIF
    PRINT AT(37,16);"_________";
    PRINT AT(37,16);halbwert
    GOTO mehr
  ENDIF
  CLS
RETURN
'
PROCEDURE tasten                          !Tastenbelegung
  LOCAL scancode%
  scancode%=SHR(MENU(14),8)
  asc%=ASC(t$)
  IF scancode%=68
    GOSUB ende
  ENDIF
  IF scancode%=67
    GOSUB rausch
  ENDIF
  IF scancode%=60
    GOSUB laufwerk
  ENDIF
RETURN
'
'
'
'  *************************************************************************
'
PROCEDURE atom                !Eingabe der Zahl der Unabh„ngigen Atomgruppen
  MENU OFF
  LOCAL maus,nik$,nikaerst%,button%
  eingabe:
  maus=0
  nikaerst%=nika%
  BOX 80,200,280,230
  BOX 320,200,520,230
  DEFTEXT 1,9,0,16
  TEXT 85,223,180,"EINGABE OK?"
  TEXT 325,223,180,"ŽNDERN?"
  DEFTEXT 1,0,0,13
  PRINT AT(20,10);"UNABHŽNGIGE ATOMGRUPPEN:_____|___";""
  PRINT AT(47,10);nika%
  IF nika%=0
    GOTO hinein
  ENDIF
  DO
    IF INKEY$=CHR$(13)
      maus=1
    ENDIF
    IF ((85<MOUSEX AND 275>MOUSEX) AND (205<MOUSEY AND 225>MOUSEY)) AND MOUSEK=1
      maus=1
    ENDIF
    IF ((325<MOUSEX AND 515>MOUSEX) AND (205<MOUSEY AND 225>MOUSEY)) AND MOUSEK=1
      maus=2
    ENDIF
    EXIT IF maus>0
  LOOP
  IF maus=1
    GOTO atomende
  ENDIF
  hinein:
  PRINT AT(50,10);
  FORM INPUT 2,nik$
  PRINT AT(43,10);":__________"
  PRINT AT(47,10);nika%
  nika%=FIX(ABS(VAL(nik$)))
  PRINT AT(47,10);nika%
  IF nika%=0
    GOTO eingabe
  ENDIF
  IF nikaerst%>0
    IF nikaerst%<>nika%
      ALERT 3," ŽNDERN DER ZAHL DER | UNABHŽNGIGEN ATOMGRUPPEN | BEDINGT DAS L™SCHEN DER | SIMULIERTEN SPEKTREN ",1,"ABBRUCH | WEITER ",button%
      IF button%=1
        nika%=nikaerst%
        GOTO eingabe
      ENDIF
      ERASE ag1()
      ERASE ag()
      ERASE at$()
      ERASE hy()
      ERASE intensi()
      ERASE huelk%()
      simgauss%=0
      simlorentz%=0
      simgauss_lorentz%=0
      simstick%=0
      MENU 21,2
      MENU 22,2
      MENU 23,2
      MENU 27,2
      MENU 28,2
      MENU 31,2
      MENU 36,2
      MENU 37,2
      MENU 38,2
      MENU 44,2
    ELSE
      GOTO eingabe
    ENDIF
  ENDIF
  nikaerst%=nika%
  DIM ag(nika%,2)
  DIM at$(nika%,2)
  DIM ag1(nika%,2)
  GOTO eingabe
  atomende:
  CLS
  MENU 17,3
RETURN
'
' **************************************************************************
'
PROCEDURE eingabe      ! Eingabe der Kernparameter; Spin,Anzahl und Kopplungs-
  MENU OFF
  DEFFILL 1,1          ! konstante
  LOCAL k%,maus,but%,butt%,j%
  PBOX 25,330,450,360
  PBOX 200,100,250,120
  GRAPHMODE 2
  DEFTEXT 0,1,0,13
  TEXT 50,350,350,"ZUM ŽNDERN DER DATEN: RECHTE MAUSTASTE !"
  TEXT 205,115,50," OK ? "
  GRAPHMODE 1
  BOX 25,20,450,360
  FOR k%=1 TO nika%
    ein:
    maus=0
    DEFTEXT 1,20,0,10,
    TEXT 50,300,400,"Eingabe in Ordnung?"
    DEFTEXT 1,0,0,6
    BOX 127,307,190,327
    TEXT 50,320,380,"weiter mit  return!  korrektur mit beliebiger Taste"
    BOX 70,100,100,120
    BOX 350,100,380,120
    TEXT 80,112,15,"<="
    TEXT 360,112,15,"=>"
    DEFTEXT 1,16,0,13
    TEXT 100,50,300,"K E R N P A R A M E T E R"
    DEFTEXT 1,0,0,13
    PRINT AT(10,5);"Atomgruppe ";k%;" von ";nika%;" unabh„ngigen Atomgruppen"
    PRINT AT(10,10);"spin....................:__________"
    PRINT AT(36,10);ag(k%,0)
    PRINT AT(10,12);"Anzahl der „quivalenten"
    PRINT AT(10,13);"Atome dieser Gruppe......:__________"
    PRINT AT(36,13);ag(k%,1)
    PRINT AT(10,16);"Kopplungskonstante......:__________"
    PRINT AT(36,16);ag(k%,2)
    '
    IF (ag(k%,0)=0 OR ag(k%,1)=0 OR ag(k%,2)=0)
      GOTO ein1
    ENDIF
    '
    DO
      IF ((127<MOUSEX AND 185>MOUSEX) AND (310<MOUSEY AND 326>MOUSEY) AND MOUSEK=1)
        maus=1
      ENDIF
      IF (INKEY$<>"") OR MOUSEK=2
        maus=2
      ENDIF
      IF ((75<MOUSEX AND 95>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
        maus=3
      ENDIF
      IF ((355<MOUSEX AND 375>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
        maus=4
      ENDIF
      IF ((200<MOUSEX AND 250>MOUSEX) AND (100<MOUSEY AND 120>MOUSEY) AND MOUSEK=1)
        maus=5
      ENDIF
      EXIT IF maus<>0
    LOOP
    IF maus=1
      GOTO naexte
    ENDIF
    '
    IF maus=3
      k%=k%-2
      IF k%<0
        k%=nika%-1
      ENDIF
      GOTO naexte
    ENDIF
    IF maus=4
      IF k%=nika%
        k%=0
      ENDIF
      GOTO naexte
    ENDIF
    IF maus=5
      k%=nika%
      GOTO naexte
    ENDIF
    ein1:
    '
    MENU 21,3
    PRINT AT(35,10);"?"
    PRINT AT(36,10);
    FORM INPUT 10 AS at$(k%,0)
    PRINT AT(35,10);" "
    ag1(k%,0)=VAL(at$(k%,0))
    PRINT AT(35,13);"?"
    PRINT AT(36,13);
    FORM INPUT 10 AS at$(k%,1)
    PRINT AT(35,13);" "
    ag1(k%,1)=FIX(ABS(VAL(at$(k%,1))))
    PRINT AT(35,16);"?"
    PRINT AT(36,16);
    FORM INPUT 10 AS at$(k%,2)
    PRINT AT(35,16);" "
    ag1(k%,2)=ABS(VAL(at$(k%,2)))
    i_np=INP(2)
    IF i_np<>13
      GOTO ein1
    ENDIF
    '
    '         *************************** Abfrage ob die Eingegebenen Daten
    IF ag1(k%,0)=0 OR ag1(k%,1)=0 OR ag1(k%,2)=0  ! mit der Programmsyntax
      GOTO ein1                                ! vertr„glich sind
    ENDIF
    '
    IF ag1(k%,0)<>1 AND ag1(k%,0)<>0.5
      IF FRAC(2*ag1(k%,0))<>0
        ALERT 1,"   DEN ' SPINNERTEN' SPINN |  KENNEN MER NET !  ",1," ZURšCK | WEITER ",butt%
        IF butt%<>1
          ALERT 3," ORGANIKER ?? ",1," ZURšCK ",button%
          GOTO ein1
        ENDIF
        GOTO ein1
      ENDIF
    ENDIF
    '
    ' ***********************************************************************
    '
    IF ag(k%,0)<>0 OR ag(k%,1)<>0 OR ag(k%,2)<>0
      IF ag1(k%,0)<>ag(k%,0) OR ag1(k%,1)<>ag(k%,1) OR ag1(k%,2)<>ag(k%,2)
        ALERT 1," ŽNDERN DER PARAMETER | HAT DAS L™SCHEN DER | SIMULIERTEN SPEKTREN  |  ZURFOLGE !",1,"ABBRUCH | WEITER ",but%
        IF but%=2
          FOR j%=0 TO 2
            ag(k%,j%)=ag1(k%,j%)
            at$(k%,j%)=STR$(ag1(k%,j%))
          NEXT j%
          ERASE hy()
          ERASE intensi()
          ERASE huelk%()
          simgauss%=0
          simlorentz%=0
          simgauss_lorentz%=0
          simstick%=0
          MENU 22,2
          MENU 23,2
          MENU 21,3
          MENU 27,2
          MENU 28,2
          MENU 31,2
          MENU 36,2
          MENU 37,2
          MENU 38,2
          MENU 44,2
        ENDIF
        FOR j%=0 TO 2
          at$(k%,j%)=STR$(ag(k%,j%))
        NEXT j%
        GOTO ein
      ENDIF
    ENDIF
    FOR j%=0 TO 2
      ag(k%,j%)=ag1(k%,j%)
      at$(k%,j%)=STR$(ag1(k%,j%))
    NEXT j%
    naexte:
    PRINT AT(36,10);"                 "
    PRINT AT(36,13);"                 "
    PRINT AT(36,16);"                 "
  NEXT k%
  eingabeend:
  CLS
RETURN
'
PROCEDURE hyper     ! Berechnung der Linienzahl eines sim.Spektrums
  MENU OFF
  LOCAL n,k%,m,m%,i,j%,i%,g,x,z,y,x%,kleii,kleis
  DEFTEXT 1,0,0,13
  DIM zwn(nika%)
  n=1
  DEFTEXT 1,0,0,13
  FOR k%=1 TO nika%
    zwn(k%)=2*ag(k%,0)*ag(k%,1)+1
    PRINT "linien der Gruppe ",k%,zwn(k%)
    n=n*zwn(k%)
  NEXT k%
  PRINT "anzahl der Linien N=",n
  FOR k%=1 TO nika%
    IF zwn(k%)>m
      m=zwn(k%)
    ENDIF
  NEXT k%
  '                             ! Zuordnung der Intensit„ten zu den einzelnen
  '                             ! Kopplungen innerhalb einer Atomgruppe
  DIM hyp(nika%,m),int(nika%,m)
  ARRAYFILL hyp(),0
  FOR k%=1 TO nika%
    d=(zwn(k%)-1)/2
    FOR g=zwn(k%) DOWNTO 1
      hyp(k%,g)=d*ag(k%,2)
      d=d-1
    NEXT g
    GOSUB spin
  NEXT k%
  MENU 21,2
  hyperfine:   !Hyperfine-Aufspaltung des gesammten Spektrums incl. Intensit„ten
  DIM h(n),hy(n),intensi(n),in(n)
  FOR i%=1 TO n
    h(i%)=0
    in(i%)=1
  NEXT i%
  z=1
  FOR k%=1 TO nika%
    x=0
    FOR m=1 TO z
      FOR g=1 TO zwn(k%)
        INC x
        hy(x)=h(m)+hyp(k%,g)
        intensi(x)=in(m)*int(k%,g)
      NEXT g
    NEXT m
    z=z*zwn(k%)
    FOR x=1 TO z
      h(x)=hy(x)
      in(x)=intensi(x)
    NEXT x
  NEXT k%
  '
  '
  reduzierung:  !Reduzierung der Gesamtlinienzahl auf die beobachtbaren Linien
  '
  '
  centerfield=10000    ! Da eh nicht absolut gerechnet werden kann ist center-
  FOR x=1 TO n         ! field so gew„hlt, daž immer (im Normalfall) die Auf-
    h(x)=h(x)+centerfield ! spaltungen im positiven Bereich sind.
  NEXT x
  ARRAYFILL hy(),0
  ARRAYFILL intensi(),0
  m=0
  FOR x=1 TO n
    IF h(x)=0
    ELSE
      ADD m,1
      hy(m)=h(x)
      intensi(m)=intensi(x)
      FOR y=x TO n
        IF hy(m)=h(y)
          h(y)=0
          ~FRE()
          ADD intensi(m),in(y)
        ENDIF
      NEXT y
    ENDIF
  NEXT x
  b=m
  '
  IF b<n
    PRINT " ZUFŽLLIGE ENTARTUNG : NUR NOCH ";b;"-LINIEN ZU SEHEN"
    SWAP h(),hy()
    SWAP in(),intensi()
    ERASE intensi(),hy()
    DIM hy(b),intensi(b)
    FOR x%=1 TO b
      ~FRE()
      hy(x%)=h(x%)
      intensi(x%)=in(x%)
    NEXT x%
  ENDIF
  ' *********  Sortierung der Hyperfine-Aufspaltung nach der Gr”že *******
  intmax=0
  intmin=1
  FOR m=1 TO b
    kleis=hy(m)
    kleii=intensi(m)
    FOR x=m TO b
      ~FRE()
      IF hy(x)<kleis
        hy(m)=hy(x)
        hy(x)=kleis
        kleis=hy(m)
        intensi(m)=intensi(x)
        intensi(x)=kleii
        kleii=intensi(m)
      ENDIF
    NEXT x
  NEXT m
  m%=0
  DO
    INC m%
    IF intmax<intensi(m%)
      intmax=intensi(m%)
      IF intmin>intensi(m%)
        intmin=intensi(m%)
      ENDIF
    ENDIF
    EXIT IF m%=b
  LOOP
  MENU 22,3
  MENU 23,3
  simstick%=1
  ERASE in(),zwn(),h(),hyp(),int()
RETURN
'
PROCEDURE bild                ! Zeichnung eines Stick-Line-Spektrums
  MENU OFF
  CLS
  LOCAL null,fak,weite,m
  IF sweep=0
    IF sw=0
      ALERT 3," |    |  SWEEP-WIDTH IST 0 ! ",1," ABBRUCH ",button%
      GOTO bildend
    ENDIF
    sweep=sw
  ENDIF
  null=centerfield-sweep*0.5
  fak=587/sweep
  DEFLINE 1,2,0,0
  BOX 27,60,613,360
  LINE 27,360,27,365
  LINE 321,360,321,365
  LINE 613,360,613,365
  DEFTEXT 1,0,0,6
  PRINT AT(3,2);"Filename: ";finame$;
  PRINT AT(3,80);"0.0";
  PRINT AT(40,80);sweep*0.5;
  PRINT AT(75,80);sweep;
  FOR m=1 TO b
    weite=(hy(m)-null)*fak
    IF weite<0
      GOTO weiter
    ENDIF
    DEFLINE 1,0,0,0
    LINE 27+weite,intensi(m)*100/intmax+210,27+weite,210-intensi(m)*100/intmax
    weiter:
  NEXT m
  spektrum!=TRUE
  MENU 27,3
  HIDEM
  SGET x1$
  SHOWM
  MENU 35,3
  MENU 36,3
  IF mess!=-1
    MENU 44,3
  ENDIF
  simm!=-1
  simess!=0
  messplo!=0
  bildend:
RETURN
'
PROCEDURE linienform          ! Initialisierung der H�llkurvenform
  MENU OFF
  LOCAL maus%,bib%,butt%,but%,button%,prog,l%
  CLS
  simkurve%=simgauss%+simlorentz%+simgauss_lorentz%
  IF f_ormstupid!=TRUE
    GOTO simstupid
  ENDIF
  linformein:
  maus%=0
  DEFTEXT 1,0,0,13
  BOX 40,40,600,350
  BOX 110,90,530,120
  TEXT 120,110,200,"AKTUELLE EINSTELLUNG :"
  TEXT 330,110,190,kurform$
  BOX 90,170,190,210
  TEXT 100,197,80,"GAUž"
  BOX 450,170,550,210
  TEXT 455,197,90,"GAUž/LORENTZ"
  BOX 270,170,370,210
  TEXT 280,197,80,"LORENTZ"
  GRAPHMODE 2
  DEFFILL 1,1
  PBOX 250,300,350,330
  DEFTEXT 0,0,0,13
  TEXT 280,320,50,"OK?"
  GRAPHMODE 1
  DEFTEXT 1,1,0,13
  DO
    IF ((90<MOUSEX AND 190>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
      kurve%=1
      maus%=1
      LET kurform$="GAUžKURVE"
    ENDIF
    IF ((270<MOUSEX AND 370>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
      maus%=2
      kurve%=2
      kurform$="LORENTZKURVE"
      prol=1
    ENDIF
    IF ((450<MOUSEX AND 550>MOUSEX) AND (170<MOUSEY AND 210>MOUSEY) AND MOUSEK=1)
      maus%=3
      kurve%=3
      kurform$="GAUž/LORENTZ-KURVE"
    ENDIF
    IF kurve%>0
      IF INKEY$=CHR$(13)
        maus%=4
      ENDIF
      IF ((250<MOUSEX AND 350>MOUSEX) AND (300<MOUSEY AND 330>MOUSEY) AND MOUSEK=1)
        maus%=4
      ENDIF
    ENDIF
    EXIT IF maus%<>0
  LOOP
  IF maus%<4
    TEXT 330,110,200,"                           "
    GOTO linformein
  ENDIF
  simstupid:                    ! šberpr�fen ob die Berechnung m”glich ist
  IF simkurve%=0
    IF sw=0
      ALERT 3," | | SWEEP-WIDTH IST 0 !",1," ABBRUCH ",butt%
      GOTO huellend
    ENDIF
    IF halbwert=0
      ALERT 3," HALBWERTSBREITE IST NICHT | |    DEFINIERT ! ",1," ABBRUCH ",butt%
      GOTO huellend
    ENDIF
    ppg=auf/sw
    bip=(hy(b)-hy(1)+halbwert*20)*ppg
    IF bip<auf
      simsw=sw
      bi%=auf
    ELSE
      IF FRE(0)<bi%*24+150000
        ALERT 3,"           | ZU WENIG SPEICHERPLATZ | VORERST NUR ...  ",1," ABBRUCH ",but%
        GOTO huellend
      ENDIF
      bi%=INT(bip)
      IF 0=EVEN(bi%)
        INC bi%
      ENDIF
    ENDIF
    IF bi%*3>65000
      ALERT 3," ZU VIELE FELDELEMENTE ZUR | BERECHNUNG DER HšLLKURVE |  VORERST NUR ...  ",1," ABBRUCH ",but%
      GOTO huellend
    ENDIF
    simsw=bi%*sw/auf
    DIM einh(1,bi%)
  ENDIF
  ppg=auf/sw
  IF halbwert*ppg<1.8
    ALERT 3," DAS WIRD SO NIX! | MAL H™HERE AUFL™žUNG NEHMEN | BZW. KLEINERE SWEEP-WIDTH ",1," ABBRUCH ",button%
    ERASE einh()
    GOTO huellend
  ENDIF
  IF kurve%=1
    IF simgauss%=1
      prol=0
      GOSUB zeichnung
      GOTO huellend
    ENDIF
    GOSUB gauss_lorentz
  ENDIF
  IF kurve%=2
    IF simlorentz%=1
      prol=1
      GOSUB zeichnung
      GOTO huellend
    ENDIF
    GOSUB gauss_lorentz
  ENDIF
  IF kurve%=3
    IF simgauss_lorentz%=1
      ALERT 2," | NEUE KURVE BERECHNEN ? ",2," NEIN | JA ",butt%
      IF butt%=1
        prol=proz
        GOSUB zeichnung
        GOTO huellend
      ENDIF
    ENDIF
    IF simgauss%=0
      GOSUB gauss_lorentz
    ENDIF
    CLS
    IF f_ormstupid!=TRUE
      GOTO stupidlorentz
    ENDIF
    DEFTEXT 1,0,0,13
    PRINT AT(30,12);
    INPUT "% Lorentz: ",prol
    stupidlorentz:
    prol=prol/100
    proz=prol
    prog=1-prol
    l%=0
    DO
      huelk%(2,l%)=huelk%(0,l%)*prog+huelk%(1,l%)*prol
      huelk%(2,bi%-l%)=-huelk%(2,l%)
      INC l%
      EXIT IF l%>spekha%
    LOOP
    simgauss_lorentz%=1
    GOSUB zeichnung
    GOTO huellend
  ENDIF
  '
  GOSUB zeichnung
  huellend:
RETURN
'
'
PROCEDURE gauss_lorentz            ! Berechnung der H�llkurve
  LOCAL l%,m,max%,start%,sta,beenden%,p,bo,di,qdi,wure,bereich
  LOCAL wert,n%,maxgau%,maxlor%,normbereich,feldanfang,mg,ml
  LOCAL feld
  gpp=sw/auf
  wure=SQR(EXP(1))
  normbereich=halbwert*20
  bereich=hy(b)-hy(1)+normbereich
  spekha%=bi%/2
  IF bereich>sw
    feldanf=centerfield-bereich/2
  ELSE
    feldanf=centerfield-sw/2
  ENDIF
  l%=0
  m=0
  max%=INT(normbereich*ppg)
  CLS
  DEFTEXT 1,0,0,13
  PRINT AT(10,15);"Nur Geduld, Rom wurde auch nicht an einem"
  PRINT AT(10,17);"Tag erbaut.................."
  DO
    INC m
    sta=(hy(m)-feldanf-normbereich/2)*ppg
    start%=INT(sta)
    beenden%=start%+max%
    IF start%<l% OR start%=l%
      start%=l%
    ENDIF
    IF beenden%>spekha%
      beenden%=spekha%
    ENDIF
    IF start%<spekha%
      FOR l%=start% TO beenden%
        p=m
        feld=feldanf+gpp*l%
        schleife:
        h%=FIX(hy(p)*ppg+0.5)
        bo=h%*gpp
        di=(feld-bo)/halbwert
        qdi=di*di
        qa=(1+4*qdi/3)^2
        wert=wure*di*EXP(-2*qdi)
        einh(0,l%)=einh(0,l%)+wert*intensi(p)
        einh(1,l%)=einh(1,l%)+16/9*di/qa*intensi(p)
        IF p<b
          INC p
          IF (hy(p)-halbwert*10)<=feld
            GOTO schleife
          ENDIF
        ENDIF
        p=m
        links:
        IF p>=2
          DEC p
          IF (hy(p)+halbwert*10)>=feld
            h%=FIX(hy(p)*ppg+0.5)
            bo=h%*gpp
            di=(feld-bo)/halbwert
            qdi=di*di
            qa=(1+4*qdi/3)^2
            wert=wure*di*EXP(-2*qdi)
            einh(0,l%)=einh(0,l%)+wert*intensi(p)
            einh(1,l%)=einh(1,l%)+16/9*di/qa*intensi(p)
          ENDIF
          GOTO links
        ENDIF
      NEXT l%
    ELSE
      l%=start%
    ENDIF
    EXIT IF l%>=spekha%
  LOOP
  PRINT AT(20,20);"...aber an einem Tag abgebrannt!"
  l%=0
  DIM huelk%(2,bi%)
  DO
    huelk%(0,l%)=CINT(einh(0,l%)*1000000)
    IF ABS(huelk%(0,l%))>maxgau%
      maxgau%=ABS(huelk%(0,l%))
    ENDIF
    huelk%(1,l%)=CINT(einh(1,l%)*1000000)
    IF ABS(huelk%(1,l%))>maxlor%
      maxlor%=ABS(huelk%(1,l%))
    ENDIF
    INC l%
    EXIT IF l%>spekha%
  LOOP
  mg=1000000/maxgau%
  ml=1000000/maxlor%
  l%=0
  DO
    huelk%(0,l%)=CINT(huelk%(0,l%)*mg)
    huelk%(0,bi%-l%)=-huelk%(0,l%)
    huelk%(1,l%)=CINT(huelk%(1,l%)*ml)
    huelk%(1,bi%-l%)=-huelk%(1,l%)
    INC l%
    EXIT IF l%>spekha%
  LOOP
  huelk%(0,spekha%)=0
  huelk%(1,spekha%)=0
  ERASE einh()
  simgauss%=1
  simlorentz%=1
RETURN
'
PROCEDURE zeichnung                    ! Zeichnen der H�llkurve
  MENU OFF
  CLS
  simess!=0
  halb!=0
  DEFLINE 1,1
  LOCAL fa,anf
  IF ver=0
    ver=1
  ENDIF
  IF sweep=0
    sweep=sw
  ENDIF
  amb=ROUND(0,2)
  mb=ROUND(sweep,2)
  BOX 27,60,613,360
  DEFLINE 1,1,0,0
  LINE 27,360,27,365
  LINE 321,360,321,365
  LINE 613,360,613,365
  DEFTEXT 1,0,0,6
  PRINT AT(3,2);"Filename: ";finame$;
  PRINT AT(40,2);"Aufl”sung: ";auf;
  PRINT AT(3,5);"Simulierte Sweep Width :";sw;
  PRINT AT(40,5);"Halbwertsbreite: ";halbwert
  PRINT AT(60,2);" % Lorentz: ";prol*100;
  PRINT AT(3,80);amb;
  PRINT AT(40,80);mb*0.5;
  PRINT AT(75,80);mb;
  fa=586/sweep
  IF sweep>=simsw
    fak=fa*simsw/bi%
    start%=CINT((sweep-simsw)/2*fa+27)
    anfang%=0
    ende%=bi%
  ELSE
    anf=sweep/2*ppg+0.5
    anfang%=spekha%-CINT(anf)
    ende%=spekha%+CINT(anf)
    fak=586/(ende%-anfang%)
    start%=27
  ENDIF
  GOSUB pinsel
  MENU 27,3
  MENU 28,3
  spektrum!=FALSE
  huell!=TRUE
  MENU 35,3
  MENU 36,3
  MENU 37,3
  MENU 31,3
  MENU 38,3
  IF mess!=-1
    MENU 44,3
  ENDIF
  bereichsplott!=FALSE
  simm!=-1
  messplo!=0
  zeichnungende:
  HIDEM
  SGET x1$
  SHOWM
  DEFLINE 1,1,0,0
RETURN
'
'
'
' *********VERGR™žEREUNG D.H. AUSSCHNITT *******************
'
PROCEDURE bereich
  MENU OFF
  LOCAL maus%,key$,x1,x2,g1,g2,gaus1,gaus2,bereich%,li%,re%,lix,rex
  LOCAL l%
  CLS
  simess!=0
  halb!=0
  DEFLINE 1,1,0,0
  IF bereichsplott!=FALSE
    bereichshalbe%=spekha%
    sweepbereich=sweep
    GOSUB zeichnung
    g1=0
    g2=0
  ELSE
    GOSUB pinsel
    BOX 27,60,613,360
    LINE 27,360,27,365
    LINE 321,360,321,365
    LINE 613,360,613,365
    DEFTEXT 1,0,0,6
    PRINT AT(3,2);"Filename: ";finame$;
    PRINT AT(40,2);"Aufl”sung: ";auf;
    PRINT AT(3,5);"Simulierte Sweep Width :";sw;
    PRINT AT(40,5);"Halbwertsbreite: ";halbwert;
    PRINT AT(60,2);" % Lorentz: ";prol*100;
    PRINT AT(3,80);amb;
    PRINT AT(35,80);ROUND(mb-amb,2);" GAUSS ";
    PRINT AT(74,80);mb;
    HIDEM
    SGET x1$
    SHOWM
  ENDIF
  g1=amb
  g2=mb
  bereichanfang:
  p_line!=FALSE
  SPUT x1$
  BOX 580,35,613,55
  DEFTEXT 1,1,0,13
  TEXT 583,50,25,"ESC"
  DEFTEXT 1,1,0,6
  DO
    key$=INKEY$
    IF key$=CHR$(27)
      maus%=3
    ENDIF
    IF key$=CHR$(127)
      maus%=2
    ENDIF
    IF MOUSEK>0
      maus%=1
    ENDIF
    IF MOUSEX>580 AND MOUSEY>35
      IF MOUSEX<613 AND MOUSEY<55 AND MOUSEK>0
        maus%=3
      ENDIF
    ENDIF
    EXIT IF maus%>0
    key$=""
  LOOP
  IF maus%=3
    GOTO bereichende
  ENDIF
  IF maus%=2
    bereichshalbe%=spekha%
    sweepbereich=sweep
    CLS
    GOSUB zeichnung
    g1=0
    g2=0
  ENDIF
  HIDEM
  SGET x1$
  SHOWM
  DEFLINE 2,1,1,1
  SETMOUSE 321,200,0
  icks1:
  DO                      !Abfrage der linken Grenze
    SPUT x1$
    x1=MOUSEX
    li%=MOUSEX-27
    IF li%<0
      li%=0
    ENDIF
    IF li%>586
      li%=586
    ENDIF
    lix=ROUND(((mb-amb)/586*li%)+amb,2)
    PRINT AT(4,7);lix
    COLOR 1
    LINE x1,60,x1,360
    PAUSE 5
    IF MOUSEK=1
      COLOR 1
      LINE x1,60,x1,360
      lin=1
      HIDEM
      SGET x1$
      SHOWM
    ENDIF
    EXIT IF lin=1
  LOOP
  IF x1<27 OR x1>613
    GOTO icks1
  ENDIF
  icks2:
  maus%=0
  DO                     !Abfrage der rechten Grenze
    SPUT x1$
    x2=MOUSEX
    re%=MOUSEX-27
    IF re%<0
      re%=0
    ENDIF
    IF re%>586
      re%=586
    ENDIF
    rex=ROUND(((mb-amb)/586*re%)+amb,2)
    PRINT AT(14,7);rex;
    PRINT AT(24,7);ROUND(rex-lix,2);
    COLOR 1
    LINE x2,60,x2,360
    PAUSE 5
    COLOR 1
    IF MOUSEK=2
      LINE x2,60,x2,360
      lin=2
    ENDIF
    EXIT IF lin=2
  LOOP
  IF x1=x2
    GOTO icks2
  ENDIF
  IF x2<x1 OR x2>614
    GOTO icks2
  ENDIF
  '
  gaus1=((x1-27)*sweepbereich/586)
  gaus2=((x2-27)*sweepbereich/586)
  '
  la%=CINT(bereichshalbe%-(sweepbereich/2-gaus1)*ppg)
  le%=CINT(bereichshalbe%-(sweepbereich/2-gaus2)*ppg)
  bereich%=le%-la%
  fak=586/bereich%
  bereichshalbe%=bereich%/2+la%
  sweepbereich=gaus2-gaus1
  g1=gaus1+g1
  g2=g1+sweepbereich
  halbe=(g2-g1)*0.5+g1
  mb=ROUND(g2,2)
  amb=ROUND(g1,2)
  fhalbe=ROUND(halbe,2)
  '
  CLS
  DEFLINE 1,1,0,0
  BOX 27,60,613,360
  LINE 27,360,27,365
  LINE 321,360,321,365
  LINE 613,360,613,365
  DEFTEXT 1,0,0,6
  PRINT AT(3,2);"Filename: ";finame$;
  PRINT AT(40,2);"Aufl”sung: ";auf;
  PRINT AT(3,5);"Simulierte Sweep Width :";sw;
  PRINT AT(40,5);"Halbwertsbreite: ";halbwert;
  PRINT AT(60,2);" % Lorentz: ";prol*100;
  PRINT AT(3,80);amb;
  PRINT AT(35,80);ROUND(mb-amb,2);" GAUSS";
  PRINT AT(74,80);mb;
  '
  IF la%>bi%
    p_line!=-1
  ENDIF
  IF la%<0 OR la%=0
    anfang%=0
    start%=CINT(ABS(la%*fak)+27)
  ENDIF
  IF la%>0
    anfang%=la%
    start%=27
  ENDIF
  IF le%<0 OR le%=0
    p_line!=TRUE
  ELSE
    IF le%>bi%
      ende%=bi%
    ELSE
      ende%=le%
    ENDIF
  ENDIF
  '
  GOSUB pinsel
  HIDEM
  SGET x1$
  SHOWM
  GOTO bereichanfang
  '
  bereichende:
  DEFFILL 0,0
  PBOX 579,34,614,56
  SGET x1$
  huell!=FALSE
  bereichsplott!=TRUE
  messplo!=0
  DEFLINE 1,1,0,0
RETURN
'
PROCEDURE pinsel
  hoehe=150/1000000
  IF simess!=-1
    DEFLINE defl%,1,0,0
  ELSE
    DEFLINE 1,1,0,0
  ENDIF
  IF p_line!=-1
    LINE 27,210+offset%,613,210+offset%
    gerade!=-1
  ELSE
    gerade!=0
    DRAW 27,210+offset%
    DRAW  TO start%,210+offset%
    '
    FOR l%=anfang% TO ende%
      x%=(l%-anfang%)*fak+start%
      y%=210+offset%+huelk%(kurve%-1,l%)*hoehe*ver
      IF halb!=-1
        IF y%<210
          y%=210
        ENDIF
      ENDIF
      IF y%>360
        y%=360
      ENDIF
      IF y%<60
        y%=60
      ENDIF
      DRAW  TO x%,y%
    NEXT l%
    DRAW  TO 613,210+offset%
  ENDIF
  DEFLINE 1,1,0,0
  IF simess!=-1
    HIDEM
    SGET x1$
    SHOWM
  ENDIF
RETURN
' **************EIN-UND AUSGABE šBER DISKETTE *************
PROCEDURE lese          ! Daten Einlesen
  MENU OFF
  '
  LOCAL wahl$,bakl%,l$
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\DATEN\*.*","",wahl$
  IF wahl$=""
    GOTO leseende
  ENDIF
  IF EXIST(wahl$)
    ERASE ag()
    ERASE ag1()
    ERASE hy()
    ERASE at$()
    ERASE intensi()
    ERASE huelk%()
    DEFTEXT 1,17,0,17
    TEXT 150,150,300,"BIN BEIM LESEN "
    VOID FRE(0)           ! Wegen der M�llabfuhr!
    OPEN "I",#1,wahl$
    WHILE NOT EOF(#1)
      INPUT #1,nika%
      INPUT #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
      INPUT #1,b,sweep,intmin,intmax,centerfield
      DIM ag(nika%,2),ag1(nika%,2),at$(nika%,2)
      DIM hy(b)
      DIM intensi(b)
      BGET #1,VARPTR(ag(0,0)),DIM?(ag())*8
      BGET #1,VARPTR(hy(0)),DIM?(hy())*8
      BGET #1,VARPTR(intensi(0)),DIM?(intensi())*8
      '
      INPUT #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
      INPUT #1,simsw
      DIM huelk%(2,bi%)
      BGET #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
    WEND
    CLOSE
    MENU 17,3
    MENU 22,3
    MENU 23,3
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    bakl%=RINSTR(wahl$,"\")
    finame$=MID$(wahl$,bakl%+1)
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '
    GOTO leseende
  ENDIF
  ALERT 1," DATEI IST NICHT | |  VORHANDEN !",1," KLAR ? ",but%
  '
  leseende:
  CLS
  '
RETURN
'
PROCEDURE schreibe                   ! Daten auf Disk. schreiben
  MENU OFF
  '
  LOCAL wahl$,l$
  IF simkurve%=0
    IF simstick%=0
      GOTO schreibende
    ENDIF
  ENDIF
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\DATEN\*.*",finame$,wahl$
  IF wahl$=""
    GOTO schreibende
  ENDIF
  IF EXIST(wahl$)
    ALERT 1," DATEI EXISTIERT SCHON ! | ACHTUNG ! | DIE DATEI WIRD šBERSCHRIEBEN !",1," ABBRUCH | WEITER ",buton%
    IF buton%=1
      GOTO schreibende
    ENDIF
  ENDIF
  DEFTEXT 1,17,0,17
  TEXT 150,150,300,"BIN BEIM SCHREIBEN "
  VOID FRE(0)                ! wegen der M�llabfuhr !
  OPEN "O",#1,wahl$
  WRITE #1,nika%
  WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
  WRITE #1,b,sweep,intmin,intmax,centerfield
  BPUT #1,VARPTR(ag(0,0)),DIM?(ag())*8
  BPUT #1,VARPTR(hy(0)),DIM?(hy())*8
  BPUT #1,VARPTR(intensi(0)),DIM?(intensi())*8
  '
  WRITE #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
  WRITE #1,simsw
  BPUT #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
  CLOSE
  '
  schreibende:
  CLS
RETURN
'
PROCEDURE loesche                    ! Der Name sagt alles
  LOCAL wahl$,l$,button%,but%
  MENU OFF
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\DATEN\*.*","",wahl$
  IF wahl$=""
    GOTO loeschende
  ENDIF
  DEFTEXT 1,0,0,13
  IF EXIST(wahl$)
    ALERT 3," SOLL DIE DATEI | | | WIRKLICH GEL™SCHT WERDEN? ",1," NEIN | JA ",button%
    IF button%=2
      KILL wahl$
    ENDIF
    GOTO loeschende
  ENDIF
  ALERT 1," DATEI IST NICHT | |  VORHANDEN !",1," KLAR ? ",but%
  loeschende:
RETURN
'
' *************************************************************************
PROCEDURE namensgebung                ! Filename
  MENU OFF
  DEFTEXT 1,0,0,13
  BOX 180,175,380,200
  PRINT AT(25,12);"Filename: ________.___"
  PRINT AT(35,12);
  FORM INPUT 12 AS finame$
RETURN
'
'
PROCEDURE fehlerbehandlung      ! Versuch um Fehler abzufangen
  CLS
  LOCAL bott%,bottom%,butt%,fehler$
  DEFTEXT 1,1,0,13
  fehler$=STR$(ERR)
  IF ERR<101
    IF ERR=37
      CLOSE
      IF f_ormstupid!=TRUE
        ALERT 1," Disk hat zuwenig Speicher ! | Also  nochmal Eintippen! | (Ich hab ja gewarnt!!) | Aber erstmal weiter!",1," TJAAA.. ",bott%
        IF bott%=1
          RESUME rettung
        ENDIF
      ELSE
        ALERT 1," Diskette hat zu- | wenig Speicherplatz! ",1," KO? ",bottom%
        IF bottom%=1
          RESUME neustart
        ENDIF
      ENDIF
    ENDIF
    IF ERR=22
      CLOSE
      RESUME neustart
    ENDIF
    ALERT 2," ŽCHZ! FEHLER "+fehler$+" | IST AUFGETRETEN | NOCH MAL PROBIEREN ? ",1," JA ! | LMAA ! ",butt%
    IF butt%=1
      RESUME neustart
    ELSE
      CLS
      DEFTEXT 1,16,0,26
      PRINT AT(10,20);" NA GOTT SEI DANK !"
      END
    ENDIF
  ENDIF
RETURN
'
'
'
PROCEDURE robot                 ! Sogenannte Autosimulationsroutine
  LOCAL maus%,s_stop%,korr%
  MENU OFF
  DEFTEXT 1,0,0,13
  IF rettung!=-1
    GOTO sichern
  ENDIF
  ' **********************************************************************************
  GOSUB datenordner
  ' *****************************************************************************`
  diskfrei%=DFREE(0)
  ' ****************************  WIRD AUSDRUCK GEWšNSCHT ? ***********
  ALERT 2," | MIT GLEICHZEITIGEM | AUSDRUCK ? ",1," KLARO | NEEE ",dr%
  IF dr%=1
    druck!=TRUE
    ALERT 2," | AUSDRUCK MIT | PARAMETER ? ",1," NA KLAR | QUATSCH ",par%
    IF par%=1
      daten!=TRUE
    ELSE
      daten!=FALSE
    ENDIF
  ELSE
    druck!=FALSE
  ENDIF
  ALERT 2," | MIT GLEICHZEITIGEM | ABSPEICHERN DER | SPEKTREN ? ",2," SICHER | UNSINN",speicher%
  ' ********************************************************************
  IF finame$=""
    finame$="Unfug"
  ENDIF
  DEFTEXT 1,0,0,13
  BOX 180,175,380,200
  PRINT AT(25,12);"Filename: ______"
  PRINT AT(35,12);
  FORM INPUT 6 AS finame$
  zaehl$=finame$
  CLS
  f_ormstupid!=TRUE
  simu_eingabe:
  laufwerk%=GEMDOS(25)
  IF BIOS(&H9,laufwerk%)>0
    CHDIR "\"
    IF 0<>FSFIRST("daten",-1)  !Ist Ordner Daten vorhanden?
      MKDIR "DATEN"
    ENDIF
    diskfrei%=DFREE(0)
    CHDIR "DATEN"
  ENDIF
  DEFTEXT 1,8,0,18
  PRINT AT(10,5);
  INPUT " Anzahl der simulationen:";simu%
  CLS
  IF speicher%=1
    DEFTEXT 1,1,0,13
    IF diskfrei%<simu%*50000
      PRINT AT(10,5);"Achtung die Diskette hat nur ";diskfrei%;" Bytes Speicherplatz !";
      PRINT AT(10,8);"             Das k”nnte knapp werden !!!! ";
      PRINT AT(10,11);"Besser ist es eine neue Diskette zu verwenden oder die ";
      PRINT AT(10,14);"     Zahl der Simulationen entsprechend zu verringern";
      BOX 100,320,200,360
      BOX 450,320,550,360
      TEXT 120,340,"NA KLAR"
      TEXT 470,340,"Risiko"
      maus%=0
      DO
        IF MOUSEY>320 AND MOUSEY<360
          IF MOUSEX>100 AND MOUSEX<200 AND MOUSEK=1
            maus%=1
          ENDIF
          IF MOUSEX>450 AND MOUSEX<550 AND MOUSEK=1
            maus%=2
          ENDIF
        ENDIF
        EXIT IF maus%>0
      LOOP
      IF maus%=1
        CLS
        GOTO simu_eingabe
      ENDIF
      IF maus%=2
        CLS
        TEXT 250,50,"Eigenes Risiko!"
      ENDIF
    ENDIF
  ENDIF
  '
  '
  IF speicher%=2
    DEFTEXT 1,1,0,13
    IF diskfrei%<simu%*1024
      PRINT AT(10,5);"Achtung die Diskette hat nur ";diskfrei%;" Bytes Speicherplatz !";
      PRINT AT(10,8);"             Das wird nicht reichen  !!!! ";
      PRINT AT(10,11);"Besser ist es eine neue Diskette zu verwenden oder die ";
      PRINT AT(10,14);"     Zahl der Simulationen entsprechend zu verringern";
      BOX 100,320,200,360
      BOX 450,320,550,360
      TEXT 120,340,"NA KLAR"
      TEXT 470,340,"Risiko"
      maus%=0
      DO
        IF MOUSEY>320 AND MOUSEY<360
          IF MOUSEX>100 AND MOUSEX<200 AND MOUSEK=1
            maus%=1
          ENDIF
          IF MOUSEX>450 AND MOUSEX<550 AND MOUSEK=1
            maus%=2
          ENDIF
        ENDIF
        EXIT IF maus%>0
      LOOP
      IF maus%=1
        CLS
        GOTO simu_eingabe
      ENDIF
      IF maus%=2
        CLS
        TEXT 200,50,200,"NICHT ZU VIEL RISIKO!"
        PAUSE 60
        GOTO simu_eingabe
      ENDIF
    ENDIF
  ENDIF
  '
  '
  '
  '
  IF simu%=0
    GOTO robotende
  ENDIF
  ERASE quark$()
  ERASE auswahl$()
  IF simstick%=1 OR simgaus%=1
    ERASE hy()
    ERASE intensi()
    ERASE huelk%()
  ENDIF
  DIM quark$(simu%),auswahl$(simu%)
  FOR simulat%=1 TO simu%
    quark$(simulat%)="init"+STR$(simulat%)
    '
    korrektur:
    '
    DEFTEXT 1,0,0,13
    PRINT AT(15,5);" DATENSATZ NUMMER : ";simulat%;" - VON - ";simu%;" - SIMULATIONEN";
    '
    GOSUB atom
    '
    GOSUB eingabe
    '
    IF simulat%=1
      auf=1024
      auf1=1024
      sw=50
      sw1=50
      halbwert=0.2
      halbwertsbreite=0.2
    ENDIF
    '
    GOSUB spektrenparameter
    '
    CLS
    DEFTEXT 1,8,0,18
    PRINT AT(14,5);"Auswahl der H�llkurvenform";
    TEXT 120,180,"GAUž"
    TEXT 240,180,"LORENTZ"
    TEXT 350,180,"GAUž/LORENTZ"
    BOX 100,150,500,200
    kurve%=0
    DO
      IF MOUSEY>150 AND MOUSEY<200
        IF MOUSEX<180 AND MOUSEX>100 AND MOUSEK=1
          kurve%=1
          prol=0
        ENDIF
        IF MOUSEX<320 AND MOUSEX>230 AND MOUSEK=1
          kurve%=2
          prol=1
        ENDIF
        IF MOUSEX<500 AND MOUSEX>350 AND MOUSEK=1
          kurve%=3
        ENDIF
      ENDIF
      EXIT IF kurve%>0
    LOOP
    CLS
    IF kurve%=3
      CLS
      PRINT AT(17,5);" Gauž-Lorentz-Kurve";
      PRINT AT(17,8);" Eingabe in Prozent";
      PRINT AT(20,11);
      INPUT "% Lorentz= ";prol
      IF prol>100
        prol=100
      ENDIF
      IF prol<0
        prol=0
      ENDIF
    ENDIF
    CLS
    '
    ALERT 2," | |  EINGABE IN ORDNUNG ? ",1," SICHER | ŽŽHH | ABBRUCH ",korr%
    IF korr%=2
      GOTO korrektur
    ENDIF
    IF korr%=3
      ALERT 2," | WIRKLICH DIE AUTO- | SIMULATION BEENDEN ? ",1," NEIN | JA DOCH ",abb%
      IF abb%=2
        s_top%=simulat%-1
        simulat%=simu%
        simu%=s_top%
        GOTO abbruch
      ENDIF
    ENDIF
    '
    OPEN "O",#1,quark$(simulat%)
    WRITE #1,nika%
    WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
    FOR j%=1 TO nika%
      WRITE #1,ag(j%,0),ag(j%,1),ag(j%,2)
    NEXT j%
    WRITE #1,kurve%,prol
    CLOSE
    abbruch:
  NEXT simulat%
  IF simu%=0
    GOTO robotende
  ENDIF
  '
  sichern:
  FOR simulat%=1 TO simu%
    IF rettung!=-1
      GOTO rettungs_schrieb
    ENDIF
    ERASE ag()
    ERASE ag1()
    ERASE at$()
    datei!=EXIST(quark$(simulat%))
    IF datei!=FALSE
      CHDIR "\"
    ENDIF
    datei!=EXIST(quark$(simulat%))
    IF datei!=FALSE
      CHDIR "\DATEN"
    ENDIF
    IF EXIST(quark$(simulat%))=FALSE
      PRINT "VERDAMMTE SCHEIžE"
      END
    ENDIF
    OPEN "I",#1,quark$(simulat%)
    WHILE NOT EOF(#1)
      INPUT #1,nika%
      INPUT #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
      DIM ag(nika%,2),ag1(nika%,2),at$(nika%,2)
      FOR j%=1 TO nika%
        INPUT #1,ag(j%,0),ag(j%,1),ag(j%,2)
      NEXT j%
      INPUT #1,kurve%,prol
    WEND
    CLOSE
    '
    auswahl$(simulat%)=zaehl$+STR$(simulat%)
    finame$=auswahl$(simulat%)
    '
    GOSUB hyper
    '
    GOSUB linienform
    '
    rettungs_schrieb:
    IF speicher%=1
      VOID FRE(0)
      OPEN "O",#1,auswahl$(simulat%)
      WRITE #1,nika%
      WRITE #1,auf,auf1,sw,sw1,halbwertsbreite,halbwert
      WRITE #1,b,sweep,intmin,intmax,centerfield
      BPUT #1,VARPTR(ag(0,0)),DIM?(ag())*8
      BPUT #1,VARPTR(hy(0)),DIM?(hy())*8
      BPUT #1,VARPTR(intensi(0)),DIM?(intensi())*8
      WRITE #1,simgauss%,simlorentz%,simgauss_lorentz%,bi%,simstick%,spekha%,proz
      WRITE #1,simsw
      BPUT #1,VARPTR(huelk%(0,0)),DIM?(huelk%())*4
      CLOSE
    ENDIF
    IF EXIST(quark$(simulat%))
      KILL quark$(simulat%)
    ENDIF
    '
    IF druck!=TRUE                    ! ABFRAGE OB AUSDRUCK GEWšNSCHT WIRD
      IF OUT?(0)=FALSE                ! IST DRUCKER EINGESCHALTET ?
        ALERT 3," DRUCKER IST NICHT | EINGESCHALTET ! | EINSCHALTEN ODER OHNE | AUSDRUCK LEBEN ",1," IST EIN | OHNE ",frag%
        IF frag%=2
          druck!=FALSE
          GOTO druck_ende
        ENDIF
      ENDIF
      IF daten!=TRUE
        GOSUB datendruck
      ENDIF
      GOSUB hardcopy
      druck_ende:
    ENDIF
    '
    '
    IF simulat%<simu%
      ERASE hy()
      ERASE intensi()
      ERASE huelk%()
      CLR bi%,proz,bildbereich,b,sw,sweep,auf,auf1,simgauss%,simlorentz%,simgauss_lorentz%
    ENDIF
    '
    rettung!=0
    '
    CLS
    DEFTEXT 1,0,0,13
    PRINT "N„chste simulation"
    '
    '
    '
  NEXT simulat%
  ERASE auswahl$()
  ERASE quark$()
  robotende:
  f_ormstupid!=FALSE
  CLS
RETURN
'
rettung:              ! Versuch um Daten vor dem Endg�ltigem Vergessen
CLOSE #1              ! zu retten
rettung!=-1
anzahl%=simu%-simulat%         ! Einlesen der Startdaten in den Arbeitsspeicher
IF anzahl%>0
  DIM datensatz(50,anzahl%)
  ARRAYFILL datensatz(),-1
  simret%=0
  FOR i=1 TO anzahl%
    k%=0
    INC simulat%
    INC simret%
    OPEN "i",#1,quark$(simulat%)
    WHILE NOT EOF(#1)
      INC k%
      INPUT #1,datensatz(k%,simret%)
    WEND
    CLOSE
    KILL quark$(simulat%)    ! L”schen des Startdaten -files
  NEXT i
ENDIF
ALERT 1," DIESER FILE KANN | GERETTET WERDEN! | DAZU NEUE DISK EINLEGEN | UND WEITERMACHEN !",1," WEITER | ACHWAS ",was%
IF was%=2
  GOTO neustart
ENDIF
was_soll_das:
ALERT 2," | NEUE DISKETTE | EINGELEGT ?",1," NA KLAR ",d%
IF BIOS(&H9,laufwerk%)=0
  GOTO was_soll_das
ENDIF
ALERT 2," |  DISKETTE FORMATIEREN ?| ",2," JA | NEIN ",f%
IF f%=1
  GOSUB format
  CHDIR "\"
  MKDIR "DATEN"
ENDIF
GOSUB datenordner
'
IF anzahl%>0               ! Start Datensatz auf neue Diskette schreiben
  simulat%=simu%-anzahl%
  FOR simret%=1 TO anzahl%
    INC simulat%
    OPEN "O",#1,quark$(simulat%)
    k%=1
    WHILE NOT datensatz(k%,simret%)=-1
      WRITE #1,datensatz(k%,simret%)
      INC k%
    WEND
    CLOSE
  NEXT simret%
ENDIF
'
GOSUB robot               ! Weiter gehts
GOTO neustart
'
'
'
PROCEDURE format
  MENU OFF
  '
  ALERT 3," | SICHER, DAž DIESE | DISKETTE FORMATIERT | WERDEN SOLL ?",1," JA | ABBRUCH ",format%
  IF format%=2
    GOTO schluss
  ENDIF
  '
  puffer$=SPACE$(10000)          ! PUFFER EINRICHTEN
  wort=VARPTR(puffer$)
  '
  ' *********** EINGABE DER PARAMETER ********************
  '
  initialisierung:
  ALERT 2,"Anzahl der Tracks ?",2,"80|81|82",track%
  IF track%=2 THEN
    anz_track%=81
  ENDIF
  IF track%=1 THEN
    anz_track%=80
  ENDIF
  IF track%=3
    anz_track%=82
  ENDIF
  '
  ALERT 2,"Sektoren pro Track ?",1,"9|10|ABBRUCH",track%
  IF track%=2 THEN
    s.t=10
  ENDIF
  IF track%=1
    s.t=9
  ENDIF
  IF track%=3
    GOTO schluss
  ENDIF
  '
  ALERT 2,"Wie viele Seiten| formatieren ?",2,"Eine|Zwei|Keine",seiten
  IF seiten=3
    GOTO schluss
  ENDIF
  '
  ' *********** GRUNDPARAMETER SETZEN *****************
  '
  wert=&HE5E5
  konst=&H87654321
  r.folge=1
  side=0
  drive=0
  '
  CLS
  DEFTEXT 1,0,0,26,
  '
  ' **** TRACK 1 SEITE 1 UND TRACK 1 SEITE 2 (NUR DOPPELS.) FORMAT ****
  '
  a=XBIOS(10,L:wort,L:0,drive,s.t,0,0,r.folge,L:konst,0)
  GOSUB auswertung
  IF seiten=2
    a=XBIOS(10,L:wort,L:0,drive,s.t,0,1,r.folge,L:konst,0)
    GOSUB auswertung
  ENDIF
  '
  ' ********* ALLE šBRIGEN TRACKS FORMATIEREN ******************
  '
  FOR track%=1 TO anz_track%-1
    '
    seite_1_oder_seite_2_format:
    a=XBIOS(10,L:wort,L:0,drive,s.t,track%,side,r.folge,L:konst,wert)
    GOSUB auswertung
    IF seiten=2
      side=side XOR 1       ! AUF ANDERE SEITE UMSCHALTEN
      IF side=1
        GOTO seite_1_oder_seite_2_format
      ENDIF
    ENDIF
  NEXT track%
  '
  ' ********* BOOTSEKTOR ERSTELLEN *****************
  '
  a=XBIOS(18,L:wort,L:0,seiten+1,0)
  '
  anz_sektoren%=anz_track%*s.t*seiten
  hi_byte%=anz_sektoren%/256
  low_byte%=anz_sektoren%-hi_byte%*256
  '
  POKE wort+19,low_byte%   ! GESAMMTANZAHL DER SEKTOREN DER DISK EINTRAGEN
  POKE wort+20,hi_byte%
  '
  IF seiten=1
    POKE wort+21,&HF8      ! EINSEITIGE DISK
  ELSE
    POKE wort+21,&HF9      ! DOPPELSEITIGE DISK
  ENDIF
  '
  POKE wort+24,s.t         ! SEKTOREN PRO TRACK EINTRAGEN
  POKE wort+25,0
  '
  ' **************** BOOTSEKTOR SCHREIBEN *************
  '
  a=XBIOS(9,L:wort,L:0,drive,1,0,0,1)
  '
  ' *************** GRUNDEINTRŽGE DER FAT ERSTELLEN  ************
  '
  LPOKE wort,&HF7FFFF00
  FOR i=3 TO 511
    POKE wort+i,0
  NEXT i
  '
  ' ******* 1.FAT BEI EIN- UND ZWEISEITIGER DISK SCHREIBEN ********
  '
  anf_sek%=2
  anz_sek%=1
  track%=0
  a=XBIOS(9,L:wort,L:0,drive,anf_sek%,track%,side,anz_sek%)
  '
  ' ********* 2. FAT BEI EIN-UND ZWEISEITIGER DISK SCHREIBEN ******
  '
  anf_sek%=7
  a=XBIOS(9,L:wort,L:0,drive,anf_sek%,track%,side,anz_sek%)
  '
  schluss:
RETURN
' *************** FEHLERAUSWERTUNG ***********************
'
PROCEDURE auswertung
  IF a=0
    x%=CINT(3600/anz_track%)
    w%=x%*track%
    IF track%=anz_track%-1
      w%=3600
    ENDIF
    IF seiten=2
      DEFFILL 1,2,9
      PCIRCLE 320,200,150,0,w%
      DEFFILL 1,2,19
      PCIRCLE 320,200,75,0,w%
    ELSE
      DEFFILL 1,2,1
      PCIRCLE 320,200,150,0,w%
    ENDIF
  ELSE
    alarm$="FEHLER AUF| |SEITE "+STR$(side)+"   TRACK "+STR$(track%)
    ALERT 1,alarm$,1," ABBRUCH | WEITER ",e%
    IF e%=1
      RESUME neustart
    ENDIF
  ENDIF
RETURN
'
PROCEDURE hardcopy    ! Der Name sagt auch schon alles
  LOCAL i%,l%,spek$
  IF OUT?(0)=FALSE    ! �bliche šberpr�fungen
    ALERT 3," |     DRUCKER BITTE     | EINSCHALTEN ! ",1," JA JA | MOG NET ",soso%
    IF soso%=2
      GOTO copy_ende
    ENDIF
  ENDIF
  IF OUT?(0)=FALSE
    DEFTEXT 1,1,0,13
    PRINT AT(30,10);" WITZBOLD !!"
    PAUSE 30
    GOTO copy_ende
  ENDIF
  IF f_ormstupid!=FALSE
    ALERT 2," | AUSDRUCK MIT | PARAMETER ? ",1," NA KLAR | QUATSCH ",par%
    IF par%=1
      GOSUB datendruck
    ENDIF
  ENDIF
  DEFTEXT 1,17,0,17
  TEXT 150,150,300,"BIN BEIM DRUCKEN "
  MENU OFF        ! Hardcopyrutine
  LPRINT CHR$(27);CHR$(108);CHR$(5);  ! linker Rand
  LPRINT CHR$(27);CHR$(65);CHR$(8);    ! Zeilenvorschub auf 8/60 Zoll
  FOR i%=1 TO 80
    spek$=""
    FOR l%=399 TO 0 STEP -1
      spek$=spek$+MID$(x1$,(l%*80)+i%,1)
    NEXT l%
    LPRINT CHR$(27);"*";CHR$(0);CHR$(144);CHR$(1);spek$
  NEXT i%
  LPRINT CHR$(13);
  LPRINT CHR$(12);                          ! N„chste Seite
  LPRINT CHR$(27);CHR$(64);                 ! DRUCKER RESET
  '
  DO
    EXIT IF OUT?(0)=TRUE
  LOOP
  '
  '
  copy_ende:
  CLS
RETURN
'
PROCEDURE datendruck  ! Ausdruck der Startdatens„tze
  MENU OFF
  IF messplo!=-1
    DEFTEXT 1,17,0,17
    TEXT 50,100,500,"DIE SOLLTE MANN/FRAU SCHON HABEN ! "
    GOTO datendruckende
  ENDIF
  LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  LPRINT CHR$(27);"E";
  LPRINT finame$
  LPRINT CHR$(27);"F";
  LPRINT CHR$(27);CHR$(74);CHR$(90);                        ! Zeilen vorschub
  LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  LPRINT "Anzahl der unabh„ngigen Atome:    ";
  LPRINT nika%;
  LPRINT CHR$(27);CHR$(74);CHR$(90);                        ! Zeilen vorschub
  LPRINT CHR$(27);CHR$(108);CHR$(15);                       ! Linker Rand
  LPRINT CHR$(27);CHR$(45);CHR$(1);                         ! Unterstrichen
  LPRINT "Kernparameter";
  LPRINT CHR$(27);CHR$(45);CHR$(0);
  LPRINT CHR$(27);CHR$(74);CHR$(50);
  LPRINT CHR$(27);CHR$(108);CHR$(15);
  FOR i=1 TO nika%
    LPRINT "Atomgruppe:       ",i
    LPRINT CHR$(10);
    LPRINT "Kernspin :        ",ag(i,0);
    LPRINT CHR$(10);
    LPRINT "Anzahl der Kerne: ",ag(i,1);
    LPRINT CHR$(10);
    LPRINT "Kopplungskonstante",ag(i,2),
    LPRINT CHR$(10);
    LPRINT "****************************************"
    LPRINT CHR$(10);
  NEXT i
  LPRINT CHR$(27);CHR$(74);CHR$(90);                      !Zeilen vorschub
  LPRINT CHR$(27);CHR$(108);CHR$(15);                     !Linker Rand
  LPRINT "Sweep-width (in Gauss):    ",sweep
  LPRINT CHR$(10);
  LPRINT "Halbwertsbreite (in Gauss):",halbwert,
  LPRINT CHR$(10);
  LPRINT "Aufl”sung (in Punkte):    ",auf
  LPRINT CHR$(10);
  LPRINT "Prozent Lorentzcharakter:  ",prol*100,
  LPRINT CHR$(12);
  '
  DO
    EXIT IF OUT?(0)=TRUE
  LOOP
  datendruckende:
  '
RETURN
'
PROCEDURE spin                                         ! Berechnung der nor -
  LOCAL atome%,anzahl%,aufspaltung%,zaehl%,max%,imax%  ! mierten Intensit„ten
  atome%=ag(k%,1)                                       ! f�r ungew”hnlich viele
  aufspaltung%=INT(ag(k%,0)*2+1)                        ! Atome und "seltene"
  anzahl%=INT(ag(k%,0)*2*ag(k%,1)+1)                     ! Spinquantenzahlen
  DIM rechenfeld%(anzahl%),inten%(anzahl%)
  rechenfeld%(1)=1
  DO
    DEC atome%
    EXIT IF atome%<0
    ARRAYFILL inten%(),0
    zaehl%=0
    DO
      INC zaehl%
      FOR z%=zaehl% TO (aufspaltung%+zaehl%-1)
        IF z%<anzahl% OR z%=anzahl%
          ADD inten%(z%),rechenfeld%(zaehl%)
        ENDIF
      NEXT z%
      EXIT IF zaehl%=anzahl%
    LOOP
    SWAP rechenfeld%(),inten%()
  LOOP
  max%=INT(anzahl%/2+1)
  imax%=rechenfeld%(max%)
  FOR z%=1 TO anzahl%
    int(k%,z%)=rechenfeld%(z%)/imax%
  NEXT z%
  ERASE rechenfeld%()
  ERASE inten%()
RETURN
'
PROCEDURE aufblasen
  MENU OFF
  DEFTEXT 1,0,0,13
  PRINT AT(25,10);
  INPUT "VERGR™žERUNGSFAKTOR: ";ver
  ver=ABS(ver)
  PRINT ver
  IF ver=0
    ver=1
  ENDIF
  GOSUB zeichnung
RETURN
'
PROCEDURE hp7475a
  MENU OFF
  BOUNDARY 1
  LOCAL stil%,lin%,leng,xin,yin,a,a$,x1,y1,maus,beenden!,yw%,penr%,pens%
  LOCAL butt%,antwort%,i%,z%,p1%,m_sweep,s_sweep
  m_sweep=ROUND(mend-manf,2)
  s_sweep=ROUND(mb-amb,2)
  IF simess!=-1
    z%=2
  ELSE
    z%=1
  ENDIF
  DO UNTIL i%=z%
    INC i%
    IF i%=2
      TEXT 460,80,penr%
      TEXT 460,230,pens%
    ENDIF
    stift:
    GRAPHMODE 2
    DEFFILL 1,2,1
    PBOX 300,20,360,50
    DEFFILL 1,0
    DEFTEXT 1,16,0,18
    TEXT 160,80,300,"STIFT FšR DEN RAHMEN: "
    TEXT 160,230,300,"STIFT FšR DAS SPEKTRUM: "
    DEFTEXT 1,0,0,15
    IF simess!=-1
      IF i%=1
        TEXT 110,43,170,"SIMULIERTES - "
      ELSE
        TEXT 100,43,"GEMESSENES - "
      ENDIF
      TEXT 400,43,170,"SPEKTRUM"
    ENDIF
    TEXT 315,43,30,"OK"
    '
    BOX 40,350,600,380
    TEXT 50,370,100,"LINIENFORM:"
    IF i%=1
      TEXT 350,370,"PATTERNLŽNGE:"
      lin%=0
    ENDIF
    xin=30
    yin=130
    a$="1"
    a=1
    FOR i=1 TO 6
      ADD xin,80
      x1=xin
      y1=yin
      FOR d=1 TO 2
        TEXT x1+16,y1+24,a$
        x2=x1+40
        y2=y1+40
        PBOX x1,y1,x2,y2
        y1=yin+150
      NEXT d
      INC a
      a$=STR$(a)
    NEXT i
    maus=0
    GRAPHMODE 1
    DEFTEXT 1,16,0,18
    DEFLINE 1,1
    LINE 180,365,300,365
    DO
      IF INKEY$=CHR$(27)
        maus=2
        beenden!=-1
      ENDIF
      IF INKEY$=CHR$(13)
        maus=2
      ENDIF
      IF MOUSEK=1
        IF i%=1
          IF MOUSEY>350 AND MOUSEY<380 AND MOUSEX>350 AND MOUSEX<600
            INC leng
            IF leng>20
              leng=1
            ENDIF
            PAUSE 10
            TEXT 500,370,"    "
            TEXT 500,370,STR$(leng)
          ENDIF
          IF MOUSEY>350 AND MOUSEY<380 AND MOUSEX>180 AND MOUSEX<300
            INC lin%
            IF lin%>5
              lin%=0
            ENDIF
            IF lin%=0
              stil%=1
            ENDIF
            IF lin%=1
              stil%=3
            ENDIF
            IF lin%=2
              stil%=5
            ENDIF
            IF lin%=3
              stil%=2
            ENDIF
            IF lin%=4
              stil%=4
            ENDIF
            IF lin%=5
              stil%=6
            ENDIF
            TEXT 180,370,120,"      "
            DEFLINE stil%,1
            LINE 180,365,300,365
            DEFLINE 1,1,0,0
            PAUSE 10
          ENDIF
        ENDIF
        TEXT 460,80,penr%
        TEXT 460,230,pens%
        IF MOUSEY>130 AND MOUSEY<170
          yw%=1
        ENDIF
        IF MOUSEY>280 AND MOUSEY<320
          yw%=2
        ENDIF
        IF MOUSEX>110 AND MOUSEX<150
          IF yw%=1
            penr%=1
          ENDIF
          IF yw%=2
            pens%=1
          ENDIF
        ENDIF
        IF MOUSEX>190 AND MOUSEX<230
          IF yw%=1
            penr%=2
          ENDIF
          IF yw%=2
            pens%=2
          ENDIF
        ENDIF
        IF MOUSEX>270 AND MOUSEX<310
          IF yw%=1
            penr%=3
          ENDIF
          IF yw%=2
            pens%=3
          ENDIF
        ENDIF
        IF MOUSEX>350 AND MOUSEX<390
          IF yw%=1
            penr%=4
          ENDIF
          IF yw%=2
            pens%=4
          ENDIF
        ENDIF
        IF MOUSEX>430 AND MOUSEX<470
          IF yw%=1
            penr%=5
          ENDIF
          IF yw%=2
            pens%=5
          ENDIF
        ENDIF
        IF MOUSEX>510 AND MOUSEX<550
          IF yw%=1
            penr%=6
          ENDIF
          IF yw%=2
            pens%=6
          ENDIF
        ENDIF
        IF MOUSEX>300 AND MOUSEX<360 AND MOUSEY>20 AND MOUSEY<50
          maus=2
        ENDIF
      ENDIF
      EXIT IF maus=2
    LOOP
    IF z%=2 AND i%=1
      pr%=penr%
      ps1%=pens%
    ENDIF
    IF beenden!=-1
      GOTO hp_ende
    ENDIF
    rahmen_aus!=FALSE
    IF penr%=0
      ALERT 2," |  KEINE BESCHRIFTUNG ??? ",1," HŽ ? | EIJO ! ",butt%
      IF butt%=1
        GOTO stift
      ELSE
        rahmen_aus!=TRUE
      ENDIF
    ENDIF
    IF pens%=0
      ALERT 2," |  KEIN SPEKTRUM ?????? ",1," OHJE ! | JA | ???? ",butt%
      IF butt%=1
        GOTO stift
      ENDIF
      IF butt%=2
        ALERT 2," |  SCHWABE ODER SCHOTTE ? ",2," SO ISSES | HANOI ",antwort%
        IF antwort%=2
          CLS
          TEXT 100,150,400," SELTSAM, SELTSAM........"
          PAUSE 120
        ENDIF
      ENDIF
      IF butt%=3
        ALERT 2," SIND SIE EIN | | ORGANIKER ? ",1," JA | NEIN ",antwort%
        CLS
        IF antwort%=1
          TEXT 100,150,400," DACHT ICH MIR DOCH GLEICH!"
        ELSE
          TEXT 100,150,400," HŽTTEN SIE ABER WERDEN K™NNEN ! "
        ENDIF
        PAUSE 120
      ENDIF
    ENDIF
    IF penr%=0 AND pens%=0
      CLS
      TEXT 150,150,300,"GEIZHALS!!!!!"
      PAUSE 150
      CLS
      GOTO stift
    ENDIF
    '
    IF i%=1
      p1%=pens%
    ENDIF
    CLS
  LOOP
  ALERT 2,"  |  PLOTTEN ?",1," EI JO | NEEEE ",butt%
  IF butt%=2
    GOTO hp_ende
  ENDIF
  TEXT 160,150,300,"Bin beim Plotten!"
  '
  OPEN "",#3,"AUX:"
  PRINT #3,"IN;"
  IF rahmen_aus!=FALSE
    GOSUB text
    DELAY 50
    GOSUB rahmen
    DELAY 80
  ENDIF
  GOSUB plott
  PRINT #3,"PU;SP0"
  PRINT #3,"DF"
  CLOSE #3
  hp_ende:
  CLS
  DEFLINE 1,1
RETURN
'
PROCEDURE text
  prozl=prol*100
  PRINT #3,"SP";penr%;
  PRINT #3,"pa2000,7480;"
  PRINT #3,"CS0;SR3,3;"
  PRINT #3,"lbSYSIPHUS - PLOT";CHR$(3)
  PRINT #3,"Pa2020,7460;LbSYSIPHUS - PLOT";CHR$(3)
  PRINT #3,"PA600,7350,PD10600,7350,PU;"
  PRINT #3,"SR.7,1;"
  IF (bereichsplott! OR huell!) OR simess!
    PRINT #3,"PA2800,7200;LBSIMULIERTES SPEKTRUM: ";CHR$(3)
    IF lin%>0
      PRINT #3,"LT",lin%,leng;
    ENDIF
    PRINT #3,"SP";p1%;"VS,2;"
    PRINT #3,"PA5500,7225,PD8000,7225,PU;"
    PRINT #3,"SP";penr%;
    PRINT #3,"LT,VS;";
    PRINT #3,"PA600,7050;LBFILENAME: ";finame$;CHR$(3)
    PRINT #3,"PA3800,7050;CS33;LBAUFL";CHR$(92);"SUNG: ";auf;CHR$(3)
    PRINT #3,"PA7000,7050;LB%-LORENTZCHARAKTER: ";prozl;CHR$(3)
    PRINT #3,"PA600,6925;CS0;LBHALBWERSTBREITE: ";halbwert;CHR$(3)
    PRINT #3,"PA3800,6925;LBSIMULIERTE SWEEP-WEITE: ";sw;CHR$(3)
    PRINT #3,"PA7000,6925;LBSWEEP-WEITE: ";s_sweep;CHR$(3)
    DELAY 10
  ENDIF
  PRINT #3,"PA600,6775,PD10600,6775,PU;"
  IF messplo!=-1
    PRINT #3,"PA2800,6625;LBGEMESSENES SPEKTRUM: ";CHR$(3)
    PRINT #3,"sp",pens%;"VS,2;"
    PRINT #3,"PA5500,6650,PD8000,6650,PU;"
    PRINT #3,"sp";penr%;"VS;"
    PRINT #3,"PA600,6500;LBFILENAME: ";mess$;CHR$(3)
    PRINT #3,"PA3800,6500;LBRESOLUTION: ";res%;CHR$(3)
    PRINT #3,"PA7000,6500;LBCENTERFIELD: ";ROUND(cf,2);CHR$(3)
    PRINT #3,"PA600,6375;LBGEMESSENE SWEEP-WEITE: ";spsw;CHR$(3)
    PRINT #3,"PA7000,6375;LBSWEEP-WEITE: ";m_sweep;CHR$(3)
    PRINT #3,"PA600,6225,PD10600,6225,PU;"
    DELAY 10
  ENDIF
RETURN
'
PROCEDURE rahmen
  LOCAL l$,r$,mit$,s_sweep,m_sweep,lm$,rm$,mitm$,ls$,rs$,mits$
  s_sweep=ROUND(mb-amb,2)
  m_sweep=ROUND(mend-manf,2)
  '
  lm$=SPACE$(7)
  RSET lm$=STR$(ROUND(manf,2))
  rm$=SPACE$(7)
  rm$=STR$(ROUND(mend,2))
  mitm$=SPACE$(7)
  RSET mitm$=STR$(m_sweep)
  l1$=STR$(ROUND(amb,2))
  IF l1$="0"
    l1$="0.00"
  ENDIF
  ls$=l1$
  rs$=STR$(ROUND(mb,2))
  mits$=STR$(s_sweep)
  l$=SPACE$(7)
  mit$=SPACE$(7)
  r$=SPACE$(7)
  '
  PRINT #3,"PU,600,600,PD,600,5620,10600,5620,10600,600,600,600;"
  PRINT #3,"PU600,600,PD600,520,PU,5600,600,PD,5600,520,PU10600,600PD10600,520,PU;"
  IF simess!=-1
    PRINT #3,"PU600,5620,PD600,5700,PU,5600,5620,PD,5600,5700,PU10600,5620PD10600,5700,PU;"
  ENDIF
  IF simess!=-1
    RSET l$=ls$
    RSET mit$=mits$
    RSET r$=rs$
  ELSE
    IF messplo!=-1
      RSET l$=lm$
      RSET mit$=mitm$
      RSET r$=rm$
    ELSE
      RSET l$=ls$
      RSET r$=rs$
      RSET mit$=mits$
    ENDIF
  ENDIF
  PRINT #3,"PA80,380,LB"+l$;CHR$(3)
  PRINT #3,"PA4000,380,LBSWEEP-WEITE"+mit$+" GAUSS";CHR$(3)
  PRINT #3,"PA10100,380,LB"+r$;CHR$(3)
  IF simess!=-1
    PRINT #3,"PA80,5900,LB"+lm$;CHR$(3)
    PRINT #3,"PA4000,5800,LBSWEEP-WEITE"+mitm$+" GAUSS";CHR$(3)
    PRINT #3,"PA10100,5800,LB"+rm$;CHR$(3)
  ENDIF
RETURN
'
PROCEDURE plott
  LOCAL x%,y%,app%,plo%,links%,vgl,off%
  PRINT #3,"IP600,600,10600,5620;"
  IF simess!=-1
    IF halb!=-1
      vgl=0.5
      off%=5000
    ELSE
      vgl=1
      off%=0
    ENDIF
  ELSE
    vgl=1
    off%=0
  ENDIF
  IF messplo!=-1
    PRINT #3,"SP";pens%;
    app%=mende%-mstart%+1
    PRINT #3,"SC1",app%,"-10010,10010;"
    PRINT #3,"PU,1,0;"
    PRINT #3,"PA",1,off%;
    IF mstart%<res%
      y%=mstart%
      DO
        INC x%
        IF y%<1
          plo%=0
          PRINT #3,"PU";
          plo%=off%
        ELSE
          PRINT #3,"PD";
          plo%=CINT(spek%(y%)*vgl/100)+off%
        ENDIF
        IF plo%>10010
          plo%=10010
        ENDIF
        IF halb!=-1
          IF plo%<0
            plo%=0
          ENDIF
        ENDIF
        IF plo%<-10010
          plo%=-10010
        ENDIF
        PRINT #3,"PA",x%,plo%;
        DELAY 0.5
        IF y%=res%
          x%=app%
        ENDIF
        EXIT IF x%=app%
        INC y%
      LOOP
      PRINT #3,"PU;"
    ENDIF
  ENDIF
  '
  IF (huell! OR bereichsplott!) OR simess!
    IF lin%=0
      PRINT #3,"LT";
    ELSE
      PRINT #3,"LT",lin%,leng;
    ENDIF
    PRINT #3,"SP";p1%;
    vgl=ver*vgl
    off%=-off%
    app%=5860
    PRINT #3,"SC1",app%,"-10010,10010;"
    PRINT #3,"PU,1,0;"
    PRINT #3,"PA",1,off%,"PD;"
    IF gerade!=TRUE
      PRINT #3,"VS",2,";"
      PRINT #3,"PA",app%,off%;
      PRINT #3,"VS",";"
    ELSE
      xa%=(start%-27)*10
      IF xa%=0
        xa%=1
      ENDIF
      PRINT #3,"VS",1,";"
      PRINT #3,"PA",xa%,off%;
      PRINT #3,"VS",";"
      FOR y%=anfang% TO ende%
        x%=(y%-anfang%)*fak*10+xa%
        plo%=CINT(-huelk%(kurve%-1,y%)*vgl/100)+off%
        IF plo%>10010
          plo%=10010
        ENDIF
        IF halb!=-1
          IF plo%>0
            plo%=0
          ENDIF
        ENDIF
        IF plo%<-10010
          plo%=-10010
        ENDIF
        PRINT #3,"PA";x%,plo%;
        DELAY 0.5
      NEXT y%
      PRINT #3,"VS",1,";"
      PRINT #3,"PA",app%,off%;
      PRINT #3,"VS",";"
    ENDIF
  ENDIF
  '
RETURN
'
PROCEDURE pixel
  MENU OFF
  LOCAL wahl$,c$,punkt%,d%,bakl%,button%,l$
  '
  IF messplo!=-1
    c$=mess$
  ELSE
    punkt%=RINSTR(finame$,".")
    bakl%=RINSTR(finame$,"\")
    d%=punkt%-bakl%-1
    IF d%<0
      d%=8
    ENDIF
    c$=MID$(finame$,bakl%+1,d%)
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ENDIF
  '
  pixelanf:
  l$=CHR$(GEMDOS(25)+65)
  '
  FILESELECT l$+":\*.PIC",c$+".PIC",wahl$
  IF wahl$>""
    IF EXIST(wahl$)
      ALERT 1," DATEI EXISTIERT SCHON ! | ACHTUNG ! | DIE DATEI WIRD šBERSCHRIEBEN !",1," ABBRUCH | WEITER ",buton%
      IF buton%=1
        GOTO pixelanf
      ENDIF
    ENDIF
    CLS
    SPUT x1$
    OPEN "O",#1,wahl$
    BPUT #1,XBIOS(2),32000
    CLOSE
  ENDIF
RETURN
'
'
PROCEDURE gwert
  MENU OFF
  LOCAL stand1$,stand2$,stand3$,b1$,b2$,b1,b2
  CLS
  DIM stand$(3)
  CHDIR "\"
  CHDIR "\DATEN"
  IF EXIST("G_WERT.PAR")
    OPEN "I",#1,"G_WERT.PAR"
    INPUT #1,wahl$
    INPUT #1,b1,b2
    CLOSE
    IF EXIST(wahl$)
      OPEN "I",#1,wahl$
      FOR i%=1 TO 3
        INPUT #1,stand$(i%)
      NEXT i%
    ENDIF
    CLOSE
  ENDIF
  GOSUB gwertbeschrift
  CLS
  ERASE stand$()
RETURN
PROCEDURE gwertbeschrift
  CLS
  stand1$=stand$(1)
  stand2$=stand$(2)
  stand3$=stand$(3)
  b1$=SPACE$(7)
  b2$=SPACE$(7)
  b1$=STR$(b1)
  b2$=STR$(b2)
  GOSUB muster
  GOSUB kaufhaus
RETURN
PROCEDURE muster
  DEFMOUSE bitmuster$
  DEFTEXT 1,0,0,13
  BOX 30,40,610,360
  BOX 40,50,600,350
  FILL 45,45
  BOX 160,60,480,80
  TEXT 170,75,300,"g-WERT-Berechnung"
  BOX 70,100,590,120
  TEXT 75,115,80,"Standard:"
  TEXT 170,115,stand1$
  BOX 70,130,590,150
  TEXT 75,145,80,"g-WERT:"
  TEXT 170,145,stand2$
  BOX 70,160,590,180
  TEXT 75,175,80,"Kommentar:"
  TEXT 170,175,stand3$
  BOX 70,189,590,211
  TEXT 75,205,115,"Feld [ in Gauž ]"
  BOX 73,191,587,209
  FILL 71,190
  DEFLINE 1,3
  LINE 205,190,205,210
  TEXT 220,205,70,"Standard:"
  DEFLINE 0,0
  BOX 293,190,308,210
  BOX 383,190,398,210
  BOX 473,190,488,210
  BOX 563,190,578,210
  TEXT 296,206,""
  TEXT 296,206,""
  TEXT 386,206,""
  TEXT 476,206,""
  TEXT 566,206,""
  TEXT 310,205,70,b1$
  TEXT 400,205,70,"Probe:"
  TEXT 490,205,70,b2$
  DEFLINE 1,0
  BOX 160,225,480,255
  BOX 155,220,485,260
  DEFFILL 1,2,9
  FILL 158,256
  DEFTEXT 1,16,0,17
  TEXT 170,247,100,"g-Wert ="
  BOX 350,270,580,340
  BOX 70,270,300,340
  BOX 100,275,270,295
  BOX 100,310,270,330
  BOX 380,275,550,295
  DEFTEXT 1,0,0,13
  TEXT 400,290,130," Standard "
  TEXT 120,290,130," Berechnen "
  TEXT 120,325,130,"   ADELE   "
  BOX 360,310,420,330
  BOX 435,310,495,330
  BOX 510,310,570,330
  TEXT 365,325,50,"NEUER"
  TEXT 440,325,50,"LADEN"
  TEXT 512,325,55,"SICHERN"
  DEFFILL 1,4
  FILL 72,272
  DEFFILL 1,2,16
  FILL 352,272
  DEFFILL 1,2,20
  FILL 55,55
RETURN
PROCEDURE kaufhaus
  DEFMOUSE bitmuster$
  DO
    IF MOUSEY>190 AND MOUSEY<210
      IF MOUSEK>0
        IF MOUSEX>293 AND MOUSEX<308
          p%=1
          GOSUB aufnieder1
        ENDIF
        IF MOUSEX>383 AND MOUSEX<398
          p%=2
          GOSUB aufnieder1
        ENDIF
        IF MOUSEX>473 AND MOUSEX<488
          p%=3
          GOSUB aufnieder2
        ENDIF
        IF MOUSEX>565 AND MOUSEX<578
          p%=4
          GOSUB aufnieder2
        ENDIF
      ENDIF
    ENDIF
    IF MOUSEX>100 AND MOUSEX<270
      IF MOUSEK>0
        IF MOUSEY>275 AND MOUSEY<295
          GOSUB berechnen
        ENDIF
        IF MOUSEY>310 AND MOUSEY<330
          GOTO gwertende
        ENDIF
      ENDIF
    ENDIF
    IF MOUSEY>310 AND MOUSEY<330
      IF MOUSEK>0
        IF MOUSEX>360 AND MOUSEX<420
          GOSUB dateneingabe
        ENDIF
        IF MOUSEX>435 AND MOUSEX<495
          GOSUB lade
          GOSUB gwertbeschrift
        ENDIF
        IF MOUSEX>510 AND MOUSEX<570
          GOSUB speicher
        ENDIF
      ENDIF
    ENDIF
  LOOP
  gwertende:
RETURN
PROCEDURE aufnieder1
  IF p%=1
    IF MOUSEK=1
      ADD b1,0.01
    ELSE
      ADD b1,1
    ENDIF
    PAUSE 8
  ENDIF
  IF p%=2
    IF MOUSEK=1
      SUB b1,0.01
    ELSE
      SUB b1,1
    ENDIF
    PAUSE 8
  ENDIF
  b1=ROUND(b1,2)
  b=b1*100
  b$=SPACE$(7)
  RSET b$=STR$(b)
  b1$=MID$(b$,1,5)+"."+MID$(b$,6)+" "
  TEXT 310,205,b1$
RETURN
PROCEDURE aufnieder2
  IF p%=3
    IF MOUSEK=1
      ADD b2,0.01
    ELSE
      ADD b2,1
    ENDIF
    PAUSE 8
  ENDIF
  IF p%=4
    IF MOUSEK=1
      SUB b2,0.01
    ELSE
      SUB b2,1
    ENDIF
    PAUSE 8
  ENDIF
  b2=ROUND(b2,2)
  b=b2*100
  b$=SPACE$(7)
  RSET b$=STR$(b)
  b2$=MID$(b$,1,5)+"."+MID$(b$,6)+" "
  TEXT 490,205,70,b2$
RETURN
PROCEDURE dateneingabe
  CLS
  BOX 40,50,600,360
  PRINT AT(20,8);
  PRINT AT(10,8);"Standard: ";stand1$
  PRINT AT(10,12);"g-Wert:   ";stand2$
  PRINT AT(10,16);"Kommentar:";stand3$
  PRINT AT(10,20);"Feld [ in Gauž ]:"
  PRINT AT(30,20);"Standard:  ";b1$
  PRINT AT(55,20);"Probe:    ";b2$
  PRINT AT(20,8);
  FORM INPUT 50 AS stand1$
  stand$(1)=stand1$
  PRINT AT(20,12);
  FORM INPUT 10 AS stand2$
  stand$(2)=stand2$
  PRINT AT(20,16);
  FORM INPUT 50 AS stand3$
  stand$(3)=stand3$
  PRINT AT(41,20);
  FORM INPUT 7 AS b1$
  PRINT AT(65,20);
  FORM INPUT 7 AS b2$
  b1=VAL(b1$)
  b2=VAL(b2$)
  CLS
  GOSUB muster
RETURN
PROCEDURE speicher
  LOCAL wahl$,l$,but%
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\daten\*.gwe",".gwe",wahl$
  IF wahl$=""
    GOTO schreibend
  ENDIF
  OPEN "O",#1,wahl$
  FOR n%=1 TO 3
    WRITE #1,stand$(n%)
  NEXT n%
  CLOSE
  ALERT 2,"  SOLLEN DIE PARAMETER | FILENAME UND FELDSRTŽRKEN | MIT ABGESPEICHERT WERDEN? ",1," FREILI | HŽH ",but%
  IF but%=1
    OPEN "O",#1,"G_WERT.PAR"
    WRITE #1,wahl$
    WRITE #1,b1,b2
    CLOSE
  ENDIF
  schreibend:
  DEFMOUSE bitmuster$
RETURN
PROCEDURE lade
  LOCAL wahl$,l$,but%
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\daten\*.GWE",".GWE",wahl$
  IF wahl$=""
    GOTO lesend
  ENDIF
  IF EXIST(wahl$)
    OPEN "I",#1,wahl$
    FOR i%=1 TO 3
      INPUT #1,stand$(i%)
    NEXT i%
    CLOSE
  ELSE
    ALERT 1," SORRY OPEN ERROR | | (keine Datei gefunden) ",1,"NICHT OK",but%
  ENDIF
  lesend:
  DEFMOUSE bitmuster$
RETURN
PROCEDURE berechnen
  LOCAL gwert$,g$,gstan,gwert
  gstan=VAL(stand2$)
  gwert=gstan*b1/b2
  gwert$=STR$(gwert)
  g$=SPACE$(7)
  LSET g$=MID$(gwert$,1,1)+"."+MID$(gwert$,3,5)+"000000"
  DEFTEXT 1,16,0,17
  TEXT 280,247,g$
  DEFTEXT 1,0,0,13
RETURN
'
'
PROCEDURE rausch
  LOCAL r%,x%,y%,i%,l%,maus%,bereich,r,zufall,auf,fak,rausch
  IF huell!=-1 OR bereichsplott!=-1
    CLS
    '
    BOX 49,150,601,251
    LINE 49,199,601,199
    LINE 49,251,49,265
    LINE 320,251,320,265
    LINE 601,251,601,265
    DEFFILL 1,2,14
    PBOX 100,300,550,350
    DEFTEXT 1,16,0,13
    TEXT 120,330,410," Gut gerauscht ist halb betrogen , oder ? "
    DEFTEXT 1,0,0,13
    TEXT 40,275,"0 %"
    TEXT 311,275,"50 %"
    TEXT 590,275,"100 %"
    TEXT 100,180,200," Prozent Grundrauschen :"
    DO UNTIL maus%=1
      IF MOUSEY>300 AND MOUSEY<350 AND MOUSEX>100 AND MOUSEX<550 AND MOUSEK=1
        maus%=1
      ENDIF
      IF MOUSEK=2
        maus%=1
      ENDIF
      IF INKEY$=CHR$(13)
        maus%=1
      ENDIF
      IF MOUSEY>200 AND MOUSEY<250
        x%=MOUSEX
        IF MOUSEK=1
          IF x%<600 AND x%>50
            DEFFILL 0
            BOUNDARY 0
            PBOX x%,200,600,250
            DEFFILL 1,2,17
            BOUNDARY 1
            PBOX 50,200,x%,250
            r%=x%-51
            r=ROUND(r%/5.48,2)
            TEXT 320,180,"      %"
            TEXT 320,180,r
          ENDIF
        ENDIF
      ENDIF
    LOOP
    '
    zufall=r*3
    zufall=ABS(zufall)
    CLS
    SPUT x1$
    DEFFILL 0
    BOUNDARY 0
    PBOX 28,61,612,359
    DRAW 27,210
    IF huell!=TRUE
      fa=586/sweep
      IF sweep>=simsw
        fak=fa*simsw/bi%
        anf=(sweep-simsw)/2*fa+27
        FOR i%=27 TO anf
          FOR l%=1 TO 4
            rausch=RANDOM(zufall)
            r%=210+CINT(rausch-zufall/2)
            DRAW  TO i%,r%
          NEXT l%
        NEXT i%
        FOR l%=0 TO bi%
          rausch=RANDOM(zufall)
          x%=l%*fak+anf
          y%=CINT(210+huelk%(kurve%-1,l%)*hoehe*ver)
          r%=y%+CINT(rausch-zufall/2)
          IF r%>360
            r%=360
          ENDIF
          IF r%<60
            r%=60
          ENDIF
          DRAW  TO x%,r%
        NEXT l%
        FOR i%=x% TO 612
          FOR l%=1 TO 4
            rausch=RANDOM(zufall)
            r%=210+CINT(rausch-zufall/2)
            DRAW  TO i%,r%
          NEXT l%
        NEXT i%
      ELSE
        anf=sweep/2*ppg+0.5
        start%=spekha%-INT(anf)
        bis%=spekha%+INT(anf)
        fak=586/(bis%-start%)
        FOR l%=start% TO bis%
          rausch=RANDOM(zufall)
          x%=(l%-start%)*fak+27
          y%=CINT(210+huelk%(kurve%-1,l%)*hoehe*ver)
          r%=y%+CINT(rausch-zufall/2)
          IF r%>360
            r%=360
          ENDIF
          IF r%<60
            r%=60
          ENDIF
          DRAW  TO x%,r%
        NEXT l%
      ENDIF
    ENDIF
    IF bereichsplott!=TRUE
      IF le%=0
        PRINT AT(30,14);"WAR WOHL NIX !";
        GOTO warnix
      ENDIF
      bereich%=le%-la%
      fak=586/bereich%
      bereichshalbe%=bereich%/2+la%
      IF la%>bi%
        GOTO gerade2
      ENDIF
      IF la%<0 OR la%=0
        anfang%=0
        start%=CINT(ABS(la%*fak)+27)
      ENDIF
      IF la%>0
        anfang%=la%
        start%=27
      ENDIF
      IF le%<0 OR le%=0
        gerade2:
        DRAW 27,210
        FOR i%=27 TO 612
          rausch=RANDOM(zufall)
          r%=210+CINT(rausch-zufall/2)
          IF r%>360
            r%=360
          ENDIF
          IF r%<60
            r%=60
          ENDIF
          DRAW  TO i%,r%
        NEXT i%
        gerade!=TRUE
        GOTO rauschende
      ELSE
        IF le%>bi%
          ende%=bi%
        ELSE
          ende%=le%
        ENDIF
      ENDIF
      '
      DRAW 27,210
      FOR i%=27 TO start%
        rausch=RANDOM(zufall)
        r%=210+CINT(rausch-zufall/2)
        IF r%>360
          r%=360
        ENDIF
        IF r%<60
          r%=60
        ENDIF
        DRAW  TO i%,r%
      NEXT i%
      '
      FOR l%=anfang% TO ende%
        rausch=RANDOM(zufall)
        x%=(l%-anfang%)*fak+start%
        y%=210+huelk%(kurve%-1,l%)*hoehe*ver
        r%=y%+CINT(rausch-zufall/2)
        IF r%>360
          r%=360
        ENDIF
        IF r%<60
          r%=60
        ENDIF
        DRAW  TO x%,r%
      NEXT l%
      FOR i%=x% TO 612
        rausch=RANDOM(zufall)
        r%=210+CINT(rausch-zufall/2)
        IF r%>360
          r%=360
        ENDIF
        IF r%<60
          r%=60
        ENDIF
        DRAW  TO i%,r%
      NEXT i%
    ENDIF
    rauschende:
    HIDEM
    SGET x1$
    SHOWM
  ENDIF
  warnix:
  BOUNDARY 1
  BOUNDARY 1
  '
RETURN
'
'
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
PROCEDURE laufwerk
  LOCAL l$,al%,x%,k%,i%,lx%,maus%,auswahl!
  CLS
  DEFTEXT 1,0,0,13
  l$=BIN$(BIOS(10))
  al%=GEMDOS(25)
  k%=LEN(l$)
  start:
  al%=k%-al%
  BOX 140,100,500,140
  TEXT 160,125,320," Aktuelles Laufwerk :"
  BOX 200,300,440,340
  TEXT 220,325,200," In Ordnung so ?"
  BOX 140,200,500,240
  BOX 140,40,500,80
  FOR i%=1 TO 8
    x%=140+40*i%
    LINE x%,200,x%,240
  NEXT i%
  TEXT 160,225,320,"ABCDEFGHI"
  FOR i%=k% TO 8
    x%=160+40*i%
    DEFFILL 1,2,9
    FILL x%,230,1
  NEXT i%
  x%=120+40*k%
  FOR i%=k% TO 1 STEP -1
    IF i%<>al%
      IF MID$(l$,i%,1)="0"
        DEFFILL 1,2,9
      ELSE
        DEFFILL 1,2,2
      ENDIF
      x%=160+40*(k%-i%)
      FILL x%,230,1
    ENDIF
  NEXT i%
  laufschleife:
  maus%=0
  DO UNTIL maus%>0
    IF INKEY$=CHR$(13)
      maus%=2
    ENDIF
    IF MOUSEK=1
      IF MOUSEY>200 AND MOUSEY<240 AND MOUSEX>140 AND MOUSEX<500
        auswahl!=-1
        lx%=MOUSEX
        SUB lx%,140
        DIV lx%,40
        INC lx%
        maus%=1
      ENDIF
      IF MOUSEY>300 AND MOUSEX>200 AND MOUSEX<440 AND MOUSEY<340
        maus%=2
      ENDIF
    ENDIF
  LOOP
  IF maus%=1
    IF lx%>k%
      GOTO laufschleife
    ENDIF
    DEC lx%
    IF MID$(l$,(k%-lx%),1)="0"
      GOTO laufschleife
    ELSE
      al%=lx%
    ENDIF
    CLS
    GOTO start
  ENDIF
  laufende:
  IF auswahl!=-1
    CHDRIVE lx%+1
  ENDIF
  al%=DFREE(0)
  TEXT 160,65,320,"NOCH "+STR$(al%)+" BYTE PLATZ AUF DER DISKETTE"
  GOSUB datenordner
  DO UNTIL (MOUSEK>0) OR (INKEY$>"")
  LOOP
  CLS
RETURN
'
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
PROCEDURE datenordner
  CHDIR "\"
  IF 0<>FSFIRST("daten",-1)
    MKDIR "DATEN"
  ENDIF
  CHDIR "\DATEN"
RETURN
'
' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
'
'   *****************************************************************
'    MANIPULATIOENEN MIT GEMESSENEN SPEKTREN
'   *****************************************************************
'
'
PROCEDURE esp300
  LOCAL par!,butt%,parwahl$,bu%,but%,b%,button%,btton%,buttn%,maus%
  LOCAL spek!,a$,b$,c$,parwahl$,punkt%,bakl%,d%,abut%,par$,specfile$
  LOCAL spec%,spc$,smax%,smin%,pech!,l%,i%,e%,spunkte%,f,al%,res!,abutt%,n,z%
  LOCAL bcd%,bcf%,bce%,ab%,ba%,kuck1!,kuck2!,bc%,bb%,gr,messfak,param!,dr%,x%,y%
  LOCAL laenge%
  DEFTEXT 1,0,0,13
  inpeingabe:
  ALERT 2," | WAS SOLL GELESEN WERDEN ? ",0,"PARAME| SPEKTR | NIX ",butt%
  IF butt%=3
    GOTO convende
  ENDIF
  IF butt%=1
    select1:
    IF spek!=-1
      c$=b$+".PAR"
    ELSE
      c$=""
    ENDIF
    FILESELECT "A:\*.par",c$,parwahl$
    IF parwahl$>""
      IF NOT EXIST(parwahl$)
        ALERT 1,parwahl$+":|Diese Datei existiert nicht!",1," ZURšCK  ",button%
        GOTO select1
      ENDIF
      ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++
      a$=parwahl$
      punkt%=RINSTR(a$,".")
      bakl%=RINSTR(a$,"\")
      d%=punkt%-bakl%-1
      a$=MID$(a$,bakl%+1,d%)
      IF spek!=-1
        IF a$<>b$
          ALERT 3," "+a$+" SOLL DER | PARAMETERFILE ZUM | SPEKTRENFILE "+b$+" |    SEIN ???",1," NEE | SO ISSES",abut%
          IF abut%=1
            GOTO select1
          ENDIF
        ENDIF
      ENDIF
      ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      CLR spsw,res%
      OPEN "I",#1,parwahl$
      z%=0
      DO
        INPUT #1,par$
        IF par$=""
          INC z%
        ENDIF
        EXIT IF z%=2
        PRINT par$
        IF LEFT$(par$,3)="HSW"
          spsw=ROUND(VAL(MID$(par$,4)),2)
        ENDIF
        IF LEFT$(par$,3)="GSI"
          spsw=ROUND(VAL(MID$(par$,4)),2)
        ENDIF
        IF LEFT$(par$,3)="HCF"
          cf=ROUND(VAL(MID$(par$,4)),2)
        ENDIF
        IF LEFT$(par$,3)="GST"
          lirand=ROUND(VAL(MID$(par$,4)),2)
        ENDIF
        IF LEFT$(par$,3)="RES"
          res%=VAL(MID$(par$,4))
        ENDIF
      LOOP
      IF cf=0
        CLS
        PRINT AT(20,10);" CENTERFILED IST NICHT | DEFFINIERT!! "
        PRINT AT(20,15);
        INPUT "CENTERFIELD: ";cf
      ENDIF
      IF spsw=0
        IF lirand>0
          spsw=ROUND(2*(cf-lirand),2)
        ENDIF
      ENDIF
      par!=TRUE
      CLOSE
      mess!=0
    ELSE
      GOTO inpeingabe
    ENDIF
    IF spek!=0
      GOTO inpeingabe
    ENDIF
  ENDIF
  IF butt%=2
    IF par!=FALSE
      ALERT 3," | | PARAMETER SIND NOCH  |  NICHT GELESEN !",1," OH JE |NA UND ",buttn%
      IF buttn%=1
        GOTO inpeingabe
      ENDIF
    ENDIF
    select2:
    IF par!=-1
      c$=a$+".BIN"
    ELSE
      c$=""
    ENDIF
    FILESELECT "A:\*.BIN",c$,specfile$
    IF specfile$>""
      IF NOT EXIST(specfile$)
        ALERT 1,specfile$+":|Diese Datei existiert nicht!",1," ZURšCK ",btton%
        GOTO select2
      ENDIF
      ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      b$=specfile$
      punkt%=RINSTR(b$,".")
      bakl%=RINSTR(b$,"\")
      d%=punkt%-bakl%-1
      b$=MID$(b$,bakl%+1,d%)
      IF par!=-1
        IF a$<>b$
          ALERT 3," "+a$+" SOLL DER | PARAMETERFILE ZUM | SPEKTRENFILE "+b$+" |    SEIN ???",1," NEE | SO ISSES",abut%
          IF abut%=1
            GOTO select2
          ENDIF
        ENDIF
      ENDIF
      ' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      ERASE spek%()
      DIM spec%(9000)
      ERASE spektrum%()
      ERASE dif%()
      OPEN "i",#1,specfile$
      l%=0
      laenge%=LOF(#1)
      DO
        EXIT IF laenge%-LOC(#1)<76
        INPUT #1,spc$
        IF LEFT$(spc$,2)="S1"
          FOR i%=9 TO 65 STEP 8
            INC l%
            IF l%<=9000
              spec%(l%)=VAL("&"+MID$(spc$,i%,8))
              IF spec%(l%)>smax%
                smax%=spec%(l%)
              ENDIF
              IF spec%(l%)<smin%
                smin%=spec%(l%)
              ENDIF
            ELSE
              pech!=-1
            ENDIF
          NEXT i%
        ENDIF
      LOOP
      spek!=-1
      CLOSE
      mess!=0
      CLS
      IF pech!=-1
        ALERT 3," DATEI ENTHŽLT MEHR ALS | 9000 STšTZSTELLEN DAS | KANN NICHT SEIN !",1," ENDE ",e%
        CLOSE
        GOTO convende
      ENDIF
      '
      spunkte%=l%
      ' **************** Hier wird gerechnet !
      '
      DIM spektrum%(spunkte%)
      f=ADD(ABS(smin%),smax%)/2
      f=1000000/f
      FOR i%=1 TO spunkte%
        spektrum%(i%)=CINT(spec%(i%)*f)
      NEXT i%
      ERASE spec%()
      '
      ' ******************************************************************
      '
      '
    ELSE
      GOTO inpeingabe
    ENDIF
  ENDIF
  '
  ' ***************** Hier wird �berpr�ft !
  IF par!=0
    ALERT 3," PARAMETER SIND IMMER | NOCH NICHT GELESEN! ",1,"JA DOCH | KUCKEN | NA UND ",al%
    IF al%=1
      GOTO inpeingabe
    ENDIF
    IF al%=2
      param!=-1
      GOTO kucken
    ENDIF
  ENDIF
  IF res%>0
    res!=-1
  ENDIF
  n$=STR$(spunkte%)
  res$=STR$(res%)
  IF res!=-1
    IF res%<>spunkte%
      IF res%<spunkte% AND res%<0
        ALERT 3," DAS IST JA OBER FAUL ! | | MEHR STšTZSTELLEN ("+n$+") | ALS RESOLUTION ("+res$+")",1," KO |NUN DENN ",abutt%
        IF abutt%=1
          GOTO convende
        ENDIF
      ENDIF
    ENDIF
  ENDIF
  n=spunkte%/1024
  IF n>8
    ALERT 3," DA STIMMT WAS NICHT! | ES SIND "+n$+" | STšTZSTELLEN VORHANDEN | ALSO ZUVIELE ",1,"SCH...",b%
    GOTO convende
  ENDIF
  IF n==1 OR n==2 OR n==4 OR n==8
  ELSE
    ALERT 3," DA STIMMT WAS NICHT ! | ES SIND NUR "+n$+" | STšTZSTELLEN VORHANDEN !",1,"AENDERN| GUTSO | SCH...",bu%
  ENDIF
  IF bu%=3
    GOTO convende
  ENDIF
  IF bu%=2
    ALERT 1," | DAS GIBT JA DOCH NUR | |       MIST ! ",1," JA DOCH | DENKSTE ",but%
    IF but%=1
      GOTO convende
    ELSE
      ALERT 2," ES WURDEN "+n$+" | STšTZSTELLEN GELESEN ",1," OK | NEIN ",bcd%
      IF bcd%=1
        res%=spunkte%
      ELSE
        IF res%>0
          ALERT 1," IN DER PARAMETERLISTE | IST DIE AUFL™SUNG MIT | "+res$+" ANGEGEBEN !",1," OK | NEIN ",bcf%
          IF bcf%=1
            GOTO wech
          ENDIF
        ENDIF
        PRINT AT(30,13);
        INPUT " AUFL™SUNG: ",res%
      ENDIF
      wech:
    ENDIF
  ENDIF
  IF bu%=1
    ALERT 2," ES WURDEN "+n$+" | STšTZSTELLEN GELESEN ",1," OK | NEIN ",bce%
    IF bce%=1
      res%=spunkte%
    ELSE
      IF res%>0
        ALERT 1," IN DER PARAMETERLISTE | IST DIE AUFL™SUNG MIT | "+res$+" ANGEGEBEN !",1," OK | NEIN ",bcf%
        IF bcf%=1
          GOTO wecher
        ENDIF
      ENDIF
      PRINT AT(30,13);
      INPUT " AUFL™SUNG: ",res%
    ENDIF
    wecher:
  ENDIF
  '
  IF par!=0
    ALERT 3," | PARAMETER LESEN! ",1," JA DOCH | NA UND ",ab%
    IF ab%=1
      GOTO inpeingabe
    ENDIF
  ENDIF
  def:
  IF res%=0
    ALERT 3," | DIE AUFL™SUNG IST | NICHT DEFINIERT ! ",1," KUCKEN | SETZEN | NIX DA ",ba%
    IF ba%=3
      GOTO convende
    ENDIF
    IF ba%=1
      kuck1!=-1
      GOTO kucken
    ENDIF
    IF ba%=2
      ALERT 1," ES WURDEN "+n$+" | STšTZSTELLEN GELESEN ",1," OK | NEIN ",bc%
      IF bc%=1
        res%=spunkte%
      ELSE
        PRINT AT(30,13);
        INPUT " AUFL™SUNG: ",res%
      ENDIF
      kuck1!=0
    ENDIF
  ENDIF
  IF spsw=0
    ALERT 3," | DIE SWEEP-WEITE IST | NICHT DEFINIERT ! ",1," KUCKEN | SETZEN | NIX DA ",bb%
    IF bb%=3
      GOTO convende
    ENDIF
    IF bb%=1
      kuck2!=-1
      GOTO kucken
    ENDIF
    IF bb%=2
      PRINT AT(30,13);
      INPUT " SWEEP-WEITE: ";spsw
      kuck2!=0
    ENDIF
  ENDIF
  '
  IF kuck1!=-1 OR kuck2!=-1
    kucken:
    ' *************** Hier wird gezeichnet !
    CLS
    '
    DEFLINE 1,1
    gr=150/1000000
    messfak=586/spunkte%
    DRAW 27,210
    FOR i%=1 TO spunkte%
      x%=i%*messfak+27
      y%=CINT(210-spektrum%(i%)*gr)
      DRAW  TO x%,y%
    NEXT i%
    DO UNTIL maus%=1
      IF MOUSEK>0
        maus%=1
      ENDIF
    LOOP
    IF param!=-1
      param!=0
      GOTO inpeingabe
    ENDIF
    IF kuck1!=-1 OR kuck2!=-1
      GOTO def
    ENDIF
    '
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ENDIF
  CLS
  '
  DIM spek%(res%)
  IF res%>=spunkte%
    daten%=spunkte%
  ELSE
    daten%=res%
  ENDIF
  '
  l%=1
  DO UNTIL l%=daten%+1
    spek%(l%)=spektrum%(l%)
    spek%(l%)=spektrum%(l%)
    INC l%
  LOOP
  ERASE spektrum%()
  mess$=a$
  GOSUB messpektrum
  mess!=TRUE
  messtart%=0
  MENU 38,3
  MENU 41,3
  MENU 42,3
  MENU 43,3
  ' *****************************************************************
  convende:
RETURN
'
'
'
'
PROCEDURE messlese
  LOCAL button%,wahl$,punkt%,bakl%,d%,l$
  DEFTEXT 1,0,0,13
  select3:
  l$=CHR$(GEMDOS(25)+65)
  FILESELECT l$+":\*.SPC","",wahl$
  IF wahl$>""
    IF NOT EXIST(wahl$)
      ALERT 1,wahl$+":|Diese Datei existiert nicht!",1," ZURšCK  ",button%
      GOTO select3
    ENDIF
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ERASE spek%()
    ERASE dif%()
    VOID FRE(0)
    OPEN "I",#1,wahl$
    INPUT #1,spsw,res%,cf
    DIM spek%(res%)
    BGET #1,VARPTR(spek%(0)),DIM?(spek%())*4
    CLOSE
    mess!=-1
    MENU 38,3
    MENU 41,3
    MENU 42,3
    MENU 43,3
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    punkt%=RINSTR(wahl$,".")
    bakl%=RINSTR(wahl$,"\")
    d%=punkt%-bakl%-1
    mess$=MID$(wahl$,bakl%+1,d%)
    ' +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    messtart%=0
    GOSUB messpektrum
  ENDIF
RETURN
'
'
PROCEDURE messchreiben
  LOCAL wahl$,button%,l$
  IF mess!=-1
    select4:
    l$=CHR$(GEMDOS(25)+65)
    FILESELECT l$+":\*.SPC",mess$+".SPC",wahl$
    VOID FRE(0)
    IF wahl$>""
      IF EXIST(wahl$)
        ALERT 1,wahl$+":|Diese Datei existiert schon!",1," ZURšCK | WEITER ",button%
        IF button%=1
          GOTO select4
        ENDIF
      ENDIF
      OPEN "O",#1,wahl$
      WRITE #1,spsw,res%,cf
      BPUT #1,VARPTR(spek%(0)),DIM?(spek%())*4
      CLOSE
    ENDIF
  ENDIF
RETURN
'
'
PROCEDURE messpektrum
  MENU OFF
  LOCAL i%,l%,x%,y%,gr%,maus%,dr%,y1%,pix%,ver%
  ver%=1
  DEFTEXT 1,0,0,6
  DEFLINE 1,1
  zeigen:
  gr=150/1000000
  messfak=586/res%
  DRAW 27,210
  FOR i%=1 TO res%
    x%=i%*messfak+27
    y%=CINT(210-spek%(i%)*gr)
    DRAW  TO x%,y%
  NEXT i%
  GET 27,50,613,390,aus$
  CLS
  BOX 27,60,613,360
  LINE 27,210,613,210
  LINE 27,360,27,365
  LINE 613,360,613,365
  manf=ROUND((cf-spsw/2),2)
  mend=ROUND((cf+spsw/2),2)
  TEXT 10,375,manf
  TEXT 580,375,mend
  PRINT AT(3,2);" Spektrum: ";mess$;
  PRINT AT(40,2);" Aufl”sung: ";res%;
  PRINT AT(3,5);" Gemessene Sweep-Weite: ";spsw;
  BOX 300,30,400,45
  BOX 500,30,600,45
  TEXT 310,40,80,"IN ORDNUNG ?"
  TEXT 510,40,80," VERŽNDERN "
  HIDEM
  SGET x1$
  SHOWM
  PUT 27,50,aus$,7
  maus%=0
  DO UNTIL maus%>0
    IF MOUSEK=1
      IF MOUSEY>30 AND MOUSEY<45
        IF MOUSEX>300 AND MOUSEX<400
          maus%=1
        ENDIF
        IF MOUSEX>500 AND MOUSEX<600
          maus%=2
        ENDIF
      ENDIF
    ENDIF
  LOOP
  IF maus%=2
    ALERT 2," | WAS DENN NU SCHON WIEDER ?  ",2," GR™žE | DREHEN | H™HE ",dr%
    IF dr%=1
      BOX 614,60,631,360
      LINE 615,210,630,210
      DO UNTIL MOUSEK=2
        DO WHILE MOUSEK=1
          DEFLINE 1,3
          DEFFILL 0,0
          IF MOUSEY>59 AND MOUSEY<361
            y%=MOUSEY-210
            ver%=-y%
            u%=210+y%
            o%=210-ver%
            IF u%<=210
              u%=210
            ENDIF
            IF o%>=210
              o%=210
            ENDIF
            LINE 622,210,622,210+y%
            PBOX 615,60,630,o%
            PBOX 615,360,630,u%
            DEFLINE 1,1
            BOX 614,60,631,360
            LINE 615,210,630,210
          ENDIF
        LOOP
      LOOP
      IF ver%=0
        ver%=1
      ENDIF
      mul=ver%
      mul=ABS(mul/10)
      IF mul<1
        mul=1
      ENDIF
      IF ver%<0
        mul=1/mul
      ENDIF
      '
      l%=1
      DO UNTIL l%=res%+1
        spek%(l%)=CINT(spek%(l%)*mul)
        INC l%
      LOOP
      CLS
      GOTO zeigen
    ENDIF
    IF dr%=2
      l%=1
      DO UNTIL l%=res%+1
        spek%(l%)=-spek%(l%)
        INC l%
      LOOP
      CLS
      GOTO zeigen
    ENDIF
    '
    IF dr%=3
      '
      y1%=50
      DO UNTIL MOUSEK=2
        DEFMOUSE bitmuster$
        y%=MOUSEY-y1%
        IF MOUSEK=1
          my%=MOUSEY
          DO UNTIL MOUSEK=0
            DEFMOUSE 4
            y1%=SUB(MOUSEY,y%)
            SPUT x1$
            PUT 27,y1%,aus$,7
            PAUSE 8
          LOOP
        ENDIF
      LOOP
      pix%=CINT((50-y1%)/gr)
      l%=1
      DO UNTIL l%=res%+1
        ADD spek%(l%),pix%
        INC l%
      LOOP
      CLS
      GOTO zeigen
    ENDIF
  ENDIF
  SPUT x1$
  DEFFILL 0
  PBOX 28,61,612,359
  DEFLINE 1,1
  PUT 27,50,aus$,7
  HIDEM
  SGET x1$
  SHOWM
  MENU 35,3
  MENU 36,3
  CLS
  IF simm!=-1
    MENU 44,3
  ENDIF
  mstart%=1
  mende%=res%
  messfak=586/res%
  huell!=0
  bereichsplott!=0
  simess!=0
  messplo!=-1
  messbereich!=0
  MENU 37,3
RETURN
'
PROCEDURE espspektrum
  halb!=0
  MENU OFF
  MENU 38,3
  esp:
  CLS
  LOCAL i%,x%,y%
  verg=1
  offset%=0
  IF 0=(messbereich! OR zentrier!)
    mstart%=1
    mende%=res%
    messfak=586/res%
    manf=ROUND((cf-spsw/2),2)
    mend=ROUND((cf+spsw/2),2)
  ENDIF
  GOSUB espzeichnung
  DEFTEXT 1,0,0,6
  DEFLINE 1,1
  gr=150/1000000
  BOX 27,60,613,360
  LINE 27,360,27,365
  LINE 613,360,613,365
  TEXT 10,375,ROUND(manf,2)
  TEXT 580,375,ROUND(mend,2)
  TEXT 300,375,STR$(ROUND(mend-manf,2))+" "+"Gauss"
  PRINT AT(3,2);" Spektrum: ";mess$;
  PRINT AT(40,2);" Aufl”sung: ";res%;
  PRINT AT(3,5);" Gemessene Sweep-Weite: ";spsw;
  ALERT 2," | ALLES IN ORDNUNG ? | ",1," JAJAJA | RESET ",butt%
  IF butt%=2
    messbereich!=0
    zentrier!=0
    GOTO esp
  ENDIF
  HIDEM
  SGET x1$
  SHOWM
  huell!=0
  bereichsplott!=0
  simess!=0
  messplo!=-1
RETURN
'
PROCEDURE espzeichnung
  DEFLINE 1,1
  gr=150/1000000
  DRAW 27,210-offset%
  IF mstart%<res%
    FOR i%=mstart% TO mende%
      IF i%<res%
        x%=(i%-mstart%)*messfak+27
        IF i%<1
          y%=210-offset%
        ELSE
          y%=CINT(210-offset%-spek%(i%)*gr*verg)
        ENDIF
        IF x%>=27
          IF y%>360
            y%=360
          ENDIF
          IF halb!=-1
            IF y%>210
              y%=210
            ENDIF
          ENDIF
          IF y%<60
            y%=60
          ENDIF
          DRAW  TO x%,y%
        ENDIF
        IF x%>613
          i%=mende%
        ENDIF
      ENDIF
    NEXT i%
  ENDIF
  IF simess!=-1
    HIDEM
    IF halb!=0
      GET 27,50,613,390,aus$
    ELSE
      GET 27,50,613,230,aus$
    ENDIF
    SHOWM
  ENDIF
RETURN
'
'
PROCEDURE spekmessbereich
  MENU OFF
  CLS
  LOCAL maus%,key$,x1,x2,messbereich%,li%,re%,lix,rex,auf,g1,g2
  LOCAL l%,anf
  halb!=0
  stpg=res%/spsw
  anf=manf
  messbereich!=0
  messbereichanfang:
  IF messbereich!=FALSE
    verg=1
    offset%=0
    g1=0
    g2=spsw
    mstart%=1
    mende%=res%
    messfak=586/res%
    manf=ROUND((cf-spsw/2),2)
    mend=ROUND((cf+spsw/2),2)
    DEFLINE 1,1,0,0
    BOX 27,60,613,360
    LINE 27,360,27,365
    LINE 321,360,321,365
    LINE 613,360,613,365
    DEFTEXT 1,0,0,6
    PRINT AT(3,2);" Spektrum: ";mess$;
    PRINT AT(40,2);"Aufl”sung: ";res%;
    PRINT AT(3,5);"Gemessene Sweep Width :";spsw;
    TEXT 18,375,ROUND(manf,2)
    TEXT 580,375,ROUND(mend,2)
    TEXT 300,375,STR$(ROUND(mend-manf,2))+" "+"Gauss"
    GOSUB espzeichnung
    HIDEM
    SGET x1$
    SHOWM
  ENDIF
  anf=manf
  BOX 580,35,613,55
  DEFTEXT 1,1,0,13
  TEXT 583,50,25,"ESC"
  DEFTEXT 1,1,0,6
  maus%=0
  DO
    key$=INKEY$
    IF key$=CHR$(27)
      maus%=3
    ENDIF
    IF key$=CHR$(127)
      maus%=2
    ENDIF
    IF MOUSEK>0
      maus%=1
    ENDIF
    IF MOUSEX>580 AND MOUSEY>35
      IF MOUSEX<613 AND MOUSEY<55 AND MOUSEK>0
        maus%=3
      ENDIF
    ENDIF
    EXIT IF maus%>0
    key$=""
  LOOP
  IF maus%=3
    CLS
    GOTO messbereichende
  ENDIF
  IF maus%=2
    CLS
    messbereich!=0
    GOTO messbereichanfang
  ENDIF
  HIDEM
  SGET x1$
  SHOWM
  DEFLINE 2,1,1,1
  SETMOUSE 321,200,0
  messbereich!=-1
  micks1:
  DO                      !Abfrage der linken Grenze
    SPUT x1$
    x1=MOUSEX
    li%=MOUSEX-27
    IF li%<0
      li%=0
    ENDIF
    IF li%>586
      li%=586
    ENDIF
    lix=ROUND(((g2-g1)/586*li%),2)
    PRINT AT(4,7);lix+anf
    lix=lix+g1
    COLOR 1
    LINE x1,60,x1,360
    PAUSE 5
    IF MOUSEK=1
      COLOR 1
      LINE x1,60,x1,360
      lin=1
      HIDEM
      SGET x1$
      SHOWM
    ENDIF
    EXIT IF lin=1
  LOOP
  IF x1<27 OR x1>613
    GOTO micks1
  ENDIF
  micks2:
  maus%=0
  DO
    SPUT x1$
    x2=MOUSEX
    re%=MOUSEX-27
    IF re%<0
      re%=0
    ENDIF
    IF re%>586
      re%=586
    ENDIF
    rex=ROUND(((g2-g1)/586*re%),2)
    PRINT AT(14,7);rex+anf
    rex=rex+g1
    PRINT AT(24,7);ROUND(rex-lix,2);
    COLOR 1
    LINE x2,60,x2,360
    PAUSE 5
    COLOR 1
    IF MOUSEK=2
      LINE x2,60,x2,360
      lin=2
    ENDIF
    EXIT IF lin=2
  LOOP
  IF x1=x2
    GOTO micks2
  ENDIF
  IF x2<x1 OR x2>614
    GOTO micks2
  ENDIF
  '
  '
  mstart%=CINT(lix*stpg)
  mende%=CINT(rex*stpg)
  messbereich%=mende%-mstart%
  IF messbereich%=0
    GOTO micks1
  ENDIF
  messfak=586/messbereich%
  mend=ROUND(rex+anf,2)
  manf=ROUND(lix+anf,2)
  g1=lix
  g2=rex
  '
  CLS
  DEFLINE 1,1,0,0
  BOX 27,60,613,360
  LINE 27,360,27,365
  LINE 321,360,321,365
  LINE 613,360,613,365
  DEFTEXT 1,0,0,6
  PRINT AT(3,2);" Spektrum: ";mess$;
  PRINT AT(40,2);"Aufl”sung: ";res%;
  PRINT AT(3,5);"Gemessene Sweep Width :";spsw;
  TEXT 18,375,ROUND(manf,2)
  TEXT 580,375,ROUND(mend,2)
  TEXT 300,375,STR$(ROUND((mend-manf),2))+" "+"Gauss"
  '
  GOSUB espzeichnung
  HIDEM
  SGET x1$
  SHOWM
  GOTO messbereichanfang
  '
  messbereichende:
  huell!=0
  bereichsplott!=0
  messbereich!=-1
  simess!=0
  messplo!=-1
  DEFLINE 1,1,0,0
RETURN
'
'
'
'
PROCEDURE simmess
  MENU OFF
  LOCAL altver,x%,x1%,y%,y1%,maus%,mst%,dummy%,messtart%,gpst,l%
  gpst=spsw/res%
  '
  CLS
  halb!=-1
  DEFTEXT 1,0,0,13
  BOX 80,80,520,110
  TEXT 100,100,400,"LINIENFORM DES SIMULIERTEN SPEKTRUMS"
  BOX 80,110,520,120
  DEFFILL 1,0
  PBOX 400,200,500,250
  DEFFILL 1,1
  PBOX 250,200,350,250
  TEXT 260,230,"IN ORDNUNG"
  PBOX 100,200,200,250
  TEXT 135,230,"HALB"
  TEXT 435,230,"VOLL"
  DEFLINE defl%,1
  LINE 100,115,500,115
  maus%=0
  DO UNTIL maus%=1
    IF INKEY$=CHR$(13)
      maus%=1
    ENDIF
    IF MOUSEK=1
      IF MOUSEY>80 AND MOUSEY<120
        INC defl%
        IF defl%>6
          defl%=1
        ENDIF
        DEFFILL 0,0
        PBOX 82,112,518,118
        DEFLINE defl%,1
        LINE 100,115,500,115
        PAUSE 10
      ENDIF
      IF MOUSEY>200 AND MOUSEY<250
        IF MOUSEX>400 AND MOUSEX<500
          DEFFILL 0,0
          PBOX 101,201,199,249
          TEXT 135,230,"HALB"
          DEFFILL 1,1
          PBOX 401,201,499,249
          TEXT 435,230,"VOLL"
          halb!=0
        ENDIF
        IF MOUSEX>100 AND MOUSEX<200
          DEFFILL 1,1
          PBOX 101,201,199,249
          TEXT 135,230,"HALB"
          DEFFILL 0,0
          PBOX 401,201,499,249
          TEXT 435,230,"VOLL"
          halb!=-1
        ENDIF
        IF MOUSEX>250 AND MOUSEX<350
          maus%=1
        ENDIF
      ENDIF
    ENDIF
  LOOP
  CLS
  '
  simess!=-1
  altver=ver
  IF halb!=-1
    offset%=75
    ver=0.5*ver
    verg=0.5
  ELSE
    verg=1
    offset%=0
  ENDIF
  GOSUB espzeichnung
  CLS
  IF spektrum!=-1
    GOSUB bild
  ELSE
    IF kurve%=0
      ALERT 3," KURVENFORM IST NICHT | DEFINIERT !!!!!! ",1," IS GUT ",l%
      GOTO simessende
    ENDIF
    GOSUB pinsel
  ENDIF
  '
  zentrier:
  CLS
  DEFTEXT 1,0,0,6
  DEFLINE 1,1
  SPUT x1$
  BOX 27,60,613,360
  LINE 27,55,27,365
  LINE 613,55,613,365
  LINE 321,60,321,55
  TEXT 20,370,STR$(amb)
  TEXT 600,370,STR$(mb)
  TEXT 300,370,STR$(ROUND(mb-amb,2))+" GAUSS"
  TEXT 10,55,STR$(ROUND(manf,2))
  TEXT 580,55,STR$(ROUND(mend,2))
  TEXT 300,55,STR$(ROUND(mend-manf,2))+" "+"Gauss"
  HIDEM
  SGET x1$
  SHOWM
  PUT 27,50,aus$,7
  x1%=27
  y1%=50
  beginn:
  DEFLINE 1,1
  DEFTEXT 1,0,0,6
  BOX 20,20,120,40
  BOX 250,20,350,40
  BOX 480,20,580,40
  TEXT 30,33,80,"IN ORDNUNG"
  TEXT 260,33,80,"VERSCHIEBEN"
  TEXT 490,33,80,"ZENTRIEREN"
  maus%=0
  DO UNTIL maus%>0
    IF MOUSEK=1 AND MOUSEY>20 AND MOUSEY<40
      IF MOUSEX>20 AND MOUSEX<120
        maus%=1
      ENDIF
      IF MOUSEX>250 AND MOUSEX<350
        maus%=2
      ENDIF
      IF MOUSEX>480 AND MOUSEX<580
        maus%=3
      ENDIF
    ENDIF
  LOOP
  IF maus%=1
    GOTO simessende
  ENDIF
  IF maus%=2
    DEFMOUSE 4
    DO UNTIL MOUSEK=2
      x%=MOUSEX-x1%
      y%=MOUSEY-y1%
      IF MOUSEK=1
        DO UNTIL MOUSEK=0
          x1%=SUB(MOUSEX,x%)
          y1%=SUB(MOUSEY,y%)
          IF y1%<0
            y1%=0
          ENDIF
          SPUT x1$
          PUT x1%,y1%,aus$,7
          PAUSE 8
        LOOP
      ENDIF
    LOOP
    DEFMOUSE bitmuster$
  ENDIF
  IF maus%=3
    messtart%=x1%-27
    SUB mstart%,CINT(messtart%/messfak)
    SUB mende%,CINT(messtart%/messfak)
    manf=ROUND((mstart%-1)*gpst,2)
    ADD manf,(cf-spsw/2)
    mend=ROUND((mende%-mstart%)*gpst+manf,2)
    CLS
    zentrier!=-1
    GOSUB espzeichnung
    CLS
    GOSUB pinsel
    GOTO zentrier
  ENDIF
  GOTO beginn
  simessende:
  DEFFILL 0,0
  PBOX 0,0,581,41
  TEXT 340,20,280,"simuliertes Spektrum: "+finame$
  TEXT 20,20,280,"gemessenes Spektrum : "+mess$
  TEXT 400,35,"Linienzug: "
  DEFLINE defl%,1
  LINE 500,33,600,33
  TEXT 20,35,"Linienzug: "
  DEFLINE 1,1,0,0
  LINE 120,33,220,33
  ver=altver
  offset%=0
  HIDEM
  SGET x1$
  SHOWM
  messplo!=-1
RETURN
'
'
PROCEDURE sichnum
  MENU OFF
  DEFLINE 1,1,0,0
  DEFTEXT 1,0,0,13
  LOCAL mfak,sfak,sichstart%,xpixel%,xa%,l%,x%,y%,z%,aus$,ok!,vgl
  LOCAL beschriftung$,l$,r$
  verg=1
  vgl=ver
  xpixel%=(start%-27)*2
  gr=150/1000000
  hoehe=gr
  mfak=messfak*2
  sfak=fak*2
  IF (bereichsplott! OR huell!) OR simess!
    beschriftung$="SIMULIERT: "+finame$
    l$=STR$(ROUND(amb,2))
    r$=STR$(ROUND(mb,2))
    IF messplo!=-1
      ok!=-1
      ALERT 2," | GRAPHMODE |    ? | ",2," 1 | 2 ",but%
      IF but%=1
        GRAPHMODE 1
      ELSE
        GRAPHMODE 2
      ENDIF
      IF halb!=-1
        offset%=75
        verg=0.5
        vgl=ver*0.5
      ENDIF
    ELSE
      ok!=0
      verg=1
      offset%=0
      vgl=ver
      defl%=1
    ENDIF
  ENDIF
  FOR z%=1 TO 2    !  ***********************************
    DEFLINE 1,1,0,0
    CLS
    LINE 27,60,613,60
    LINE 27,360,613,360
    IF z%=1
      IF ok!=-1
        LINE 27,50,27,380
      ELSE
        LINE 27,60,27,380
      ENDIF
      LINE 613,360,613,380
      xa%=27
      sichstart%=xa%+xpixel%
    ELSE
      IF ok!=-1
        LINE 613,50,613,380
      ELSE
        LINE 613,60,613,380
      ENDIF
      LINE 27,360,27,380
      xa%=-559
      sichstart%=xa%+xpixel%
    ENDIF
    IF messplo!=-1
      beschriftung$="GEMESSEN: "+mess$+".SPC"
      l$=STR$(ROUND(manf,2))
      r$=STR$(ROUND(mend,2))
      messspek:
      IF mstart%<res%
        IF mstart%>1
          st%=spek%(mstart%)
        ELSE
          st%=0
        ENDIF
        DRAW xa%,CINT(210-offset%-st%*gr*verg)
        FOR i%=mstart% TO mende%
          IF i%<res%
            x%=(i%-mstart%)*mfak+xa%
            IF i%<1
              y%=210-offset%
            ELSE
              y%=CINT(210-offset%-spek%(i%)*gr*verg)
            ENDIF
            IF y%>360
              y%=360
            ENDIF
            IF halb!=-1
              IF y%>210
                y%=210
              ENDIF
            ENDIF
            IF y%<60
              y%=60
            ENDIF
            IF x%>0 AND x%<640
              DRAW  TO x%,y%
            ENDIF
          ENDIF
        NEXT i%
      ENDIF
      IF ok!=-1
        GOTO simspek
      ENDIF
    ELSE
      simspek:
      DEFLINE defl%,1,0,0
      IF p_line!=-1
        LINE 27,210+offset%,613,210+offset%
        gerade!=-1
      ELSE
        gerade!=0
        DRAW xa%,210+offset%
        DRAW  TO sichstart%,210+offset%
        FOR l%=anfang% TO ende%
          x%=(l%-anfang%)*sfak+sichstart%
          y%=210+offset%+huelk%(kurve%-1,l%)*hoehe*vgl
          IF y%>360
            y%=360
          ENDIF
          IF y%<60
            y%=60
          ENDIF
          IF halb!=-1
            IF y%<210
              y%=210
            ENDIF
          ENDIF
          IF x%>0 AND x%<640
            DRAW  TO x%,y%
          ENDIF
        NEXT l%
        IF x%<613
          DRAW  TO 613,210+offset%
        ENDIF
      ENDIF
    ENDIF
    HIDEM
    GET 27,50,613,390,aus$
    SHOWM
    CLS
    PUT 27,30,aus$
    IF ok!=-1
      IF z%=1
        DEFLINE 1,1,0,0
        LINE 400,18,600,18
        BOX 400,10,600,25
        TEXT 10,25,STR$(manf)
        TEXT 150,25,200,"GEMESSEN: "+mess$+".SPC"
        TEXT 25,370,STR$(ROUND(amb,2))
      ELSE
        DEFLINE defl%,1,0,0
        LINE 300,18,500,18
        DEFLINE 1,1,0,0
        BOX 300,10,500,25
        TEXT 50,25,200,"SIMULIERT :"+finame$
        TEXT 570,25,STR$(mend)
        TEXT 600,370,STR$(ROUND(mb,2))
      ENDIF
    ELSE
      IF z%=1
        TEXT 150,25,200,beschriftung$
        TEXT 25,370,l$
      ELSE
        TEXT 50,25,200,beschriftung$
        TEXT 625-(LEN(r$)*8),370,r$
      ENDIF
    ENDIF
    HIDEM
    SGET x1$
    SHOWM
    GOSUB pixel
  NEXT z%  !***********************************************************
  DEFLINE 1,1,0,0
  offset%=0
  GRAPHMODE 1
RETURN