'**************************************************************************** '* Stand: 28.03.97 * '* SBMS34.BAS Hauptprogramm * '**************************************************************************** 'die folgende Zeile mit REM enthaelt einen Meta-Befehl ! nicht loeschen ! REM $DYNAMIC 'alle folgenden Arrays dynamisch ! '$INCLUDE: 'qb.bi' 'Meta-Befehl muss stehen bleiben !! TYPE DirectoryEntry 'benutzt in SUB FileFirst dummy1 AS STRING * 22 dummy2 AS INTEGER dummy3 AS INTEGER dummy4 AS LONG filename AS STRING * 13 END TYPE TYPE DirectoryStrings 'benutzt in SUB FileFirst dummy5 AS STRING * 34 filename AS STRING * 13 END TYPE COMMON SHARED BaseAddress%, DataAddress%, CommAddress%, ResetAddress% COMMON SHARED XSize, YSize, xa, xe, ya, ye, Col1, Col2, t COMMON SHARED Period%, Duration%, UTCDiff%, Response% COMMON SHARED x, y, z, Rfz% COMMON SHARED RawFile%, RawFile$, MarkFile%, MarkFile$ COMMON SHARED A$, taste$, Path$, PathRamDisk$ COMMON SHARED RXStartTime$ COMMON SHARED n&, MaxMarker%, Delay% COMMON SHARED RXTXT$, RXTXT% COMMON SHARED StartTime%, StartHour%, StartMinute%, StartSec% DECLARE SUB ALAS () 'Lizenzbedingungen am Prg.ende DECLARE SUB Auto () 'Prg. Auto DECLARE SUB Background () 'Bild Hintergrund fuer alle Menues DECLARE SUB Button () 'Bild grauer Knopf DECLARE SUB ChangeIni () 'einige Parameter neu einstellen DECLARE SUB Collect () 'Datei aus markiert. Bereichen anl. DECLARE SUB DetectSB () 'ermittelt SoundBlaster Adressen DECLARE SUB DownKeys () 'alle 7 Knoepfe unten neutral DECLARE SUB FindFirst (filespec$, D AS DirectoryStrings) DECLARE SUB FindNext (D AS DirectoryStrings) DECLARE SUB GreenMarkers () '20 gruene Markerkaestchen m.Zahlen DECLARE SUB K1Neutral () 'Knopf 1 neutral DECLARE SUB K2Neutral () 'Knopf 2 neutral DECLARE SUB K3Neutral () 'Knopf 3 neutral DECLARE SUB K4Neutral () 'Knopf 4 neutral DECLARE SUB K5Neutral () 'Knopf 5 neutral DECLARE SUB K6Neutral () 'Knopf 6 neutral DECLARE SUB K7Neutral () 'Knopf 7 neutral DECLARE SUB MakeFont () 'Prg. liest Font ein DECLARE SUB MenuAuto () 'Menue Auto DECLARE SUB MenuMain () 'Hauptmenue DECLARE SUB MenuOszi () 'Menue Oszi DECLARE SUB MenuPlayback () 'Menue Playback DECLARE SUB MenuPlayFile () 'Menue Play File DECLARE SUB MenuPlayPeriod () 'Menue Play Period DECLARE SUB MenuRecordFile () 'Menue Record File DECLARE SUB MenuReadDoc () 'Menue Read Docu DECLARE SUB Noise () 'kurzes Rauschen ausgeben DECLARE SUB Oszi () 'Prg. Oszi DECLARE SUB Playback () 'zentr. Prg. Wiedergabe DECLARE SUB PlayFile () 'Prg. spielt File DECLARE SUB PlayPeriod () 'Prg. spielt letzte Period DECLARE SUB PrintText () 'Prg. Text manipuliert ausgeben DECLARE SUB Record () 'zentr. Prg. Herzstueck Aufzeichnung DECLARE SUB RecordFile () 'Prg. Aufnahme auf RAM-Disk DECLARE SUB ReadDoc () 'Prg. Documentation lesen DECLARE SUB ReadIni () 'Prg. Anfangsvariable einlesen DECLARE SUB StatusCollect () 'Fenster DECLARE SUB StatusCopyFile () 'Fenster DECLARE SUB StatusFileNotFound () 'Fenster DECLARE SUB StatusNoFile () 'Fenster DECLARE SUB StatusPlay () 'Fenster DECLARE SUB StatusPlayingFile () 'Fenster DECLARE SUB StatusReady () 'Fenster DECLARE SUB StatusRec () 'Fenster DECLARE SUB StatusTextInp () 'Fenster DECLARE SUB StatusWait () 'Fenster DECLARE SUB StatusWaitPeri () 'Fenster DECLARE SUB Strace () 'Prg. Bildschirmschoner ON ERROR GOTO mistake Rfz% = 1 'Rufzeichen in Screensave zeigen RXTXT$ = "" 'noch kein empfangener Text MaxMarker% = 40 '20 Markerpaare pro Periode RawFile% = 1 'gilt im ganzen Programm MarkFile% = 2 'gilt im ganzen Programm z = 1 'Zoomfaktor Oszi 'dynamisches Array Fonts, Fontsgroessen anlegen mit REDIM, nicht mit DIM REDIM SHARED Font(94, 8, 16), XS(8), ys(16) AS INTEGER SCREEN 12 CLS CALL DetectSB 'SB Adressen aus Umgebungsvariable CALL Noise 'kurzes Test-Rauschen ausgeben CALL MakeFont 'Font einlesen fuer Schriften CALL ReadIni 'Datei SBMS.INI lesen StartSec% = VAL(MID$(RXStartTime$, 7, 2)) 'Anfangswert Start Auto aus INI StartMinute% = VAL(MID$(RXStartTime$, 4, 2)) 'Anfangswert Start Auto aus INI StartHour% = VAL(MID$(RXStartTime$, 1, 2)) 'Anfangswert Start Auto aus INI REDIM SHARED Marker&(MaxMarker%) 'Array Markerstand DIM SHARED DTA AS DirectoryEntry, DIR(1000) AS DirectoryStrings DIM DE AS INTEGER RawFile$ = PathRamDisk$ + "lastperi.msf" 'leere Datei anlegen OPEN RawFile$ FOR BINARY AS #1 CLOSE #1 MarkFile$ = PathRamDisk$ + "markperi.msf" 'leere Datei anlegen OPEN MarkFile$ FOR BINARY AS #2 CLOSE #2 SoundFile$ = PathRamDisk$ + "sndfile.msf" 'leere Datei anlegen OPEN SoundFile$ FOR BINARY AS #3 CLOSE #3 start: 'Hauptmenue CALL MenuMain 'MenuMain neu zeichnen x = 535: y = 63 LINE (x, y)-(x + 65, y + 17), 15, B 'Rahmen Zeitfenster COLOR 14 'Zeitanzeige in gelb marke1: 'wenn falsche Taste gedrueckt wurde DO taste$ = INKEY$ 'warten auf Tastendruck LOCATE 5, 68: PRINT TIME$ 'Zeit anzeigen LOOP WHILE taste$ = "" SELECT CASE taste$ CASE CHR$(27) 'ESCAPE Rfz% = 1 'Rufzeichen einblenden KILL PathRamDisk$ + "lastperi.msf" KILL PathRamDisk$ + "markperi.msf" KILL PathRamDisk$ + "sndfile.msf" CALL Strace CALL ALAS 'Lizenzbestimmungen DO: LOOP WHILE INKEY$ = "" SYSTEM 'Programm-ENDE CASE CHR$(0) + CHR$(59) 'F1 CALL MenuReadDoc CALL ReadDoc CASE CHR$(0) + CHR$(60) 'F2 CALL MenuRecordFile CALL RecordFile CASE CHR$(0) + CHR$(61) 'F3 CALL MenuPlayback CALL PlayPeriod CASE CHR$(0) + CHR$(62) 'F4 CALL ChangeIni CASE CHR$(0) + CHR$(63) 'F5 CALL MenuAuto CALL Auto CASE CHR$(0) + CHR$(64) 'F6 CALL MenuOszi CALL Oszi CASE CHR$(0) + CHR$(65) 'F7 CALL MenuPlayFile CALL PlayFile CASE CHR$(0) + CHR$(66) 'F8 Rfz% = 0 'kein Rufzeichen einblenden CALL Strace 'Sternenhimmel zeigen CASE CHR$(0) + CHR$(67) 'F9 CLS LOCATE 3, 1: COLOR 7: PRINT "Type EXIT for SBMS Main Menu !"; SHELL ' CASE CHR$(0) + CHR$(68) 'F10 ' reserve CASE ELSE GOTO marke1 'nicht definierte Taste gedrueckt ! END SELECT GOTO start 'wenn SUB abgearbeitet mistake: 'Fehlerbehandlungs-Routine GOTO start RESUME REM $STATIC SUB ALAS '**************************************************************************** '* Stand 13.03.97 * '* gibt ALAS am Programmende aus * '**************************************************************************** CLS COLOR 15 LOCATE 4, 1: PRINT "SBMS þ Sound Blaster Meteor Scatter þ Version 1.0"; LOCATE 4, 52: PRINT "(C) Peter Tonak, DL3JIN 1997" LOCATE 7, 3: PRINT "ÉÍÍÍÍ NOTE "; : PRINT STRING$(60, "Í"); : PRINT "»" LOCATE 8, 3: PRINT "º SBMS is protected by the regulations of the" LOCATE 8, 74: PRINT "º" LOCATE 9, 3: PRINT "º ''General Licence for Ham Radio Software'' ! " LOCATE 9, 74: PRINT "º" LOCATE 10, 3: PRINT "º (Allgemeine Lizenz fuer Amateurfunk Software," LOCATE 10, 59: PRINT "ALAS)": LOCATE 10, 74: PRINT "º" LOCATE 11, 3: PRINT "º Read the File SBMS.DOC for further" LOCATE 11, 51: PRINT "information º" LOCATE 12, 3: PRINT "È"; : PRINT STRING$(70, "Í"); : PRINT "¼" END SUB SUB Auto '**************************************************************************** '* Stand: 13.03.97 * '* automatischer Ablauf der S/E Perioden bei MS-Empfang * '**************************************************************************** RXTXT% = 1 'RXTXT anzeigen StartHour% = StartHour% + UTCDiff% 'UTC-Differenz beruecksichtigen StopHour% = StartHour% 'Berechne Endzeit QSO StopMinute% = StartMinute% + Duration% StopSec% = StartSec% IF StopMinute% >= 60 THEN StopMinute% = StopMinute% - 60 StopHour% = StopHour% + 1 IF StopHour% = 24 THEN StopHour% = 0 END IF END IF x = 20: y = 190: Col1 = 7: t = 4 'Text A$ = "Start Time": CALL PrintText x = 115: y = 190 'zeige Startzeit an A$ = STR$(StartHour%) + ":" + RIGHT$(STR$(StartMinute%), 2) + ":" + RIGHT$(STR$(StartSec%), 2) + " UTC" CALL PrintText x = 20: y = 214 'Text A$ = "End Time": CALL PrintText x = 115: y = 214 'zeige Stopzeit an A$ = STR$(StopHour%) + ":" + RIGHT$(STR$(StopMinute%), 2) + ":" + RIGHT$(STR$(StartSec%), 2) + " UTC" CALL PrintText x = 330: y = 190 'zeige Duration% an A$ = STR$(Duration%) + " min.": CALL PrintText x = 330: y = 214: 'zeige Period% an A$ = STR$(Period%) + " sec.": CALL PrintText x = 530: y = 190 'zeige Response% an A$ = STR$(Response%) + " Bytes": CALL PrintText CALL StatusWait 'Statusfenster 'hier Marke einfuegen zum wiederholten Start nach Anhoeren marke6: IF StartHour% >= StopHour% THEN 'EndZeit erreicht ? IF StartMinute% >= StopMinute% THEN IF StartSec% >= StopSec% THEN CALL StatusReady DO: LOOP WHILE INKEY$ <> CHR$(27) 'warten auf ESCAPE EXIT SUB END IF END IF END IF DO taste$ = INKEY$ 'Taste gedrueckt ? IF taste$ = CHR$(27) THEN EXIT DO 'ESCAPE verlaesst Schleife CurrSec% = VAL(MID$(TIME$, 7, 2)) 'aktueller Sekundenstand CurrMinute% = VAL(MID$(TIME$, 4, 2)) 'aktueller Minutenstand CurrHour% = VAL(MID$(TIME$, 1, 2)) 'aktueller Stundenstand IF StartHour% <= CurrHour% THEN 'Startzeit erreicht oder IF StartMinute% <= CurrMinute% THEN 'schon vorbei ? IF StartSec% <= CurrSec% THEN EXIT DO 'ja, Schleife verlassen END IF END IF END IF LOOP IF taste$ = CHR$(27) THEN EXIT SUB 'mit ESCAPE zum Hauptmenue CALL StatusRec 'rotes Fenster RECORDING x = 277: y = 435: Col1 = 12: t = 4 'Knopf 4 beschriften A$ = "SET MARKER ": CALL PrintText x = 293: y = 458: Col1 = 0: t = 0 'Knopf 4 beschriften A$ = "SPACE": CALL PrintText KILL RawFile$ 'alte Aufzeichnung loeschen KILL MarkFile$ 'alte Aufzeichnung loeschen SOUND 1000, 1 'Bimmel bei Start Recording CALL Record 'Herzstueck Aufzeichnung IF taste$ = CHR$(27) THEN EXIT SUB 'mit ESCAPE zum Hauptmenue CALL GreenMarkers 'Markerkaestchen wieder gruen '*** Hier geht das Auto-Abspielen los, sofort nach einer Period% Aufnahme CALL StatusPlay 'Fenster PLAYBACK gruen x = 78: y = 435: Col1 = 0: t = 0 A$ = "SLOW": CALL PrintText 'Knopf 2 beschriften x = 138: y = 435: Col1 = 0: t = 0 'Knopf 3 beschriften A$ = "FAST": CALL PrintText x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 CALL Playback 'Herzstueck Wiedergabe CALL K2Neutral CALL K3Neutral IF taste$ = CHR$(27) THEN EXIT SUB 'ESC ->Hauptmenu '2 * Period in naechster Zeile wegen der eigenen TX-Zeit fuer langsame Wiederg. StartSec% = StartSec% + 2 * Period% 'neue Startzeit festlegen IF StartSec% >= 60 THEN 'fuer naechsten Durchgang StartSec% = StartSec% - 60 StartMinute% = StartMinute% + 1 IF StartMinute% >= 60 THEN StartMinute% = StartMinute% - 60 StartHour% = StartHour% + 1 IF StartHour% >= 24 THEN StartHour% = StartHour - 24 END IF END IF END IF CALL StatusWaitPeri 'Statusfenster GOTO marke6 END SUB SUB Background '**************************************************************************** '* Stand: 13.03.97 * '* Hintergrund-Bild aller Menues (kleinster gemeinsamer Nenner) * '**************************************************************************** LINE (0, 0)-(640, 480), 1, BF 'gesamter BS Hintergrund LINE (0, 0)-(639, 479), 15, B 'Aussenrand y = 70: FOR x = 0 TO 640: PSET (x, y), 15: NEXT x 'Trennlinie 'XSize = 16: YSize = 64: x = 185: y = 10: Col1 = 14: Col2 = 0: t = 4 'A$ = "Meteor Scatter": CALL PrintText XSize = 16: YSize = 64: x = 170: y = 10: Col1 = 14: Col2 = 0: t = 4 A$ = "S": CALL PrintText XSize = 8: YSize = 32: y = 35 A$ = "ound ": CALL PrintText XSize = 16: YSize = 64: y = 10 A$ = "B": CALL PrintText XSize = 8: YSize = 32: y = 35 A$ = "laster ": CALL PrintText XSize = 16: YSize = 64: y = 10 A$ = "M": CALL PrintText XSize = 8: YSize = 32: y = 35 A$ = "eteor ": CALL PrintText XSize = 16: YSize = 64: y = 10 A$ = "S": CALL PrintText XSize = 8: YSize = 32: y = 35 A$ = "catter": CALL PrintText XSize = 8: YSize = 16: x = 34: y = 8: Col1 = 7: Col2 = 0 A$ = "DL3JIN": CALL PrintText x = 26: y = 22 A$ = "Software": CALL PrintText x = 16: y = 36 A$ = "Version 1.0": CALL PrintText x = 20: y = 50 A$ = "March 1997": CALL PrintText x = 498: y = 22 A$ = "Current Module": CALL PrintText 'x = 498: y = 8: Col1 = 4 'A$ = "TESTER: 6": CALL PrintText END SUB SUB Button '**************************************************************************** '* Stand: 13.03.97 * '* stellt einen nicht gedrueckten grauen Tastenknopf mit Schatten dar * '**************************************************************************** LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz END SUB SUB ChangeIni '**************************************************************************** '* Stand: 13.03.97 * '* erlaubt aenderung einiger Ini-werte nach Programm-Aufruf * '**************************************************************************** CALL Background x = 535: y = 63 LINE (x, y)-(x + 65, y + 17), 15, B 'Rahmen Zeitfenster x = 151: y = 79 '6x Rahmen Wertefenster FOR i = 1 TO 6 y = y + 48 LINE (x, y)-(x + 65, y + 17), 15, B NEXT i x = 520: y = 36: Col1 = 5: t = 4 A$ = "Change Ini": CALL PrintText CALL DownKeys '7x Knopf neutral COLOR 3 'tuerkis auf schwarz x = 20: y = 128: Col1 = 7: t = 4 A$ = "Duration QSO": CALL PrintText x = 225 A$ = "Minutes": CALL PrintText LOCATE 9, 20: PRINT USING "########"; Duration% x = 20: y = 176: Col1 = 7: t = 4 A$ = "Period": CALL PrintText x = 225 A$ = "Seconds": CALL PrintText LOCATE 12, 20: PRINT USING "########"; Period% x = 20: y = 224: Col1 = 7: t = 4 A$ = "Delay": CALL PrintText LOCATE 15, 20: PRINT USING "########"; Delay% - 11 x = 20: y = 272: Col1 = 7: t = 4 A$ = "RX Start Time": CALL PrintText x = 225 A$ = "UTC": CALL PrintText LOCATE 18, 20: PRINT USING "##"; StartHour% LOCATE 18, 22: PRINT ":" LOCATE 18, 23: PRINT USING "##"; StartMinute% LOCATE 18, 25: PRINT ":" LOCATE 18, 26: PRINT USING "##"; StartSec% x = 20: y = 320: Col1 = 7: t = 4 A$ = "UTC-Difference": CALL PrintText x = 225 A$ = "Hours": CALL PrintText LOCATE 21, 20: PRINT USING "########"; UTCDiff% x = 20: y = 368: Col1 = 7: t = 4 A$ = "Response Speed": CALL PrintText x = 225 A$ = "Bytes": CALL PrintText LOCATE 24, 20: PRINT USING "########"; Response% x = 18: y = 435: Col1 = 5: t = 4 A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 74: y = 435 A$ = "VALUE": CALL PrintText 'Funktion 2.Taste x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 x = 134: y = 435 'Knopf 3 beschriften A$ = "VALUE": CALL PrintText x = 600: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Enter PAINT (x - 2, y + 5), 0, 0 LINE (x, 463)-(x + 13, y + 5), 0 LINE (x + 13, y + 5)-(x + 13, y), 0 x = 588: y = 435 'Knopf 7 beschriften A$ = "NEXT": CALL PrintText COLOR 14 'alle aenderungen gelb '*** Change Duration QSO **************************************************** DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'schleife verlassen CASE CHR$(0) + CHR$(72) 'Corsor hoch=laenger Duration% = Duration% + 1 IF Duration% > 360 THEN Duration% = 360 'max. 6 h CASE CHR$(0) + CHR$(80) 'Cursor runter=kuerzer Duration% = Duration% - 1 IF Duration% < 2 THEN Duration% = 2 CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 9, 23: PRINT USING "#####"; Duration% LOOP IF taste$ = CHR$(27) THEN EXIT SUB 'SUB vorzeitig verlassen '*** Change Period ******************************************************** DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'schleife verlassen CASE CHR$(0) + CHR$(72) 'Corsor hoch=laenger Period% = Period% + 1 IF Period% > 600 THEN Period% = 600 'max. 10 Minuten CASE CHR$(0) + CHR$(80) 'Cursor runter=kuerzer Period% = Period% - 1 IF Period% < 1 THEN Period% = 1 CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 12, 23: PRINT USING "#####"; Period% LOOP IF taste$ = CHR$(27) THEN EXIT SUB 'SUB vorzeitig verlassen '*** Change Delay ********************************************************** DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'erst schleife verlassen~ CASE CHR$(0) + CHR$(80) 'Corsor runter=schneller Delay% = Delay% - Delay% / 20 'ausreichende Schrittweite IF Delay% <= 10 THEN Delay% = 11 'sonst klemmts bei 10 ! CASE CHR$(0) + CHR$(72) 'Cursor hoch=langsamer Delay% = Delay% + Delay% / 20 IF Delay% > 30011 THEN Delay% = 30011 'hoechstens 32766 CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 15, 23: PRINT USING "#####"; Delay% - 11 LOOP IF taste$ = CHR$(27) THEN EXIT SUB '~und dann SUB verlassen '*** Change RX Start Time ************************************************** LOCATE 18, 22: PRINT ":" 'auch Doppelpunkt gelb LOCATE 18, 25: PRINT ":" DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'erst schleife verlassen~ CASE CHR$(0) + CHR$(72) 'Corsor hoch=spaeter StartSec% = StartSec% + 30 IF StartSec% = 60 THEN StartSec% = 0 StartMinute% = StartMinute% + 1 IF StartMinute% = 60 THEN StartMinute% = 0 StartHour% = StartHour% + 1 IF StartHour% = 24 THEN StartHour% = 0 END IF END IF CASE CHR$(0) + CHR$(80) 'Cursor runter=frueher StartSec% = StartSec% - 30 IF StartSec% = -30 THEN StartMinute% = StartMinute% - 1 StartSec% = 30 IF StartMinute% = -1 THEN StartMinute% = 59 StartHour% = StartHour% - 1 IF StartHour% = -1 THEN StartHour% = 23 END IF END IF END IF CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 18, 20: PRINT USING "##"; StartHour% LOCATE 18, 23: PRINT USING "##"; StartMinute% LOCATE 18, 26: PRINT USING "##"; StartSec% LOOP IF taste$ = CHR$(27) THEN EXIT SUB '~und dann SUB verlassen '*** Change UTC Difference ************************************************ DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'schleife verlassen CASE CHR$(0) + CHR$(72) 'Corsor hoch=groesser UTCDiff% = UTCDiff% + 1 IF UTCDiff% > 23 THEN UTCDiff% = 23 ' CASE CHR$(0) + CHR$(80) 'Cursor runter=weniger UTCDiff% = UTCDiff% - 1 IF UTCDiff% < -23 THEN UTCDiff% = -23 CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 21, 23: PRINT USING "#####"; UTCDiff% LOOP IF taste$ = CHR$(27) THEN EXIT SUB 'SUB vorzeitig verlassen 'hier noch mehr eventuelle zusaetzliche Schleifen einbauen CALL K7Neutral 'schon hier sinnvoll ! '*** Change Response ******************************************************** DO LOCATE 5, 68: PRINT TIME$ taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'schleife verlassen CASE CHR$(0) + CHR$(72) 'Corsor hoch=laenger Response% = Response% + 100 IF Response% > 10000 THEN Response% = 10000 'etwa 2 Sek. Reaktionszeit CASE CHR$(0) + CHR$(80) 'Cursor runter=kuerzer Response% = Response% - 100 IF Response% < 0 THEN Response% = 0 'weniger geht nicht CASE CHR$(13) 'ENTER weiter EXIT DO CASE ELSE END SELECT LOCATE 24, 20: PRINT USING "########"; Response% LOOP taste$ = "" 'sonst gibts in Folge-SUBs 'Dreckeffekte END SUB SUB Collect '**************************************************************************** '* Stand: 13.03.97 * '* Markierte Stellen aus einer Datei ausschneiden und in eine kleinere * '* neue schreiben * '**************************************************************************** OPEN PathRamDisk$ + "markperi.msf" FOR OUTPUT AS #1 'Loesche alte Datei CLOSE #1 Byte$ = " " 'Datenpuffer fuer 1 Byte anlegen FOR i = 1 TO MaxMarker% 'leere Marker ausblenden IF Marker&(i) = 0 THEN EXIT FOR NEXT i LastMarker = i - 1 'letzter benutzer Marker OPEN PathRamDisk$ + "lastperi.msf" FOR BINARY AS #1 'Datei #1 zum Lesen OPEN PathRamDisk$ + "markperi.msf" FOR BINARY AS #2 'Datei #2 zum Schreiben FOR m = 1 TO LastMarker STEP 2 'm=Markersatz# SEEK #1, Marker&(m) 'sonst geht's immer bei 1 los ! 'SEEK's kleinster Satz ist 1 ! FOR i& = Marker&(m) TO Marker&(m + 1) GET #1, , Byte$ 'ein Byte aus #1 lesen PUT #2, , Byte$ 'ein Byte in #2 schreiben NEXT i& NEXT m CLOSE #2 CLOSE #1 FOR i = 1 TO MaxMarker% 'alle Marker wieder loeschen Marker&(i) = 0 NEXT i END SUB SUB DetectSB '**************************************************************************** '* Stand: 13.03.97 * '* ermittelt die SB-Adresse aus der Umgebungsvariablen BLASTER * '* Ausgabe: BaseAddress%,ResetAddress%,CommAddress%,DataAddress% * '**************************************************************************** IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT " BLASTER environment variable not set." PRINT " Program will not work properly." EXIT SUB END IF FOR Length% = 1 TO LEN(ENVIRON$("BLASTER")) SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1) CASE "A" BaseAddress% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3)) CASE "I" IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1)) CASE "D" DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1)) CASE ELSE END SELECT NEXT Length% CommAddress% = BaseAddress% + &HC DataAddress% = BaseAddress% + &HA ResetAddress% = BaseAddress% + &H6 LOCATE 1, 1: COLOR 15: PRINT " Environment BLASTER : "; ENVIRON$("BLASTER") END SUB SUB DownKeys '**************************************************************************** '* Stand: 13.03.97 * '* zeichnet untere Tastenleiste komplett, aber ohne Beschriftung * '**************************************************************************** CALL K1Neutral CALL K2Neutral CALL K3Neutral CALL K4Neutral CALL K5Neutral CALL K6Neutral CALL K7Neutral END SUB SUB FindFirst (filespec$, D AS DirectoryStrings) '**************************************************************************** '* Stand: 13.03.97 * '* prueft, ob ein Directory existiert * '**************************************************************************** DIM inregs AS RegTypeX, outregs AS RegTypeX inregs.dx = VARPTR(DTA) inregs.ds = VARSEG(DTA) inregs.ax = &H1A00 CALL INTERRUPTX(&H21, inregs, outregs) filespec$ = filespec$ + CHR$(0) inregs.ax = &H4E00 inregs.dx = SADD(filespec$) inregs.ds = VARSEG(filespec$) inregs.cx = mask% CALL INTERRUPTX(&H21, inregs, outregs) IF (outregs.flags AND 1) = 0 THEN D.filename = DTA.filename ELSE D.filename = "" END IF END SUB SUB FindNext (D AS DirectoryStrings) '*************************************************************************** '* Stand:13.03.97 * '* prueft, ob ein File in einem directory vorkommt * '*************************************************************************** DIM inregs AS RegTypeX, outregs AS RegTypeX DTA.filename = "" inregs.ax = &H4F00 CALL INTERRUPTX(&H21, inregs, outregs) IF (outregs.flags AND 1) = 0 THEN D.filename = DTA.filename ELSE D.filename = "" END IF END SUB SUB GreenMarkers '**************************************************************************** '* Stand: 13.03.97 * '* gibt 20 gruene Markerkaestchen mit Ziffern 1-20 aus * '**************************************************************************** xa = 100: xe = xa + 20: ya = 88: ye = ya + 20: Col1 = 0: t = 0 FOR i = 1 TO 20 '20 gruene Kaestchen LINE (xa + 25 * i, ya)-(xe + 25 * i, ye), 2, BF NEXT i x = 99: y = 87 '20 weisse Kaestchenrahmen FOR i = 1 TO 20 x = x + 25 LINE (x, y)-(x + 22, y + 22), 15, B NEXT i XSize = 8: YSize = 16 FOR i = 1 TO 9 'Zahlen 1...9 A$ = STR$(i) x = xa + 25 * i: y = ya + 4: Col1 = 0: CALL PrintText NEXT i FOR i = 10 TO 20 'Zahlen 10...20 A$ = STR$(i) x = xa - 5 + 25 * i: y = ya + 4: Col1 = 0: CALL PrintText NEXT i END SUB SUB K1Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 1 neutral zeichnen * '**************************************************************************** xa = 10: xe = 60: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K2Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 2 neutral zeichnen * '**************************************************************************** xa = 70: xe = 120: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K3Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 3 neutral zeichnen * '**************************************************************************** xa = 130: xe = 180: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K4Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 4 neutral zeichnen * '**************************************************************************** xa = 190: xe = 450: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K5Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 5 neutral zeichnen * '**************************************************************************** xa = 460: xe = 510: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K6Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 6 neutral zeichnen * '**************************************************************************** xa = 520: xe = 570: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB K7Neutral '**************************************************************************** '* Stand: 13.03.97 * '* Knopf 7 neutral zeichnen * '**************************************************************************** xa = 580: xe = 630: ya = 430: ye = 474 LINE (xa + 2, ya + 2)-(xe - 2, ye - 2), 7, BF 'Feld LINE (xa, ya)-(xe, ye), 0, B 'Rahmen schwarz LINE (xa + 1, ya + 1)-(xe - 1, ya + 1), 15 'oben weiss LINE (xa + 1, ya + 1)-(xa + 1, ye - 1), 15 'links weiss LINE (xe - 1, ya + 2)-(xe - 1, ye - 1), 0 'rechts schwarz LINE (xa, ye - 1)-(xe - 2, ye - 1), 0 'unten schwarz LINE (xa + 7, ya + 21)-(xe - 5, ya + 21), 0 'Mittellinie schwarz LINE (xa + 6, ya + 23)-(xe - 4, ya + 23), 15 'Mittellinie weiss END SUB SUB MakeFont '**************************************************************************** '* Stand: 13.03.97 * '* vorhandenen Font einlesen fuer scalierbare Schriften * '**************************************************************************** COLOR 1 'Blau auf schwarz, damit das Einlesen des 'Fonts in Zeile 2 Pos.1 nicht so auffaellt Char1 = 1 'ab hier Font einlesen FOR Char2 = 33 TO 126 LOCATE 2, 1: PRINT CHR$(Char2) FOR J = 1 TO 16 FOR i = 1 TO 8 Font(Char1, i, J) = POINT(i - 1, J + 15) NEXT i NEXT J i = 8: A = 0: Font(Char1, 0, 0) = i Char1 = Char1 + 1 NEXT Char2 END SUB SUB MenuAuto '**************************************************************************** '* Stand: 13.03.97 * '* zeigt Bild Auto Sequencer * '**************************************************************************** CALL Background y = 125 '1.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 180 '2.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 208 '3.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 235 '4.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x x = 240 '1.vertikale Trennlinie FOR y = 180 TO 235: PSET (x, y), 15: NEXT y x = 426 '2.vertikale Trennlinie FOR y = 180 TO 235: PSET (x, y), 15: NEXT y x = 583: y = 143 'Rahmen Delay-Fenster LINE (x, y)-(x + 41, y + 17), 15, B LOCATE 10, 74: COLOR 14: PRINT USING "#####"; Delay% - 11 x = 545: y = 36: Col1 = 5: t = 4 A$ = "Auto": CALL PrintText x = 20: y = 90: Col1 = 7 A$ = "Marker": CALL PrintText x = 20: y = 147 A$ = "Status": CALL PrintText x = 510: y = 145 A$ = "Delay": CALL PrintText x = 250: y = 214 A$ = "Period": CALL PrintText x = 250: y = 190 A$ = "Duration": CALL PrintText x = 20: y = 245 A$ = "Received Text:": CALL PrintText x = 450: y = 190 A$ = "Response": CALL PrintText CALL DownKeys 'Tastenleiste zeichnen x = 18: y = 435: Col1 = 5: t = 4 'Tastenleiste beschriften A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste CALL GreenMarkers '20 Markerkaestchen gruen CALL StatusWait 'zeige Status END SUB SUB MenuMain '**************************************************************************** '* Stand: 13.03.97 * '* bringt Bild Hauptmenue auf Bildschirm * '**************************************************************************** CALL Background xa = 80: xe = 150: ya = 150 'Bild Knopf 11 mal FOR i = 0 TO 10 ya = 125 + 25 * i: ye = ya + 20: CALL Button NEXT i XSize = 16: YSize = 16: x = 170: y = 100: Col1 = 10 A$ = "Select": CALL PrintText 'ueberschrift Hauptmenue XSize = 8: YSize = 16: Col1 = 15 FOR i = 1 TO 9 'Knopf F1 bis F9 beschriften x = 105: y = 103 + i * 25: A$ = "F" + CHR$(48 + i): CALL PrintText NEXT i 'x = 101: y = 353 'A$ = "F10": CALL PrintText 'Knopf F10 beschriften x = 101: y = 378 'Knopf ESC beschriften A$ = "ESC": CALL PrintText x = 545: y = 36: Col1 = 5 A$ = "Main": CALL PrintText x = 170: y = 128: Col1 = 11 A$ = "Read SBMS.DOC": CALL PrintText x = 170: y = 153 A$ = "Record": CALL PrintText x = 170: y = 178 A$ = "Playback": CALL PrintText x = 170: y = 203 A$ = "Change Ini": CALL PrintText x = 170: y = 228 A$ = "Auto": CALL PrintText x = 170: y = 253 A$ = "Oscilloscope": CALL PrintText x = 170: y = 278 A$ = "Play File": CALL PrintText x = 170: y = 303 A$ = "Screen Save": CALL PrintText x = 170: y = 328 A$ = "DOS": CALL PrintText x = 170: y = 353 A$ = "": CALL PrintText x = 170: y = 378 A$ = "Exit": CALL PrintText END SUB SUB MenuOszi '**************************************************************************** '* Stand: 13.03.97 * '* zeigt Bild Oszi * '**************************************************************************** CALL Background x = 510: y = 36: Col1 = 5 A$ = "Oscilloscope": CALL PrintText CALL DownKeys x = 18: y = 435: Col1 = 5: t = 4 'Tastenleiste beschriften A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 x = 78: y = 435 A$ = "BEAM": CALL PrintText 'Knopf 2 beschriften x = 138 'Knopf 3 beschriften A$ = "BEAM": CALL PrintText x = 469 'Knopf 5 beschriften A$ = "ZOOM": CALL PrintText x = 530 'Knopf 6 beschriften A$ = "ZOOM": CALL PrintText x = 544: y = 458 PSET (x, y), 0: DRAW "d10 e5 h5" 'Symbol Cursor nach rechts PAINT (x + 1, y + 5), 0, 0 'schwarz einfaerben x = 485: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Cursor nach links PAINT (x - 1, y + 5), 0, 0 'schwarz einfaerben x = 588: y = 435 'Knopf 7 beschriften A$ = "HOME": CALL PrintText x = 600: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Enter PAINT (x - 2, y + 5), 0, 0 LINE (x, 463)-(x + 13, y + 5), 0 LINE (x + 13, y + 5)-(x + 13, y), 0 END SUB SUB MenuPlayback '**************************************************************************** '* Stand: 13.03.97 * '* bringt Menue Playback auf Bildschirm * '**************************************************************************** CALL Background y = 125 '1.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 180 '2.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 235 '3.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x x = 525: y = 36: Col1 = 5 A$ = "Playback": CALL PrintText x = 510: y = 145: Col1 = 7 A$ = "Delay": CALL PrintText x = 583: y = 143 'Rahmen Delay-Fenster LINE (x, y)-(x + 41, y + 17), 15, B x = 20: y = 147: Col1 = 7 A$ = "Status": CALL PrintText x = 20: y = 245: Col1 = 7 A$ = "Received Text:": CALL PrintText CALL DownKeys 'leere Tastenleiste x = 18: y = 435: Col1 = 5: t = 4 A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste x = 78: y = 435 A$ = "SLOW": CALL PrintText 'Funktion 2.Taste x = 138 'Knopf 3 beschriften A$ = "FAST": CALL PrintText x = 588 'Knopf 7 beschriften A$ = "PLAY": CALL PrintText x = 472 'Knopf 5 beschriften A$ = "FBW": CALL PrintText x = 533 'Knopf 6 beschriften A$ = "FFW": CALL PrintText x = 544: y = 458 PSET (x, y), 0: DRAW "d10 e5 h5" 'Symbol Cursor nach rechts PAINT (x + 1, y + 5), 0, 0 'schwarz einfaerben x = 485: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Cursor nach links PAINT (x - 1, y + 5), 0, 0 'schwarz einfaerben x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 x = 600: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Enter PAINT (x - 2, y + 5), 0, 0 LINE (x, 463)-(x + 13, y + 5), 0 LINE (x + 13, y + 5)-(x + 13, y), 0 END SUB SUB MenuPlayFile '**************************************************************************** '* Stand: 13.03.97 * '* Bild zu PlayFile * '**************************************************************************** CALL Background y = 125 '1.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 180 '2.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x x = 525: y = 36: Col1 = 5 A$ = "Play File": CALL PrintText x = 20: y = 96: Col1 = 7 A$ = "File to Play": CALL PrintText x = 510: y = 145: Col1 = 7 A$ = "Delay": CALL PrintText x = 583: y = 143 'Rahmen Delay-Fenster LINE (x, y)-(x + 41, y + 17), 15, B x = 135: y = 95 'Rahmen Path+File-Fenster LINE (x, y)-(x + 498, y + 17), 15, B x = 20: y = 147: Col1 = 7 A$ = "Status": CALL PrintText CALL DownKeys 'leere Tastenleiste x = 588: y = 435: Col1 = 0: t = 0 'Knopf 7 A$ = "PLAY": CALL PrintText x = 600: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Enter PAINT (x - 2, y + 5), 0, 0 LINE (x, 463)-(x + 13, y + 5), 0 LINE (x + 13, y + 5)-(x + 13, y), 0 END SUB SUB MenuReadDoc '**************************************************************************** '* Stand: 13.03.97 * '* zeigt Bild Read Doc * '**************************************************************************** CALL Background x = 503: y = 36: Col1 = 5 A$ = "Documentation": CALL PrintText CALL DownKeys END SUB SUB MenuRecordFile '**************************************************************************** '* Stand: 13.03.97 * '* Bild zu RECORD * '**************************************************************************** CALL Background y = 125 '1.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 180 '2.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x y = 235 '3.Trennlinie FOR x = 0 TO 640: PSET (x, y), 15: NEXT x x = 522: y = 36: Col1 = 5: t = 4 A$ = "Record MS": CALL PrintText x = 20: y = 90: Col1 = 7 A$ = "Marker": CALL PrintText x = 20: y = 147 A$ = "Status": CALL PrintText x = 510: y = 202 A$ = "Period": CALL PrintText x = 20: y = 202 A$ = "Bytes": CALL PrintText x = 250: y = 202 A$ = "Samples/s": CALL PrintText CALL DownKeys 'Tastenleiste zeichnen x = 18: y = 435: Col1 = 5: t = 4 'Tastenleiste beschriften A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste END SUB SUB Noise '*************************************************************************** '* Stand:13.03.97 * '* gibt etwas Rauschen ueber SB aus * '*************************************************************************** IF BaseAddress% <> 0 THEN LOCATE 2, 1: COLOR 15: PRINT " SBlaster test, you should hear some noise ..." END IF WAIT CommAddress%, &H80, &HFF OUT CommAddress%, &HD1 'Lsp ein z& = 0 DO z& = z& + 1 Byte = 100 * RND(1) WAIT CommAddress%, &H80, &HFF OUT CommAddress%, &H10 WAIT CommAddress%, &H80, &HFF OUT CommAddress%, Byte LOOP WHILE z& < 50000 WAIT CommAddress%, &H80, &HFF OUT CommAddress%, &HD3 'Lsp aus END SUB SUB Oszi '**************************************************************************** '* Stand: 13.03.97 * '* zeigt NF als Oszi-Aufnahme * '**************************************************************************** LINE (1, 71)-(638, 420), 0, BF 'schwarze Zeichenflaeche LINE (0, 70)-(639, 421), 15, B 'weiss umrahmt y = 100 'Startwert y-offset nn = 230 'gruene Nullinien-Null abst = 80 'Abstand Nullinie-rote Linien xMax = 638 '638 Pixel in x-Richtung merker = 0 'keine Uhrzeit anzeigen py = nn 'Startwert gelbe=gruene Linie DO taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'Schleife verlassen CASE CHR$(0) + CHR$(80) 'Corsor runter=Strahl runter y = y + 1 IF y > 180 THEN y = 180 CASE CHR$(0) + CHR$(72) 'Cursor hoch=Strahl hoch y = y - 1 IF y < 20 THEN y = 20 'obere Strahlgrenze Null CASE CHR$(0) + CHR$(75) 'Cursor links IF z > .0001 THEN z = z - .01 * z 'guenstiger Wert CASE CHR$(0) + CHR$(77) 'Cursor rechts z = z + .01 * z 'guenstiger Wert IF z > 5 THEN z = 5 'untere Strahlgrenze Null CASE CHR$(13) 'ENTER = HOME np = 0 'Pixel-Nummer = 0 px = 0 'Position X = 0 LINE (1, 71)-(638, 420), 0, BF 'Zeichenflaeche loeschen LOCATE 6, 2: PRINT "Started at "; TIME$; " UTC"; CASE ELSE END SELECT LINE (1, nn - abst)-(639, nn - abst), 4 'obere Linie rot LINE (1, nn)-(639, nn), 2 'Nullinie gruen LINE (1, nn + abst)-(639, nn + abst), 4 'untere Linie rot LOCATE 26, 12: COLOR 2: PRINT USING "Beam+###"; 100 - y LOCATE 26, 60: COLOR 2: PRINT "Zoom"; : PRINT USING "##.####"; z; OUT CommAddress%, &H20 'SB Achtung ! g = INP(DataAddress%) 'lese ein Byte g H = y + g 'Y=YOffset+Bytewert LINE (np, H)-(px, py), 14 'Oszi-Kurve gelb zeichnen py = H 'alte h in py merken px = np 'alte np in px merken np = np + z 'Pixel-Zaehler +1 oder Zoomfaktor IF np >= xMax THEN 'rechter Rand erreicht ? np = 0 'Pixel-Nummer = 0 px = 0 'Position X = 0 LINE (1, 71)-(638, 420), 0, BF 'Zeichenflaeche loeschen END IF LOOP END SUB SUB Playback '**************************************************************************** '* Stand: 13.03.97 * '* Herzstueck Abspielen einer Datei von RAM-Disk * '**************************************************************************** n& = 1 'Bytezaehler auf Anfang WAIT CommAddress%, &H80, &HFF 'SB auf EIN vorbereiten OUT CommAddress%, &HD1 'LP EIN '*** ABSPIELEN ************************************************************* OPEN MarkFile$ FOR BINARY AS MarkFile% nmax& = LOF(MarkFile%) 'ermittle Filelaenge DO WHILE n& < nmax& 'Beginn Abspiel-Schleife GET MarkFile%, n&, Byte% 'ein Byte Abspielen FOR i = 1 TO Delay% 'Verzoegerungs-Schleife NEXT i 'fuer Abspiel-Tempo WAIT CommAddress%, &H80, &HFF 'warte bis SB-Daten fertig OUT CommAddress%, &H10 'SB: Achtung ! kommen Daten WAIT CommAddress%, &H80, &HFF 'warte bis SB-Daten fertig OUT CommAddress%, Byte% 'einen WERT aus Puffer an SB taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27), CHR$(13) 'bei ESCAPE oder ENTER EXIT DO 'Schleife vorzeitig verlassen CASE CHR$(0) + CHR$(80) 'Corsor runter Delay% = Delay% - Delay% / 20 'guenstige Schrittweite IF Delay% <= 10 THEN Delay% = 11 'sonst klemmts bei 10 ! LOCATE 10, 74: COLOR 14: PRINT USING "#####"; Delay% - 11 CASE CHR$(0) + CHR$(72) 'Cursor hoch Delay% = Delay% + Delay% / 20 IF Delay% > 30000 THEN Delay% = 30000 LOCATE 10, 74: COLOR 14: PRINT USING "#####"; Delay% - 11 CASE CHR$(0) + CHR$(75) 'Cursor links n& = n& - 1000 '1000 Byte zurueckspulen IF n& < 1 THEN n& = 1 'Byte-# CASE CHR$(0) + CHR$(77) 'Cursor rechts n& = n& + 1000 '1000 Byte vorspulen IF n& > nmax& THEN n& = nmax& - 1 'Byte-# CASE ELSE RXTXT$ = RXTXT$ + taste$ 'empfangene Zeichen anfuegen END SELECT n& = n& + 1 'naechstes Byte LOOP IF RXTXT% = 1 THEN XSize = 16: YSize = 32: Col1 = 14: t = 0 'empf. Zeichen gross gelb anz. FOR zeile = 0 TO 4 'max. 5 Zeilen x = 20: y = 260 + 35 * zeile 'x,y,Zeilenabstand A$ = UCASE$(MID$(RXTXT$, 1 + zeile * 36, 36)): CALL PrintText '36 Z/Zeile NEXT zeile RXTXT$ = RXTXT$ + " " 'Trennung der Perioden-Texte END IF WAIT CommAddress%, &H80, &HFF 'SB auf AUS vorbereiten OUT CommAddress%, &HD3 'LP AUS CLOSE MarkFile% 'Datei schliessen END SUB SUB PlayFile '**************************************************************************** '* Stand: 13.03.97 * '* File-Player via RAM-Disk * '**************************************************************************** RXTXT% = 0 'keinen Text anzeigen marke8: LOCATE 7, 18: PRINT STRING$(62, " "); 'schwarze Schreiblinie vorber. LOCATE 10, 74: COLOR 14: PRINT USING "#####"; Delay% - 11 CALL StatusTextInp LOCATE 7, 19: INPUT "", SoundFile$ 'Pfad und Datei eingeben IF INSTR(1, SoundFile$, "*") <> 0 THEN GOTO marke8 'kein * erlaubt ! IF SoundFile$ = "" THEN 'Bei "" dieses spielen SoundFile$ = Path$ + "1000lpm.msf" LOCATE 7, 19: PRINT SoundFile$ END IF 'ab hier pruefen ob Path und File existieren ! filespec$ = SoundFile$ 'Filespec$ ist Pruefvariable DE = 0 'DE = Directory Eintraege FindFirst filespec$, DIR(DE) 'directory finden WHILE (DE < 999) AND (RTRIM$(DIR(DE).filename) <> "") 'file (mehrmals) finden DE = DE + 1 FindNext DIR(DE) WEND IF DE = 0 THEN 'wenn file nicht gefunden CALL StatusFileNotFound 'Fenster zeigen i = TIMER DO: LOOP UNTIL TIMER > i + 1 '1 sec. anzeigen GOTO marke8 'nochmal END IF marke5: KILL PathRamDisk$ + "sndfile.msf" CALL StatusCopyFile 'erst Musterfile von Stammverzeichis nach RamDisk kopieren, dann abspielen OPEN SoundFile$ FOR BINARY AS #1 'File auf HD lesen OPEN PathRamDisk$ + "sndfile.msf" FOR BINARY AS #2 'File auf RAM-Disk schreiben A$ = SPACE$(1024) 'Puffer einrichten FOR i = 1 TO LOF(1) \ 1024 'in Bloecken kopieren GET 1, , A$ PUT 2, , A$ NEXT i IF LOF(1) MOD 1024 > 0 THEN 'und den Rest auch kopieren A$ = SPACE$(LOF(1) MOD 1024) GET 1, , A$ PUT 2, , A$ END IF CLOSE #2 CLOSE #1 XSize = 8: YSize = 16: x = 18: y = 435: Col1 = 5: t = 4 A$ = "MAIN": CALL PrintText 'Knopf 1 x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1 x = 78: y = 435: Col1 = 0 'Knopf 2 A$ = "FAST": CALL PrintText x = 138 'Knopf 3 A$ = "SLOW": CALL PrintText x = 472 'Knopf 5 beschriften A$ = "FBW": CALL PrintText x = 533 'Knopf 6 beschriften A$ = "FFW": CALL PrintText x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 x = 544: y = 458 PSET (x, y), 0: DRAW "d10 e5 h5" 'Symbol Cursor nach rechts PAINT (x + 1, y + 5), 0, 0 'schwarz einfaerben x = 485: y = 458 PSET (x, y), 0: DRAW "d10 h5 e5" 'Symbol Cursor nach links PAINT (x - 1, y + 5), 0, 0 'schwarz einfaerben MarkFile$ = PathRamDisk$ + "sndfile.msf" 'fuer SUB Playback benennen CALL StatusPlayingFile CALL Playback 'Abspielen CALL StatusReady 'Fenster MarkFile$ = PathRamDisk$ + "lastperi.msf" 'zurueck benennen IF taste$ = CHR$(27) THEN 'Taste$ von SUB Playback ! RXTXT = 1 'Text wieder anzeigen CLOSE EXIT SUB END IF IF taste$ = CHR$(13) THEN GOTO marke5 'ENTER=nochmal marke7: DO taste$ = INKEY$ LOOP WHILE taste$ = "" SELECT CASE taste$ CASE CHR$(27) RXTXT = 1 'Text wieder anzeigen CLOSE EXIT SUB CASE CHR$(13) GOTO marke5 'Enter=nochmal CASE ELSE GOTO marke7 'falsche Taste gedrueckt END SELECT END SUB SUB PlayPeriod '**************************************************************************** '* Stand: 13.03.97 * '* liest lastperi.msf von RamDisk und gibt es mit variabler Geschw. * '* auf Lautsprecher aus, hat schnellen Vor- und Ruecklauf * '**************************************************************************** RXTXT% = 1 'RXTXT anzeigen OPEN MarkFile$ FOR BINARY AS MarkFile% IF LOF(MarkFile%) = 0 THEN 'Test ob MarkFile Inhalt hat CALL StatusNoFile 'Statusfenster NO FILE REC... CALL K2Neutral CALL K3Neutral CALL K5Neutral CALL K6Neutral CALL K7Neutral DO taste$ = INKEY$ LOOP UNTIL taste$ = CHR$(27) 'nur mit ESCAPE gehts weiter! END IF CLOSE MarkFile% IF taste$ = CHR$(27) THEN EXIT SUB marke3: 'Marke fuer nochmal CALL StatusWait '*** Warten auf Cursor hoch/runter, ENTER oder ESCAPE ********************** DO taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(27) 'ESCAPE EXIT DO 'erst schleife verlassen~ CASE CHR$(0) + CHR$(80) 'Corsor runter=schneller Delay% = Delay% - Delay% / 20 'ausreichende Schrittweite IF Delay% <= 10 THEN Delay% = 11 'sonst klemmts bei 10 ! CASE CHR$(0) + CHR$(72) 'Cursor hoch=langsamer Delay% = Delay% + Delay% / 20 IF Delay% > 30011 THEN Delay% = 30011 'hoechstens 32766 CASE CHR$(13) 'ENTER sofort neu abspielen EXIT DO CASE ELSE END SELECT LOCATE 10, 74: COLOR 14: PRINT USING "#####"; Delay% - 11 LOOP IF taste$ = CHR$(27) THEN EXIT SUB '~und dann SUB verlassen CALL StatusPlay 'Fenster PLAYBACK gruen CALL Playback 'Herzstueck von Wiedergabe IF taste$ = CHR$(27) THEN EXIT SUB 'ESCAPE zum Hauptmenue GOTO marke3 'ansonsten nochmal END SUB SUB PrintText '**************************************************************************** '* Stand: 13.03.97 * '* ermoeglicht scalierbare Schriften auf Bildschirm * '**************************************************************************** IX = XSize \ 8: IY = YSize \ 16 T1 = t AND 1 T2 = t AND 2: IF T2 <> 0 THEN T2 = 1 T3 = t AND 4: IF T3 <> 0 THEN T3 = 1 XS = IX * 8: ys = IY * 16 FOR i = 1 TO 8: XS(i) = IX: NEXT i FOR i = 1 TO 16: ys(i) = IY: NEXT i IF XS <> XSize THEN FOR i = 1 TO XSize - XS: XS(i) = XS(i) + 1: NEXT i IF ys <> YSize THEN FOR i = 1 TO YSize - ys: ys(i) = ys(i) + 1: NEXT i FOR i = 1 TO LEN(A$): c = ASC(MID$(A$, i, 1)) IF c = 13 THEN x = 0: y = y + YSize: IF y < 480 GOTO Oops ELSE RETURN IF c = 32 THEN x = x + XSize: IF x < 640 GOTO Oops ELSE RETURN IF c >= 33 AND c <= 127 THEN Char = c - 32 TD1: XS2 = Font(Char, 0, 0): XS3 = 0 FOR A = 1 TO XS2: XS3 = XS3 + XS(A): NEXT A IF x + XS3 > 639 THEN EXIT SUB X2 = x: Y2 = y FOR k = 1 TO 16: Z1 = ys(k): IF Z1 = 0 THEN 96 FOR J = 1 TO XS2: Z2 = XS(J): IF Z2 = 0 THEN 95 IF Font(Char, J, k) = 0 GOTO TD2 X9 = x + Z2 - 1: Y9 = y + Z1 - 1 IF T2 = 1 GOTO T2 IF T3 = 1 THEN LINE (x + IX, y + IY)-(X9 + IX, Y9 + IY), Col2, BF LINE (x, y)-(X9, Y9), Col1, BF GOTO TD2 T2: Q = (4 - k \ 2) * IX IF T3 = 1 THEN LINE (x + Q + IX, y + IY)-(X9 + Q + IX, Y9 + IY), Col2, BF LINE (x + Q, y)-(X9 + Q, Y9), Col1, BF 'Unterstrich TD2: x = x + Z2 95 NEXT J: x = X2: y = y + Z1 96 NEXT k: y = Y2 IF T1 = 1 THEN LINE (x, y + YSize - 2)-(x + XS3, y + YSize - 2), Col1 IF T1 = 1 AND T3 = 1 THEN LINE (x + 1, y + YSize - 1)-(x + XS3 + 1, y + YSize - 1), Col2 x = x + XS3 + 1 Oops: NEXT i END SUB SUB ReadDoc '**************************************************************************** '* Stand: 13.03.97 * '* gibt Text in einem Fenster aus * '* Steuertasten CursorUp, CursorDwn, PgUp, PgDwn, Pos1, END, ESC * '**************************************************************************** DIM text AS STRING * 80 'Zeilenlaenge fuer ReadDoc LINE (0, 421)-(639, 421), 15 'obere Linie untere Leiste filename$ = Path$ + "sbms.doc" OPEN filename$ FOR INPUT AS #1 spread = 20 'Anzahl Zeilen Low = 6 'Zeilengrenze 1 wg.Fenster High = Low + spread 'Zeilengrenze 2 zeile = 1 'Zaehler fuer ZeilenKaeSTCHEN LINE (0, 71)-(639, 420), 0, BF 'gesamte Sichtflaeche schwarz COLOR 7 LOCATE 10, 10: PRINT "Status: copy 'sbms.doc' to 'temp.msf', please wait !" OPEN "temp.msf" FOR RANDOM AS #2 LEN = LEN(text) DO UNTIL EOF(1) 'copy a plain ASCII text file LINE INPUT #1, line$ 'into a structured file for text = line$ 'random access (file 2) PUT #2, , text 'text ist ein 80ZeichenString! LOOP CLOSE 1 '#2 bleibt auch weiter offen! x = 18: y = 435: Col1 = 5: t = 4 'Tastenleiste beschriften A$ = "MAIN": CALL PrintText 'Funktion 1.Taste x = 23: y = 458: Col1 = 0: t = 0 A$ = "ESC": CALL PrintText 'Knopf 1.Taste x = 155: y = 461 PSET (x, y), 0: DRAW "g5 r10 h5" 'Symbol Cursor hoch PAINT (x, y + 3), 0, 0 x = 93: y = 466 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Cursor runter PAINT (x, y - 3), 0, 0 x = 78: y = 435 A$ = "LINE": CALL PrintText 'Knopf 2 beschriften x = 138 'Knopf 3 beschriften A$ = "LINE": CALL PrintText x = 303: y = 455 'Knopf 4 beschriften A$ = "END": CALL PrintText x = 251: y = 435 A$ = "GO TO END OF FILE": CALL PrintText x = 469: y = 435 'Knopf 5 beschriften A$ = "PAGE": CALL PrintText x = 529 'Knopf 6 beschriften A$ = "PAGE": CALL PrintText x = 545: y = 457 'Symbol Page Up PSET (x, y), 0: DRAW "g5 r10 h5" PAINT (x, y + 3), 0, 0 x = 545: y = 462 PSET (x, y), 0: DRAW "g5 r10 h5" PAINT (x, y + 3), 0, 0 x = 485: y = 463 PSET (x, y), 0: DRAW "h5 r10 g5" 'Symbol Page Down PAINT (x, y - 3), 0, 0 x = 485: y = 468 PSET (x, y), 0: DRAW "h5 r10 g5" PAINT (x, y - 3), 0, 0 x = 588: y = 435 'Knopf 7 beschriften A$ = "HOME": CALL PrintText x = 588: y = 456 'Knopf 7 beschriften A$ = "POS1": CALL PrintText size = LOF(2) / LEN(text) 'Anzahl Zeilen/File ermitteln COLOR 11 'Zeilenzaehler in tuerkis LOCATE 5, 61: PRINT USING "#########"; size; : PRINT " Lines " LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen again: 'zeige ausgewaehlten Auschnitt tl = 6 'Hilfszaehler auf Anfangzeile IF Low < 6 THEN Low = 6 'Kontrolle Zeilengrenze IF High > size THEN 'Zeile > max.Zeile in File ? High = size 'letzte zeile nicht > max.Zeile Low = High - spread 'erste Zeile END IF High = Low + spread 'eine Seite = 20 Zeilen FOR x = Low TO High GET #2, x, text 'lese Zeile LOCATE tl, 1: COLOR 15: PRINT text; 'zeige Zeile auf BS in weiss tl = tl + 1 NEXT x COLOR 11 'alle Line-Anzeigen in tuerkis marke2: 'Bewegen im File taste$ = INKEY$ 'Zeichen von Tastatur SELECT CASE taste$ CASE CHR$(0) + CHR$(71) 'Pos.1-Taste zeile = 1 LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen Low = 6 GOTO again CASE CHR$(0) + CHR$(79) 'end key zeile = size - spread LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen High = size Low = High - spread GOTO again CASE CHR$(0) + CHR$(81) 'page down key zeile = zeile + spread IF zeile > size - spread THEN zeile = size - spread LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen Low = Low + spread High = High + spread GOTO again CASE CHR$(0) + CHR$(73) 'page up key zeile = zeile - spread IF zeile < 1 THEN zeile = 1 LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen Low = Low - spread High = High - spread GOTO again CASE CHR$(0) + "P" 'Cursor runter zeile = zeile + 1 IF zeile > (size - spread) THEN zeile = (size - spread) LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen Low = Low + 1 High = High + 1 GOTO again CASE CHR$(0) + "H" 'Cursor hoch zeile = zeile - 1 IF zeile < 1 THEN zeile = 1 LOCATE 5, 61: PRINT "Lines "; : PRINT USING "#####"; zeile; PRINT " to"; : PRINT USING "#####"; zeile + spread LINE (479, 63)-(632, 78), 15, B 'Lines-Kaestchen Low = Low - 1 High = High - 1 GOTO again CASE CHR$(27) 'escape key CLOSE KILL "temp.msf" EXIT SUB CASE ELSE END SELECT GOTO marke2 END SUB SUB ReadIni '**************************************************************************** '* Stand: 13.03.97 * '* Anfangsvariablen einlesen * '**************************************************************************** REDIM inhalt$(8) '8 ini-werte LOCATE 3, 1: COLOR 15 PRINT " In case there is some trouble now at this position try instead of a" PRINT " command like F:\SUBDIR\SBMS.EXE to change the directory in a first" PRINT " step and call SBMS.EXE in a second step." 'sbms.ini muss im selben Verzeichnis stehen wie sbms.exe bzw. sbms.bas OPEN "sbms.ini" FOR INPUT AS #1 FOR i = 1 TO 8 '8 zeilen aus SBMS.INI lesen LINE INPUT #1, zeile$ 'ganze Zeile bis CR/LF lesen Length = INSTR(zeile$, " ") 'wo taucht erstes " " auf ? inhalt$(i) = RTRIM$(LEFT$(zeile$, Length)) 'zeichen bis dahin lesen ' LOCATE i, 1: PRINT i; inhalt$(i) 'TEST NEXT i CLOSE #1 Path$ = inhalt$(1) 'Pfad zu Programmdateien PathRamDisk$ = inhalt$(2) 'Pfad zu RAM-Disk RXStartTime$ = inhalt$(3) 'Startzeit QSO Duration% = VAL(inhalt$(4)) 'Laenge des QSO in Minuten Period% = VAL(inhalt$(5)) 'S/E-Periode in Sekunden Response% = VAL(inhalt$(6)) 'Reaktionszeit in bytes Delay% = VAL(inhalt$(7)) + 11 'Abspielverlangsamung UTCDiff% = VAL(inhalt$(8)) 'Zeitdifferenz UTC-MEZ END SUB SUB Record '**************************************************************************** '* Stand: 13.03.97 * '* Herzstueck Aufnahme * '**************************************************************************** Marker = 1 'Anfangswert setzen n& = 1 'Anfangswert setzen OPEN RawFile$ FOR BINARY AS RawFile% OUT ResetAddress%, 1 'reset SB OUT ResetAddress%, 0 StartTime = TIMER 'start time recording xa = 100: xe = xa + 20: ya = 88: ye = ya + 20 'Pos.u Groesse Marker-Kaestchen MarPos = 1 'erstes Marker-Kaestchen DO AktTime = TIMER - StartTime 'elapsed time SELECT CASE INKEY$ 'Tastaturabfrage CASE CHR$(27) 'ESCAPE EXIT DO 'Schleife vorzeitig verlassen CASE CHR$(32) 'SPACE Marker&(Marker) = n& 'store Byte# to Marker SELECT CASE Marker CASE IS = 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, 29, 31, 33, 35, 37, 39 'rot Marker&(Marker) = Marker&(Marker) - Response% 'Reaktionszeit beruecksichtigen IF Marker&(Marker) < 1 THEN Marker&(Marker) = 1 'hoechstens bis Anfang zurueck LINE (xa + 25 * (MarPos), ya)-(xe + 25 * (MarPos), ye), 12, BF CASE ELSE 'schwarz LINE (xa + 25 * (MarPos), ya)-(xe + 25 * (MarPos), ye), 0, BF IF Marker < MaxMarker% THEN MarPos = MarPos + 1 'naechste Pos. Markerkaestchen END IF END SELECT IF Marker < MaxMarker% THEN Marker = Marker + 1 'next marker ELSE 'mehr als MaxMarker gesetzt ! CALL K4Neutral 'SPACE Loeschen x = 300: y = 435: Col1 = 4: t = 0 'Knopf 4 umbeschriften A$ = "SORRY": CALL PrintText x = 240: y = 458: Col1 = 4: t = 0 'Knopf 4 umbeschriften A$ = "NO MARKER AVAILABLE": CALL PrintText END IF CASE ELSE END SELECT WAIT CommAddress%, &H80, &HFF OUT CommAddress%, &H20 'SB read data Byte% = INP(DataAddress%) 'read a single byte PUT RawFile%, n&, Byte% 'store byte to file n& = n& + 1 'next byte LOOP WHILE AktTime < Period% 'record time over ? CLOSE RawFile% 'Datei immer schliessen '*** Letzter Marker nicht gesetzt ? ***************************************** SELECT CASE Marker CASE IS = 2, 4, 6, 8, 10, 12, 14, 16, 18, 20 Marker&(Marker) = n& 'dann letzter Marker=Filelaenge LINE (xa + 25 * (MarPos), ya)-(xe + 25 * (MarPos), ye), 0, BF 'rot->schwarz CASE ELSE END SELECT CALL K4Neutral 'Knopf 4 loeschen '*** ist ueberhaupt ein Marker gesetzt ? ************************************* IF Marker > 1 THEN 'mindestens einer mehr ? CALL StatusCollect 'Statusfenster CALL Collect 'File m.mark.Bereichen anlegen END IF END SUB SUB RecordFile '**************************************************************************** '* date: 13.03.97 * '* writes file lastperi.msf to RAM-Disk * '* set marker by pressing space-bar at beginning and end of a ping/burst * '* creates file containing marked areas only (markperi.msf) * '**************************************************************************** x = 580: y = 202: Col1 = 7: t = 4 'Period anzeigen A$ = STR$(Period%) + "s": CALL PrintText marke4: 'nochmal CALL GreenMarkers '20 guene Kaestchen zeichnen CALL StatusWait 'Statusfenster WAITING... x = 592: y = 435: Col1 = 0: t = 0 'Taste7 beschriften A$ = "REC": CALL PrintText x = 600: y = 458 'Symbol ENTER PSET (x, y), 0: DRAW "d10 h5 e5" PAINT (x - 2, y + 5), 0, 0 LINE (x, 463)-(x + 13, y + 5), 0 LINE (x + 13, y + 5)-(x + 13, y), 0 '*** wait until ESC for Abort or ENTER for Start **************************** DO taste$ = INKEY$ 'Taste gedrueckt ? SELECT CASE taste$ CASE CHR$(13), CHR$(27) 'nur ENTER oder ESCAPE EXIT DO 'zum Verlassen der Schleife CASE ELSE END SELECT LOOP IF taste$ = CHR$(27) THEN EXIT SUB 'bei 13 mit Kill... weiter KILL RawFile$ 'alte Aufzeichnung loeschen xa = 125: xe = 230: ya = 200: ye = 222 'Bytes-Anzeige loeschen LINE (xa, ya)-(xe, ye), 1, BF xa = 335: xe = 400: ya = 200: ye = 222 'Samples/s-Anzeige loeschen LINE (xa, ya)-(xe, ye), 1, BF CALL StatusRec 'Statusfenster RECORDING x = 277: y = 435: Col1 = 12: t = 4 'Knopf 4 beschriften A$ = "SET MARKER ": CALL PrintText x = 293: y = 458: Col1 = 0: t = 0 'Knopf 4 beschriften A$ = "SPACE": CALL PrintText CALL K7Neutral 'Knopf 7 loeschen CALL Record 'Herzstueck Aufzeichnung IF taste$ = CHR$(27) THEN EXIT SUB x = 120: y = 202: Col1 = 7: t = 4 'zeige Byte-Anzahl A$ = STR$(n&): CALL PrintText x = 330: y = 202: Col1 = 7: t = 4 'zeige Samples/s A$ = STR$(n& \ Period%): CALL PrintText GOTO marke4 END SUB SUB StatusCollect '**************************************************************************** '* Stand: 13.03.97 * '* gibt tuerkis Statusfenster mit hellroter Schrift COLLECTING... aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 11, BF 'Feld tuerkis XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "COLLECTING PINGS AND BURSTS, WAIT": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusCopyFile '**************************************************************************** '* Stand: 13.03.97 * '* gibt tuerkis Statusfenster mit hellroter Schrift aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 3, BF 'Feld tuerkis XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "COPY FILE TO RAM-DISK": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusFileNotFound '**************************************************************************** '* Stand: 13.03.97 * '* gibt rotes Statusfenster mit schwarzer Schrift FILE NOT FOUND aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 12, BF 'Feld hellrot XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 0: Col2 = 0: t = 0 A$ = "FILE NOT FOUND": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusNoFile '**************************************************************************** '* Stand: 13.03.97 * '* gibt rotes Statusfenster mit schwarzer Schrift NO FILE RECORDED... * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 12, BF 'Feld hellrot XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 0: Col2 = 0: t = 0 A$ = "NO FILE RECORDED OR NO MARKER SET": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusPlay '**************************************************************************** '* Stand: 13.03.97 * '* gibt gruenes Statusfenster mit hellroter Schrift PLAYBACK ... aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 10, BF 'Feld gruen XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "PLAYING BACK MARKED AREA": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusPlayingFile '**************************************************************************** '* Stand: 13.03.97 * '* gibt gruenes Statusfenster mit hellroter Schrift PLAYING FILE aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 10, BF 'Feld gruen XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "PLAYING FILE": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusReady '**************************************************************************** '* Stand: 13.03.97 * '* gibt braunes Statusfenster mit gelber Schrift READY ... aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 6, BF 'Feld braun XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 14: Col2 = 0: t = 4 A$ = "DONE !": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusRec '**************************************************************************** '* Stand: 13.03.97 * '* gibt rotes Statusfenster mit gelber Schrift RECORDING aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 12, BF 'Feld rot XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 14: Col2 = 0: t = 4 A$ = "RECORDING TO RAM-DISK": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusTextInp '**************************************************************************** '* Stand: 13.03.97 * '* gibt tuerkis Statusfenster mit hellroter Schrift aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 11, BF 'Feld tuerkis XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "WAITING FOR PATH AND FILENAME": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusWait '**************************************************************************** '* Stand: 13.03.97 * '* gibt gelbes Statusfenster mit roter Schrift WAITING... aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 14, BF 'Feld gelb XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "WAITING FOR START": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB StatusWaitPeri '**************************************************************************** '* Stand: 13.03.97 * '* gibt gelbes Statusfenster mit roter Schrift WAITING... aus * '**************************************************************************** x = 125: y = 142 LINE (x, y)-(x + 300, y + 20), 14, BF 'Feld gelb XSize = 8: YSize = 16: x = x + 5: y = y + 3: Col1 = 12: Col2 = 0: t = 4 A$ = "WAITING FOR NEXT RX PERIOD": CALL PrintText x = 124: y = 141 'Statusfenster Rahmen LINE (x, y)-(x + 302, y + 22), 15, B END SUB SUB Strace '**************************************************************************** '* Stand: 13.03.97 * '* zeichnet Sternenhimmel mit Zufallsgenerator und Meteoritenspuren * '* sowie Mars und Venus, blendet links oben "73 de DL3JIN" ein * '**************************************************************************** XZ = 50 'X-Koord Ursprung der Spuren YZ = 50 'Y-Koord Ursprung der Spuren LenTrace = 600 '600 Pixel je Meteoritenspur Stars% = 300 '300 kleine Sterne BigStars% = 50 '50 grosse Sterne DIM x(Stars%) 'x-Koord Sterne DIM y(Stars%) 'y-Koord Sterne DIM SpurX(LenTrace) 'X-Koord Spur DIM SpurY(LenTrace) 'Y-Koord Spur DIM Farbe(LenTrace) 'an X u. Y vorhand. alte Farbe CLS RANDOMIZE TIMER '***** STERNENHIMMEL AUF BILDSCHIRM ************************************* FOR i = 1 TO BigStars% 'grosse Sterne x = INT(RND * 640 + 1) y = INT(RND * 480 + 1) COLOR 15 PSET (x, y) COLOR 7 PSET (x - 1, y): PSET (x + 1, y): PSET (x, y - 1): PSET (x, y + 1) COLOR 8 PSET (x - 2, y): PSET (x + 2, y): PSET (x, y - 2): PSET (x, y + 2) NEXT i x = INT(RND * 480 + 1) 'Mars y = INT(RND * 640 + 1) PSET (x, y), 12 CIRCLE (x, y), 1, 4 x = INT(RND * 480 + 1) 'Venus y = INT(RND * 640 + 1) PSET (x, y), 15 PSET (x + 1, y + 1), 7 PSET (x - 1, y - 1), 7 PSET (x + 1, y - 1), 7 PSET (x - 1, y + 1), 7 CIRCLE (x, y), 1, 15 FOR i = 1 TO Stars% 'Koordinaten kleine Sterne y(i) = INT(RND * 480 + 1) x(i) = INT(RND * 640 + 1) NEXT i FOR i = 1 TO Stars% 'kleine Sterne setzen PSET (x(i), y(i)), 15 NEXT i '******************* 73 de DL3JIN in linke obere BS-Ecke ************** IF Rfz% = 1 THEN XSize = 8: YSize = 16: Col1 = 1: Col2 = 0: x = 15: y = 10 A$ = "73 de": CALL PrintText x = 10: y = 26 A$ = "DL3JIN": CALL PrintText END IF '********************* Meteoritenspuren zeichnen *********************** DO time! = TIMER 'Warte bis naechster Meteorit diff% = INT(10 * RND(1)) '0...10 sek. DO 'warte auf Taste oder Zeit taste$ = INKEY$ IF taste$ <> "" THEN EXIT DO 'Schleife vorzeitig verlassen LOOP UNTIL TIMER > time! + diff% alpha = RND 'Variation Spurende in X beta = RND ' " " in Y s = INT(4 * RND(1)) 'Variation Spurbreite FOR i = 1 TO LenTrace 'Spurpunkte definieren SpurX(i) = XZ + (i * alpha) + RND * s SpurY(i) = YZ + (i * beta) + RND * s NEXT FOR i = 1 TO LenTrace 'alte Spurpunktfarben einlesen Farbe(i) = POINT(SpurX(i), SpurY(i)) NEXT Farbe = INT(4 * RND(1) + 1) '4 verschiedene Farben FOR i = 1 TO LenTrace 'Spur setzen FOR V = 1 TO 30 * RND: NEXT V 'Meteoriten-Kopf-Geschw. PSET (SpurX(i), SpurY(i)), 11 + Farbe 'Farbe der Spur NEXT FOR i = 1 TO LenTrace 'Spur alte Farben rueckschreiben FOR V = 1 TO 3000 * RND: NEXT V 'Zeit bis Loeschen einsetzt PSET (SpurX(i), SpurY(i)), Farbe(i) NEXT LOOP WHILE taste$ = "" 'uebernommen von oberer Schleife END SUB