home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / elektro / rcl / rcl.lst < prev    next >
Encoding:
File List  |  1989-04-05  |  92.5 KB  |  3,246 lines
  1. ' Name:  RCL
  2. ' von :  H. Pape   DK2ZA   Gaußstraße 20    90459 Nürnberg    Tel.: 0911/449184
  3. '
  4. '
  5. dimensionieren_u_initialisieren
  6. '
  7. fehlereinsprung:
  8. '
  9. ON ERROR GOSUB fehlerbehandlung
  10. '
  11. '
  12. '
  13. ' Es folgt die Hauptschleife des Programms:
  14. '
  15. DO
  16.   '
  17.   IF eingabe&=1
  18.     dialogbox1
  19.   ELSE
  20.     dialogbox2
  21.   ENDIF
  22.   '
  23.   EXIT IF prog_ende&=TRUE
  24.   '
  25.   IF zeige_grafik&=TRUE
  26.     grafik_zeigen
  27.   ENDIF
  28.   '
  29.   IF zeichne_kurve&=TRUE
  30.     kurve_zeichnen
  31.   ENDIF
  32.   '
  33. LOOP
  34. '
  35. '
  36. '
  37. ' Nun die Unterprogramme:
  38. '
  39. PROCEDURE dimensionieren_u_initialisieren
  40.   '
  41.   LOCAL n&,k&
  42.   '
  43.   '
  44.   OPTION BASE 0               ! Indizes beginnen mit 0
  45.   MAT BASE 0                  ! auch bei Matrizen
  46.   '
  47.   GRAPHMODE 1                 ! ersetzen
  48.   DEFLINE 1                   ! durchgezogen
  49.   COLOR 1                     ! schwarz
  50.   '
  51.   CLIP 0,0 TO 639,399         ! nicht über den Bildrand zeichnen
  52.   '
  53.   '
  54.   ' Hier werden globale Konstanten dimensioniert und vorbelegt:
  55.   '
  56.   '
  57.   anzahl_bef&=20              ! Es gibt 20 Befehle
  58.   '
  59.   DIM befehl$(anzahl_bef&)    ! Liste mit den Namen der Befehle
  60.   '
  61.   FOR n&=0 TO anzahl_bef&     ! Die Namen der Befehle lesen
  62.     READ befehl$(n&)
  63.   NEXT n&
  64.   '
  65.   DATA "     ","R    ","C    ","L    ","ser  "
  66.   DATA "par  ","dup  ","sto  ","rcl  ","/    "
  67.   DATA "*    ","drop ","swap ","over ","rot  "
  68.   DATA "inv  ","+    ","-    ","cstk ","~~~~~"
  69.   DATA "conj "
  70.   '
  71.   '
  72.   DIM box&(29)                ! Zu jedem der 30 Items in Dialogbox 1
  73.   '                             steht hier die Nummer der Rasterzeile
  74.   FOR n&=0 TO 29              ! der obersten Linie des umgebenden
  75.     READ box&(n&)             ! Kastens ( Breite ist bei allen gleich )
  76.   NEXT n&
  77.   '
  78.   '     0  1   2   3   4   5   6   7   8   9  10  11  12  13  14
  79.   DATA 56,56,105,105,105,137,137,169,169,169,169,169,201,201,249
  80.   '     15  16  17  18  19  20  21  22  23  24  25  26  27  28  29
  81.   DATA 249,249,297,297,297,297,297,329,329,329,329,361,361,361,361
  82.   '
  83.   '
  84.   DIM n_item&(29,6)           ! n_item&() enthält zu jedem Item
  85.   '                             von Dialogbox 1 die
  86.   FOR n&=0 TO 29              ! Cursorposition (x,y) und die Nummer
  87.     FOR k&=0 TO 6             ! des Items, welches nach Betätigung
  88.       READ n_item&(n&,k&)     ! der Pfeiltasten bzw. der Return-
  89.     NEXT k&                   ! Taste als nächstes zur Eingabe
  90.   NEXT n&                     ! angeboten wird
  91.   '
  92.   '  x, y, Pfeilrichtung links, rechts, rauf, runter, Return
  93.   '
  94.   ' item1&=0                                   f_min
  95.   DATA 11,5,0,1,0,2,1
  96.   ' item1&=1                                   f_max
  97.   DATA 52,5,0,1,1,3,2
  98.   ' item1&=2                                   maximaler Betrag bzw. SWR
  99.   DATA 27,8,2,3,0,5,5
  100.   ' item1&=3                                   nicht automatisch festlegen
  101.   DATA 69,8,2,4,1,6,5
  102.   ' item1&=4                                   automatisch festlegen
  103.   DATA 76,8,3,4,1,6,5
  104.   ' item1&=5                                   maximale Dämpfung
  105.   DATA 27,10,5,6,2,7,6
  106.   ' item1&=6                                   Wellenwiderstand
  107.   DATA 67,10,5,6,3,9,7
  108.   ' item1&=7                                   Betrag /
  109.   DATA 3,12,7,8,5,12,9
  110.   ' item1&=8                                          / SWR
  111.   DATA 12,12,7,9,5,12,9
  112.   ' item1&=9                                   Betrag / SWR darstellen nein
  113.   DATA 40,12,8,10,6,12,12
  114.   ' item1&=10                                  Betrag / SWR darstellen lin
  115.   DATA 49,12,9,11,6,12,12
  116.   ' item1&=11                                  Betrag / SWR darstellen log
  117.   DATA 57,12,10,11,6,12,12
  118.   ' item1&=12                                  Phasenwinkel darstellen nein
  119.   DATA 40,14,12,13,9,14,14
  120.   ' item1&=13                                  Phasenwinkel darstellen ja
  121.   DATA 49,14,12,13,9,14,14
  122.   ' item1&=14                                  Schrittweite
  123.   DATA 31,17,14,15,12,17,15
  124.   ' item1&=15                                  Frequenzachsenteilung lin
  125.   DATA 69,17,14,16,12,17,17
  126.   ' item1&=16                                  Frequenzachsenteilung log
  127.   DATA 75,17,15,16,12,17,17
  128.   ' item1&=17                                  Befehlsfolge laden
  129.   DATA 25,20,17,18,14,22,22
  130.   ' item1&=18                                  Befehlsfolge anhängen
  131.   DATA 34,20,17,19,14,23,14
  132.   ' item1&=19                                  Befehlsfolge speichern
  133.   DATA 46,20,18,20,14,24,23
  134.   ' item1&=20                                  Befehlsfolge drucken
  135.   DATA 59,20,19,21,14,25,14
  136.   ' item1&=21                                  Befehlsfolge löschen
  137.   DATA 71,20,20,21,14,25,14
  138.   ' item1&=22                                  Bauteile laden
  139.   DATA 25,22,22,23,17,26,14
  140.   ' item1&=23                                  Bauteile speichern
  141.   DATA 34,22,22,24,18,27,14
  142.   ' item1&=24                                  Bauteile drucken
  143.   DATA 47,22,23,25,19,28,14
  144.   ' item1&=25                                  Bauteile löschen
  145.   DATA 59,22,24,25,20,29,14
  146.   ' item1&=26                                  Grafik laden
  147.   DATA 25,24,26,27,22,26,14
  148.   ' item1&=27                                  Grafik speichern
  149.   DATA 34,24,26,28,23,27,14
  150.   ' item1&=28                                  Grafik drucken
  151.   DATA 47,24,27,29,24,28,14
  152.   ' item1&=29                                  Grafik löschen
  153.   DATA 59,24,28,29,25,29,14
  154.   '
  155.   '
  156.   DIM li_ob&(3)               ! Diese Liste enthält für Dialogbox 2
  157.   '                             ( Befehle und Bauteilwerte )
  158.   FOR n&=0 TO 3               ! die x-Werte des ersten Zeichens der
  159.     READ li_ob&(n&)           ! jeweiligen Befehls- bzw. Wertespalte
  160.   NEXT n&
  161.   '
  162.   DATA 4,23,43,63
  163.   '
  164.   '
  165.   ' Diese Festlegungen sollen das Listing besser lesbar machen:
  166.   '
  167.   nein&=0
  168.   lin&=1
  169.   log&=2
  170.   weiss&=0
  171.   schwarz&=1
  172.   '
  173.   '
  174.   ' Hier stehen die bei INP(2) von der jeweiligen Taste gelieferten Nummern:
  175.   '
  176.   backspace&=8
  177.   return&=13
  178.   esc&=27
  179.   leertaste&=32
  180.   jk&=106                     ! Taste j ( klein )
  181.   jg&=74                      ! Taste J ( groß )
  182.   delete&=127
  183.   eins&=49
  184.   zwei&=50
  185.   drei&=51
  186.   f1&=187
  187.   f2&=188
  188.   f3&=189
  189.   f4&=190
  190.   f5&=191
  191.   f7&=193
  192.   f10&=196
  193.   clrhome&=199
  194.   auf&=200
  195.   ab&=208
  196.   links&=203
  197.   rechts&=205
  198.   insert&=210
  199.   undo&=225
  200.   help&=226
  201.   control_clrhome&=247
  202.   '
  203.   '
  204.   ' Hier werden globale Variable dimensioniert und vorbelegt:
  205.   '
  206.   '
  207.   DIM r(99),c(99),l(99)       ! Speicher für Bauteilwerte R, C, L
  208.   DIM bauteil(99)             ! Zwischenspeicher zur Bearbeitung
  209.   DIM sp_r(99),sp_i(99)       ! sto - rcl - Speicher für komplexe Zahlen
  210.   '                             sp_r(): Realteil,  sp_i(): Imaginärteil
  211.   DIM st_r(99),st_i(99)       ! Rechenstapel für komplexe Zahlen
  212.   DIM befehl&(999)            ! Befehlsfolge. Jedes 16 Bit Wort dieser
  213.   '                             Liste enthält einen der eingegebenen
  214.   '                             Befehle evtl. mit der dazugehörigen
  215.   '                             Speicher- oder Bauteilnummer
  216.   DIM betr_swr(639)           ! Wenn der Maximalwert von Betrag / SWR
  217.   '                             automatisch bestimmt werden soll, werden
  218.   '                             die berechneten Werte Werte zuerst hier
  219.   '                             gespeichert
  220.   DIM anzahl&(255)            ! Wenn ein Bild komprimiert gespeichert wird,
  221.   '                             brauchen wir diese Liste, um das seltenste
  222.   '                             Byte zu finden
  223.   DIM oberst&(3)              ! Nummern der Befehle bzw. der Bauteile in den
  224.   '                             obersten Zeilen der 4 Spalten von Dialogbox 2
  225.   DIM zeile&(3)               ! Cursorzeile in der jeweiligen Spalte
  226.   '
  227.   DIM linie(9)                ! legt bei logarithmischer Teilung der
  228.   FOR n&=0 TO 9               ! Frequenzachse fest, welche Teilungslinien
  229.     READ linie(n&)            ! gezeichnet werden sollen. Hier:
  230.   NEXT n&                     ! ... 0,1 0,2 0,3 0,4 0,5 0,6 0,7 0,8 0,9 1 2
  231.   '                               3 4 5 6 7 8 9 10 20 30 40 50 60 70 80 ...
  232.   DATA -1,1.5,-2,-3,-4,-5,-6,-7,-8,-9
  233.   '
  234.   ' Es folgen Bitmuster für die verschiedenen Arten von Teilungslinien
  235.   '
  236.   DIM strich%(7)
  237.   strich%(0)=&X11111111111111110000000000000001   !  Eingabe als
  238.   strich%(1)=&X11111111111111110011001100110100   ! = -%1100110011001100
  239.   strich%(2)=&X11111111111111110000111100010000
  240.   strich%(3)=&X11111111111111110000000100000000
  241.   strich%(4)=&X11111111111111110000000000010000
  242.   strich%(5)=&X11111111111111110000011100001000
  243.   strich%(6)=&X11111111111111111111100011111001
  244.   strich%(7)=&X11111111111111110011111101000000
  245.   '
  246.   linienstilf&=0              ! Linienstil für Frequenzteilung
  247.   linienstild&=0              ! Linienstil für Dämpfungslinien
  248.   '
  249.   eingabe&=1                  ! Dialogbox 1: Allgemeine Eingaben
  250.   '                             Dialogbox 2: Befehle und Bauteile eingeben
  251.   '
  252.   antw&=0                     ! Antwortvariable bei Alarmboxen
  253.   '
  254.   streifen$=""                ! String als Zwischenspeicher beim Scrollen
  255.   '                             der Spalten in Dialogbox 2
  256.   item2&=0                    ! beim nächsten Aufruf der Eingaberoutine für
  257.   '                             Befehle und Werte (Dialogbox 2) wird der
  258.   '                             Cursor auf die Spalte item2& gesetzt (0..3)
  259.   item1&=17                   ! beim nächsten Aufruf der Eingaberoutine
  260.   '                             für allgemeine Eingaben (Dialogbox 1) wird
  261.   '                             der Cursor auf dieses item1& gesetzt
  262.   '
  263.   nullpkt_neu&=FALSE          ! Flag, falls 1 wurde der Koordinatenursprung
  264.   '                             ( bei Darstellung mit F5 ) verschoben
  265.   x0&=0                       ! Koordinatenursprung
  266.   y0lin&=0                    ! für "anschauen" ( Taste F5 )
  267.   y0log&=0
  268.   '
  269.   f_min=0                     ! Frequenzuntergrenze
  270.   f_max=10000000              ! Frequenzobergrenze
  271.   f_achse&=lin&               ! Teilung der Frequenzachse
  272.   frequenzlinien&=FALSE       ! Frequenzteilung nicht zeichnen ( bei log )
  273.   betr_swr_max=2              ! am oberen Bildrand
  274.   betr_swr_auto&=FALSE        ! kann man in Dialogbox 1 ändern
  275.   daempf_max=60               ! Dämpfung am unteren Bildrand bei
  276.   '                             logarithmischer Darstellung in dB
  277.   daempfungslinien&=FALSE     ! dB - Linien nicht zeichnen ( bei log )
  278.   wellenwiderstand=50         ! für SWR- Berechnung
  279.   schrittweite&=4             ! 640/4=160 Berechnungen, dazwischen linear
  280.   befehlz&=0                  ! zeigt auf aktuellen Befehl in Befehlsfolge
  281.   betrag_darst&=TRUE          ! kann man in Dialogbox 1 ändern
  282.   '                             wenn FALSE, wird das SWR dargestellt
  283.   betr_swr_darst&=lin&        ! dito
  284.   phase_darst&=FALSE          ! dito
  285.   prog_ende&=FALSE            ! wird mit Esc auf TRUE gesetzt
  286.   zeige_grafik&=FALSE         ! wird mit F5 auf TRUE gesetzt
  287.   zeichne_kurve&=FALSE        ! wird mit F10 auf TRUE gesetzt
  288.   kurve$=STRING$(32000,0)     ! in kurve$ wird der Bildschirm mit der
  289.   '                             Kurve aber ohne Gitter aufgehoben
  290.   bild$=STRING$(32000,0)      ! in bild$ wird der Bildschirm mit Kurve
  291.   '                             und Gitter aufgehoben (für F5)
  292.   dialogbox2_neu&=TRUE        ! wird FALSE gesetzt, nachdem die betreffende
  293.   dialogbox1_neu&=TRUE        ! Dialogbox gezeichnet und als Bild
  294.   '                             gespeichert ist
  295.   dialogbox2$=STRING$(32000,0)       ! Enthält den Bildschirm für Dialogbox 2
  296.   '                                    (Befehls- und Werteeingabe)
  297.   dialogbox1$=STRING$(32000,0)       ! Enthält den Bildschirm für Dialogbox 1
  298.   '                                    (übrige Eingaben)
  299.   '
  300.   '
  301.   ' Hier folgen die Vorgaben für Pfade und Dateinamen:
  302.   '
  303.   pfad$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\"
  304.   dnam$="TEST"
  305.   datei$=""
  306.   '
  307. RETURN
  308. '
  309. PROCEDURE dialogbox1
  310.   '
  311.   LOCAL w,taste&,k&,n&,raus&,e&
  312.   '
  313.   GRAPHMODE 1
  314.   COLOR schwarz&
  315.   '
  316.   IF dialogbox1_neu&=TRUE
  317.     '
  318.     CLS
  319.     PRINT
  320.     PRINT " andere Eingaben: F1   anschauen: F5";
  321.     PRINT "   zeichnen: F10   Hilfe: Help    Ende: Esc"
  322.     PRINT
  323.     PRINT
  324.     PRINT "  f min = ";FN wert$(f_min,12,0);"Hz";
  325.     PRINT TAB(43);"f max = ";FN wert$(f_max,12,0);"Hz"
  326.     PRINT
  327.     PRINT
  328.     PRINT "  Betrag / SWR   max.   = ";
  329.     betr_swr_drucken(betr_swr_max)
  330.     PRINT TAB(43);"automatisch einstellen:  nein / ja"
  331.     PRINT
  332.     PRINT "  Dämpfung       max.   =  ";daempf_max;" dB";
  333.     PRINT TAB(43);"Wellenwiderstand   =   ";
  334.     PRINT STR$(wellenwiderstand,7,2);" Ohm"
  335.     PRINT
  336.     PRINT "  Betrag / SWR    darstellen:          nein  /  lin  /  log"
  337.     PRINT
  338.     PRINT "  Phasenwinkel    darstellen:          nein  /  ja"
  339.     PRINT
  340.     PRINT
  341.     PRINT "  Schrittweite ( 1 ... 9 )  = ";schrittweite&;
  342.     PRINT "        Teilung der Frequenzachse    lin / log"
  343.     PRINT
  344.     PRINT
  345.     PRINT "  Befehlsfolge  ";
  346.     PRINT "        laden  / anhängen  / speichern /  drucken  /  löschen"
  347.     PRINT
  348.     PRINT "  Bauteile      ";
  349.     PRINT "        laden  / speichern /  drucken  /  löschen"
  350.     PRINT
  351.     PRINT "  Grafik        ";
  352.     PRINT "        laden  / speichern /  drucken  /  löschen  ( oder F3 )"
  353.     '
  354.     RESTORE tabelle
  355.     '
  356.     FOR n&=0 TO 8
  357.       READ k&
  358.       BOX 5,k&,634,k&+32
  359.     NEXT n&
  360.     '
  361.   tabelle:
  362.     DATA 56,105,137,169,201,249,297,329,361
  363.     '
  364.     SGET dialogbox1$                        ! Bildschirm aufheben
  365.     dialogbox1_neu&=FALSE
  366.     '
  367.   ELSE
  368.     SPUT dialogbox1$
  369.     PRINT AT(n_item&(2,0),n_item&(2,1));
  370.     betr_swr_drucken(betr_swr_max)
  371.   ENDIF
  372.   '
  373.   raus&=FALSE
  374.   '
  375.   DO
  376.     '
  377.     IF betr_swr_auto&=FALSE                 ! Unterstreichungen
  378.       COLOR schwarz&
  379.       BOX 541,130,578,131
  380.       COLOR weiss&
  381.       BOX 599,130,617,131
  382.     ELSE
  383.       COLOR schwarz&
  384.       BOX 599,130,617,131
  385.       COLOR weiss&
  386.       BOX 541,130,578,131
  387.     ENDIF
  388.     '
  389.     IF betrag_darst&=TRUE
  390.       COLOR schwarz&
  391.       BOX 13,194,64,195
  392.       COLOR weiss&
  393.       BOX 86,194,112,195
  394.     ELSE
  395.       COLOR schwarz&
  396.       BOX 86,194,112,195
  397.       COLOR weiss&
  398.       BOX 13,194,64,195
  399.     ENDIF
  400.     '
  401.     IF betr_swr_darst&=nein&
  402.       COLOR schwarz&
  403.       BOX 310,194,345,195
  404.       COLOR weiss&
  405.       BOX 382,194,410,195
  406.       BOX 447,194,473,195
  407.     ELSE IF betr_swr_darst&=lin&
  408.       COLOR schwarz&
  409.       BOX 382,194,410,195
  410.       COLOR weiss&
  411.       BOX 310,194,345,195
  412.       BOX 447,194,473,195
  413.     ELSE
  414.       COLOR schwarz&
  415.       BOX 447,194,473,195
  416.       COLOR weiss&
  417.       BOX 382,194,410,195
  418.       BOX 310,194,345,195
  419.     ENDIF
  420.     '
  421.     IF phase_darst&=FALSE
  422.       COLOR schwarz&
  423.       BOX 310,226,345,227
  424.       COLOR weiss&
  425.       BOX 382,226,402,227
  426.     ELSE
  427.       COLOR schwarz&
  428.       BOX 382,226,402,227
  429.       COLOR weiss&
  430.       BOX 310,226,345,227
  431.     ENDIF
  432.     '
  433.     IF f_achse&=lin&
  434.       COLOR schwarz&
  435.       BOX 543,274,569,275
  436.       COLOR weiss&
  437.       BOX 591,274,617,275
  438.     ELSE
  439.       COLOR schwarz&
  440.       BOX 591,274,617,275
  441.       COLOR weiss&
  442.       BOX 543,274,569,275
  443.     ENDIF
  444.     '
  445.     n&=box&(item1&)+1
  446.     COLOR schwarz&
  447.     BOX 6,n&,633,n&+30
  448.     BOX 7,n&+1,632,n&+29
  449.     '
  450.     LOCATE n_item&(item1&,0),n_item&(item1&,1)
  451.     taste_holen(taste&)
  452.     '
  453.     SELECT taste&
  454.       '
  455.     CASE links&
  456.       item1&=n_item&(item1&,2)
  457.     CASE rechts&
  458.       item1&=n_item&(item1&,3)
  459.     CASE auf&
  460.       item1&=n_item&(item1&,4)
  461.     CASE ab&
  462.       item1&=n_item&(item1&,5)
  463.     CASE return&
  464.       '
  465.       SELECT item1&
  466.         '
  467.       CASE 3
  468.         betr_swr_auto&=FALSE
  469.       CASE 4
  470.         betr_swr_auto&=TRUE
  471.       CASE 7
  472.         betrag_darst&=TRUE
  473.       CASE 8
  474.         betrag_darst&=FALSE
  475.       CASE 9
  476.         betr_swr_darst&=nein&
  477.       CASE 10
  478.         betr_swr_darst&=lin&
  479.       CASE 11
  480.         betr_swr_darst&=log&
  481.       CASE 12
  482.         phase_darst&=FALSE
  483.       CASE 13
  484.         phase_darst&=TRUE
  485.       CASE 15
  486.         f_achse&=lin&
  487.       CASE 16
  488.         f_achse&=log&
  489.       CASE 17
  490.         befehle_laden
  491.         raus&=TRUE
  492.       CASE 18
  493.         befehle_anhaengen
  494.         raus&=TRUE
  495.       CASE 19
  496.         befehle_speichern
  497.       CASE 20
  498.         befehle_drucken
  499.       CASE 21
  500.         befehle_loeschen
  501.       CASE 22
  502.         bauteile_laden
  503.         raus&=TRUE
  504.       CASE 23
  505.         bauteile_speichern
  506.       CASE 24
  507.         bauteile_drucken
  508.       CASE 25
  509.         bauteile_loeschen
  510.       CASE 26
  511.         grafik_laden
  512.         raus&=TRUE
  513.       CASE 27
  514.         grafik_speichern
  515.         SPUT dialogbox1$
  516.       CASE 28
  517.         grafik_drucken
  518.       CASE 29
  519.         grafik_loeschen
  520.       ENDSELECT
  521.       item1&=n_item&(item1&,6)
  522.       '
  523.     CASE f1&
  524.       raus&=TRUE
  525.       eingabe&=2
  526.       '
  527.     CASE f3&
  528.       grafik_loeschen
  529.       '
  530.     CASE f5&
  531.       zeige_grafik&=TRUE
  532.       raus&=TRUE
  533.       '
  534.     CASE f10&
  535.       raus&=TRUE
  536.       zeichne_kurve&=TRUE
  537.       '
  538.     CASE help&
  539.       help_bearbeitung
  540.       '
  541.     CASE esc&
  542.       alarmbox("| Programm beenden ? |||       j / n|")
  543.       IF antw&=jk& OR antw&=jg&
  544.         prog_ende&=TRUE
  545.         raus&=TRUE
  546.       ENDIF
  547.       '
  548.     CASE 44,46,48 TO 57              ! Punkt, Komma oder Ziffern 0 ... 9 ?
  549.       FOR k&=0 TO 20
  550.         KEYPRESS delete&
  551.       NEXT k&
  552.       IF taste&=44 OR taste&=46      ! Punkt oder Komma ?
  553.         KEYPRESS 48                  ! dann eine 0 voransetzen
  554.       ENDIF
  555.       KEYPRESS taste&
  556.       '
  557.       SELECT item1&
  558.       CASE 0
  559.         e$="                    "
  560.         FORM INPUT 20 AS e$
  561.         e$=TRIM$(e$)
  562.         f_min=FN wert(e$)
  563.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));
  564.         PRINT FN wert$(f_min,12,0);"Hz     "
  565.       CASE 1
  566.         e$="                    "
  567.         FORM INPUT 20 AS e$
  568.         e$=TRIM$(e$)
  569.         f_max=FN wert(e$)
  570.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));
  571.         PRINT FN wert$(f_max,12,0);"Hz     "
  572.       CASE 2
  573.         e$="          "
  574.         FORM INPUT 10 AS e$
  575.         betr_swr_max=FN wert(e$)
  576.         IF betr_swr_max=0
  577.           betr_swr_max=2
  578.           PRINT CHR$(7);
  579.         ENDIF
  580.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));
  581.         betr_swr_drucken(betr_swr_max)
  582.         betr_swr_auto&=FALSE
  583.       CASE 5
  584.         e$=" "
  585.         FORM INPUT 3 AS e$
  586.         daempf_max=ABS(VAL(e$))
  587.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));STR$(daempf_max,3);
  588.       CASE 6
  589.         e$="      "
  590.         FORM INPUT 6 AS e$
  591.         w=FN wert(e$)
  592.         IF w<9999 AND w>0.01
  593.           wellenwiderstand=w
  594.         ELSE
  595.           PRINT CHR$(7);
  596.         ENDIF
  597.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));
  598.         PRINT STR$(wellenwiderstand,7,2);
  599.       CASE 14
  600.         IF taste&>48 AND taste&<58
  601.           schrittweite&=taste&-48
  602.         ENDIF
  603.         PRINT AT(n_item&(item1&,0),n_item&(item1&,1));schrittweite&
  604.       ENDSELECT
  605.       '
  606.       REPEAT                         ! sonst Gefahr einer Endlosschleife
  607.       UNTIL INKEY$=""                ! bei Eingabe von Delete etc.
  608.       '
  609.       item1&=n_item&(item1&,6)
  610.       '
  611.     ENDSELECT
  612.     '
  613.     IF n&<>box&(item1&)+1 OR raus&=TRUE
  614.       COLOR weiss&
  615.       BOX 6,n&,633,n&+30
  616.       BOX 7,n&+1,632,n&+29
  617.     ENDIF
  618.     '
  619.     SGET dialogbox1$
  620.     EXIT IF raus&=TRUE
  621.     '
  622.   LOOP
  623.   '
  624. RETURN
  625. '
  626. PROCEDURE dialogbox2
  627.   '
  628.   LOCAL a$,e$,element%,raus&,einf&,itemalt&,listenlaenge&,flag&
  629.   LOCAL li&,zeile&,taste&,n&
  630.   '
  631.   GRAPHMODE 1                                      ! normal
  632.   COLOR schwarz&
  633.   '
  634.   IF dialogbox2_neu&=TRUE                          ! Dialogbox 2 aufbauen
  635.     '
  636.     CLS
  637.     PRINT
  638.     PRINT " andere Eingaben: F1   anschauen: F5";
  639.     PRINT "   zeichnen: F10   Hilfe: Help    Ende: Esc"
  640.     a$="       Befehle          R in Ohm            C in Far"
  641.     TEXT 10,71,a$+"ad         L in Henry"
  642.     PRINT CHR$(esc&);"f";                          ! Cursor aus
  643.     '
  644.     schreibe_spalte(0)
  645.     '
  646.     MAT CPY bauteil()=r()
  647.     schreibe_spalte(1)
  648.     '
  649.     MAT CPY bauteil()=c()
  650.     schreibe_spalte(2)
  651.     '
  652.     MAT CPY bauteil()=l()
  653.     schreibe_spalte(3)
  654.     '
  655.     COLOR schwarz&
  656.     BOX 5,50,635,76
  657.     BOX 5,76,635,339
  658.     DRAW 159,51 TO 159,338
  659.     DRAW 316,51 TO 316,338
  660.     DRAW 473,51 TO 473,338
  661.     '
  662.     PRINT AT(3,23);"Steuertasten:       Pfeile,  Insert,  Delete,  ";
  663.     PRINT "Backspace,  Clr Home,  Return"
  664.     a$="Eine ganze Bauteilspalte löschen :    Control/Clr Home"
  665.     TEXT 80,387,a$
  666.     '
  667.     dialogbox2_neu&=FALSE
  668.     SGET dialogbox2$                        ! Dialogbox 2 speichern
  669.     '
  670.   ELSE
  671.     SPUT dialogbox2$                        ! schneller als Neuaufbau
  672.   ENDIF
  673.   '
  674.   raus&=FALSE
  675.   flag&=FALSE
  676.   einf&=FALSE
  677.   '
  678.   DO
  679.     '
  680.     itemalt&=item2&
  681.     '
  682.     COLOR schwarz&
  683.     '
  684.     LET listenlaenge&=99             ! 0..99 Bauteile, aber 0..999 Befehle
  685.     IF item2&=0
  686.       BOX 6,77,158,338               ! fette Umrandung
  687.       BOX 7,78,157,337
  688.       LET listenlaenge&=999
  689.     ELSE IF item2&=1
  690.       BOX 160,77,315,338
  691.       BOX 161,78,314,337
  692.       MAT CPY bauteil()=r()          ! kopieren zur Bearbeitung
  693.     ELSE IF item2&=2
  694.       BOX 317,77,472,338
  695.       BOX 318,78,471,337
  696.       MAT CPY bauteil()=c()
  697.     ELSE IF item2&=3
  698.       BOX 474,77,634,338
  699.       BOX 475,78,633,337
  700.       MAT CPY bauteil()=l()
  701.     ENDIF
  702.     '
  703.     li&=li_ob&(item2&)*8-8           ! linke obere Ecke der Spalte (x-Wert)
  704.     '
  705.     FOR zeile&=0 TO 15               ! die aktuelle Spalte neu schreiben
  706.       schreibe_befehl_oder_wert(item2&,zeile&)
  707.     NEXT zeile&
  708.     '
  709.     REPEAT
  710.       '
  711.       ' in dieser Schleife geht es nur in einer der vier Spalten
  712.       ' rauf und runter
  713.       '
  714.       ' nun plazieren wir den Cursor in der aktuellen Spalte item2&
  715.       ' auf zeile&(item2&) :
  716.       '
  717.       LOCATE li_ob&(item2&)+5,zeile&(item2&)+6
  718.       '
  719.       IF flag&=FALSE
  720.         taste_holen(taste&)
  721.       ELSE
  722.         taste&=insert&
  723.       ENDIF
  724.       '
  725.       IF taste&=auf&                               ! Pfeil nach oben ?
  726.         DEC zeile&(item2&)                         ! Cursor nach oben
  727.         IF zeile&(item2&)<0                        ! mit Anschlag
  728.           zeile&(item2&)=0
  729.           DEC oberst&(item2&)                      ! Spalte nach unten
  730.           IF oberst&(item2&)<0
  731.             oberst&(item2&)=0
  732.           ELSE
  733.             GET li&,80,li&+128,319,streifen$
  734.             PUT li&,96,streifen$
  735.             schreibe_befehl_oder_wert(item2&,0)
  736.           ENDIF
  737.         ENDIF
  738.       ENDIF
  739.       '
  740.       element%=befehl&(oberst&(0)+zeile&(0))       ! 16 Bit
  741.       IF item2&>0
  742.         element%=1
  743.       ENDIF
  744.       '
  745.       IF (taste&=ab& OR taste&=return&) AND (element%>0)
  746.         INC zeile&(item2&)
  747.         IF zeile&(item2&)>15
  748.           zeile&(item2&)=15
  749.           INC oberst&(item2&)
  750.           IF oberst&(item2&)>listenlaenge&-15
  751.             oberst&(item2&)=listenlaenge&-15       ! Spalte nach oben
  752.           ELSE
  753.             GET li&,96,li&+128,336,streifen$
  754.             PUT li&,80,streifen$
  755.             schreibe_befehl_oder_wert(item2&,15)
  756.           ENDIF
  757.         ENDIF
  758.       ENDIF
  759.       '
  760.       flag&=FALSE
  761.       IF taste&=ab& AND einf&=TRUE
  762.         flag&=TRUE
  763.       ENDIF
  764.       '
  765.     UNTIL taste&<>auf& AND taste&<>ab& AND taste&<>return&
  766.     '
  767.     SELECT taste&
  768.       '
  769.     CASE clrhome&
  770.       oberst&(item2&)=0                     ! ganz nach oben
  771.       zeile&(item2&)=0
  772.       '
  773.     CASE control_clrhome&
  774.       oberst&(item2&)=0                     ! ganze Bauteilspalte löschen
  775.       zeile&(item2&)=0
  776.       IF item2&=1
  777.         ARRAYFILL r(),0
  778.       ELSE IF item2&=2
  779.         ARRAYFILL c(),0
  780.       ELSE IF item2&=3
  781.         ARRAYFILL l(),0
  782.       ENDIF
  783.       '
  784.     CASE links&                             ! eine Spalte nach links
  785.       DEC item2&
  786.       IF item2&<0
  787.         item2&=0
  788.       ENDIF
  789.       '
  790.     CASE rechts&                            ! eine Spalte nach rechts
  791.       INC item2&
  792.       IF item2&>3
  793.         item2&=3
  794.       ENDIF
  795.       '
  796.     CASE delete&
  797.       IF item2&=0
  798.         DELETE befehl&(oberst&(item2&)+zeile&(item2&))    ! ganzen Befehl
  799.       ELSE                                                ! löschen
  800.         bauteil(oberst&(item2&)+zeile&(item2&))=0         ! ganzes Bauteil
  801.         aenderungen_merken                                ! löschen
  802.       ENDIF
  803.       '
  804.     CASE insert&
  805.       IF item2&=0
  806.         IF befehl&(999)=0
  807.           einf&=TRUE
  808.           INSERT befehl&(oberst&(0)+zeile&(0))=0          ! Befehl einfügen
  809.           KEYPRESS leertaste&
  810.         ELSE
  811.           alarmbox("|  Kein Platz mehr !  |||       Taste !|")
  812.           einf&=FALSE
  813.           flag&=FALSE
  814.         ENDIF
  815.       ENDIF
  816.       '
  817.     CASE f1&                                       ! zu Dialogbox 1
  818.       raus&=TRUE
  819.       eingabe&=1
  820.       '
  821.     CASE f3&
  822.       grafik_loeschen
  823.       '
  824.     CASE f10&                                      ! Ende der Eingabe
  825.       zeichne_kurve&=TRUE
  826.       raus&=TRUE
  827.       '
  828.     CASE esc&
  829.       alarmbox("| Programm beenden ? |||       j / n|")
  830.       IF antw&=jk& OR antw&=jg&
  831.         prog_ende&=TRUE
  832.         raus&=TRUE
  833.       ENDIF
  834.       '
  835.     CASE f5&
  836.       zeige_grafik&=TRUE
  837.       raus&=TRUE
  838.       '
  839.     CASE help&
  840.       help_bearbeitung
  841.       '
  842.     CASE 32,42 TO 57,65 TO 90,97 TO 122,126
  843.       '
  844.       IF item2&=0 AND taste&<>44 AND taste&<>46
  845.         FOR n&=0 TO 6                ! Alten Befehl löschen
  846.           KEYPRESS delete&
  847.         NEXT n&
  848.         KEYPRESS taste&              ! Tastendruck darf nicht verloren gehen
  849.         IF einf&=TRUE
  850.           KEYPRESS backspace&
  851.         ENDIF
  852.         PRINT "          "           ! überschreibt alten Eintrag
  853.         LOCATE li_ob&(item2&)+5,zeile&(item2&)+6
  854.         FORM INPUT 8,e$
  855.         e$=TRIM$(e$)                 ! vorne und hinten Blanks weg
  856.         befehlein(e$)
  857.       ENDIF
  858.       '
  859.       IF item2&>0
  860.         FOR n&=0 TO 13               ! Alten Wert löschen
  861.           KEYPRESS delete&
  862.         NEXT n&
  863.         IF taste&=44 OR taste&=46    ! Punkt oder Komma ?
  864.           KEYPRESS 48                ! dann eine 0 voransetzen
  865.         ENDIF
  866.         KEYPRESS taste&              ! Tastendruck darf nicht verloren gehen
  867.         PRINT "           "          ! überschreibt alten Eintrag
  868.         LOCATE li_ob&(item2&)+5,zeile&(item2&)+6
  869.         FORM INPUT 10,e$
  870.         e$=TRIM$(e$)                 ! vorne und hinten Blanks weg
  871.         bauteilein(e$)
  872.       ENDIF
  873.       '
  874.     ENDSELECT
  875.     '
  876.     IF item2&<>itemalt& OR raus&=TRUE       ! Umrahmung entfernen
  877.       COLOR weiss&
  878.       IF itemalt&=0
  879.         BOX 6,77,158,338                    ! fette Umrandung
  880.         BOX 7,78,157,337
  881.       ELSE IF itemalt&=1
  882.         BOX 160,77,315,338
  883.         BOX 161,78,314,337
  884.       ELSE IF itemalt&=2
  885.         BOX 317,77,472,338
  886.         BOX 318,78,471,337
  887.       ELSE
  888.         BOX 474,77,634,338
  889.         BOX 475,78,633,337
  890.       ENDIF
  891.     ENDIF
  892.     '
  893.     SGET dialogbox2$                 ! mit Änderungen speichern
  894.     '
  895.     EXIT IF raus&=TRUE
  896.     '
  897.   LOOP
  898.   '
  899. RETURN
  900. '
  901. PROCEDURE schreibe_spalte(spalte&)
  902.   '
  903.   LOCAL zeile&
  904.   '
  905.   FOR zeile&=0 TO 15
  906.     schreibe_befehl_oder_wert(spalte&,zeile&)
  907.   NEXT zeile&
  908.   '
  909. RETURN
  910. '
  911. PROCEDURE schreibe_befehl_oder_wert(spalte&,zeile&)
  912.   '
  913.   LOCAL element%,nummer&,ausgabe$
  914.   '
  915.   nummer&=oberst&(spalte&)+zeile&
  916.   ausgabe$=STR$(nummer&,3)+"  "
  917.   IF spalte&=0                                     ! es ist ein Befehl
  918.     element%=befehl&(nummer&)
  919.     ausgabe$=ausgabe$+befehl$(element% AND 255)
  920.     IF element%>255                                ! eine Adresse ist dabei
  921.       ausgabe$=ausgabe$+STR$((element% AND 65280)/256-1,3)
  922.     ELSE
  923.       ausgabe$=ausgabe$+"    "
  924.     ENDIF
  925.   ELSE                                             ! es ist ein Bauteilwert
  926.     ausgabe$=ausgabe$+FN wert$(bauteil(nummer&),8,0)
  927.   ENDIF
  928.   PRINT AT(li_ob&(spalte&),zeile&+6);ausgabe$;
  929.   '
  930. RETURN
  931. '
  932. PROCEDURE befehlein(e$)
  933.   '
  934.   LOCAL befehl$,befehl&,blank_pos&,fehler&,nummer&,n&
  935.   '
  936.   IF e$=""                                         ! nur alles gelöscht ?
  937.     DELETE befehl&(oberst&(item2&)+zeile&(item2&)) ! ganzen Befehl löschen
  938.     einf&=FALSE
  939.   ELSE
  940.     IF e$="s" OR e$="S"                            ! zur Vereinfachung
  941.       e$="ser"                                     ! der Eingabe
  942.     ENDIF
  943.     IF e$="p" OR e$="P"
  944.       e$="par"
  945.     ENDIF
  946.     IF LEFT$(e$)="~"
  947.       e$="~~~~~"
  948.     ENDIF
  949.     blank_pos&=INSTR(e$," ")
  950.     nummer&=0                 ! Nummer des Bauteils oder des Speicherplatzes
  951.     IF blank_pos&>0                         ! Wurde eine Nummer eingegeben ?
  952.       nummer&=VAL(MID$(e$,blank_pos&))+1    ! Nummern > 0 !
  953.       e$=LEFT$(e$,blank_pos&-1)             ! in e$ ist jetzt der Befehl
  954.     ENDIF
  955.     befehl$="     "                         ! nun wird der eingegebene Befehl
  956.     LSET befehl$=e$                         ! in der Liste der Befehle gesucht
  957.     befehl&=0
  958.     FOR n&=1 TO anzahl_bef&
  959.       IF UPPER$(befehl$)=UPPER$(befehl$(n&))
  960.         befehl&=n&                          ! Befehlsnummer
  961.       ENDIF
  962.     NEXT n&
  963.     '
  964.     fehler&=FALSE
  965.     '
  966.     IF befehl&=0 OR nummer&>100             ! unbekannter Befehl
  967.       fehler&=TRUE                          ! oder zu große Registernummer
  968.     ENDIF
  969.     '
  970.     ' auf die Befehle Nr. 1 2 3 7 und 8 muß eine Nummer folgen:
  971.     IF nummer&=0 AND INSTR("12378",STR$(befehl&))>0
  972.       fehler&=TRUE
  973.     ENDIF
  974.     '
  975.     ' auf die übrigen Befehle darf keine Nummer folgen:
  976.     IF nummer&>0 AND NOT INSTR("12378",STR$(befehl&))>0
  977.       fehler&=TRUE
  978.     ENDIF
  979.     '
  980.     IF fehler&=FALSE
  981.       befehl&(oberst&(item2&)+zeile&(item2&))=befehl&+256*nummer&
  982.       KEYPRESS ab&                          ! Cursor runter
  983.     ELSE
  984.       PRINT CHR$(7);                        ! Ping !
  985.       IF einf&=TRUE
  986.         KEYPRESS leertaste&
  987.       ENDIF
  988.     ENDIF
  989.     '
  990.   ENDIF
  991.   '
  992. RETURN
  993. '
  994. PROCEDURE bauteilein(e$)
  995.   '
  996.   IF e$=""                                         ! nur alles gelöscht ?
  997.     DELETE bauteil(oberst&(item2&)+zeile&(item2&)) ! ganzes Bauteil löschen
  998.   ELSE
  999.     bauteil(oberst&(item2&)+zeile&(item2&))=FN wert(e$)
  1000.     KEYPRESS ab&                                   ! Pfeil runter
  1001.   ENDIF
  1002.   aenderungen_merken
  1003.   '
  1004. RETURN
  1005. '
  1006. PROCEDURE aenderungen_merken
  1007.   '
  1008.   IF item2&=1
  1009.     MAT CPY r()=bauteil()
  1010.   ELSE IF item2&=2
  1011.     MAT CPY c()=bauteil()
  1012.   ELSE IF item2&=3
  1013.     MAT CPY l()=bauteil()
  1014.   ENDIF
  1015.   '
  1016. RETURN
  1017. '
  1018. PROCEDURE kurve_zeichnen
  1019.   '
  1020.   LOCAL a$,p,q,r,s,f,y,omega,re,im,exp_fakt,daempf,zeile%,st_z&,befehl&
  1021.   LOCAL x&,x_alt&,y_alt,p_x_alt&,p_y_alt,addr&,fehler&,n&
  1022.   '
  1023.   zeichne_kurve&=FALSE
  1024.   '
  1025.   GRAPHMODE 1
  1026.   COLOR schwarz&
  1027.   '
  1028.   ' Zuerst wird überprüft, ob ein offensichtlicher Fehler vorliegt
  1029.   '
  1030.   fehler&=FALSE
  1031.   '
  1032.   IF befehl&(0)=0
  1033.     fehler&=TRUE
  1034.     alarmbox("| ohne Befehle geht's nicht |||          Taste !|")
  1035.   ENDIF
  1036.   '
  1037.   IF f_max<=f_min
  1038.     fehler&=TRUE
  1039.     a$="| f max   muß größer sein als   f min  ! |||               Taste !|"
  1040.     alarmbox(a$)
  1041.   ENDIF
  1042.   '
  1043.   IF f_min=0 AND f_achse&=log&
  1044.     fehler&=TRUE
  1045.     a$="| Bei logarithmischer Teilung | der Frequenzachse ||"
  1046.     a$=a$+" darf  f min  nicht 0 sein ! |||           Taste !|"
  1047.     alarmbox(a$)
  1048.   ENDIF
  1049.   '
  1050.   IF fehler&=FALSE
  1051.     '
  1052.     befehlz&=0                       ! Hier wird überprüft, ob irgendwelche
  1053.     n&=0
  1054.     '
  1055.     WHILE befehl&(befehlz&)>0        ! der verwendeten Bauteile den Wert 0
  1056.       '
  1057.       zeile%=befehl&(befehlz&)       ! besitzen
  1058.       INC befehlz&
  1059.       befehl&=(zeile% AND 255)       ! der Befehlscode steht im rechten Byte
  1060.       '                                des 16-Bit-Wortes
  1061.       addr&=(zeile% AND 65280)/256-1 ! evtl. vorhandene Bauteil- oder
  1062.       '                                Speichernummer
  1063.       '
  1064.       SELECT befehl&
  1065.         '
  1066.       CASE 1
  1067.         '
  1068.         ' R
  1069.         '
  1070.         IF r(addr&)=0
  1071.           INC n&
  1072.         ENDIF
  1073.         '
  1074.       CASE 2
  1075.         '
  1076.         ' C
  1077.         '
  1078.         IF c(addr&)=0
  1079.           INC n&
  1080.         ENDIF
  1081.         '
  1082.       CASE 3
  1083.         '
  1084.         ' L
  1085.         '
  1086.         IF l(addr&)=0
  1087.           INC n&
  1088.         ENDIF
  1089.         '
  1090.       ENDSELECT
  1091.       '
  1092.     WEND
  1093.     '
  1094.     IF n&>0
  1095.       fehler&=TRUE
  1096.       a$="|                      Warnung !||"
  1097.       IF n&=1
  1098.         a$=a$+" Ein in der Schaltung verwendetes Bauteil hat den Wert 0 ! "
  1099.       ELSE
  1100.         a$=a$+" Einige in der Schaltung verwendete Bau"
  1101.         a$=a$+"teile haben den Wert 0 ! "
  1102.       ENDIF
  1103.       a$=a$+"|||               Return :   die Sache geht in Ordnung"
  1104.       a$=a$+"||         andere Taste :   abbrechen|"
  1105.       alarmbox(a$)
  1106.       IF antw&=return&
  1107.         fehler&=FALSE
  1108.       ENDIF
  1109.     ENDIF
  1110.     '
  1111.   ENDIF
  1112.   '
  1113.   IF betr_swr_darst&=nein& AND phase_darst&=FALSE AND betr_swr_auto&=FALSE
  1114.     fehler&=TRUE
  1115.     a$="| Es wurden Einstellungen gewählt, bei denen nichts zu tun ist ! |||"
  1116.     a$=a$+"                         Taste !|"
  1117.     alarmbox(a$)
  1118.   ENDIF
  1119.   '
  1120.   ' Überprüfung auf offensichtliche Fehler beendet, Rechnungen beginnen
  1121.   '
  1122.   IF fehler&=FALSE            ! natürlich nur, wenn kein Fehler erkannt wurde
  1123.     '
  1124.     ARRAYFILL betr_swr(),0    ! Liste der Betragswerte löschen
  1125.     '
  1126.     SPUT kurve$               ! Es wird über die vorhandene Grafik gezeichnet
  1127.     '                           beim erstenmal ist kurve$ natürlich leer
  1128.     IF f_achse&=log&
  1129.       exp_fakt=LOG(f_max/f_min)/639         ! spart weiter unten Rechenzeit
  1130.     ENDIF
  1131.     '
  1132.     FOR x&=0 TO 639 STEP schrittweite&             ! Beginn der Hauptschleife
  1133.       '                                              zur Kurvenberechnung
  1134.       EXIT IF INP?(2)=TRUE OR fehler&=TRUE         ! Abbruch mit bel. Taste
  1135.       '
  1136.       IF f_achse&=lin&
  1137.         f=f_min+x&*(f_max-f_min)/640
  1138.         IF f<f_max/1000              ! Verhindert Division durch 0 bei f=0
  1139.           f=f_max/1000
  1140.         ENDIF
  1141.       ELSE
  1142.         f=f_min*EXP(x&*exp_fakt)     ! log. Teilung der Frequenzachse
  1143.       ENDIF
  1144.       '
  1145.       omega=2*PI*f
  1146.       st_z&=-1                       ! Stapelzeiger auf letzten belegten Platz
  1147.       '                                es ist allerdings keiner belegt
  1148.       befehlz&=0                     ! Befehlszeiger auf den ersten Befehl
  1149.       '
  1150.       ' In der folgenden WHILE- Schleife wird die Befehlsfolge für eine
  1151.       ' bestimmte Frequenz f einmal abgearbeitet
  1152.       '
  1153.       WHILE befehl&(befehlz&)>0             ! 0: Ende der Befehlsfolge
  1154.         '
  1155.         zeile%=befehl&(befehlz&)
  1156.         befehl&=(zeile% AND 255)            ! der Befehlscode steht im rechten
  1157.         '                                     Byte des 16-Bit-Wortes
  1158.         addr&=(zeile% AND 65280)/256-1      ! evtl. vorhandene Bauteil- oder
  1159.         '                                     Speichernummer
  1160.         '
  1161.         SELECT befehl&
  1162.           '
  1163.         CASE 1
  1164.           '
  1165.           ' R
  1166.           '
  1167.           test_stack_voll
  1168.           EXIT IF fehler&=TRUE
  1169.           INC st_z&
  1170.           st_r(st_z&)=r(addr&)
  1171.           st_i(st_z&)=0
  1172.           '
  1173.         CASE 2
  1174.           '
  1175.           ' C
  1176.           '
  1177.           test_stack_voll
  1178.           EXIT IF fehler&=TRUE
  1179.           INC st_z&
  1180.           st_r(st_z&)=0
  1181.           st_i(st_z&)=-1/(omega*c(addr&))
  1182.           '
  1183.         CASE 3
  1184.           '
  1185.           ' L
  1186.           '
  1187.           test_stack_voll
  1188.           EXIT IF fehler&=TRUE
  1189.           INC st_z&
  1190.           st_r(st_z&)=0
  1191.           st_i(st_z&)=omega*l(addr&)
  1192.           '
  1193.         CASE 4,16
  1194.           '
  1195.           ' + ser
  1196.           '
  1197.           test_stack(2)
  1198.           EXIT IF fehler&=TRUE
  1199.           DEC st_z&
  1200.           st_r(st_z&)=st_r(st_z&)+st_r(st_z&+1)
  1201.           st_i(st_z&)=st_i(st_z&)+st_i(st_z&+1)
  1202.           '
  1203.         CASE 5
  1204.           '
  1205.           ' par
  1206.           '
  1207.           test_stack(2)
  1208.           EXIT IF fehler&=TRUE
  1209.           p=st_r(st_z&)+st_r(st_z&-1)
  1210.           q=st_i(st_z&)+st_i(st_z&-1)
  1211.           r=st_r(st_z&)*st_r(st_z&-1)-st_i(st_z&)*st_i(st_z&-1)
  1212.           s=st_r(st_z&)*st_i(st_z&-1)+st_i(st_z&)*st_r(st_z&-1)
  1213.           DEC st_z&
  1214.           st_r(st_z&)=(r*p+s*q)/(p*p+q*q)
  1215.           st_i(st_z&)=(s*p-r*q)/(p*p+q*q)
  1216.           '
  1217.         CASE 6
  1218.           '
  1219.           ' dup
  1220.           '
  1221.           test_stack_voll
  1222.           EXIT IF fehler&=TRUE
  1223.           test_stack(1)
  1224.           EXIT IF fehler&=TRUE
  1225.           INC st_z&
  1226.           st_r(st_z&)=st_r(st_z&-1)
  1227.           st_i(st_z&)=st_i(st_z&-1)
  1228.           '
  1229.         CASE 7
  1230.           '
  1231.           ' sto
  1232.           '
  1233.           test_stack(1)
  1234.           EXIT IF fehler&=TRUE
  1235.           sp_r(addr&)=st_r(st_z&)
  1236.           sp_i(addr&)=st_i(st_z&)
  1237.           '
  1238.         CASE 8
  1239.           '
  1240.           ' rcl
  1241.           '
  1242.           test_stack_voll
  1243.           EXIT IF fehler&=TRUE
  1244.           INC st_z&
  1245.           st_r(st_z&)=sp_r(addr&)
  1246.           st_i(st_z&)=sp_i(addr&)
  1247.           '
  1248.         CASE 9
  1249.           '
  1250.           ' /
  1251.           '
  1252.           test_stack(2)
  1253.           EXIT IF fehler&=TRUE
  1254.           DEC st_z&
  1255.           p=st_r(st_z&)*st_r(st_z&+1)+st_i(st_z&)*st_i(st_z&+1)
  1256.           q=st_i(st_z&)*st_r(st_z&+1)-st_r(st_z&)*st_i(st_z&+1)
  1257.           r=st_r(st_z&+1)^2+st_i(st_z&+1)^2
  1258.           st_r(st_z&)=p/r
  1259.           st_i(st_z&)=q/r
  1260.           '
  1261.         CASE 10
  1262.           '
  1263.           ' *
  1264.           '
  1265.           test_stack(2)
  1266.           EXIT IF fehler&=TRUE
  1267.           DEC st_z&
  1268.           p=st_r(st_z&)
  1269.           q=st_i(st_z&)
  1270.           r=st_r(st_z&+1)
  1271.           s=st_i(st_z&+1)
  1272.           st_r(st_z&)=p*r-q*s
  1273.           st_i(st_z&)=q*r+p*s
  1274.           '
  1275.         CASE 11
  1276.           '
  1277.           ' drop
  1278.           '
  1279.           test_stack(1)
  1280.           EXIT IF fehler&=TRUE
  1281.           DEC st_z&
  1282.           '
  1283.         CASE 12
  1284.           '
  1285.           ' swap
  1286.           '
  1287.           test_stack(2)
  1288.           EXIT IF fehler&=TRUE
  1289.           SWAP st_r(st_z&),st_r(st_z&-1)
  1290.           SWAP st_i(st_z&),st_i(st_z&-1)
  1291.           '
  1292.         CASE 13
  1293.           '
  1294.           ' over
  1295.           '
  1296.           test_stack_voll
  1297.           EXIT IF fehler&=TRUE
  1298.           test_stack(2)
  1299.           EXIT IF fehler&=TRUE
  1300.           INC st_z&
  1301.           st_r(st_z&)=st_r(st_z&-2)
  1302.           st_i(st_z&)=st_i(st_z&-2)
  1303.           '
  1304.         CASE 14
  1305.           '
  1306.           ' rot
  1307.           '
  1308.           test_stack(3)
  1309.           EXIT IF fehler&=TRUE
  1310.           SWAP st_r(st_z&),st_r(st_z&-2)
  1311.           SWAP st_i(st_z&),st_i(st_z&-2)
  1312.           SWAP st_r(st_z&-1),st_r(st_z&-2)
  1313.           SWAP st_i(st_z&-1),st_i(st_z&-2)
  1314.           '
  1315.         CASE 15
  1316.           '
  1317.           ' inv
  1318.           '
  1319.           test_stack(1)
  1320.           EXIT IF fehler&=TRUE
  1321.           p=st_r(st_z&)
  1322.           q=st_i(st_z&)
  1323.           st_r(st_z&)=p/(p*p+q*q)
  1324.           st_i(st_z&)=-q/(p*p+q*q)
  1325.           '
  1326.         CASE 17
  1327.           '
  1328.           ' -
  1329.           '
  1330.           test_stack(2)
  1331.           EXIT IF fehler&=TRUE
  1332.           DEC st_z&
  1333.           st_r(st_z&)=st_r(st_z&)-st_r(st_z&+1)
  1334.           st_i(st_z&)=st_i(st_z&)-st_i(st_z&+1)
  1335.           '
  1336.         CASE 18
  1337.           '
  1338.           ' cstk = lösche ganzen Stapel
  1339.           '
  1340.           st_z&=-1
  1341.           '
  1342.         CASE 20
  1343.           '
  1344.           ' conj = bilde konjugiert komplexe Zahl
  1345.           '
  1346.           test_stack(1)
  1347.           EXIT IF fehler&=TRUE
  1348.           st_i(st_z&)=-st_i(st_z&)
  1349.           '
  1350.         ENDSELECT
  1351.         '
  1352.         INC befehlz&                                      ! nächster Befehl
  1353.         '
  1354.       WEND
  1355.       '
  1356.       ' bei einem der obigen test_ ... Unterprogramme könnte fehler& = TRUE
  1357.       ' gesetzt worden sein, deshalb:
  1358.       '
  1359.       IF fehler&=FALSE
  1360.         '
  1361.         ' das Ergebnis befindet sich jetzt in st_r(st_z&), st_i(st_z&)
  1362.         '
  1363.         re=st_r(st_z&)                      ! Realteil des Ergebnisses
  1364.         im=st_i(st_z&)                      ! Imaginärteil des Ergebnisses
  1365.         '
  1366.         IF betrag_darst&=TRUE
  1367.           y=SQR(re^2+im^2)
  1368.         ELSE                                ! Stehwellenverhältnis berechnen
  1369.           y=SQR(((re-wellenwiderstand)^2+im^2)/((re+wellenwiderstand)^2+im^2))
  1370.           IF ABS(1-y)<0.00001
  1371.             y=0.99999
  1372.           ENDIF
  1373.           y=(1+y)/(1-y)
  1374.         ENDIF
  1375.         betr_swr(x&)=y                      ! berechneten Wert speichern
  1376.         '
  1377.         IF betr_swr_auto&=FALSE AND betr_swr_darst&<>nein&
  1378.           ' dann müssen wir den gerade berechneten Wert
  1379.           ' gleich in die Grafik einzeichnen
  1380.           '
  1381.           y=y/betr_swr_max
  1382.           IF betr_swr_darst&=lin&
  1383.             y=400-400*y
  1384.           ELSE
  1385.             IF y>0
  1386.               y=-8000*LOG10(y)/daempf_max
  1387.             ELSE
  1388.               y=400
  1389.             ENDIF
  1390.           ENDIF
  1391.           '
  1392.           IF y<0
  1393.             y=0
  1394.           ENDIF
  1395.           IF y>399
  1396.             y=399
  1397.           ENDIF
  1398.           '
  1399.           IF x&=0             ! damit die erste kleine Strecke links
  1400.             x_alt&=x&         ! auf der richtigen Höhe beginnt
  1401.             y_alt=y
  1402.           ENDIF
  1403.           '
  1404.           DRAW x_alt&,y_alt TO x&,y         ! kleine Strecke
  1405.           x_alt&=x&
  1406.           y_alt=y
  1407.           '
  1408.         ENDIF
  1409.         '
  1410.         IF betr_swr_auto&=TRUE AND phase_darst&=FALSE
  1411.           ' in diesem Fall ist während der Berechnung nichts zu zeichnen
  1412.           '
  1413.           PRINT AT(30,12);"Bitte warten .. ";STR$(640-x&,3)
  1414.         ENDIF
  1415.         '
  1416.         IF phase_darst&=TRUE
  1417.           ' dann können wir jedenfalls während der Berechnung
  1418.           ' schon den Phasenverlauf zeichnen
  1419.           '
  1420.           p=st_r(st_z&)
  1421.           q=st_i(st_z&)
  1422.           IF p>0
  1423.             y=ATN(q/p)
  1424.           ENDIF
  1425.           IF p<0 AND q>0
  1426.             y=PI+ATN(q/p)
  1427.           ENDIF
  1428.           IF p<0 AND q<0
  1429.             y=ATN(q/p)-PI
  1430.           ENDIF
  1431.           IF p=0
  1432.             y=SGN(q)*PI/2
  1433.           ENDIF
  1434.           y=200-200*y/PI
  1435.           IF x&=0 THEN
  1436.             p_x_alt&=x&
  1437.             p_y_alt=y
  1438.           ENDIF
  1439.           DRAW p_x_alt&,p_y_alt TO x&,y
  1440.           p_x_alt&=x&
  1441.           p_y_alt=y
  1442.           '
  1443.         ENDIF
  1444.         '
  1445.       ENDIF
  1446.       '
  1447.     NEXT x&
  1448.     '
  1449.     ' Die Berechnungen sind beendet
  1450.     '
  1451.     IF fehler&=FALSE
  1452.       '
  1453.       IF betr_swr_auto&=TRUE
  1454.         '
  1455.         betr_swr_max=0                             ! größten Betrag suchen
  1456.         FOR x&=0 TO 639 STEP schrittweite&
  1457.           IF betr_swr_max<betr_swr(x&)
  1458.             betr_swr_max=betr_swr(x&)
  1459.           ENDIF
  1460.         NEXT x&
  1461.         '
  1462.         IF betr_swr_max=0
  1463.           '
  1464.           e$="| Hier stimmt wohl etwas nicht !|||"
  1465.           e$=e$+" Der Maximalwert aller Beträge / SWRs ist Null||||"
  1466.           e$=e$+" Das Programm wird mit dem Eingabemenü fortgesetzt ||"
  1467.           e$=e$+" Befehle und Bauteilwerte sind noch vorhanden  (?)|||"
  1468.           e$=e$+"                   Taste !|"
  1469.           alarmbox(e$)
  1470.           '
  1471.           betr_swr_max=2
  1472.           '
  1473.           zeige_grafik&=FALSE
  1474.           zeichne_kurve&=FALSE
  1475.           dialogbox2_neu&=TRUE
  1476.           dialogbox1_neu&=TRUE
  1477.           '
  1478.           fehler&=TRUE
  1479.           '
  1480.         ENDIF
  1481.         '
  1482.         IF phase_darst&=FALSE
  1483.           SPUT kurve$
  1484.         ENDIF
  1485.         '
  1486.         IF fehler&=FALSE
  1487.           '
  1488.           IF betr_swr_darst&<>nein&
  1489.             FOR x&=0 TO 639 STEP schrittweite&
  1490.               y=betr_swr(x&)/betr_swr_max
  1491.               IF betr_swr_darst&=lin&
  1492.                 y=400-400*y
  1493.               ELSE
  1494.                 IF y>0
  1495.                   y=-8000*LOG10(y)/daempf_max
  1496.                 ELSE
  1497.                   y=400
  1498.                 ENDIF
  1499.               ENDIF
  1500.               '
  1501.               IF y<0
  1502.                 y=0
  1503.               ENDIF
  1504.               IF y>399
  1505.                 y=399
  1506.               ENDIF
  1507.               '
  1508.               IF x&=0
  1509.                 x_alt&=x&
  1510.                 y_alt=y
  1511.               ENDIF
  1512.               DRAW x_alt&,y_alt TO x&,y
  1513.               x_alt&=x&
  1514.               y_alt=y
  1515.             NEXT x&
  1516.           ENDIF
  1517.           '
  1518.         ENDIF
  1519.         '
  1520.       ENDIF
  1521.       '
  1522.       IF phase_darst&=TRUE
  1523.         DRAW 0,200 TO 639,200
  1524.         DEFLINE 5
  1525.         DRAW 0,100 TO 639,100
  1526.         DRAW 0,300 TO 639,300
  1527.         DEFLINE 1
  1528.       ENDIF
  1529.       '
  1530.       SGET bild$       ! damit die folgenden Angaben nicht in kurve$ stehen
  1531.       '
  1532.       ' Bild fertig
  1533.       '
  1534.       IF phase_darst&=TRUE
  1535.         TEXT 600,95,"+90"
  1536.         TEXT 616,195,"0"
  1537.         TEXT 600,295,"-90"
  1538.       ENDIF
  1539.       '
  1540.       IF betr_swr_darst&=lin& AND betr_swr_auto&=FALSE
  1541.         PRINT AT(2,2);
  1542.         betr_swr_drucken(betr_swr_max)
  1543.       ENDIF
  1544.       '
  1545.       IF betr_swr_darst&=log&
  1546.         a$=STR$(-daempf_max)+" dB"
  1547.         PRINT AT(40,24);TRIM$(a$)
  1548.       ENDIF
  1549.       '
  1550.       IF betr_swr_darst&<>nein& OR phase_darst&=TRUE
  1551.         '
  1552.         a$=FN wert$(f_min,12,0)+"Hz"
  1553.         PRINT AT(2,24);TRIM$(a$)
  1554.         '
  1555.         a$=FN wert$(f_max,12,0)+"Hz"
  1556.         PRINT AT(62,24);TRIM$(a$)
  1557.         '
  1558.         ~INP(2)
  1559.         REPEAT
  1560.           a$="| neue Kurve(n) überne"
  1561.           a$=a$+"hmen: Return ||                verwerfen: Undo |"
  1562.           alarmbox(a$)
  1563.         UNTIL antw&=return& OR antw&=undo&
  1564.         '
  1565.         IF antw&=return&
  1566.           kurve$=bild$
  1567.         ENDIF
  1568.         '
  1569.       ENDIF
  1570.       '
  1571.     ENDIF
  1572.     '
  1573.     item1&=14
  1574.     '
  1575.   ENDIF
  1576.   '
  1577. RETURN
  1578. '
  1579. PROCEDURE befehle_laden
  1580.   '
  1581.   LOCAL kopf$,anz&,n&
  1582.   '
  1583.   FILESELECT #"Befehlsfolge laden",pfad$+"*.BEF",dnam$+".BEF",datei$
  1584.   '
  1585.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1586.     IF EXIST(datei$)
  1587.       OPEN "I",#1,datei$
  1588.       anz&=LOF(#1)-4
  1589.       IF anz&>=0
  1590.         kopf$=""
  1591.         FOR n&=1 TO 4
  1592.           kopf$=kopf$+CHR$(INP(#1))
  1593.         NEXT n&
  1594.         IF kopf$="BEFE"
  1595.           ARRAYFILL befehl&(),0
  1596.           BGET #1,VARPTR(befehl&(0)),anz&
  1597.           oberst&(0)=0
  1598.           zeile&(0)=0
  1599.           item2&=0
  1600.           neu_pfad_u_vorgabe
  1601.           dialogbox1_neu&=TRUE
  1602.         ELSE
  1603.           alarmbox("| Keine RCL-Befehlsdatei ! |||         Taste !|")
  1604.         ENDIF
  1605.       ELSE
  1606.         alarmbox("| Keine RCL-Befehlsdatei ! |||         Taste !|")
  1607.       ENDIF
  1608.       CLOSE #1
  1609.     ELSE
  1610.       alarmbox("| Datei existiert nicht ! |||         Taste !|")
  1611.     ENDIF
  1612.   ENDIF
  1613.   '
  1614. RETURN
  1615. '
  1616. PROCEDURE befehle_anhaengen
  1617.   '
  1618.   LOCAL a$,kopf$,n&,anz&,anz2&
  1619.   '
  1620.   FILESELECT #"Befehlsfolge anhängen",pfad$+"*.BEF",dnam$+".BEF",datei$
  1621.   '
  1622.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1623.     IF EXIST(datei$)
  1624.       anz&=0
  1625.       WHILE befehl&(anz&)<>0
  1626.         INC anz&
  1627.       WEND
  1628.       OPEN "I",#1,datei$
  1629.       IF LOF(#1)>=4
  1630.         anz2&=(LOF(#1)-4)/2
  1631.         kopf$=""
  1632.         FOR n&=1 TO 4
  1633.           kopf$=kopf$+CHR$(INP(#1))
  1634.         NEXT n&
  1635.         IF kopf$="BEFE"
  1636.           IF anz&+anz2&<1000
  1637.             BGET #1,VARPTR(befehl&(0))+2*anz&,anz2&*2
  1638.             dialogbox1_neu&=TRUE
  1639.           ELSE
  1640.             a$="|      Platz reicht nicht !|| zusammen mehr als 999 Bef"
  1641.             a$=a$+"ehle |||           Taste !|"
  1642.             alarmbox(a$)
  1643.           ENDIF
  1644.         ELSE
  1645.           alarmbox("| Keine RCL-Befehlsdatei ! |||         Taste !|")
  1646.         ENDIF
  1647.       ELSE
  1648.         alarmbox("| Keine RCL-Befehlsdatei ! |||         Taste !|")
  1649.       ENDIF
  1650.       CLOSE #1
  1651.       item2&=0
  1652.       neu_pfad_u_vorgabe
  1653.     ELSE
  1654.       alarmbox("| Datei existiert nicht ! |||         Taste !|")
  1655.     ENDIF
  1656.   ENDIF
  1657.   '
  1658. RETURN
  1659. '
  1660. PROCEDURE befehle_speichern
  1661.   '
  1662.   LOCAL anz&
  1663.   '
  1664.   FILESELECT #"Befehlsfolge speichern",pfad$+"*.BEF",dnam$+".BEF",datei$
  1665.   '
  1666.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1667.     IF INSTR(datei$,".")=0
  1668.       datei$=datei$+".BEF"
  1669.     ENDIF
  1670.     anz&=0
  1671.     WHILE befehl&(anz&)<>0
  1672.       INC anz&
  1673.     WEND
  1674.     OPEN "O",#1,datei$
  1675.     OUT #1,66,69,70,69                      ! B E F E  als Dateikennung
  1676.     BPUT #1,VARPTR(befehl&(0)),2*anz&
  1677.     CLOSE #1
  1678.     neu_pfad_u_vorgabe
  1679.   ENDIF
  1680.   '
  1681. RETURN
  1682. '
  1683. PROCEDURE befehle_drucken
  1684.   '
  1685.   LOCAL a$,wort%,n&,zeile&,spalte&
  1686.   '
  1687.   n&=0                               ! Befehle zählen
  1688.   DO
  1689.     wort%=befehl&(n&)
  1690.     EXIT IF wort%=0
  1691.     INC n&
  1692.   LOOP
  1693.   '
  1694.   IF n&=0
  1695.     '
  1696.     a$="|Es sind keine Befehle vorhanden|||           Taste !|"
  1697.     alarmbox(a$)
  1698.     '
  1699.   ELSE
  1700.     '
  1701.     IF GEMDOS(17)=TRUE
  1702.       drucker_initialisieren
  1703.       LPRINT
  1704.       LPRINT
  1705.       LPRINT "Befehlsfolge zu  ";dnam$
  1706.       LPRINT
  1707.       '
  1708.       DEC n&
  1709.       spaltenlaenge&=n&/4
  1710.       '
  1711.       FOR zeile&=0 TO spaltenlaenge&
  1712.         '
  1713.         FOR spalte&=0 TO 3
  1714.           '
  1715.           a$=STR$(zeile&+(spaltenlaenge&+1)*spalte&,3)+"   "
  1716.           wort%=befehl&(zeile&+(spaltenlaenge&+1)*spalte&)
  1717.           a$=a$+befehl$(wort% AND 255)
  1718.           IF wort%>255                             ! eine Adresse ist dabei
  1719.             a$=a$+STR$((wort% AND 65280)/256-1,3)
  1720.           ELSE
  1721.             a$=a$+"   "
  1722.           ENDIF
  1723.           IF wort%<>0
  1724.             LPRINT a$;
  1725.           ENDIF
  1726.           IF spalte&<3
  1727.             LPRINT "      ";
  1728.           ENDIF
  1729.           '
  1730.         NEXT spalte&
  1731.         LPRINT
  1732.         '
  1733.       NEXT zeile&
  1734.       '
  1735.     ELSE
  1736.       alarmbox("| Drucker nicht bereit ! |||        Taste !|")
  1737.     ENDIF
  1738.     '
  1739.   ENDIF
  1740.   '
  1741. RETURN
  1742. '
  1743. PROCEDURE befehle_loeschen
  1744.   '
  1745.   alarmbox("| Befehle löschen ? |||       j / n|")
  1746.   IF antw&=jk& OR antw&=jg&
  1747.     ARRAYFILL befehl&(),0
  1748.     oberst&(0)=0
  1749.     zeile&(0)=0
  1750.   ENDIF
  1751.   '
  1752. RETURN
  1753. '
  1754. PROCEDURE bauteile_laden
  1755.   '
  1756.   LOCAL kopf$,r,c,l,n&
  1757.   '
  1758.   FILESELECT #"Bauteile laden",pfad$+"*.BAU",dnam$+".BAU",datei$
  1759.   '
  1760.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1761.     IF EXIST(datei$)
  1762.       ARRAYFILL r(),0
  1763.       ARRAYFILL c(),0
  1764.       ARRAYFILL l(),0
  1765.       OPEN "I",#1,datei$
  1766.       IF LOF(#1)>=4
  1767.         kopf$=""
  1768.         FOR n&=1 TO 4
  1769.           kopf$=kopf$+CHR$(INP(#1))
  1770.         NEXT n&
  1771.         IF kopf$="BAUT"
  1772.           BGET #1,VARPTR(f_min),8
  1773.           BGET #1,VARPTR(f_max),8
  1774.           BGET #1,VARPTR(betr_swr_max),8
  1775.           BGET #1,VARPTR(daempf_max),8
  1776.           BGET #1,VARPTR(wellenwiderstand),8
  1777.           BGET #1,VARPTR(betrag_darst&),2
  1778.           BGET #1,VARPTR(betr_swr_darst&),2
  1779.           BGET #1,VARPTR(phase_darst&),2
  1780.           BGET #1,VARPTR(schrittweite&),2
  1781.           BGET #1,VARPTR(f_achse&),2
  1782.           BGET #1,VARPTR(r),8
  1783.           BGET #1,VARPTR(c),8
  1784.           BGET #1,VARPTR(l),8
  1785.           BGET #1,VARPTR(r(0)),(r+1)*8
  1786.           BGET #1,VARPTR(c(0)),(c+1)*8
  1787.           BGET #1,VARPTR(l(0)),(l+1)*8
  1788.           dialogbox2_neu&=TRUE
  1789.           dialogbox1_neu&=TRUE
  1790.           betr_swr_auto&=FALSE
  1791.         ELSE
  1792.           alarmbox("| Keine RCL-Bauteiledatei ! |||         Taste !|")
  1793.         ENDIF
  1794.       ELSE
  1795.         alarmbox("| Keine RCL-Bauteiledatei ! |||         Taste !|")
  1796.       ENDIF
  1797.       CLOSE #1
  1798.       neu_pfad_u_vorgabe
  1799.     ELSE
  1800.       alarmbox("| Datei existiert nicht ! |||         Taste !|")
  1801.     ENDIF
  1802.   ENDIF
  1803.   '
  1804. RETURN
  1805. '
  1806. PROCEDURE bauteile_speichern
  1807.   '
  1808.   LOCAL r,c,l
  1809.   '
  1810.   FILESELECT #"Bauteile speichern",pfad$+"*.BAU",dnam$+".BAU",datei$
  1811.   '
  1812.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1813.     '
  1814.     IF INSTR(datei$,".")=0
  1815.       datei$=datei$+".BAU"
  1816.     ENDIF
  1817.     '
  1818.     r=99
  1819.     DO
  1820.       EXIT IF r(r)>0 OR r=0
  1821.       DEC r
  1822.     LOOP
  1823.     '
  1824.     c=99
  1825.     DO
  1826.       EXIT IF c(c)>0 OR c=0
  1827.       DEC c
  1828.     LOOP
  1829.     '
  1830.     l=99
  1831.     DO
  1832.       EXIT IF l(l)>0 OR l=0
  1833.       DEC l
  1834.     LOOP
  1835.     '
  1836.     OPEN "O",#1,datei$
  1837.     OUT #1,66,65,85,84                      ! B A U T  als Dateikennung
  1838.     BPUT #1,VARPTR(f_min),8
  1839.     BPUT #1,VARPTR(f_max),8
  1840.     BPUT #1,VARPTR(betr_swr_max),8
  1841.     BPUT #1,VARPTR(daempf_max),8
  1842.     BPUT #1,VARPTR(wellenwiderstand),8
  1843.     BPUT #1,VARPTR(betrag_darst&),2
  1844.     BPUT #1,VARPTR(betr_swr_darst&),2
  1845.     BPUT #1,VARPTR(phase_darst&),2
  1846.     BPUT #1,VARPTR(schrittweite&),2
  1847.     BPUT #1,VARPTR(f_achse&),2
  1848.     BPUT #1,VARPTR(r),8
  1849.     BPUT #1,VARPTR(c),8
  1850.     BPUT #1,VARPTR(l),8
  1851.     BPUT #1,VARPTR(r(0)),(r+1)*8
  1852.     BPUT #1,VARPTR(c(0)),(c+1)*8
  1853.     BPUT #1,VARPTR(l(0)),(l+1)*8
  1854.     CLOSE #1
  1855.     neu_pfad_u_vorgabe
  1856.   ENDIF
  1857.   '
  1858. RETURN
  1859. '
  1860. PROCEDURE bauteile_drucken
  1861.   '
  1862.   LOCAL a$,n&,k&
  1863.   '
  1864.   n&=99                                     ! Zeilenzahl bestimmen
  1865.   WHILE r(n&)=0 AND c(n&)=0 AND l(n&)=0
  1866.     DEC n&
  1867.     EXIT IF n&=-1
  1868.   WEND
  1869.   '
  1870.   IF n&<0
  1871.     '
  1872.     a$="|Es sind keine Bauteile vorhanden|||           Taste !|"
  1873.     alarmbox(a$)
  1874.     '
  1875.   ELSE
  1876.     '
  1877.     IF GEMDOS(17)=TRUE
  1878.       drucker_initialisieren
  1879.       LPRINT
  1880.       LPRINT
  1881.       LPRINT " Bauteile zu  ";dnam$
  1882.       LPRINT
  1883.       LPRINT "     Nummer           R                    C                    L"
  1884.       LPRINT
  1885.       FOR k&=0 TO n&
  1886.         LPRINT "      ";STR$(k&,2);"     ";FN wert$(r(k&),10,0);"        ";
  1887.         LPRINT FN wert$(c(k&),10,0);"        ";FN wert$(l(k&),10,0)
  1888.       NEXT k&
  1889.     ELSE
  1890.       alarmbox("| Drucker nicht bereit ! |||        Taste !|")
  1891.     ENDIF
  1892.     '
  1893.   ENDIF
  1894.   '
  1895. RETURN
  1896. '
  1897. PROCEDURE bauteile_loeschen
  1898.   '
  1899.   alarmbox("| Bauteile löschen ? |||       j / n|")
  1900.   IF antw&=jk& OR antw&=jg&
  1901.     ARRAYFILL r(),0
  1902.     ARRAYFILL c(),0
  1903.     ARRAYFILL l(),0
  1904.     oberst&(1)=0
  1905.     oberst&(2)=0
  1906.     oberst&(3)=0
  1907.     zeile&(1)=0
  1908.     zeile&(2)=0
  1909.     zeile&(3)=0
  1910.     dialogbox2_neu&=TRUE
  1911.   ENDIF
  1912.   '
  1913. RETURN
  1914. '
  1915. PROCEDURE grafik_laden
  1916.   '
  1917.   LOCAL kopf$,dateilaenge%,bildzeiger%,bildende%
  1918.   LOCAL kurvezeiger%,schirmzeiger%,byte&,byteanzahl&,signal&,n&
  1919.   '
  1920.   FILESELECT #"Grafik laden",pfad$+"*.P??",dnam$+".PAK",datei$
  1921.   '
  1922.   IF datei$<>"" AND RIGHT$(datei$)<>"\"
  1923.     '
  1924.     IF EXIST(datei$)
  1925.       '
  1926.       OPEN "I",#1,datei$
  1927.       dateilaenge%=LOF(#1)
  1928.       '
  1929.       IF dateilaenge%=32000
  1930.         BGET #1,VARPTR(kurve$),32000
  1931.         SPUT kurve$
  1932.         DELAY 1
  1933.         dialogbox1_neu&=TRUE
  1934.       ELSE IF dateilaenge%>58
  1935.         kopf$=""
  1936.         FOR n&=1 TO 4
  1937.           kopf$=kopf$+CHR$(INP(#1))
  1938.         NEXT n&
  1939.         IF kopf$="DKZA"
  1940.           BGET #1,VARPTR(f_min),8
  1941.           BGET #1,VARPTR(f_max),8
  1942.           BGET #1,VARPTR(betr_swr_max),8
  1943.           BGET #1,VARPTR(daempf_max),8
  1944.           BGET #1,VARPTR(wellenwiderstand),8
  1945.           BGET #1,VARPTR(betrag_darst&),2
  1946.           BGET #1,VARPTR(betr_swr_darst&),2
  1947.           BGET #1,VARPTR(phase_darst&),2
  1948.           BGET #1,VARPTR(schrittweite&),2
  1949.           BGET #1,VARPTR(f_achse&),2
  1950.           BGET #1,VARPTR(signal&),2
  1951.           dateilaenge%=dateilaenge%-56
  1952.           '
  1953.           BGET #1,VARPTR(bild$),dateilaenge%
  1954.           '
  1955.           ' Jetzt wird das Bild in bild$ dekomprimiert nach kurve$
  1956.           '
  1957.           bildzeiger%=VARPTR(bild$)
  1958.           bildende%=bildzeiger%+dateilaenge%-1
  1959.           kurvezeiger%=VARPTR(kurve$)
  1960.           schirmzeiger%=XBIOS(2)
  1961.           CLS
  1962.           '
  1963.           REPEAT
  1964.             '
  1965.             byte&=PEEK(bildzeiger%)
  1966.             POKE kurvezeiger%,byte&
  1967.             INC kurvezeiger%
  1968.             POKE schirmzeiger%,byte&
  1969.             INC schirmzeiger%
  1970.             INC bildzeiger%
  1971.             '
  1972.             IF byte&=signal&
  1973.               byteanzahl&=PEEK(bildzeiger%)
  1974.               INC bildzeiger%
  1975.               IF byteanzahl&>0
  1976.                 byte&=PEEK(bildzeiger%-3)
  1977.                 DEC kurvezeiger%
  1978.                 DEC schirmzeiger%
  1979.                 FOR n&=1 TO byteanzahl&+2
  1980.                   POKE kurvezeiger%,byte&
  1981.                   INC kurvezeiger%
  1982.                   POKE schirmzeiger%,byte&
  1983.                   INC schirmzeiger%
  1984.                 NEXT n&
  1985.               ENDIF
  1986.             ENDIF
  1987.             '
  1988.           UNTIL bildzeiger%>bildende%
  1989.           '
  1990.           dialogbox1_neu&=TRUE
  1991.         ELSE
  1992.           alarmbox("| Kein RCL-Bild ! |||     Taste !|")
  1993.         ENDIF
  1994.       ELSE
  1995.         alarmbox("| Falsche Dateilänge ! |||       Taste !|")
  1996.       ENDIF
  1997.       CLOSE #1
  1998.       neu_pfad_u_vorgabe
  1999.     ELSE
  2000.       alarmbox("| Datei existiert nicht ! |||        Taste !|")
  2001.     ENDIF
  2002.   ENDIF
  2003.   '
  2004. RETURN
  2005. '
  2006. PROCEDURE grafik_speichern
  2007.   '
  2008.   LOCAL a$,dateilaenge%,bildzeiger%,bildanfang%,bildende%
  2009.   LOCAL byte&,seltenstes_byte&,aagb&,min&,n&
  2010.   '
  2011.   GRAPHMODE 1
  2012.   COLOR schwarz&
  2013.   '
  2014.   a$="|                          Grafik speichern|"
  2015.   a$=a$+"                         ==================||"
  2016.   a$=a$+"Auswahl                                  "
  2017.   a$=a$+"                            Taste|"
  2018.   a$=a$+"-------                                   "
  2019.   a$=a$+"                           -----||"
  2020.   a$=a$+"Die erzeugte Grafik wird ungepackt als Datei der Länge|"
  2021.   a$=a$+"32000 Bytes gespeichert, die von jedem Zeichenprogramm|"
  2022.   a$=a$+"und von RCL gelesen werden kann. ( Dateiname:  xxxxxxxx.PIC )"
  2023.   a$=a$+" .....    1|||"
  2024.   a$=a$+"Die erzeugte Grafik wird als gepackte Datei ( zusammen mit|"
  2025.   a$=a$+"allen Parametern von Dialogbox 1 ) gespeichert, die nur von|"
  2026.   a$=a$+"RCL wieder gelesen werden kann.  Beim Lesen werden die|"
  2027.   a$=a$+"Parameter wieder eingestellt.    ( Dateiname:  xxxxxxxx.PAK )"
  2028.   a$=a$+" .....    2||||"
  2029.   a$=a$+"abbrechen ............."
  2030.   a$=a$+"............................................  Undo |"
  2031.   alarmbox(a$)
  2032.   '
  2033.   IF antw&=eins&
  2034.     '
  2035.     FILESELECT #"Grafik speichern",pfad$+"*.PIC",dnam$+".PIC",datei$
  2036.     '
  2037.     IF datei$<>"" AND RIGHT$(datei$)<>"\"
  2038.       IF INSTR(datei$,".")=0
  2039.         datei$=datei$+".PIC"
  2040.       ENDIF
  2041.       SPUT kurve$
  2042.       teilungslinien_zeichnen
  2043.       BSAVE datei$,XBIOS(2),32000
  2044.       neu_pfad_u_vorgabe
  2045.     ENDIF
  2046.     '
  2047.     dialogbox1_neu&=TRUE
  2048.   ENDIF
  2049.   '
  2050.   IF antw&=zwei&
  2051.     '
  2052.     FILESELECT #"Grafik speichern",pfad$+"*.PAK",dnam$+".PAK",datei$
  2053.     '
  2054.     IF datei$<>"" AND RIGHT$(datei$)<>"\"
  2055.       '
  2056.       IF INSTR(datei$,".")=0
  2057.         datei$=datei$+".PAK"
  2058.       ENDIF
  2059.       '
  2060.       OPEN "O",#1,datei$
  2061.       '
  2062.       OUT #1,68,75,90,65                    ! D K Z A  als Dateikennung
  2063.       BPUT #1,VARPTR(f_min),8               ! Es folgen 50 Bytes Parameter
  2064.       BPUT #1,VARPTR(f_max),8
  2065.       BPUT #1,VARPTR(betr_swr_max),8
  2066.       BPUT #1,VARPTR(daempf_max),8
  2067.       BPUT #1,VARPTR(wellenwiderstand),8
  2068.       BPUT #1,VARPTR(betrag_darst&),2
  2069.       BPUT #1,VARPTR(betr_swr_darst&),2
  2070.       BPUT #1,VARPTR(phase_darst&),2
  2071.       BPUT #1,VARPTR(schrittweite&),2
  2072.       BPUT #1,VARPTR(f_achse&),2
  2073.       '
  2074.       ' Es wird eine einfache Lauflängenkomprimierung verwendet
  2075.       '
  2076.       SPUT kurve$
  2077.       teilungslinien_zeichnen               ! Bild auf Bildschirm
  2078.       '
  2079.       ' Zuerst wird das seltenste Byte bestimmt. In der komprimierten Datei
  2080.       ' bedeutet es:  Das nach mir folgende Byte gibt an, wie oft das vor
  2081.       ' mir stehende Byte noch wiederholt werden soll.
  2082.       ' Falls das Signalbyte selbst im Bild vorkommt, wird es an die
  2083.       ' komprimierte Datei weitergegeben, gefolgt von einem Nullbyte.
  2084.       '
  2085.       bildanfang%=XBIOS(2)
  2086.       bildende%=bildanfang%+31999           ! letztes Bildschirmbyte
  2087.       '
  2088.       ' Häufigkeit der einzelnen Bytes feststellen:
  2089.       '
  2090.       ARRAYFILL anzahl&(),0
  2091.       FOR bildzeiger%=bildanfang% TO bildende%
  2092.         byte&=PEEK(bildzeiger%)
  2093.         INC anzahl&(byte&)
  2094.       NEXT bildzeiger%
  2095.       '
  2096.       ' Nun das seltenste bestimmen:
  2097.       '
  2098.       min&=anzahl&(0)
  2099.       seltenstes_byte&=0
  2100.       '
  2101.       FOR byte&=1 TO 255
  2102.         IF anzahl&(byte&)<min&
  2103.           min&=anzahl&(byte&)
  2104.           seltenstes_byte&=byte&
  2105.         ENDIF
  2106.       NEXT byte&
  2107.       '
  2108.       BPUT #1,VARPTR(seltenstes_byte&),2
  2109.       dateilaenge%=56
  2110.       '
  2111.       bildzeiger%=bildanfang%               ! erstes Bildschirmbyte
  2112.       '
  2113.       REPEAT
  2114.         '
  2115.         byte&=PEEK(bildzeiger%)
  2116.         OUT #1,byte&
  2117.         INC bildzeiger%
  2118.         INC dateilaenge%
  2119.         '
  2120.         IF byte&=seltenstes_byte&
  2121.           OUT #1,0
  2122.           INC dateilaenge%
  2123.         ELSE
  2124.           '
  2125.           ' Anzahl aufeinanderfolgender gleicher Bytes (aagb&) bestimmen:
  2126.           '
  2127.           aagb&=0
  2128.           WHILE PEEK(bildzeiger%)=byte& AND aagb&<256 AND bildzeiger%<=bildende%
  2129.             INC aagb&
  2130.             INC bildzeiger%
  2131.           WEND
  2132.           '
  2133.           ' aagb& ist jetzt die Anzahl der Bytes, die auch gleich byte& sind
  2134.           ' meistens zeigt hier bildzeiger% auf ein anderes Byte als byte&
  2135.           '
  2136.           IF aagb&<3
  2137.             FOR n&=1 TO aagb&
  2138.               OUT #1,byte&
  2139.               INC dateilaenge%
  2140.             NEXT n&
  2141.           ELSE
  2142.             OUT #1,seltenstes_byte&
  2143.             INC dateilaenge%
  2144.             OUT #1,aagb&-2
  2145.             INC dateilaenge%
  2146.           ENDIF
  2147.         ENDIF
  2148.         '
  2149.       UNTIL bildzeiger%>bildende%
  2150.       '
  2151.       IF dateilaenge%=32000   ! gepackte Datei darf nicht 32000 lang sein
  2152.         OUT #1,0
  2153.       ENDIF
  2154.       '
  2155.       CLOSE #1
  2156.       neu_pfad_u_vorgabe
  2157.       dialogbox1_neu&=TRUE
  2158.       '
  2159.     ENDIF
  2160.     '
  2161.   ENDIF
  2162.   '
  2163. RETURN
  2164. '
  2165. PROCEDURE grafik_drucken
  2166.   '
  2167.   LOCAL graphmod$,datenanz$,vorschub$,lwort%,druckzeile&,n&,x&,punkt&,y&
  2168.   LOCAL zwopunkt&,e&,dreipunkt&,i&,abbrechen&
  2169.   LOCAL byte1|,byte2|,byte3|
  2170.   '
  2171.   GRAPHMODE 1
  2172.   COLOR schwarz&
  2173.   '
  2174.   SGET dialogbox1$
  2175.   '
  2176.   a$="|                           Grafik drucken|"
  2177.   a$=a$+"                          ================||"
  2178.   a$=a$+"  NEC P 6, EPSON LQ 570 oder zu die"
  2179.   a$=a$+"sen kompatible 24-Nadel-Drucker|||"
  2180.   a$=a$+"  Auswahl               "
  2181.   a$=a$+"                                     Taste|"
  2182.   a$=a$+"  -------                                                    --"
  2183.   a$=a$+"---  |||"
  2184.   a$=a$+"  Format   9 cm  x   5,6 cm ......... ( 2 m"
  2185.   a$=a$+"in 20 s) ........   1  ||"
  2186.   a$=a$+"  Format  18 cm  x  11,2 cm ......... ( 4 m"
  2187.   a$=a$+"in ) ............   2  ||"
  2188.   a$=a$+"  Format  27 cm  x  16,8 cm ......... ( 6 m"
  2189.   a$=a$+"in 30 s ) .......   3  ||||"
  2190.   a$=a$+"  oder abbrechen ( auch wä"
  2191.   a$=a$+"hrend des Druckens ) .............  Undo  ||"
  2192.   alarmbox(a$)
  2193.   '
  2194.   IF antw&=eins& OR antw&=zwei& OR antw&=drei&
  2195.     '
  2196.     IF GEMDOS(17)=TRUE
  2197.       '
  2198.       SPUT kurve$
  2199.       teilungslinien_zeichnen
  2200.       BOX 0,0,639,399
  2201.       '
  2202.       graphmod$=CHR$(esc&)+"*"+CHR$(39)
  2203.       vorschub$=CHR$(esc&)+"J"+CHR$(24)+CHR$(13)
  2204.       '
  2205.       IF antw&=eins&                 ! Ein Bildschirmpunkt -> ein Druckerpunkt
  2206.         '
  2207.         datenanz$=CHR$(178)+CHR$(2)
  2208.         '
  2209.         LPRINT
  2210.         FOR druckzeile&=0 TO 15
  2211.           '
  2212.           abbrechen&=FALSE
  2213.           IF INP?(2)
  2214.             i&=INP(2)
  2215.             REPEAT                                 ! Nachlaufen verhindern
  2216.             UNTIL INKEY$=""
  2217.             IF i&=undo&
  2218.               alarmbox("| Druck abbrechen ? |||       j / n|")
  2219.               IF antw&=jk& OR antw&=jg&
  2220.                 abbrechen&=TRUE
  2221.               ENDIF
  2222.               EXIT IF abbrechen&=TRUE
  2223.             ENDIF
  2224.           ENDIF
  2225.           '
  2226.           LPRINT graphmod$;datenanz$;
  2227.           '
  2228.           FOR n&=0 TO 49
  2229.             LPRINT CHR$(0);CHR$(0);CHR$(0);
  2230.           NEXT n&
  2231.           '
  2232.           FOR x&=0 TO 639
  2233.             '
  2234.             lwort%=0
  2235.             FOR punkt&=0 TO 23
  2236.               y&=ADD(MUL(24,druckzeile&),punkt&)
  2237.               IF PTST(x&,y&)
  2238.                 lwort%=BSET(lwort%,SUB(23,punkt&))
  2239.               ENDIF
  2240.             NEXT punkt&
  2241.             '
  2242.             byte3|=BYTE(lwort%)
  2243.             byte2|=DIV(CARD(lwort%),256)
  2244.             lwort%=SWAP(lwort%)
  2245.             byte1|=BYTE(lwort%)
  2246.             '
  2247.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2248.             '
  2249.           NEXT x&
  2250.           '
  2251.           LPRINT vorschub$;
  2252.           '
  2253.         NEXT druckzeile&
  2254.         '
  2255.         ' Jetzt kommen die letzten 16 Rasterzeilen:
  2256.         '
  2257.         IF abbrechen&=FALSE
  2258.           '
  2259.           LPRINT graphmod$;datenanz$;
  2260.           '
  2261.           FOR n&=0 TO 49
  2262.             LPRINT CHR$(0);CHR$(0);CHR$(0);
  2263.           NEXT n&
  2264.           '
  2265.           FOR x&=0 TO 639
  2266.             '
  2267.             lwort%=0
  2268.             FOR punkt&=0 TO 15
  2269.               y&=ADD(384,punkt&)
  2270.               IF PTST(x&,y&)
  2271.                 lwort%=BSET(lwort%,SUB(15,punkt&))
  2272.               ENDIF
  2273.             NEXT punkt&
  2274.             '
  2275.             LPRINT CHR$(DIV(CARD(lwort%),256));CHR$(BYTE(lwort%));CHR$(0);
  2276.             '
  2277.           NEXT x&
  2278.           '
  2279.         ENDIF
  2280.         '
  2281.       ENDIF
  2282.       '
  2283.       IF antw&=zwei&                 ! Ein Bildschirmpunkt -> 4 Druckerpunkte
  2284.         '
  2285.         datenanz$=CHR$(50)+CHR$(5)
  2286.         '
  2287.         LPRINT
  2288.         FOR druckzeile&=0 TO 32
  2289.           '
  2290.           abbrechen&=FALSE
  2291.           IF INP?(2)
  2292.             i&=INP(2)
  2293.             REPEAT                                 ! Nachlaufen verhindern
  2294.             UNTIL INKEY$=""
  2295.             IF i&=undo&
  2296.               alarmbox("| Druck abbrechen ? |||       j / n|")
  2297.               IF antw&=jk& OR antw&=jg&
  2298.                 abbrechen&=TRUE
  2299.               ENDIF
  2300.               EXIT IF abbrechen&=TRUE
  2301.             ENDIF
  2302.           ENDIF
  2303.           '
  2304.           LPRINT graphmod$;datenanz$;
  2305.           '
  2306.           FOR n&=0 TO 49
  2307.             LPRINT CHR$(0);CHR$(0);CHR$(0);
  2308.           NEXT n&
  2309.           '
  2310.           FOR x&=0 TO 639
  2311.             '
  2312.             lwort%=0
  2313.             FOR punkt&=0 TO 11
  2314.               y&=ADD(MUL(12,druckzeile&),punkt&)
  2315.               zwopunkt&=ADD(punkt&,punkt&)
  2316.               IF PTST(x&,y&)
  2317.                 lwort%=BSET(lwort%,SUB(23,zwopunkt&))
  2318.                 lwort%=BSET(lwort%,SUB(22,zwopunkt&))
  2319.               ENDIF
  2320.             NEXT punkt&
  2321.             '
  2322.             byte3|=BYTE(lwort%)
  2323.             byte2|=DIV(CARD(lwort%),256)
  2324.             lwort%=SWAP(lwort%)
  2325.             byte1|=BYTE(lwort%)
  2326.             '
  2327.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2328.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2329.             '
  2330.           NEXT x&
  2331.           '
  2332.           LPRINT vorschub$;
  2333.           '
  2334.         NEXT druckzeile&
  2335.         '
  2336.         ' Jetzt kommen die letzten 4 Rasterzeilen:
  2337.         '
  2338.         IF abbrechen&=FALSE
  2339.           '
  2340.           LPRINT graphmod$;datenanz$;
  2341.           '
  2342.           FOR n&=0 TO 49
  2343.             LPRINT CHR$(0);CHR$(0);CHR$(0);
  2344.           NEXT n&
  2345.           '
  2346.           FOR x&=0 TO 639
  2347.             '
  2348.             byte1|=0
  2349.             FOR punkt&=0 TO 3
  2350.               y&=ADD(396,punkt&)
  2351.               zwopunkt&=ADD(punkt&,punkt&)
  2352.               IF PTST(x&,y&)
  2353.                 byte1|=BSET(byte1|,SUB(7,zwopunkt&))
  2354.                 byte1|=BSET(byte1|,SUB(6,zwopunkt&))
  2355.               ENDIF
  2356.             NEXT punkt&
  2357.             '
  2358.             LPRINT CHR$(byte1|);CHR$(0);CHR$(0);
  2359.             LPRINT CHR$(byte1|);CHR$(0);CHR$(0);
  2360.             '
  2361.           NEXT x&
  2362.           '
  2363.         ENDIF
  2364.         '
  2365.       ENDIF
  2366.       '
  2367.       IF antw&=drei&                 ! Ein Bildschirmpunkt -> 9 Druckerpunkte
  2368.         '
  2369.         datenanz$=CHR$(help&)+CHR$(4)
  2370.         '
  2371.         LPRINT
  2372.         FOR druckzeile&=0 TO 79
  2373.           '
  2374.           abbrechen&=FALSE
  2375.           IF INP?(2)
  2376.             i&=INP(2)
  2377.             REPEAT                                 ! Nachlaufen verhindern
  2378.             UNTIL INKEY$=""
  2379.             IF i&=undo&
  2380.               alarmbox("| Druck abbrechen ? |||       j / n|")
  2381.               IF antw&=jk& OR antw&=jg&
  2382.                 abbrechen&=TRUE
  2383.               ENDIF
  2384.               EXIT IF abbrechen&=TRUE
  2385.             ENDIF
  2386.           ENDIF
  2387.           '
  2388.           LPRINT graphmod$;datenanz$;
  2389.           '
  2390.           FOR n&=0 TO 49
  2391.             LPRINT CHR$(0);CHR$(0);CHR$(0);
  2392.           NEXT n&
  2393.           '
  2394.           FOR x&=0 TO 399
  2395.             '
  2396.             lwort%=0
  2397.             FOR punkt&=0 TO 7
  2398.               y&=ADD(MUL(8,druckzeile&),punkt&)
  2399.               dreipunkt&=ADD(ADD(punkt&,punkt&),punkt&)
  2400.               IF PTST(y&,SUB(399,x&))
  2401.                 lwort%=BSET(lwort%,SUB(23,dreipunkt&))
  2402.                 lwort%=BSET(lwort%,SUB(22,dreipunkt&))
  2403.                 lwort%=BSET(lwort%,SUB(21,dreipunkt&))
  2404.               ENDIF
  2405.             NEXT punkt&
  2406.             '
  2407.             byte3|=BYTE(lwort%)
  2408.             byte2|=DIV(CARD(lwort%),256)
  2409.             lwort%=SWAP(lwort%)
  2410.             byte1|=BYTE(lwort%)
  2411.             '
  2412.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2413.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2414.             LPRINT CHR$(byte1|);CHR$(byte2|);CHR$(byte3|);
  2415.             '
  2416.           NEXT x&
  2417.           '
  2418.           LPRINT vorschub$;
  2419.           '
  2420.         NEXT druckzeile&
  2421.         '
  2422.       ENDIF
  2423.       '
  2424.       LPRINT
  2425.       '
  2426.     ELSE
  2427.       alarmbox("| Drucker nicht bereit ! |||        Taste !|")
  2428.     ENDIF
  2429.     '
  2430.   ENDIF
  2431.   '
  2432.   SPUT dialogbox1$
  2433.   '
  2434. RETURN
  2435. '
  2436. PROCEDURE grafik_loeschen
  2437.   '
  2438.   alarmbox("| Grafik löschen ? |||      j / n|")
  2439.   IF antw&=jk& OR antw&=jg&
  2440.     kurve$=STRING$(32000,0)
  2441.   ENDIF
  2442.   '
  2443. RETURN
  2444. '
  2445. PROCEDURE grafik_zeigen
  2446.   '
  2447.   ' Hierher gelangt man mit der Taste F5
  2448.   '
  2449.   LOCAL a$,ausschnitt_oben$,ausschnitt_unten$
  2450.   LOCAL f_nullp,f,f1,f2,exp_fakt,e&,x&,y&,x_alt&,y_alt&
  2451.   LOCAL lage&,x0&,x1&,y1&
  2452.   '
  2453.   zeige_grafik&=FALSE
  2454.   '
  2455.   IF f_min=0 AND f_achse&=log&
  2456.     '
  2457.     a$="| Bei logarithmischer Teilung | der Frequenzachse ||"
  2458.     a$=a$+" darf  f min  nicht 0 sein ! |||           Taste !|"
  2459.     alarmbox(a$)
  2460.     '
  2461.   ELSE
  2462.     '
  2463.     SPUT kurve$
  2464.     teilungslinien_zeichnen
  2465.     SGET bild$
  2466.     '
  2467.     y0log&=0
  2468.     y0lin&=0
  2469.     nullpkt_neu&=FALSE
  2470.     '
  2471.     GRAPHMODE 3
  2472.     '
  2473.     x_alt&=100
  2474.     y_alt&=250
  2475.     DRAW x_alt&,0 TO x_alt&,399
  2476.     DRAW 0,y_alt& TO 639,y_alt&
  2477.     HIDEM
  2478.     '
  2479.     lage&=25                                ! Zeile für Frequenz bzw. Betrag
  2480.     '
  2481.     f_nullp=0                               ! wird mit rechter Maustaste
  2482.     '                                         geändert
  2483.     IF f_achse&=log&
  2484.       exp_fakt=LOG(f_max/f_min)/639         ! spart weiter unten Rechenzeit
  2485.     ENDIF
  2486.     '
  2487.     REPEAT
  2488.       '
  2489.       GRAPHMODE 3
  2490.       '
  2491.       x&=MOUSEX
  2492.       y&=MOUSEY
  2493.       '
  2494.       IF x&<>x_alt&                         ! Fadenkreuz zeichnen
  2495.         DRAW x_alt&,0 TO x_alt&,399
  2496.         DRAW x&,0 TO x&,399
  2497.         x_alt&=x&
  2498.       ENDIF
  2499.       '
  2500.       IF y&<>y_alt&
  2501.         DRAW 0,y_alt& TO 639,y_alt&
  2502.         DRAW 0,y& TO 639,y&
  2503.         y_alt&=y&
  2504.       ENDIF
  2505.       '
  2506.       IF y&<24                             ! Zeile mit Betrag und Frequenz
  2507.         IF lage&=1                         ! evtl. aus dem Weg nehmen
  2508.           SPUT bild$
  2509.           DRAW 0,y& TO 639,y&
  2510.           DRAW x&,0 TO x&,399
  2511.         ENDIF
  2512.         lage&=25
  2513.       ENDIF
  2514.       '
  2515.       IF y&>376
  2516.         IF lage&=25
  2517.           SPUT bild$
  2518.           DRAW 0,y& TO 639,y&
  2519.           DRAW x&,0 TO x&,399
  2520.         ENDIF
  2521.         lage&=1
  2522.       ENDIF
  2523.       '
  2524.       IF f_achse&=lin&                                    ! Frequenz zur
  2525.         f=x&*(f_max-f_min)/639+f_min-f_nullp              ! Cursorstellung
  2526.       ELSE                                                ! berechnen
  2527.         f=f_min*EXP(x&*exp_fakt)-f_nullp
  2528.       ENDIF
  2529.       '
  2530.       PRINT AT(62,lage&);FN wert$(f,12,1);"Hz";
  2531.       '
  2532.       IF betr_swr_darst&=lin&                             ! Betrag zur
  2533.         betr_swr=(399-y&-y0lin&)*betr_swr_max/399         ! Cursorstellung
  2534.         PRINT AT(2,lage&);"Betrag/SWR: ";                 ! berechnen
  2535.         betr_swr_drucken(betr_swr)
  2536.       ENDIF
  2537.       '
  2538.       IF betr_swr_darst&=log&                             ! Dämpfung zur
  2539.         daempf=(y&-y0log&)*daempf_max/399                 ! Cursorstellung
  2540.         PRINT AT(2,lage&);USING "-###.## dB",-daempf;     ! berechnen
  2541.       ENDIF
  2542.       '
  2543.       IF phase_darst&=TRUE                                       ! dito
  2544.         PRINT AT(38,lage&);USING "-###.# Grad",9*(200-y&)/10;    ! Phase
  2545.       ENDIF
  2546.       '
  2547.       IF MOUSEK=1                                  ! linke Maustaste
  2548.         REPEAT                                     ! Warten, bis wieder
  2549.         UNTIL MOUSEK=0                             ! losgelassen
  2550.         x1&=MOUSEX
  2551.         y1&=MOUSEY
  2552.         SPUT kurve$
  2553.         DRAW x1&-5,y1& TO x1&+5,y1&                ! Kreuzchen zeichnen
  2554.         DRAW x1&,y1&-5 TO x1&,y1&+5
  2555.         DRAW x1&,y1&
  2556.         SGET kurve$
  2557.         SPUT bild$
  2558.         DRAW x1&-5,y1& TO x1&+5,y1&
  2559.         DRAW x1&,y1&-5 TO x1&,y1&+5
  2560.         DRAW x1&,y1&
  2561.         SGET bild$
  2562.         GRAPHMODE 3
  2563.         DRAW 0,y& TO 639,y&                        ! neues Fadenkreuz
  2564.         DRAW x&,0 TO x&,399
  2565.       ENDIF
  2566.       '
  2567.       IF MOUSEK=2                                  ! rechte Maustaste
  2568.         REPEAT
  2569.         UNTIL MOUSEK=0
  2570.         IF nullpkt_neu&=FALSE
  2571.           x0&=MOUSEX
  2572.           IF f_achse&=lin&
  2573.             f_nullp=x0&*(f_max-f_min)/639+f_min
  2574.           ELSE
  2575.             f_nullp=f_min*EXP(x0&*exp_fakt)
  2576.           ENDIF
  2577.           y0log&=MOUSEY
  2578.           y0lin&=399-y0log&
  2579.           nullpkt_neu&=TRUE
  2580.         ELSE
  2581.           f_nullp=0
  2582.           y0log&=0
  2583.           y0lin&=0
  2584.           nullpkt_neu&=FALSE
  2585.         ENDIF
  2586.       ENDIF
  2587.       '
  2588.       e&=0
  2589.       IF INP?(2)                            ! Taste gedrückt ?
  2590.         e&=INP(2)                           ! Taste holen
  2591.         REPEAT                              ! Nachlaufen verhindern
  2592.         UNTIL INKEY$=""
  2593.         '
  2594.         IF e&=help&
  2595.           a$="|Linke Maustaste  :  Markierungen setzen/löschen||"
  2596.           a$=a$+"Rechte Maustaste :  Koordinatennullpunkt setzen/rücksetzen|||"
  2597.           a$=a$+"F2               :  Teilungs"
  2598.           a$=a$+"linien Betrag    ein / aus|"
  2599.           a$=a$+"                    ( nur bei logarithmischer Darstellung )||"
  2600.           a$=a$+"F4               :  Teilungs"
  2601.           a$=a$+"linien Frequenz  ein / aus|"
  2602.           a$=a$+"                    ( nur bei logarithmischer Darstellung )|||"
  2603.           a$=a$+"F5               :  zurück zum Menü||"
  2604.           a$=a$+"F7               :  Frequenzintervall von dem ( evtl. mit der "
  2605.           a$=a$+"rechten|"
  2606.           a$=a$+"                    Maustaste gesetzten ) Koordinatennullpunkt "
  2607.           a$=a$+"bis zur|"
  2608.           a$=a$+"                    Cursorposition als  f min  und  f max  "
  2609.           a$=a$+"übernehmen,|"
  2610.           a$=a$+"                    dann zurück zum Menü|||"
  2611.           a$=a$+"                            Taste !|"
  2612.           alarmbox(a$)
  2613.           GRAPHMODE 3
  2614.         ENDIF
  2615.         '
  2616.         IF e&=(f2& AND betr_swr_darst&=log&) OR (e&=f4& AND f_achse&=log&)
  2617.           GRAPHMODE 1
  2618.           COLOR 1
  2619.           IF e&=f2&
  2620.             IF daempfungslinien&=TRUE
  2621.               daempfungslinien&=FALSE
  2622.             ELSE
  2623.               daempfungslinien&=TRUE
  2624.               '
  2625.               SPUT kurve$
  2626.               GET 8,360,631,392,ausschnitt_unten$
  2627.               DEFFILL 0,1
  2628.               PBOX 8,360,631,392
  2629.               BOX 8,360,631,392
  2630.               BOX 9,361,630,391
  2631.               BOX 12,364,627,388
  2632.               PRINT AT(4,24);"Linienstil wechseln:  F10";
  2633.               PRINT AT(61,24);"Wenn fertig:  F2"
  2634.               '
  2635.               GET 0,0,639,355,ausschnitt_oben$
  2636.               '
  2637.               DO
  2638.                 '
  2639.                 PUT 0,0,ausschnitt_oben$
  2640.                 '
  2641.                 DEFLINE strich%(linienstild&)
  2642.                 '
  2643.                 IF daempf_max>3
  2644.                   IF 1200/daempf_max<360
  2645.                     DRAW 0,1200/daempf_max TO 639,1200/daempf_max
  2646.                   ENDIF
  2647.                 ENDIF
  2648.                 IF daempf_max>6
  2649.                   IF 2400/daempf_max<360
  2650.                     DRAW 0,2400/daempf_max TO 639,2400/daempf_max
  2651.                   ENDIF
  2652.                 ENDIF
  2653.                 FOR daempf=10 TO daempf_max STEP 10
  2654.                   IF 400*daempf/daempf_max<360
  2655.                     DRAW 0,400*daempf/daempf_max TO 639,400*daempf/daempf_max
  2656.                   ENDIF
  2657.                 NEXT daempf
  2658.                 '
  2659.                 PRINT AT(35,24);"Linienstil jetzt ";linienstild&
  2660.                 REPEAT
  2661.                   n&=INP(2)
  2662.                   REPEAT
  2663.                   UNTIL INKEY$=""
  2664.                 UNTIL n&=f2& OR n&=f10&
  2665.                 '
  2666.                 EXIT IF n&=f2&
  2667.                 '
  2668.                 IF n&=f10&
  2669.                   linienstild&=linienstild&+1
  2670.                   IF linienstild&>7
  2671.                     linienstild&=0
  2672.                   ENDIF
  2673.                 ELSE
  2674.                   n&=n&-48
  2675.                   linie(n&)=-linie(n&)
  2676.                 ENDIF
  2677.                 '
  2678.               LOOP
  2679.               '
  2680.               PUT 0,0,ausschnitt_oben$
  2681.               PUT 8,360,ausschnitt_unten$
  2682.               '
  2683.             ENDIF
  2684.             '
  2685.           ELSE
  2686.             '
  2687.             IF frequenzlinien&=TRUE
  2688.               frequenzlinien&=FALSE
  2689.             ELSE
  2690.               frequenzlinien&=TRUE
  2691.               '
  2692.               SPUT kurve$
  2693.               GET 8,245,631,392,ausschnitt_unten$
  2694.               DEFFILL 0,1
  2695.               PBOX 8,245,631,392
  2696.               BOX 8,245,631,392
  2697.               BOX 9,246,630,391
  2698.               BOX 12,249,627,388
  2699.               PRINT AT(4,17);"Bei welchen Frequenzen sol";
  2700.               PRINT "len Linien gezeichnet werden ?"
  2701.               PRINT AT(4,18);"Drücken Sie die entsprechende Zifferntaste !"
  2702.               PRINT AT(4,20);"Bei           1 *   1,5     2     3     4     5";
  2703.               PRINT "     6     7     8     9"
  2704.               PRINT AT(4,22);"Taste:               1      2     3     4     5";
  2705.               PRINT "     6     7     8     9"
  2706.               PRINT AT(4,24);"Linienstil wechseln:  F10";
  2707.               PRINT AT(61,24);"Wenn fertig:  F4"
  2708.               '
  2709.               GET 0,0,639,229,ausschnitt_oben$
  2710.               '
  2711.               h=639/LOG(f_max/f_min)
  2712.               '
  2713.               DO
  2714.                 '
  2715.                 FOR n&=1 TO 9
  2716.                   IF linie(n&)<0
  2717.                     PRINT AT(22+6*n&,20);"*";
  2718.                   ELSE
  2719.                     PRINT AT(22+6*n&,20);" ";
  2720.                   ENDIF
  2721.                 NEXT n&
  2722.                 '
  2723.                 PUT 0,0,ausschnitt_oben$
  2724.                 '
  2725.                 DEFLINE strich%(linienstilf&)
  2726.                 n&=0
  2727.                 fa=10^INT(LOG10(f_min))
  2728.                 fx=fa
  2729.                 DO
  2730.                   EXIT IF fx>f_max
  2731.                   IF fx>=f_min
  2732.                     xx=h*LOG(fx/f_min)
  2733.                     DRAW xx,0 TO xx,229
  2734.                   ENDIF
  2735.                   INC n&
  2736.                   IF n&>9
  2737.                     n&=0
  2738.                     fa=10*fa
  2739.                   ENDIF
  2740.                   IF linie(n&)<0
  2741.                     fx=-fa*linie(n&)
  2742.                   ENDIF
  2743.                 LOOP
  2744.                 '
  2745.                 PRINT AT(35,24);"Linienstil jetzt ";linienstilf&
  2746.                 REPEAT
  2747.                   n&=INP(2)
  2748.                   REPEAT
  2749.                   UNTIL INKEY$=""
  2750.                 UNTIL n&=f4& OR n&=f10& OR (n&>48 AND n&<58)
  2751.                 '
  2752.                 EXIT IF n&=f4&
  2753.                 '
  2754.                 IF n&=f10&
  2755.                   linienstilf&=linienstilf&+1
  2756.                   IF linienstilf&>7
  2757.                     linienstilf&=0
  2758.                   ENDIF
  2759.                 ELSE
  2760.                   n&=n&-48
  2761.                   linie(n&)=-linie(n&)
  2762.                 ENDIF
  2763.                 '
  2764.               LOOP
  2765.               '
  2766.               PUT 0,0,ausschnitt_oben$
  2767.               PUT 8,245,ausschnitt_unten$
  2768.               '
  2769.             ENDIF
  2770.             '
  2771.           ENDIF
  2772.           SPUT kurve$
  2773.           teilungslinien_zeichnen
  2774.           SGET bild$
  2775.           GRAPHMODE 3
  2776.           DRAW x_alt&,0 TO x_alt&,399
  2777.           DRAW 0,y_alt& TO 639,y_alt&
  2778.         ENDIF
  2779.         '
  2780.         IF e&=f7&
  2781.           f1=f_nullp
  2782.           f2=f1+f
  2783.           IF f1<>f2
  2784.             IF f2<f1
  2785.               SWAP f1,f2
  2786.             ENDIF
  2787.             IF nullpkt_neu&=TRUE
  2788.               f_min=f1
  2789.             ENDIF
  2790.             f_max=f2
  2791.             dialogbox1_neu&=TRUE
  2792.           ELSE
  2793.             a$="| f min  =  f max  ist nicht sinn"
  2794.             a$=a$+"voll ! |||              Taste !|"
  2795.             alarmbox(a$)
  2796.             GRAPHMODE 3
  2797.           ENDIF
  2798.         ENDIF
  2799.         '
  2800.       ENDIF
  2801.       '
  2802.     UNTIL e&=f7& OR e&=f5&
  2803.     '
  2804.   ENDIF
  2805.   '
  2806. RETURN
  2807. '
  2808. PROCEDURE betr_swr_drucken(b_s)
  2809.   '
  2810.   IF ABS(b_s)>=10000 OR (ABS(b_s)<0.00001 AND ABS(b_s)>b_s_max/400)
  2811.     PRINT USING "-###.##^^^^",b_s;
  2812.   ELSE IF ABS(b_s)>=1
  2813.     PRINT USING "-#####.####",b_s;
  2814.   ELSE
  2815.     PRINT USING "-#.########",b_s;
  2816.   ENDIF
  2817.   '
  2818. RETURN
  2819. '
  2820. PROCEDURE alarmbox(e$)
  2821.   '
  2822.   LOCAL ausschnitt$
  2823.   LOCAL maxlang&,zeilenzahl&,wo&,p&,erste_zeile&,zeilenanfang&,zeile&
  2824.   LOCAL x_min&,x_max&,y_min&,y_max&
  2825.   '
  2826.   GRAPHMODE 1
  2827.   COLOR schwarz&
  2828.   '
  2829.   maxlang&=0
  2830.   zeilenzahl&=1
  2831.   '
  2832.   IF INSTR(e$,"|")=0
  2833.     maxlang&=LEN(e$)
  2834.   ELSE
  2835.     wo&=1
  2836.     DO
  2837.       p&=INSTR(e$,"|",wo&)
  2838.       EXIT IF p&=0
  2839.       INC zeilenzahl&
  2840.       IF maxlang&<p&-wo&
  2841.         maxlang&=p&-wo&
  2842.       ENDIF
  2843.       wo&=p&+1
  2844.     LOOP
  2845.   ENDIF
  2846.   '
  2847.   erste_zeile&=13-INT(zeilenzahl&/2)
  2848.   zeilenanfang&=41-INT(maxlang&/2)
  2849.   x_min&=(zeilenanfang&-1)*8-20
  2850.   x_max&=x_min&+8*maxlang&+38
  2851.   y_min&=(erste_zeile&-1)*16-11
  2852.   y_max&=y_min&+16*zeilenzahl&+21
  2853.   '
  2854.   GET x_min&,y_min&,x_max&,y_max&,ausschnitt$
  2855.   DEFFILL 0,1
  2856.   PBOX x_min&,y_min&,x_max&,y_max&
  2857.   BOX x_min&,y_min&,x_max&,y_max&
  2858.   BOX x_min&+1,y_min&+1,x_max&-1,y_max&-1
  2859.   BOX x_min&+4,y_min&+4,x_max&-4,y_max&-4
  2860.   '
  2861.   FOR zeile&=0 TO zeilenzahl&-2
  2862.     p&=INSTR(e$,"|")
  2863.     PRINT AT(zeilenanfang&,erste_zeile&+zeile&);LEFT$(e$,p&-1);
  2864.     e$=MID$(e$,p&+1)
  2865.   NEXT zeile&
  2866.   PRINT AT(zeilenanfang&,erste_zeile&+zeile&);e$;
  2867.   '
  2868.   antw&=INP(2)
  2869.   REPEAT
  2870.   UNTIL INKEY$=""
  2871.   PUT x_min&,y_min&,ausschnitt$
  2872.   '
  2873. RETURN
  2874. '
  2875. PROCEDURE taste_holen(VAR e&)
  2876.   '
  2877.   PRINT CHR$(esc&);"e";                     ! Cursor darstellen
  2878.   e&=INP(2)                                 ! Tastatur abfragen
  2879.   REPEAT                                    ! Nachlaufen verhindern
  2880.   UNTIL INKEY$=""
  2881.   PRINT CHR$(esc&);"f";                     ! Cursor ausschalten
  2882.   '
  2883. RETURN
  2884. '
  2885. PROCEDURE fehlerbehandlung
  2886.   '
  2887.   LOCAL e$
  2888.   '
  2889.   e$="| Es ist ein Fehler aufgetreten !|||"
  2890.   e$=e$+" Nummer der Befehlszeile :   "+STR$(befehlz&-1)+"||||"
  2891.   e$=e$+" Die GFA-Basic Fehlermeldung lautet :|||"
  2892.   e$=e$+"  "+ERR$(ERR)+"|||"
  2893.   e$=e$+" Das Programm wird mit dem Eingabemenü fortgesetzt ||"
  2894.   e$=e$+" Befehle und Bauteilwerte sind noch vorhanden  (?)|||"
  2895.   e$=e$+"                   Taste !|"
  2896.   alarmbox(e$)
  2897.   '
  2898.   zeige_grafik&=FALSE
  2899.   zeichne_kurve&=FALSE
  2900.   dialogbox2_neu&=TRUE
  2901.   dialogbox1_neu&=TRUE
  2902.   CLOSE
  2903.   '
  2904.   RESUME fehlereinsprung
  2905.   '
  2906. RETURN
  2907. '
  2908. PROCEDURE help_bearbeitung
  2909.   '
  2910.   LOCAL a$
  2911.   '
  2912.   IF (eingabe&=1 AND (item1&=0 OR item1&=1)) OR (eingabe&=2 AND item2&>0)
  2913.     a$="|  So gibt man Frequenzen und Bauteilwerte ein:||"
  2914.     a$=a$+"  als ganze Zahl,   z.B.:     470         3         0|"
  2915.     a$=a$+"  als Dezimalzahl   z.B.:       6,8        .123     0.0001|"
  2916.     a$=a$+"  mit Zehnerpotenz  z.B.:       8,2e7   400E-3      0.12e+12  ||"
  2917.     a$=a$+"  mit den Zusätzen    f,  p,  n,  u,  m,  k,  M,  G,  T||"
  2918.     a$=a$+"  diese stehen für die Faktoren:||"
  2919.     a$=a$+"  f=10^(-15)   p=10^(-12)   n=10^(-9)   u=10^(-6)   m=10^(-3)|"
  2920.     a$=a$+"  k=10^3       M=10^6       G=10^9      T=10^12||"
  2921.     a$=a$+"  Beispiele:   6,8p     1200 u     0,003G     12e+3 n|||"
  2922.     a$=a$+"                            Taste !|"
  2923.   ELSE IF eingabe&=2 AND item2&=0
  2924.     a$="Mögliche Befehle:||R 34  C 0  L 87     bringt den komplexen"
  2925.     a$=a$+" Widerstand des jeweiligen|                    Bauteiles"
  2926.     a$=a$+" auf den Stapel|sto 22              kopiert den obersten"
  2927.     a$=a$+" Stapeleintrag nach Speicher 22|rcl 8               holt"
  2928.     a$=a$+" eine Kopie aus Speicher 8 auf den Stapel|ser oder +  "
  2929.     a$=a$+"        addiert die beiden obersten komplexen Widerstände|"
  2930.     a$=a$+" -                  subtrahiert sie ( den ober"
  2931.     a$=a$+"sten von dem darunter )|"
  2932.     a$=a$+" *                  bildet ihr komplexes Produkt|"
  2933.     a$=a$+" /                  komplexer Quotient"
  2934.     a$=a$+" ( zweiter durch obersten )|"
  2935.     a$=a$+"par                 schaltet sie parallel|"
  2936.     a$=a$+"inv                 komplexer"
  2937.     a$=a$+" Kehrwert des obersten Eintrages |conj                bildet"
  2938.     a$=a$+" den konjugiert komplexen Wert|drop                entfernt"
  2939.     a$=a$+" den obersten Stapeleintrag|dup                 dupliziert"
  2940.     a$=a$+" den obersten Stapeleintrag|swap                vertauscht die"
  2941.     a$=a$+" beiden obersten Stapeleinträge|over                legt"
  2942.     a$=a$+" den zweiten Stapeleintrag nochmal obendrauf|rot        "
  2943.     a$=a$+"         vertauscht die drei obersten Einträge zyklisch|"
  2944.     a$=a$+"cstk                löscht den ganzen Rechenstapel|~   "
  2945.     a$=a$+"                dient nur zum Trennen von Befehlsgruppen"
  2946.     a$=a$+" (entspr. REM)||                              Taste !|"
  2947.   ELSE IF eingabe&=1 AND item1&>1 AND item1&<5
  2948.     a$="|Gewöhnlich möchte man, daß der höchste Punkt der dargestellten"
  2949.     a$=a$+" Kurve|gerade den oberen Bildrand erreicht.||Falls"
  2950.     a$=a$+" der Maximalwert von Betrag bzw. SWR vorher bekannt ist, kann er|"
  2951.     a$=a$+"eingegeben werden.||Andernfalls stellt man 'automatisch' ein und"
  2952.     a$=a$+" das Programm schreibt die|berechneten Werte zunächst in eine"
  2953.     a$=a$+" Liste, sucht darin den Maximalwert|und zeichnet dann erst"
  2954.     a$=a$+" die Kurve.|||                            Taste !|"
  2955.   ELSE IF eingabe&=1 AND item1&=5
  2956.     a$="|Der obere Bildrand entspricht 0 dB Dämpfung.||Die Strecke bis zum"
  2957.     a$=a$+" unteren Bildrand teilt"
  2958.     a$=a$+" das Programm dB-linear.||Die Teilungslinien ( nach F5 F2 )"
  2959.     a$=a$+" liegen bei Dämpfungen von||       3 dB,   6 dB,   10 dB,   20 dB,"
  2960.     a$=a$+"   30 dB   u.s.w. ||Als maximale Dämpfung sollte man ein"
  2961.     a$=a$+" Vielfaches von 10 angeben.|||"
  2962.     a$=a$+"                         Taste !|"
  2963.   ELSE IF eingabe&=1 AND item1&=6
  2964.     a$="|Für die Berechnung des Stehwellenverhältnisses ( SWR ) kann man|"
  2965.     a$=a$+"hier den Wellenwiderstand des verwendeten Kabels eingeben.||"
  2966.     a$=a$+"Standardwert ist 50 Ohm.||"
  2967.     a$=a$+"( Siehe auch Hilfe zum Punkt 'SWR darstellen' )|||"
  2968.     a$=a$+"                         Taste !|"
  2969.   ELSE IF eingabe&=1 AND item1&=7
  2970.     a$="|Nachdem die Befehlsfolge für eine bestimmte Frequenz abgearbeitet|"
  2971.     a$=a$+"wurde, ist das Ergebnis all dieser Rechnungen eine komplexe"
  2972.     a$=a$+" Zahl.|||Falls ein Zweipol untersucht wird, ist sie dessen"
  2973.     a$=a$+" Impedanz.|Ihr Betrag||     SQR( Realteil^2 + Imaginärteil^2 )"
  2974.     a$=a$+"   ( = Scheinwiderstand )||wird dargestellt.|||Falls ein"
  2975.     a$=a$+" Spannungsteiler untersucht wird, ist sie dessen Ausgangs-|spannung"
  2976.     a$=a$+" bei einer Eingangsspannung von 1V. |Der Betrag dieser Span"
  2977.     a$=a$+"nung ( s.o. ) wird dargestellt.|||"
  2978.     a$=a$+"                         Taste !|"
  2979.   ELSE IF eingabe&=1 AND item1&=8
  2980.     a$="|Die Darstellung des SWR ist nur sinnvoll, wenn ein Zweipol|"
  2981.     a$=a$+"untersucht wird !|||Dieser bildet den Abschluß eines Kabels"
  2982.     a$=a$+" mit dem vorgegebenen|Wellenwiderstand.||Falls die"
  2983.     a$=a$+" Zweipolimpedanz nicht reell und gleich dem"
  2984.     a$=a$+" Wellen-|widerstand des Kabels ist, bilden sich"
  2985.     a$=a$+" stehende Wellen, d.h.|an verschiedenen Stellen des Kabels"
  2986.     a$=a$+" mißt man unterschiedliche|Wechselspannungen.|||"
  2987.     a$=a$+"Das SWR ist das Verhältnis des größten dieser Werte zum|"
  2988.     a$=a$+"kleinsten.  Deshalb ist es immer größer oder gleich 1.||"
  2989.     a$=a$+"Ein SWR = 1 bedeutet perfekte Anpassung ohne stehende Wellen.|||"
  2990.     a$=a$+"                         Taste !|"
  2991.   ELSE IF eingabe&=1 AND (item1&=12 OR item1&=13)
  2992.     a$="|Nachdem die Befehlsfolge für eine bestimmte Frequenz abgearbeitet|"
  2993.     a$=a$+"wurde, ist das Ergebnis all dieser Rechnungen eine komplexe"
  2994.     a$=a$+" Zahl.|||Falls ein Zweipol untersucht wird, ist sie dessen"
  2995.     a$=a$+" Impedanz.|Ihr Phasenwinkel  ATN( Imaginärteil / Realteil ) "
  2996.     a$=a$+" wird dargestellt.|||Falls ein Spannungsteiler"
  2997.     a$=a$+" untersucht wird, ist sie dessen Ausgangs-|spannung bei einer"
  2998.     a$=a$+" Eingangsspannung von 1V. |Die Phasenverschiebung der Ausgangsspan"
  2999.     a$=a$+"nung gegen die Eingangsspannung|wird dargestellt.|||"
  3000.     a$=a$+"                         Taste !|"
  3001.   ELSE IF eingabe&=1 AND item1&=14
  3002.     a$="|Bei Schrittweite 1 wird die Kurve für alle 640 Spalten|"
  3003.     a$=a$+"des Bildschirms berechnet.||"
  3004.     a$=a$+"|Bei Schrittweite n nur für jede n-te, dazwischen wird"
  3005.     a$=a$+"|linear interpoliert.|||"
  3006.     a$=a$+"Also:|"
  3007.     a$=a$+"|Kleine Schrittweite   -         genauer Kurvenverlauf"
  3008.     a$=a$+"|                                aber lange Rechenzeit|"
  3009.     a$=a$+"|Große Schrittweite    -         nur grober Kurvenverlauf"
  3010.     a$=a$+"|                                dafür kurze Rechenzeit|||"
  3011.     a$=a$+"                         Taste !|"
  3012.   ELSE IF eingabe&=1 AND item1&=16
  3013.     a$="|           Die Frequenzachse wird logarithmisch geteilt|||"
  3014.     a$=a$+"Wenn z.B.   f min = 10 Hz   und   f max = 100 MHz   ist, dann "
  3015.     a$=a$+"belegt|jede der sieben Dekaden||10 Hz .. 100 Hz, 100 Hz .. 1 kHz,"
  3016.     a$=a$+" 1 kHz .. 10 kHz, 10 kHz .. 100 kHz,||100 kHz .. 1 MHz,"
  3017.     a$=a$+" 1 MHz .. 10 MHz, 10 MHz .. 100 MHz||einen gleich langen"
  3018.     a$=a$+" Abschnitt auf der Frequenzachse.|||"
  3019.     a$=a$+"Nachdem man  F5  gedrückt hat, um das Bild zu betrachten, "
  3020.     a$=a$+"läßt sich|mit  F4  ein vertikales Gitter über das Diagramm "
  3021.     a$=a$+"legen, dessen Linien|sich bei folgenden Frequenzen befinden:||"
  3022.     a$=a$+"... 0,05   0,1   0,2   0,5   1   2   5   10   20"
  3023.     a$=a$+"   50   100   200 ...|||"
  3024.     a$=a$+"                             Taste !|"
  3025.   ELSE
  3026.     a$="| Zu diesem Punkt sollte keine Hilfe nötig sein ! |||"
  3027.     a$=a$+"                    Taste !|"
  3028.   ENDIF
  3029.   alarmbox(a$)
  3030.   '
  3031. RETURN
  3032. '
  3033. PROCEDURE neu_pfad_u_vorgabe
  3034.   '
  3035.   pfad$=LEFT$(datei$,RINSTR(datei$,"\"))
  3036.   dnam$=MID$(datei$,RINSTR(datei$,"\")+1)
  3037.   IF INSTR(dnam$,".")
  3038.     dnam$=LEFT$(dnam$,RINSTR(dnam$,".")-1)
  3039.   ENDIF
  3040.   '
  3041. RETURN
  3042. '
  3043. PROCEDURE drucker_initialisieren
  3044.   '
  3045.   LPRINT CHR$(27);"R";CHR$(0);       ! Amerikanischer Zeichensatz
  3046.   LPRINT CHR$(27);"N";CHR$(6);       ! Überspringe Perforation. 6 Zeilen
  3047.   LPRINT CHR$(27);"M";               ! 12 Zeichen pro Zoll
  3048.   LPRINT CHR$(27);"x";CHR$(1);       ! Letter Quality
  3049.   LPRINT CHR$(27);"l";CHR$(17);      ! Linker Rand 12 Zeichen = 1 Zoll
  3050.   '
  3051. RETURN
  3052. '
  3053. PROCEDURE test_stack_voll
  3054.   '
  3055.   LOCAL e$
  3056.   '
  3057.   IF st_z&>98
  3058.     '
  3059.     e$="| Es ist ein Fehler aufgetreten !|||"
  3060.     e$=e$+" Nummer der Befehlszeile :   "+STR$(befehlz&)+"||||"
  3061.     e$=e$+" Art des Fehlers :|||"
  3062.     e$=e$+"            Stapel ist voll|||"
  3063.     e$=e$+" Das Programm wird mit dem Eingabemenü fortgesetzt ||"
  3064.     e$=e$+" Befehle und Bauteilwerte sind noch vorhanden  (?)|||"
  3065.     e$=e$+"                   Taste !|"
  3066.     alarmbox(e$)
  3067.     '
  3068.     zeige_grafik&=FALSE
  3069.     zeichne_kurve&=FALSE
  3070.     dialogbox2_neu&=TRUE
  3071.     dialogbox1_neu&=TRUE
  3072.     '
  3073.     fehler&=TRUE
  3074.     '
  3075.   ENDIF
  3076.   '
  3077. RETURN
  3078. '
  3079. PROCEDURE test_stack(n&)
  3080.   '
  3081.   LOCAL e$
  3082.   '
  3083.   IF st_z&<n&-1
  3084.     '
  3085.     e$="| Es ist ein Fehler aufgetreten !|||"
  3086.     e$=e$+" Nummer der Befehlszeile :   "+STR$(befehlz&)+"||||"
  3087.     e$=e$+" Art des Fehlers :|||"
  3088.     e$=e$+"     Nicht genügend Operanden !||"
  3089.     e$=e$+"     Die Operation erfordert mindestens "
  3090.     e$=e$+STR$(n&)+" Zahl"
  3091.     IF n&>1
  3092.       e$=e$+"en"
  3093.     ENDIF
  3094.     e$=e$+" auf dem Stapel  |||"
  3095.     e$=e$+" Das Programm wird mit dem Eingabemenü fortgesetzt ||"
  3096.     e$=e$+" Befehle und Bauteilwerte sind noch vorhanden  (?)|||"
  3097.     e$=e$+"                   Taste !|"
  3098.     alarmbox(e$)
  3099.     '
  3100.     zeige_grafik&=FALSE
  3101.     zeichne_kurve&=FALSE
  3102.     dialogbox2_neu&=TRUE
  3103.     dialogbox1_neu&=TRUE
  3104.     '
  3105.     fehler&=TRUE
  3106.     '
  3107.   ENDIF
  3108.   '
  3109. RETURN
  3110. '
  3111. PROCEDURE teilungslinien_zeichnen
  3112.   '
  3113.   LOCAL fx,xx,fa,h,n&
  3114.   '
  3115.   GRAPHMODE 1
  3116.   COLOR schwarz&
  3117.   '
  3118.   IF frequenzlinien&=TRUE AND f_achse&=log&
  3119.     '
  3120.     h=639/LOG(f_max/f_min)
  3121.     fa=10^INT(LOG10(f_min))
  3122.     fx=fa
  3123.     n&=0
  3124.     DEFLINE strich%(linienstilf&)
  3125.     DO
  3126.       EXIT IF fx>f_max
  3127.       IF fx>=f_min
  3128.         xx=h*LOG(fx/f_min)
  3129.         DRAW xx,0 TO xx,399
  3130.       ENDIF
  3131.       INC n&
  3132.       IF n&>9
  3133.         n&=0
  3134.         fa=10*fa
  3135.       ENDIF
  3136.       IF linie(n&)<0
  3137.         fx=-fa*linie(n&)
  3138.       ENDIF
  3139.     LOOP
  3140.     '
  3141.   ENDIF
  3142.   '
  3143.   IF daempfungslinien&=TRUE AND betr_swr_darst&=log&
  3144.     DEFLINE strich%(linienstild&)
  3145.     IF daempf_max>3
  3146.       DRAW 0,1200/daempf_max TO 639,1200/daempf_max
  3147.     ENDIF
  3148.     IF daempf_max>6
  3149.       DRAW 0,2400/daempf_max TO 639,2400/daempf_max
  3150.     ENDIF
  3151.     FOR daempf=10 TO daempf_max STEP 10
  3152.       DRAW 0,400*daempf/daempf_max TO 639,400*daempf/daempf_max
  3153.     NEXT daempf
  3154.   ENDIF
  3155.   '
  3156.   DEFLINE 1
  3157.   '
  3158. RETURN
  3159. '
  3160. FUNCTION wert$(x,l&,flag&)
  3161.   '
  3162.   LOCAL f$
  3163.   '
  3164.   f$=" "
  3165.   IF ABS(x)>=1000
  3166.     x=x/1000
  3167.     f$="k"
  3168.   ENDIF
  3169.   IF ABS(x)>=1000
  3170.     x=x/1000
  3171.     f$="M"
  3172.   ENDIF
  3173.   IF ABS(x)>=1000
  3174.     x=x/1000
  3175.     f$="G"
  3176.   ENDIF
  3177.   IF ABS(x)>=1000
  3178.     x=x/1000
  3179.     f$="T"
  3180.   ENDIF
  3181.   IF ABS(x)<1
  3182.     x=x*1000
  3183.     f$="m"
  3184.   ENDIF
  3185.   IF ABS(x)<1
  3186.     x=x*1000
  3187.     f$="u"
  3188.   ENDIF
  3189.   IF ABS(x)<1
  3190.     x=x*1000
  3191.     f$="n"
  3192.   ENDIF
  3193.   IF ABS(x)<1
  3194.     x=x*1000
  3195.     f$="p"
  3196.   ENDIF
  3197.   IF ABS(x)<1
  3198.     x=x*1000
  3199.     f$="f"
  3200.   ENDIF
  3201.   IF ABS(x)=0
  3202.     f$=" "
  3203.   ENDIF
  3204.   '
  3205.   IF flag&=1
  3206.     f$=STR$(x,l&,4)+"  "+f$
  3207.   ELSE
  3208.     f$=STR$(x,l&)+"  "+f$
  3209.   ENDIF
  3210.   '
  3211.   RETURN f$
  3212.   '
  3213. ENDFUNC
  3214. '
  3215. FUNCTION wert(x$)
  3216.   '
  3217.   LOCAL hilf
  3218.   '
  3219.   hilf=INSTR(x$,",")
  3220.   IF hilf
  3221.     x$=LEFT$(x$,hilf-1)+"."+MID$(x$,hilf+1)
  3222.   ENDIF
  3223.   hilf=ABS(VAL(x$))
  3224.   IF INSTR(x$,"f")
  3225.     hilf=hilf*1.0E-15
  3226.   ELSE IF INSTR(x$,"p")
  3227.     hilf=hilf*1.0E-12
  3228.   ELSE IF INSTR(x$,"n")
  3229.     hilf=hilf*1.0E-09
  3230.   ELSE IF INSTR(x$,"u")
  3231.     hilf=hilf*1.0E-06
  3232.   ELSE IF INSTR(x$,"m")
  3233.     hilf=hilf*0.001
  3234.   ELSE IF INSTR(x$,"k")
  3235.     hilf=hilf*1000
  3236.   ELSE IF INSTR(x$,"M")
  3237.     hilf=hilf*1000000
  3238.   ELSE IF INSTR(x$,"G")
  3239.     hilf=hilf*1000000000
  3240.   ELSE IF INSTR(x$,"T")
  3241.     hilf=hilf*1000000000000
  3242.   ENDIF
  3243.   RETURN hilf
  3244.   '
  3245. ENDFUNC
  3246.