' *****************************************************
' *                                                   *
' *            Z  E  H  N  E  R  B  L  O  C  K        *
' *                     -Der Trainer-                 *          
' *                                                   *
' *  Alle Rechte reserviert von Stefan Sticht © 1988  *
' *                                                   *
' *   Programmiert in Amiga-Basic von Stefan Sticht   *
' *                                                   *
' *   Compilierfertig fÜr den AC/BASIC Compiler (TM)  *
' *****************************************************

OPTION BASE 0        'Indexwert fÜr Variablen = 0
DIM SHARED x%(10),y%(10),bx%(10,1),by%(10,1),nFont&(20)
DIM SHARED zd%(2),Zeichen$(2),mx%(4,1),my%(4,1)
RANDOMIZE TIMER      'Zufallszahlengenerator setzen
ON ERROR GOTO Fehler 'Fehler abfangen
CALL  InitWindow     'Fenster definieren und aufbauen
CALL  Init           'Datas lesen
GOSUB Init2          'Funktionen deklarieren 

'-------------------------------------------------------
Hauptmenu:

COLOR 1,0: CLS: Font "Diamond",20: SetStyle 2
LOCATE 2,11: PRINT "Z E H N E R B L O C K"
Font "topaz",8
FOR i%=0 TO 4         'fÜnf MenÜgadgets malen
  CALL Block(mx%(i%,0),my%(i%,0),mx%(i%,1),my%(i%,1),1,2)
NEXT i%
COLOR 1,2: LOCATE 7,36: PRINT "Einführung"
LOCATE 9,34: PRINT "Anfängertraining"
LOCATE 11,27:PRINT "Training für Fortgeschrittene"
LOCATE 13,39:PRINT "Info"
LOCATE 15,34:PRINT "Programm beenden"
COLOR 1,0: Font "diamond",12: LOCATE 13,16
PRINT "© 1988  ";: COLOR 2,0: PRINT " Stefan Sticht" 
COLOR 1,0: Font "topaz",8
WHILE 1              'MenÜgadgets abfragen
  GOSUB Askmouse
  IF mouseX%>200 AND mouseX%<446 THEN
    IF mouseY%>45 AND mouseY%<58 THEN GOSUB Einfuhrung
    IF mouseY%>61 AND mouseY%<74 THEN GOSUB ATrainer
    IF mouseY%>77 AND mouseY%<90 THEN GOSUB FTrainer
    IF mouseY%>93 AND mouseY%<106 THEN GOSUB Info
    IF mouseY%>109 AND mouseY%<122 THEN GOSUB Ende
  END IF
  SLEEP
WEND  

Askmouse:
MOUSE ON                'Mausabfrage ein
mouseX%=0: mouseY%=0    'letzte Mausposition löschen
WHILE MOUSE(0)<>0       'Position des Mauszeigers beim
  mouseX%=MOUSE(1)      'drÜcken der linken Maustaste
  mouseY%=MOUSE(2)      'abfragen
  SLEEP                 'auf Mausbutton warten
WEND
RETURN

'-------------------------------------------------------
Einfuhrung:

CLS: Font "Diamond",20: SetStyle 2
LOCATE 2,12: PRINT "E I N F Ü H R U N G"
LINE (208,16)-(454,38),1,B     'Rahmen fÜr Überschrift
Font "diamond",12
LOCATE 5,3: PRINT "Üben Sie die Grundstellung:"
Font "topaz",8: LOCATE 9,2:
PRINT "Legen Sie die Finger auf den Zahlenblock, den ";
PRINT "Mittel-": PRINT " finger auf die Taste <5>, Ze";
PRINT "ige- und Ringfinger dane-": PRINT " ben auf di";
PRINT "e Tasten <4> und <6>!": LOCATE 13,2
PRINT "Versuchen Sie nun - ohne auf die Tastatur zu ";
PRINT "sehen -"
PRINT " die verschiedenen Tasten zu treffen!"
LOCATE 16,2
PRINT "Üben Sie solange, bis Sie jede Taste sicher ";
PRINT "treffen!
GOSUB Tastatur
LOCATE 19,14:PRINT "Zurück zum Hauptmenü mit <ESC>";
WHILE 1                        'gedrÜckte Taste abfragen
  GOSUB Eingabe
WEND

'-------------------------------------------------------
ATrainer:

CLS: Font "Diamond",20: SetStyle 2
LOCATE 2,9: PRINT "A N F Ä N G E R T R A I N I N G"
LINE (154,16)-(512,38),1,B    'Rahmen fÜr Überschrift
Font "topaz",8
LOCATE 7,2: PRINT "In diesem Teil üben Sie drei";
PRINT " Tasten, die das Programm zufällig auswählt."
PRINT " Gehen Sie mit der rechten Hand in die Grund";
PRINT "stellung auf dem Zahlenblock."
PRINT " Tippen Sie die zehn Ziffern und Zeichen nach, ";
PRINT "die": PRINT " Ihnen das Programm vorgibt, bis ";
PRINT "Sie diese perfekt": PRINT " beherrschen!"
GOSUB Tastatur

ATrainer1:            'sucht die drei zufälligen Tasten 
zd%(0)=INT(RND*11)    'erste zufällige Taste festlegen
Zwei%=0
WHILE Zwei%=0         'zweite Taste dazusuchen, die 
  zd%(1)=INT(RND*11)  'nicht gleich der ersten ist
  IF zd%(1)<>zd%(0) THEN Zwei%=1
WEND
Drei%=0
WHILE Drei%=0         'dritte Taste, die ungleich erste
  zd%(2)=INT(RND*11)  'und zweite Taste
  IF zd%(2)<>zd%(0) AND zd%(2)<>zd%(1) THEN Drei%=1
WEND  
      
ATrainer2:
GOSUB Tippen           'Ein/Ausgaberahmen zeichnen
Fehl%=0                'kein Tippfehler bisher
FOR s%=1 TO 30 STEP 3  '10 Tasten vorgeben
  Zufall%=(INT(RND*3)) 'eine der drei Tasten aussuchen
  GOSUB Zeichenein     'Ein/Ausgabe vornehmen 
NEXT s%
COLOR 2,1: CALL Block (5,124,420,175,2,1) 'fÜr Ergebnis
LOCATE 17,17: PRINT "Anzahl der Fehler:";Fehl%
LOCATE 19,6
PRINT "  <1>   Nocheinmal mit den gleichen Tasten"
LOCATE 20,6
PRINT "  <2>   Neue Tastenkombination zum Üben"
LOCATE 21,6
PRINT " <ESC>  Zurück zum Hauptmemü";
x$=""
WHILE x$<>"1" OR x$<>"2" OR x$<>CHR$(27)
  x$=INKEY$
  IF x$="1" THEN GOTO ATrainer2
  IF x$="2" THEN GOTO ATrainer1
  IF x$=CHR$(27) THEN GOTO Hauptmenu
  SLEEP
WEND

'------------------------------------------------------
FTrainer:         'dritter Teil: fÜr Fortgeschrittene

CLS: Font "Diamond",20
LOCATE 2,8: PRINT "TRAINING FüR FORTGESCHRITTENE"
LINE (134,16)-(530,38),1,B: Font "topaz",8
LOCATE 8,2: PRINT "In diesem Teil üben Sie sämtliche ";
PRINT "Tasten auf Zeit!"
PRINT " Üben Sie solange, bis Sie es ständig und fehl";
PRINT "erfrei": PRINT " unter zehn Sekunden schaffen!"
GOSUB Tastatur

FTrainer1:
GOSUB Tippen              'Ein/Ausgabekasten malen
Fehl%=0: Zeit1=TIMER      'kein Fehler, Anfangszeit
FOR s%=1 TO 30 STEP 3     '10 Tasten vorgeben
  zd%(0)=INT(RND*11): Zufall%=0  'nur zd%(0) wird ge-
  GOSUB Zeichenein               'braucht
NEXT s%
Zeit2=TIMER: Zeit=CINT(Zeit2-Zeit1)  'Zeit=Differenz
COLOR 2,1: CALL Block (5,124,420,175,2,1)
LOCATE 17,17: PRINT "Anzahl der Fehler: ";Fehl%
LOCATE 18,17: PRINT "Benötigte Zeit:   ";Zeit;"s" 
LOCATE 20,13: PRINT "  <1>     Übung wiederholen"
LOCATE 21,13: PRINT " <ESC>  Zurück zum Hauptmemü";
x$=""
WHILE x$<>"1" OR x$<>CHR$(27)
  x$=INKEY$
  IF x$="1" THEN FTrainer1
  IF x$=CHR$(27) THEN Hauptmenu
  SLEEP
WEND

'------------------------------------------------------
Info:
                              
COLOR 1,0: CLS: Font "Diamond",20: SetStyle 2
LOCATE 1,11: PRINT "Z E H N E R B L O C K"
Font "diamond",12 
LOCATE 3,18: PRINT "Der Tastentrainer"
Font "topaz",8: LOCATE 6,2
PRINT "Systematische Ausnutzung der Tastatur - d.h. ";
PRINT "auch den Zehnerblock beherrschen"
PRINT " und Zahlen schnell eintippen zu können."
PRINT " Mit >ZEHNERBLOCK< können Sie dessen Handha";
PRINT "bung schnell erlernen."
COLOR 2,0: Font "diamond",12
LOCATE 7,14: PRINT "Dieses Programm ist Public Domain!"
COLOR 1,0: Font "topaz",8: LOCATE 12,2
PRINT "D.h. Sie dürfen dieses Programm kopieren und ";
PRINT "weitergeben, solange dies nicht"
PRINT " kommerziellen Zwecken dient!"
PRINT " Sollte Sich dieses  Programm als Ihnen nütz";
PRINT "lich erweisen, so würde  sich der"
PRINT " Autor über eine kleine Spende (10.-DM) von ";
PRINT " Ihnen sehr freuen. Vielen Dank."
LOCATE 17,2: PRINT "Autor:       Stefan Sticht"
PRINT "              Lessingstr. 30      ";
COLOR 2,0: PRINT "            (C) 1988 Stefan Sticht"
COLOR 1,0: PRINT "              8407 Obertraubling"
LOCATE 21,27: PRINT "Zurück zum Hauptmenü mit <ESC>";
x$=""
WHILE x$<>CHR$(27)
  x$=INKEY$
  IF x$=CHR$(27) THEN Hauptmenu
  SLEEP
WEND

'------------------gemeinsame Routinen-----------------

Zeichenein:
COLOR 1,2: Eingabe%=1      'Flag fÜr Routine <Eingabe>
Zeichen$(0)=MID$(STR$(zd%(0)),2,1)  
IF zd%(0)=10 THEN Zeichen$(0)="."   
Zeichen$(1)=MID$(STR$(zd%(1)),2,1)  'die drei Zufalls-
IF zd%(1)=10 THEN Zeichen$(1)="."   'zahlen in Strings
Zeichen$(2)=MID$(STR$(zd%(2)),2,1)  'umwandeln
IF zd%(2)=10 THEN Zeichen$(2)="."
LOCATE 13,s%+22: PRINT Zeichen$(Zufall%): GOSUB Eingabe
COLOR 1,2: LOCATE 15,s%+22: PRINT x$
IF x$<>Zeichen$(Zufall%) THEN Fehl%=Fehl%+1
Eingabe%=0
RETURN

Tippen:
COLOR 0,1
CALL Block (4,92,420,122,2,1)   'Ein/Ausgabeblock malen
CALL Block (5,124,420,175,0,0)  'Ergebnisblock löschen
LOCATE 13,3:PRINT "Bitte tippen Sie: "
LOCATE 15,3:PRINT "Sie haben getippt:"
RETURN

Tastatur:              'Tastatur malen
COLOR 2,1
FOR i%=0 TO 10         '10 Kästchen malen
 CALL Block(bx%(i%,0),by%(i%,0),bx%(i%,1),by%(i%,1),2,1)
NEXT i%
FOR i%=0 TO 9          'Zeichen in Kästchen setzen
 LOCATE y%(i%),x%(i%): PRINT MID$(STR$(i%),2,1)
NEXT i%
LOCATE y%(10),x%(10): PRINT ".": COLOR 1,0
RETURN

Eingabe:                  'welche Taste wird gedrÜckt?
x$=""          
WHILE x$=""
  x$=INKEY$
  SLEEP
WEND
COLOR 1,0: LOCATE 21,10
PRINT "                                     ";  
IF x$=CHR$(27) THEN GOTO Hauptmenu      'Escape-Taste!
FOR i%=0 TO 9
   i$=STR$(i%)
   IF i$=" "+x$ THEN Blink i%: RETURN   'Taste zeigen
NEXT i%
IF x$="." THEN 
  Blink 10: RETURN
ELSE
  COLOR 3,2: LOCATE 21,10
  PRINT " Bitte benutzen Sie den Zehnerblock! ";
  BEEP: IF Eingabe%=1 THEN GOTO Zeichenein
END IF
RETURN

'--------Initialiesierung und Fehlerbehandlung------------
Init2:          'Funktionen deklarieren und Libs' laden

DECLARE FUNCTION AskSoftStyle& LIBRARY
DECLARE FUNCTION OpenDiskFont& LIBRARY
DECLARE FUNCTION OpenFont& LIBRARY
GOSUB Laden1
enable%=AskSoftStyle&(WINDOW(8))
RETURN

Laden1:          'suchen wir mal im Directory <libs>...
OK%=0
LIBRARY ":libs/diskfont.library"
LIBRARY ":libs/graphics.library"
RETURN

Laden2:          'oder vielleicht im current Directory?
OK%=1
LIBRARY "diskfont.library"
LIBRARY "graphics.library"
enable%=AskSoftStyle&(WINDOW(8))
GOTO Hauptmenu

Fehler:

IF ERR=53 THEN            'ERROR 53 = File not found
  IF OK%=0 THEN           'nicht im Directory <libs>
    RESUME Laden2         'vielleicht wo anders?
  ELSE
    RESUME Libraryfehler  'Leider nicht gefunden
  END IF
 ELSE
END IF
IF ERR=100 THEN           'Diamond-Font nicht gefunden!
  GOSUB Fontfehler        'Fehler ausgeben
'die nächsten beiden Zeilen bitte zum compilieren mit dem
'AC/BASIC Compiler (TM) weglassen!  
 ELSE
  ON ERROR GOTO 0         'anderer Fehler: Fehlerausgabe
END IF  
END  

Libraryfehler:
BEEP: COLOR 3,0: PRINT
PRINT " Leider kann ich die Libraries <graphics.libra";
PRINT "ry> und <diskfont.library) nicht"
PRINT " öffnen !!!"
PRINT: PRINT " Bitte sorgen Sie dafür, daß im Directo";
PRINT "ry <libs> oder im Directory, in dem"
PRINT " sich dieses Programm befindet, die FILES <gra";
PRINT "phics.bmap> und <diskfont.bmap>"
PRINT " vorhanden sind. Auch muß im Directory <libs>";
PRINT " der Bootdiskette das File"
PRINT " <diskfont.library> vorhanden sein."
PRINT " Sie finden die ersten beiden Files auf der Ex";
PRINT "trasD-Diskette im Directory"
PRINT " <BasicDemos>, das dritte File im Directory <l";
PRINT "ibs> auf Ihrer Workbench!" 
LOCATE 19,25: COLOR 1,0
PRINT "Drücken Sie bitte die <ESC>-Taste!"
x$=""
WHILE x$<>CHR$(27)
  x$=INKEY$
  IF x$=CHR$(27) THEN Ende
  SLEEP
WEND

Fontfehler:
CLS: BEEP: COLOR 3,0: PRINT
PRINT " Der Font Diamond 20 und/oder 12 kann leider ";
PRINT "nicht geöffnet werden !!!": PRINT
PRINT " Bitte sorgen Sie dafür, daß sich der Font Diam";
PRINT "ond im Directory <Fonts> der"
PRINT " Bootdiskette befindet!"
LOCATE 19,25: COLOR 1,0
PRINT "Drücken Sie bitte die <ESC>-Taste!"
x$=""
WHILE x$<>CHR$(27)
  x$=INKEY$
  IF x$=CHR$(27) THEN Ende
  SLEEP
WEND

'---------------------------------------------------------
Ende:                      'Feierabend!

IF Fontnum%<>0 THEN
  FOR i%=1 TO Fontnum%     'Diskfonts wieder schließen
    CALL CloseFont(nFont&(i))
  NEXT i%
END IF    
LIBRARY CLOSE              'Libraries schließen
ERASE x%,y%,bx%,by%,nFont&,zd%,Zeichen$,mx%,my%
SYSTEM: END

'---------------------------------------------------------
Daten:     

DATA 19,58,16,58,16,64,16,70,13,58,13,64,13,70,10,58,10,64
DATA 10,70,19,70

DATA 449,140,536,160,449,116,489,136,496,116,536,136,543
DATA 116,583,136,449,92,489,112,496,92,536,112,543,92
DATA 583,112,449,68,489,88,496,68,536,88,543,68,583,88
DATA 543,140,583,160

DATA 200,45,446,58,200,61,446,74,200,77,446,90,200,93
DATA 446,106,200,109,446,122

'------------------Subroutinen----------------------------

SUB Blink (n%) STATIC         'läßt die Tasten blinken
COLOR 3,1: C%=3               'C% fÜr orangen Rahmen
FOR i%=0 TO 10                
IF i%=0 OR i%=10 THEN         'mit Zeitverzögerung
 IF n%=10 THEN                'beim Punkt dann
  CALL Block(bx%(10,0),by%(10,0),bx%(10,1),by%(10,1),C%,1)
   LOCATE y%(n%),x%(n%): PRINT "."
 ELSE                         'ansonsten
  CALL Block(bx%(n%,0),by%(n%,0),bx%(n%,1),by%(n%,1),C%,1)
  LOCATE y%(n%),x%(n%): PRINT MID$(STR$(n%),2,1)
 END IF
END IF
COLOR 2,1: C%=2               'Rahmenfarbe schwarz
NEXT i%
END SUB  

SUB Block(x1%,y1%,x2%,y2%,r%,f%) STATIC 'zeichnet Blöcke
LINE (x1%,y1%)-(x2%,y2%),f%,BF
LINE (x1%,y1%)-(x2%,y2%),r%,B    'andersfarbiger Rahmen
END SUB

SUB InitWindow STATIC            'öffnet das Window
WINDOW CLOSE 1                
WINDOW 1,"Zehnerblock-Trainer",(0,11)-(631,186),22
WINDOW OUTPUT 1
END SUB

SUB Font(Fontname$, height%) STATIC   'öffnet Fonts
SHARED Fontnum%,pFont&,Ffehler%
Fontnum%=0
Fontname0$=Fontname$+".font"+CHR$(0)
textAttr&(0)=SADD(Fontname0$)
textAttr&(1)=height%*65536&
pFont&=OpenFont&(VARPTR(textAttr&(0)))
IF pFont&<>0 THEN CALL CloseFont(pFont&)
IF pFont&=0 THEN
  pFont&=OpenDiskFont&(VARPTR(textAttr&(0)))
  nheight%=PEEKW(pFont&+20)
  IF nheight%<>height% THEN ERROR 100   'falscher Font
  Fontnum%=Fontnum%+1
  nFont&(Fontnum%)=pFont&  
END IF
IF pFont&<>0 THEN CALL SetFont(WINDOW(8),pFont&)
IF pFont&=0 THEN ERROR 100         'Font nicht auf Disk
END SUB

SUB SetStyle(mask%) STATIC        'Textattribute ändern
SHARED enable%
SetSoftStyle WINDOW(8),mask%,enable%
END SUB

SUB Init STATIC                  'ließt die Data-Zeilen
RESTORE Daten
FOR i%=0 TO 10         'Datas fÜr Zahlen im Zehnerblock
  READ y%(i%),x%(i%)
NEXT i%
FOR i%=0 TO 10         'Datas fÜr Blöcke im Zehnerblock
  FOR j%=0 TO 1
    READ bx%(i%,j%),by%(i%,j%)
  NEXT j%
NEXT i%
FOR i%=0 TO 4          'Datas fÜr Blöcke im HauptmenÜ
  FOR j%=0 TO 1
    READ mx%(i%,j%),my%(i%,j%)
  NEXT j%
NEXT i%    
END SUB