'****************************************************************************
'*                                                                          *
'*                         8052 AH-Basic-Terminal               25.11.1993  *
'*                                                                          *
'*                       © 1993 by Andreas Heinrich                         *
'*                                                                          *
'*                      Dieses Programm ist Freeware.                       *
'*                                                                          *
'*               DIE RECHTE DARAN BLEIBEN ABER WEITERHIN BEI MIR.           *
'*  Das Umschreiben und Erweitern für die private Nutzung ist aber erlaubt. *
'*  Die Geldmacherei mit meinem Programm bzw. Teilen daraus hingegen nicht. *
'*                                                                          *
'****************************************************************************
'
Set Buffer 50 : Rem  Variablenpuffer auf 50 KB vergrößern
' Screen öffnen
Screen Open 0,640,250,8,Hires
' Screenfarben einstellen
Palette $999,$0,$CCC,$558,$68B,$FF,$FFF,$666
' Hintergrundfarbe einstellen
Colour Back $999
' Cursor aus 
Curs Off 
' Vertikalblank abwarten 
Wait Vbl 
' Screen mit der Farbe $999 löschen  
Cls 0
' Cursorblinken einstellen 
Flash 3,"(F00,50)(000,5)"
' Globale Variablen festlegen
Global SPEED,_BUFFER,BYTE,FREI$,A$,B$,KOMM$,TX,TY,T$,I
' Verschiedene Variablen / Strings mit Defaultwerten belegen 
BYTE=0
I$=""
KOMM$=""
'
'
 SPEED=9600 : Rem   Default-Wert -> Baudrate 
_BUFFER=16386 : Rem Default-Wert -> Serial Buffer
'
' Damit der Mauszeiger auch über die Y-Koordinate 200 kommt
Limit Mouse X Hard(0,0),Y Hard(0,0) To X Hard(0,639),Y Hard(0,245)
'
'************************ Screen aufbauen ****************************** 
'
'  Zeichnen des oberen Menübalken
Ink 2 : Polyline 0,11 To 0,0 To 640,0 : Draw 1,1 To 1,10
Ink 1 : Polyline 1,11 To 639,11 To 639,0 : Draw 638,10 To 638,1
Ink 4 : Paint 2,2 : Rem Paint 10,2 
SCHATTEN[16,8,"8052 AH-Basic-Terminal",6]
SCHATTEN[440,8,"© 1993 Andreas Heinrich",6]
'
'  Zeichnen des Ausgabefensters
Ink 1 : Polyline 0,246 To 0,16 To 638,16 : Draw 1,245 To 1,17
Ink 6 : Polyline 1,246 To 639,246 To 639,16 : Draw 638,17 To 638,245
'
' Serielle Schnittstelle initialisieren durch Procedure INIT 
INIT
'
'
' Ausgabefenster öffnen
Wind Open 1,20,19,77,28
Paper 0 : Pen 1 : Clw 
Wind Save 
Print ">";
'
'
' Der Amos to Front Befehl ist nur wichtig, wenn das Programm compiliert 
' werden soll. Der Compiler sollte dann mit " Amos To Back " Kommando
' gestartet werden.
Amos To Front 
'
'*********************************** Menus **********************************
'
Menu$(1)="(INk 1,1:INk 2,4) Info/Ende   "
Menu$(1,1)="(INk 1,5) Info    F 1 " : Menu Key(1,1) To 80
Menu$(1,2)="(INk 1,5) Ende    ESC "
'
Menu$(2)="(INk 1,1:INk 2,4) Baud/Puffer     "
Menu$(2,1)="(INk 1,1:INk 1,5) Baud    "
Menu$(2,1,1)="(INk 1,5)   300  "
Menu$(2,1,2)="(INk 1,5)   600  "
Menu$(2,1,3)="(INk 1,5)  1200  "
Menu$(2,1,4)="(INk 1,5)  2400  "
Menu$(2,1,5)="(INk 1,5)  4800  "
Menu$(2,1,6)="(INk 1,5)  9600  "
Menu$(2,1,7)="(INk 1,5) 19200  "
'
Menu$(2,2)="(INk 1,1:INk 1,5) Puffer  "
Menu$(2,2,1)="(INk 1,5)  2 KB "
Menu$(2,2,2)="(INk 1,5)  4 KB "
Menu$(2,2,3)="(INk 1,5)  8 KB "
Menu$(2,2,4)="(INk 1,5) 16 KB "
Menu$(2,2,5)="(INk 1,5) 32 KB "
'
Menu$(3)="(INk 1,1:INk 2,4) File-Transfer            "
Menu$(3,1)="(INk 0,1:INk 1,3) File übertragen Ctrl-F2 " : Menu Key(3,1) To 81,8
Menu$(3,2)="(INk 0,1:INk 1,3) Listing holen   Ctrl-F3 " : Menu Key(3,2) To 82,8
'
Menu$(4)="(INk 1,1:INk 2,4) Befehle & Kommandos   "
Menu$(4,1)="(INk 0,1:INk 1,3) New         Ctrl-F 1  " : Menu Key(4,1) To 80,8
Menu$(4,2)="(INk 1,5) Dummy            F 2  " : Menu Key(4,2) To 81
Menu$(4,3)="(INk 1,5) RAM              F 3  " : Menu Key(4,3) To 82
Menu$(4,4)="(INk 1,5) ROM              F 4  " : Menu Key(4,4) To 83
Menu$(4,5)="(INk 1,5) XFer             F 5  " : Menu Key(4,5) To 84
Menu$(4,6)="(INk 1,5) Run              F 6  " : Menu Key(4,6) To 85
Menu$(4,7)="(INk 1,5) Break            F 7  " : Menu Key(4,7) To 86
Menu$(4,8)="(INk 1,5) Cont             F 8  " : Menu Key(4,8) To 87
Menu$(4,9)="(INk 1,5) List             F 9  " : Menu Key(4,9) To 88
Menu$(4,10)="(INk 1,5) CLS              F10  " : Menu Key(4,10) To 89
Menu$(4,11)="(INk 0,1:INk 1,3) Zeichen löschen   Del " : Menu Key(4,11) To 70
Menu$(4,12)="(INk 0,1:INk 1,3) Zeile lösch. Ctrl-Del" : Menu Key(4,12) To 70,8
'
Rem***************************** Init Menu *********************************** 
'
On Menu Proc INFO_ENDE,BAUDRATE,FILE_TRANSFER,BEFEHL_KOMMANDOS
On Menu On 
Menu On 
'
'**************************** Terminalschleife ******************************* 
'
'**************** Diese Schleife überprüft ob etwas ankommt ****************** 
'
TERMINALSCHLEIFE:
'                        Bleibt J$ leer wird diese Schleife wiederholt 
'                        Sonst Programmfortsetzung hinter Wend 
While J$=""
   '                        Tastaturabfrage  J$ 
   J$=Inkey$
   '                        Nimmt ankommende Daten in I$ auf
   I$=Serial Input$(1)
   '                        Und gibt sie auf den Monitor aus
   Print I$;
   '               Der Multi Wait Befehl an dieser Stelle ist wichtig!!!
   '               Sonst würde das Programm zuviel CPU-Zeit horten  
   '               und der Multitaskbetrieb darunter leiden.  
   '               ( Schließlich haben wir einen Amiga und keine DOSe. )
   Multi Wait 
Wend 
'
'***************************************************************************** 
'
'
'*********************** Datenausgabe **************************************** 
'
'                        Gibt den Tastaturwert seriell aus 
Serial Send 1,J$
'                        Setzt J$ leer 
J$=""
'                        Escape für Programmende 
'
If Key State(69)=True Then QUIT
'
'                        Rücksprung zum Anfang der Terminalschleife
Goto TERMINALSCHLEIFE
'
'***************************************************************************** 
'
'
Rem******************* Proceduren Menüwahl *********************************** 
'
Procedure INFO_ENDE
On Choice(2) Proc INFO,QUIT
   OMENU
End Proc
Procedure BAUDRATE
On Choice(2) Proc _BAUD,_BUFF
   OMENU
End Proc
Procedure _BAUD
On Choice(3) Proc _BAUD1,_BAUD2,_BAUD3,_BAUD4,_BAUD5,_BAUD6,_BAUD7
   OMENU
End Proc
Procedure _BUFF
On Choice(3) Proc _PUFFER1,_PUFFER2,_PUFFER3,_PUFFER4,_PUFFER5
   OMENU
End Proc
Procedure FILE_TRANSFER
On Choice(2) Proc FILE_ÜBER,_LISTING_HOLEN
   OMENU
End Proc
Procedure BEFEHL_KOMMANDOS
On Choice(2) Proc _NEW,DUMMY,_RAM,_ROM,_XFER,_RUN,_BREAK,_CONT,_LIST,_CLW,_ZEICHEN_LÖSCHEN,_ZEILE_LÖSCHEN
   OMENU
End Proc
Procedure OMENU
   On Menu On 
End Proc
'
'****************************** Proceduren **********************************
'
Procedure INFO
   Paper 7
    Wind Open 2,180,80,35,12
    Curs Off : Hide On 
'
Ink 2 : Polyline 176,175 To 176,80 To 445,80 : Draw 177,174 To 177,81
Ink 1 : Polyline 177,175 To 445,175 To 445,81 : Draw 446,80 To 446,175
'
 SCHATTEN[285,92,"Info:",5]
_DATUM
_ZEIT
SCHATTEN[185,125,"Baudrate",2]
SCHATTEN[347,125,Str$(SPEED)+" Baud",5]
SCHATTEN[185,135,"Puffergröße",2]
SCHATTEN[340,135,Str$(_BUFFER)+" Bytes",5]
SCHATTEN[185,147,"Freies Chip-Mem",2]
SCHATTEN[355,147,Str$(Chip Free),6]
SCHATTEN[185,157,"Freies Fast-Mem",2]
SCHATTEN[355,157,Str$(Fast Free),6]
SCHATTEN[183,167,"Insgesamt freies Mem",2]
SCHATTEN[355,167,Str$(Chip Free+Fast Free),6]
Wait 50
'
X1=X Mouse
Y1=Y Mouse
Do 
Poke $BFEC01,0
Exit If X1<>X Mouse
Exit If Y1<>Y Mouse
TASTE=Peek($BFEC01)
Exit If TASTE<>0
Loop 
'
Wind Close 
Paper 0 : Show 
Clear Key 
End Proc
'
Procedure QUIT
Serial Close 1
Curs Off 
Fade 1
 FAD_ALL[10]
   Wait 50
     End 
End Proc
'
Procedure _BAUD1
SPEED=300
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD2
SPEED=600
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD3
SPEED=1200
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD4
SPEED=2400
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD5
SPEED=4800
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD6
SPEED=9600
_SERIALSPEED
INFO
End Proc
'
Procedure _BAUD7
SPEED=19200
_SERIALSPEED
INFO
End Proc
'
Procedure _SERIALSPEED
Serial Speed 1,SPEED
End Proc
'
Procedure _PUFFER1
_BUFFER=2048
INFO
End Proc
'
Procedure _PUFFER2
_BUFFER=4096
INFO
End Proc
'
Procedure _PUFFER3
_BUFFER=8192
INFO
End Proc
'
Procedure _PUFFER4
_BUFFER=16384
INFO
End Proc
'
Procedure _PUFFER5
_BUFFER=32768
INFO
End Proc
'
Procedure _PUFFERGRößE
Serial Buf 1,_BUFFER
End Proc
'
Procedure _DATUM
'  
   T$=Space$(12)
   Dreg(1)=Varptr(T$)
   RIEN=Doscall(-192)
   NJ=Leek(Varptr(T$))
   A=1978 : JOUR=7
   Do 
      BIS=0 : If(A and 3)=0 : BIS=1 : End If 
      Exit If NJ-365-BIS<0
      Add JOUR,1+BIS : If JOUR>7 : Add JOUR,-7 : End If 
      Add NJ,-365-BIS
      Inc A
   Loop 
   M=1
   Do 
      Read N
      Exit If NJ-N<0
      Add NJ,-N : Inc M
   Loop 
   Inc NJ
      J$=Mid$(Str$(NJ),2) : If Len(J$)<2 : J$="0"+J$ : End If 
      M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
      A$=Mid$(Str$(A),2)
      DATUM$=J$+"."+M$+"."+A$
   Data 31,28+BIS,31,30,31,30,31,31,30,31,30,31
 SCHATTEN[185,103,"Heutiges Datum",2]
 SCHATTEN[350,103,DATUM$,6]
End Proc
'
Procedure _ZEIT
'
   T$=Space$(12)
   Dreg(1)=Varptr(T$)
   RIEN=Doscall(-192)
   MN=Leek(Varptr(T$)+4)
   SEC=Leek(Varptr(T$)+8)
   H=MN/60 : H$=Mid$(Str$(H),2) : If Len(H$)<2 : H$="0"+H$ : End If 
   M=MN mod 60 : M$=Mid$(Str$(M),2) : If Len(M$)<2 : M$="0"+M$ : End If 
   S=SEC/50 : S$=Mid$(Str$(S),2) : If Len(S$)<2 : S$="0"+S$ : End If 
   ZEIT$=H$+":"+M$
'
 SCHATTEN[185,113,"Uhrzeit",2]
 SCHATTEN[370,113,ZEIT$,6]
End Proc
'
Procedure INIT
'
Serial Open 1,1
Serial Bits 1,8,1
Serial Parity 1,-1
Serial Speed 1,SPEED
Serial Buf 1,_BUFFER
'
End Proc
'
Procedure FILE_ÜBER
   '
   F$=Fsel$("","","Welches File soll übertragen werden ?")
   If F$="" Then Pop Proc
   Open In 1,F$ : L=Lof(1) : Close 1
   Print "Übertrage das File ->  "; : Print F$ : Print 
   Reserve As Work 10,L : AD=Start(10) : Print "Länge in Bytes: ",L
   Bload F$,AD
   Print 
   Change Mouse 3
   '
   _START=AD
   POS=AD
   A$=Chr$($A)
   B$=Chr$($D)
   '
   Do 
      F=Hunt(POS To AD+L,A$)
      Exit If F=0
      POS=F
      For TEX=_START To POS
         BU=Peek(TEX)
         BU$=BU$+Chr$(BU)
      Next TEX
      Print BU$
      Cup 
      Serial Send 1,BU$+B$+A$
      '
      '
      '                Ende der Zeile? (Überprüfung!)
      '
      Multi Wait 
      Do 
         CH=Serial Check(1)
         Exit If CH=-1
      Loop 
      '
      '
      '
      Do 
         W=Serial Get(1)
         Exit If W=62
      Loop 
      '
      Serial Send 1,B$
      Do 
         W=Serial Get(1)
         Exit If W=62
      Loop 
      '
      Inc POS
      _START=POS
      BU$=""
      '
   Loop 
   '
   Centre "Fertig !  File komplett übertragen."
   Serial Send 1,B$
   Erase 10
   Change Mouse 1
   '
End Proc
'
Procedure _LISTING_HOLEN
   '
   Centre "Hole nun das Listing!"
   Print : Print 
   Change Mouse 3
   KO["LIST"]
   '
   W$=""
   WW$=""
   '
   Do 
      '
      W$=Serial Input$(1)
      Print W$;
      WW$=WW$+W$-Chr$($D)
      If W$<>""
         CD=0
      Else 
         Inc CD
      End If 
      '
      '
      If CD=5
         Exit If W$=""
         CD=0
      End If 
      Multi Wait 
   Loop 
'
   Change Mouse 1
   '
   '
   F$=Fsel$("","","Listing sichern als...")
   If F$=""
      Print 
      Centre "Achtung !  Listing nicht gesichert !"
      Print : Print ">";
      Pop Proc
   End If 
'
   Open Out 1,F$
   Print #1,WW$
   Close 1
'
   Print 
   Centre "Fertig!" : Print 
   Print ">";
   '
   WW$=""
End Proc
'
Procedure _LIST
KO["List"]
End Proc
'
Procedure _NEW
KO["New"]
End Proc
'
Procedure _CONT
KO["Cont"]
End Proc
'
Procedure _RUN
KO["Run"]
End Proc
'
Procedure _RAM
KO["RAM"]
End Proc
'
Procedure _ROM
KO["ROM"]
End Proc
'
Procedure _XFER
KO["XFER"]
End Proc
'
Procedure _BREAK
     Serial Send 1,Chr$(3)
End Proc
'
Procedure _ZEICHEN_LÖSCHEN
     Serial Send 1,Chr$($7F)
End Proc
'
Procedure _ZEILE_LÖSCHEN
     Serial Send 1,Chr$($4)+Chr$($D)
Do 
CH=Serial Check(1)
Exit If CH=-1
Loop 
End Proc
'
Procedure KO[KOMM$]
'
     Serial Send 1,KOMM$+Chr$($D)
Do 
CH=Serial Check(1)
Exit If CH=-1
Loop 
'
End Proc
'
Procedure DUMMY
Boom 
End Proc
'
Procedure _CLW
Clw 
Print ">";
End Proc
'
Procedure FAD_ALL[W]
   For T=1 To W
      Colour Back(Colour(0))
      View 
      Wait Vbl 
   Next 
End Proc
'
' Nicht das hinzuladen der Procedure SCHATTEN vergessen!!! 
'
' ( Hier könnte sie zum Beispiel stehen.)
'
'Procedure SCHATTEN[TX,TY,T$,I]
'