'===========================================================================
' Subject: MASTERMIND GAME FOR PB             Date: 10-20-98 (13:14)       
'  Author: Michael Kr”ber                     Code: PB                     
'  Origin: IBS-Doebeln@t-online.de          Packet: GAMES.ABC
'===========================================================================
'MasterMind - Help - English                              Free ware
'
'The computer gives You a combination of 4 hidden colors. Your Task
'is to find the right combination by a logical trial and error. But
'keep in mind that colors could occur doubbled and the limit of the
'tests is 8. You must solve the problem within 8 combinations.
'The result of each trial is shown by black and white tiles.  Black
'tiles indicate the number - not the position - of right placed co-
'lor tiles. White tiles show the number of right choosen colors but
'placed at wrong position.
'Color tiles could be picked by mouse from down right, from numbers
'or from the playing field. Putting in numbers works too.
'
'Boss: The Boss-Key delates the game from screen.  The former sreen
'appears, pretending to work correctly for the boss. Any key brings
'back the game. A working mouse indicates that the game is still in
'memory. As boss-key 'B', SPACE, ENTER, klicking a space or double-
'klick is accepted.
'
'Undo: Undo takes back one move,  consisting from 3 color  tiles in
'maximum. Have Fun!
'
'The programme is dual lingual; it 'speakes' german an english.
'
'Included is how to create different fonts and a wide mouse support.
'
'Michael Kr”ber, Germany - email IBS-Doebeln@T-Online.De
'                        - phone +49 3431 574153
'                        - letter Badische Straáe 5-24, 04720 D”beln

$FLOAT EMULATE

$CPU 8086              ' alle 80x86 CPUs werden untersttzt

$OPTIMIZE SIZE         ' optimiere auf kleine Programmgr”áe
$COMPILE EXE           ' erzeuge eine EXE

$DEBUG MAP OFF         ' kein Map-File erzeugen
$DEBUG PBDEBUG OFF     ' keinen Code fr PBD erzeugen

$LIB FULLFLOAT  OFF    ' Flieákomma-Untersttzung ausschalten.
$LIB COM        OFF    ' Untersttzung fr COMs ausschalten.
$LIB CGA        OFF    ' Untersttzung fr CGA-Graphik ausschalten.
$LIB EGA        OFF    ' Untersttzung fr EGA-Graphik ausschalten.
$LIB VGA        OFF    ' Untersttzung fr VGA-Graphik ausschalten.
$LIB HERC       OFF    ' Untersttzung fr Hercules-Graphik ausschalten.
$LIB LPT        OFF    ' Untersttzung fr LPTs ausschalten.
$LIB IPRINT     OFF    ' Untersttzung fr Interpreted-Print ausschalten.
                       ' OFF- CHR$(0) bis CHR$(31) werden ausgegeben
                       ' ON - Zeichen werden interpretiert (CHR$(10)=LF)

$ERROR BOUNDS   OFF    ' Array-Grenzen-šberprfung ausschalten
$ERROR NUMERIC  OFF    ' Numeric-šberprfung (zB. DIV durch 0) ausschalten
$ERROR OVERFLOW OFF    ' šberlauf-šberprfung ausschalten
$ERROR STACK    OFF    ' Stack-šberprfung ausschalten

$COM    0              ' Kommunikationspuffer = 0
$STRING 8              ' maximale Stringl„nge = 8k
$STACK  2048           ' Stackgr”áe           = 2k
$SOUND  1              ' kleinster m”glicher Klang-Puffer

$DYNAMIC               ' alle Arrays werden standardm„áig als dynamisch def.

$OPTION CNTLBREAK ON   ' Unterbrechung mit Strg-Pause einschalten

ON ERROR GOTO 990

TM%=300    'Timer for screen saver, works in IDE only
TF%=1      'Tafeln ein
MS%=1      'Mouse ein
CB%=7      'Back Ground Color
CL%=0      'Letters
CA%=4      'Alert
CU%=1
CM%=1      '.
CS%=15     '.
CT%=15     '... colors ...
CM%=1
CH%=15     'TSR     '          Hotkey's in POP-Menu 2. Ebene wie 2nd Fu
CB%=CB%             '          Hintergrund der Klappmenus
CT%=CM%+8:IF CM%=1 THEN CT%=11'HotKey bei Schildern

CALL SaveScreen("R",2)

ASM MOV AX,&H0000
ASM MOV ES,AX
ASM MOV AX,ES:[&H0484]
ASM AND AX,&HFF
ASM INC AX
ASM MOV A%,AX
IF A%<>25 THEN SCREEN 0:WIDTH 80,25
COLOR CL%,CB%:CLS

DIM X$(50):LoadFont

LOCATE 1,1:COLOR 15,CM%:?"Michael Kr”ber, Badische Straáe 5, 04720 D”beln, Tel/Fax 03431574153 =mk= 050497

FOR I%=1 TO 8
 FOR J%=1 TO 8
  X$(1)=" "
  TAFEL  3*I%-1,5*J%-4,CU%,15
  LOCATE 3*I%  ,5*J%-3:COLOR CL%,CB%:?"   "
 NEXT
NEXT
FOR I%=1 TO 8
 FOR J%=1 TO 2                                               'Farbscala
  X$(1)=" "                                                  'color scale
  TAFEL 17+3*J%,36+5*I%,CU%,15:
  IF J%=1 THEN LOCATE 18+3*J%,37+5*I%:COLOR I%-1+8,CB%:?I%
  IF J%=2 THEN LOCATE 18+3*J%,37+5*I%:COLOR I%-1+8,CB%:?"ÛÛÛ"
 NEXT
NEXT

CALL SaveScreen("R",5):SLD"~English / ~Deutsch":VV$=V$:CALL SaveScreen("W",5)

IF VV$="D" THEN
 X$(01)="MasterMind - Einfhrung
 X$(03)="Der Rechner hinterlegt eine Kombina-
 X$(04)="tion aus 4 Farben mit 8  Stufen, die
 X$(05)="durch  sinnvolles Auskombinieren  zu
 X$(06)="finden sind. Nach jeder Auswahl wer-
 X$(07)="den Steine in weiá und schwarz ange-
 X$(08)="zeigt. Weiáe Steine zeigen  richtige
 X$(09)="Farben  an der falschen Position  an
 X$(10)="w„hrend bei schwarzen Steinen sowohl
 X$(11)="die Farbe als auch Position stimmen.
 X$(13)="~Boá  ~Neu  ~Zurck  ~F~1"+CHR$(0)+"Hilfe  ~E~S~C"+CHR$(0)+"Ende
 TAFEL 2,41,CL%,CH%
ELSE
 X$(01)="MasterMind - Introduction
 X$(03)="The computer creates a random combi-
 X$(04)="nation of 4 colors in 8 steps,  that
 X$(05)="is  to be found by a sytematic trial
 X$(06)="and error. Black and white tiles re-
 X$(07)="present  the result.  Black show the
 X$(08)="number of right  placed color tiles.
 X$(09)="White tiles indicate the number (not
 X$(10)="the position!) of  richt choosen co-
 X$(11)="lors but  placed at wrong  position.
 X$(13)="~Boss  ~New   ~Undo   ~F~1"+CHR$(0)+"Help   ~E~S~C"+CHR$(0)+"End
 TAFEL 2,41,CL%,CH%
END IF

IF VV$="D" THEN
 X$(1)="Kombination"+SPACE$(25)
 TAFEL 17,41,CL%,CB%
ELSE
 X$(1)="Combination"+SPACE$(25)
 TAFEL 17,41,CL%,CB%
END IF

CALL SaveScreen("R",1)

GOSUB F1

GAM1:

CALL SaveScreen("W",1)
TMP=RND(-TIMER):ZP%=0:Z0%=0:TIM&=TIMER:F$="-GAME-"
FOR N%=1 to 4
 A%(N%+8)=INT(RND*8+1)
NEXT
FOR N%=1 TO 8
 FOR Q%=1 TO 4                     'Beginn Vergleich Position und Ziffer
  DO                               'compare of position and digit/color
   M$=" ":CO%=0
   GOSUB TASTE
   IF V$="!" OR V$="E" OR V$="S" OR V$="C" THEN COLOR CL%,CB%:CLS:END    'ESC
   IF V$="B" OR V$=" " THEN CALL SaveScreen("R",3):CALL SaveScreen("W",2):GOSUB TASTE:CALL SaveScreen("W",3)
   IF V$=";" OR V$="F" OR V$="1" AND Y%=15 THEN GOSUB F1   'F1
   IF V$="N" THEN GOTO GAM1                                        'Neu
   IF V$="." THEN FOR I%=1 TO 4:LOCATE 3,5*I%-2:COLOR A%(I%+8)+7,CB%:?"ú":NEXT:V$=""
   IF V$="U" OR V$="Z" THEN                                                  'Zurck
    FOR I%=1 TO 4
     LOCATE 27-N%*3,5*I%-3:COLOR CB%,CB%:?"ÛÛÛ":Q%=1:ZP%=0:Z0%=0:V$=""
    NEXT
   END IF
   IF V$="Û"  THEN CO%=(SCREEN(Y%,X%,1) AND &B000111)+1:Y%=24 'Mous, Bildschirmattribut also Farbe
   IF VAL(V$) THEN CO%=VAL(V$)                         :Y%=21 'Zahleneingabe
   X%=38+5*CO%                                  'X-Koordinate der Inverstaste
   IF CO%>0 AND CO%<9 THEN GOSUB TASTE_INVERS
  LOOP WHILE CO%<=0 OR CO%>8
  LOCATE 27-N%*3,5*Q%-3:COLOR CO%+7,CB%:?"ÛÛÛ"
  A%(Q%+4)=CO%:A%(Q%)=A%(Q%+8)
  IF A%(Q%)=A%(Q%+4) THEN
   INCR ZP%:A%(Q%)=11:A%(Q%+4)=22
  END IF
 NEXT
 FOR M%=1 TO 4                     'Beginn Vergleich auf Ziffer
  FOR O%=1 TO 4                    'start comparision of digit/color
   IF A%(O%)=A%(M%+4) THEN
    INCR Z0%:A%(O%)=33:A%(M%+4)=44
   END IF
  NEXT
 NEXT
 FOR S%=1 TO ZP%                   'Zeichen&Position richtig
  LOCATE 27-N%*3,5* S%     -3+20   'color and position ok
  COLOR  0,CB%:?"þþþ"
 NEXT
 FOR S%=1 TO Z0%                   'Zeichen richtig
  LOCATE 27-N%*3,5*(S%+ZP%)-3+20   'color ok
  COLOR 15,CB%:?"þþþ"
 NEXT
 IF ZP%=4 THEN EXIT
 ZP%=0:Z0%=0
NEXT

LOCATE 18,54      :COLOR 15,CM%   :?INT(TIMER-TIM&);"s"
LOCATE 18,60      :COLOR CL%,CB%   :?SPACE$(20)      ' ¿
FOR N%=1 TO 4                                        ' ³
 LOCATE 18,57+5*N%:COLOR A%(N%+8)+7:?"ÛÛÛ"           ' Ã Ergebnisausgabe
NEXT                                                 ' Ù solution

IF VV$="D" THEN
 SLD "~Neues"+CHR$(0)+"Spiel oder ~Ende    "
ELSE
 SLD "~New"+CHR$(0)+"Game or ~End    "
END IF
IF V$="N" THEN GOTO GAM1 ELSE COLOR CL%,CB%:CLS:END

SUB MENU(A$,B%,C%,C1%,C2%,C3%)
    LOCATE B%,C%:COLOR C3%,C2%
    FOR N%=1 TO LEN(A$)
     Z$=MID$(A$,N%,1)
     IF Z$="~" THEN COLOR C1%,C2% ELSE ?Z$;:COLOR C3%,C2%
    NEXT
    END SUB

F1:
    CALL SaveScreen("R",4)
    X$(01)="MasterMind - Help - English                              Free ware
    X$(02)="
    X$(03)="The computer gives You a combination of 4 hidden colors. Your Task
    X$(04)="is to find the right combination by a logical trial and error. But
    X$(05)="keep in mind that colors could occur doubbled and the limit of the
    X$(06)="tests is 8. You must solve the problem within 8 combinations.
    X$(07)="The result of each trial is shown by black and white tiles.  Black
    X$(08)="tiles indicate the ~n~u~m~b~e~r - ~n~o~t ~t~h~e ~p~o~s~i~t~i~o~n - of right placed co-
    X$(09)="lor tiles. White tiles show the number of right choosen colors but
    X$(10)="placed at wrong position.
    X$(11)="Color tiles could be picked by mouse from down right, from numbers
    X$(12)="or from the playing field. Putting in numbers works too.
    X$(13)="
    X$(14)="~B~o~s~s: The Boss-Key delates the game from screen.  The former sreen
    X$(15)="appears, pretending to work correctly for the boss. Any key brings
    X$(16)="back the game. A working mouse indicates that the game is still in
    X$(17)="memory. As boss-key '~B', ~S~P~A~C~E, ~E~N~T~E~R, klicking a space or double-
    X$(18)="klick is accepted.
    X$(19)="~U~n~d~o: Undo takes back one move,  consisting from 3 color  tiles in
    X$(20)="maximum. Have Fun!                                              ~o~k
    TAFEL 2,3,CL%,CH%:GOSUB TASTE
    '
    X$(01)="MasterMind - Hilfe - Deutsch
    X$(02)="
    X$(03)="Die  Farbkombination ist an Hand der vom Rechner ausgegeben Ergeb-
    X$(04)="nissteine auszukombinieren.  Zu beachten ist, daá Farben auch dop-
    X$(05)="pelt vorkommen k”nnen.
    X$(06)="
    X$(07)="Die  Wertungssteine zeigen nur die ~A~n~z~a~h~l richtiger Farben,  ~n~i~c~h~t
    X$(08)="aber deren Position.
    X$(09)="
    X$(10)="Es ist ~n~i~c~h~t unbedingt notwendig, die Farben aus dem Kombinations-
    X$(11)="feld  zu  picken.  Ebenso k”nnen bereits im  Spielfeld  vorhandene
    X$(12)="Farbe gezeigt werden.
    X$(13)="
    X$(14)="~B~o~á~:  Mit der Boá-Taste wird das Spiel vom Bilschirm gel”scht  und
    X$(15)="der ursprngliche Hintergrund angezeigt.  Die weiterhin verfgbare
    X$(16)="Mouse  zeigt  an,  daá das Spiel weiter aktiv ist.  Ein  folgender
    X$(17)="Tastendruck bringt das Spiel zurck.
    X$(18)="Als Boá-Taste funktionieren neben dem '~B' auch ~S~P~A~C~E,  ~E~N~T~E~R,  das
    X$(19)="Klicken auf ein Leerzeichen,  die mittlere Moustaste und ein  Dop-
    X$(20)="pelklick mit der Mouse.                                         ~o~k
    TAFEL 2,3,CL%,CH%:GOSUB TASTE
    '
    X$(01)="About ...                              copyright DI Michael Kr”ber
    X$(02)="
    X$(03)="Das ProgrammSystem LVZ dient in der Vollversion der Erstellung von
    X$(04)="LeistungsVerzeichnissen, und Zeichnungen und wurde fr PlanungsB-
    X$(05)="ros der Fachrichtung ElektroTechnik entwickelt. Zu den wichtigsten
    X$(06)="Eigenschaften des Programmes geh”ren:
    X$(07)="
    X$(08)="Erstellung von Leistungsverzeichnissen mit kompletter AVA
    X$(09)="
    X$(10)="- Aufbau des LV's auf Basis einer umfangreichen Datenbank
    X$(11)="- Kostensch„tzung/-berechnung nach Titeln und nach DIN 276
    X$(12)="- Honorarberechnung nach HOAI
    X$(13)="- Ausschreibung frei und nach  Standardleistungsbuch
    X$(14)="- Preisspiegel und Bietervergleich
    X$(15)="- Aufmaákontrolle und Kostenverfolgung
    X$(16)="                                                                ~o~k
    X$(17)="
    X$(18)="MasterMind  ist FreeWare und darf ~f~r~e~i benutzt und kopiert werden.
    X$(19)="Informationen : Telefon und Fax (03431)-574153 Funk (0171)-5735947
    X$(20)="Kontaktadresse: IBS, Ingenieurbro,  Badische Str. 5, 04720 D”beln
    TAFEL 2,3,CL%,CH%:GOSUB TASTE
    '
    X$(01)="About ...                              copyright DI Michael Kr”ber
    X$(02)="
    X$(03)="Erstellung von Projektzeichnungen auf der Basis von AutoCAD
    X$(04)="
    X$(05)="- Automatisierung vom Zeichnungsaufbau, konsequent als 3D-Modell
    X$(06)="- Massenermittlung mit allen  Leitungsl„ngen aus  der Zeichnung
    X$(07)="- automatisches Erstellen des šbersichtsschaltplanes zum I-Pl
    X$(08)="- Berechnung von Spannungsabfall,  Verlustleistung, Brandlast nach
    X$(09)="  VDE 108,  Trassenquerschnitt,  Kabelgewicht, Beleuchtungsst„rke,
    X$(10)="  Verteilergr”áe, Kurzschluánachweis, Nullungsnachweis
    X$(11)="- Makrobibliothek mit z Zeit 1050 Symbolen nach DIN, erweiterbar
    X$(12)="- Routinen zum Digitalisieren von Zeichnungen,   dabei werden W„n-
    X$(13)="  de, Fenster, Tren, Treppen, Heizk”rper, Wand- und  Deckendurch-
    X$(14)="  brche nach Angabe von 3 Punkten auf Basis mathematischer Model-
    X$(15)="  le  berechnet und als 3D gezeichnet
    X$(16)="- umfangreiche Toolbox zur Vereinfachung von Routinearbeiten    ~o~k
    X$(17)="
    X$(18)="MasterMind  ist FreeWare und darf ~f~r~e~i benutzt und kopiert werden.
    X$(19)="Informationen : Telefon und Fax (03431)-574153 Funk (0171)-5735947
    X$(20)="Kontaktadresse: IBS, Ingenieurbro,  Badische Str. 5, 04720 D”beln
    TAFEL 2,3,CL%,CH%:GOSUB TASTE:CALL SaveScreen("W",4)
    RETURN

TASTE:
    TI&=TIMER:TT%=0
    DO
     DM$=MID$(DATE$,4,2)+"."+MID$(DATE$,1,2)+"."+MID$(DATE$,9,2)
     V$=INKEY$
     LOCATE 1,1,0
     IF T0% THEN LOCATE 18,46:?DM$;"  ";TIME$                 'TSR DIR-Manager
     IF TIMER>TI&+TM% THEN KUGEL:TI&=TIMER
     IF MS%=1 THEN
      CALL MouseOn
      CALL MouseGet(X%,Y%,T%):TT%=T%
      IF T%=1 THEN V$=MouseHotKey(Y%,X%):IF V$=" " THEN P%=Y%-3  'Pick  links, also Zeichen auf Mausposition; DIR Kursor auf Mouseposition
      IF T%=2 THEN V$="!"                                        'ESC   rechts
      IF T%=4 THEN V$=CHR$(13)                                   'ENTER mitte
      WHILE T%:CALL MouseGet(X%,Y%,T%):WEND   'Warteschleife bis MouseTaste wieder losgelassen wurde
      IF TT%=1 THEN                               '¿
       TI=TIMER                                   '³
       WHILE TIMER<TI+0.15                        '³  Wartezeit 0.15 s
        CALL MouseGet (X%,Y%,T%)                  '³
        IF T%=1 THEN                              'Ã  Test auf Doppelklick
         V$=CHR$(13)                'Doppelklick  '³
         WHILE T%:CALL MouseGet(X%,Y%,T%):WEND    '³  Warteschleife bis MouseTaste wieder losgelassen wurde
         EXIT                                     '³
        END IF                                    '³
       WEND                                       '³
      END IF                                      'Ù
     END IF
    LOOP WHILE V$=""
    IF TALLY(V$,ANY "àâ
") THEN V$=" !"      'ESC alle Zeichen
    IF TALLY(V$,ANY "åçè") THEN V$=" s"      'DEL alle Zeichen
    IF TALLY(V$,ANY "“éë") THEN V$=" ;"      'F1 alle Zeichen
    IF V$="Ó" THEN V$=CHR$(13)               'ENTER <ÄÄÙ Pfeil-Spitze
    IF LEN(V$)=1 THEN V$=UCASE$(V$)
    IF LEN(V$)=2 THEN V$=LCASE$(RIGHT$(V$,1))
    IF V$="J" THEN V$="Y"
    IF V$=CHR$(13) THEN V$=LEFT$(M$,1)       'ENTER
    IF V$=CHR$(27) THEN V$="!"               'ESC
    IF V$="k" THEN V$="Y"                    'LEFT ARROW
    IF V$="m" THEN V$="N"                    'RIGHT ARROW
    IF V$="Y" THEN VV%=1 ELSE VV%=0
    IF V$="#" THEN
     LOCATE 2,57:?"DEBUG=";
     IF DE%=0 THEN DE%=1:?"ON " ELSE DE%=0:?"OFF"
    END IF
    M$=""
    IF DE% THEN LOCATE 2,66:?V$;:?USING"####";ASC(V$)
    CALL MouseOff
    RETURN

SUB SaveScreen (Modus$, Seite%)              'Read/Write, Page
    SHARED S$()
    DEF SEG=&HB800                           'Modus=Read/Write
    IF Modus$="R" THEN                       '
     S$(Seite%)=PEEK$(0,8000)                '
    ELSE                                     '
     POKE$ 0,S$(Seite%)
    END IF
    END SUB

SUB MouseOn
    ASM MOV AX,01
    ASM INT &H33
    END SUB

SUB MouseOff
    ASM MOV AX,02
    ASM INT &H33
    END SUB

SUB MouseGet (X%,Y%,T%)                      'X%,Y%=MouseKoordinaten in Pixel
    ASM PUSH DI                              ;Zeile bzw Spalte = Pixel/8+1
    ASM MOV AX,3                             ;T% links=1, rechts=2, mitte=4
    ASM INT &H33
    ASM LES DI,X%
    ASM MOV ES:[DI],CX
    ASM LES DI,Y%
    ASM MOV ES:[DI],DX
    ASM LES DI,T%
    ASM MOV ES:[DI],BX
    X%=X%/8+1:Y%=Y%/8+1
    END SUB

FUNCTION MouseHotKey$(Y%,X%)      'Berechnung des gedrckten HoKey's bei T%=1
    DO                            'von Klickposition nach links zum ersten Leerzeichen
     Z%=SCREEN(Y%,X%-L%)          'Zeichen
     IF Z%<>32 THEN INCR L%       'links
    LOOP WHILE Z%<>32 AND X%-L%>0 'nach links gehen, bis Leerzeichen gefunden wird
    IF SCREEN(Y%,X%)= 32 THEN FUNCTION=" ":EXIT FUNCTION
    IF SCREEN(Y%,X%)=219 THEN FUNCTION="Û":EXIT FUNCTION   'MasterMind
    MouseOff
    DO
     Z%=SCREEN(Y%,X%-L%+1+R%)     'Zeichen
     A%=SCREEN(Y%,X%-L%+1+R%,1)   'Attribut
     Z$=Z$+CHR$(Z%)               'Zeichenkette
     IF Z%<>32 THEN
      INCR R%                     'nach rechts laufen
      IF R%=1 THEN
       A1%=A%:INCR N1%
      ELSE
       IF A%=A1% THEN INCR N1% ELSE A2%=A%:INCR N2%
      END IF
     END IF
    LOOP WHILE Z%<>32 AND X%-L%+R%<81'nach rechts gehen, bis Leerzeichen gefunden wird
    FOR I%=X%-L%+1 TO X%-L%+R%
     IF N1%<N2% THEN Ax%=A1% ELSE Ax%=A2%                     'das seltenere Attribut finden
     IF SCREEN(Y%,I%,1)=Ax% THEN FUNCTION=CHR$(SCREEN(Y%,I%)) 'allgemein
     IF N1%+N2%<4 THEN FUNCTION=CHR$(SCREEN(Y%,X%-L%+1))      'kurze Zeichenkette mit unterschiedlichen Attributen bei nur 2 Zeichen, dann das linke ... oder wenn links 2HotKeyTasten sind und nur ein normales Zeichen folgt wie zB. ~œ~ND
     IF N1%=N2%   THEN FUNCTION=CHR$(SCREEN(Y%,X%-L%+1))      'gleiche Anzahl HotKey's wie normale Zeichen wie zB. in ~›~Ren oder ~œ~Suc in FIL
     IF N2%=0     THEN FUNCTION=CHR$(SCREEN(Y%,X%))           'nur HotKey's wie in den Laufwerkssysmbolen
     IF TALLY(Z$,"Y/N") THEN FUNCTION=CHR$(SCREEN(Y%,X%))     'Sonderfunktion bei Y/N
    NEXT
    MouseOn
    END FUNCTION

SUB SLD(A$)
    SHARED CA%,CB%,CS%,CM%,CM%,CT%,OX%,OY%,M$,V$,X$(),TF%,SLDText$
    CALL SaveScreen("R",3)
    IF LEFT$(A$,1)="a" THEN A$=MID$(A$,2):CX%=4 ELSE CX%=1
    A%=VAL(A$):IF A% THEN X%=OX%+5*A%:Y%=OY%+7+2*A%:A$=MID$(A$,2) ELSE X%=OX%:Y%=OY%+7
    IF LEFT$(A$,1)="#" THEN A$=MID$(A$,2)
    M$=MID$(A$,INSTR(A$,"~")+1,1)
    TAFEL Y%-1,33+X%,CS%,CB%
    A%=LEN(A$):COLOR 15,CX%:LOCATE Y%,X%+34:?SPACE$(30):LOCATE Y%,X%+35
    FOR I%=1 TO A%
     Z$=MID$(A$,I%,1)
     IF Z$="~" OR  Z$="^"THEN COLOR CT%,CX% ELSE ?Z$;:COLOR CS%,CX%
    NEXT
    IF U%=0 THEN U%=I%+1
    COLOR CS%,CB%:LOCATE Y%,35+X%+U%
    IF TALLY(A$,"~") THEN GOSUB TASTE
    END SUB

SUB TAFEL (Y%,X%,V%,T%)                                  'Y,X, Taste, Schrift
    SHARED CA%,CB%,CM%,X$(),TF%
    FOR N%=1 TO 48                           '¿
     X$=LTRIM$(REMOVE$(X$(N%),ANY "~"),"a")  '³   Fettdruck und Alert entfernen
     IF LEN(X$)+2>B% THEN B%=LEN(X$)+2       '³
     IF X$(N%)<>"" THEN Z%=N%                'Ã H”he und Breite ermitteln
    NEXT                                     '³
    IF Z%<1 AND B%<30 THEN B%=30:Z%=1        'Ù   Mindestbreite wegen SLD
    COLOR CB%+8,CB%:LOCATE Y%,X%    : ?"Ú";STRING$(B%,196);:COLOR 0,CB%:?"¿"
    IF X$(2)="" THEN X$=X$(1)
    FOR I%=1 TO Z%
     COLOR CB%+8,CB%:LOCATE Y%+I%,X%: ?"³"
     IF TF% AND I%=1 AND X$(2)="" THEN
      IF LEFT$(X$(1),1)="a" THEN
       C2%=CA%:C3%=15:X$(1)=MID$(X$(1),2) 'Alertfarbe
      ELSE
       C2%=CM%:C3%=15                     'Menufarbe
      END IF
     ELSE
      C2%=CB%:C3%=V%
     END IF
     MENU " "+SL$(B%-1,X$(I%)),Y%+I%,X%+1,T%,C2%,C3%:X$(I%)=""
     LOCATE Y%+I%,X%+B%+1:COLOR 0,CB%:?"³";
    NEXT
    COLOR CB%+8,CB%:LOCATE Y%+Z%+1,X%:?"À";:COLOR 0,CB%:?STRING$(B%,196);"Ù";
    IF TF% THEN COLOR 15,CM%
    END SUB

SUB KUGEL
    CALL MouseOff
    RANDOMIZE TIMER
    CO% =RND*100                       'Ballfarbe innen
    WHILE INC%<3:INC%=RND*10:WEND      'Schrittweite
    KU% =RND*10                        'Kugel oder Muster zeichnen
    CALL SaveScreen("R",4)
    REDIM DYNAMIC B(150):SCREEN 12
    XMA%=639:XMI%=0:YMA%=479:YMI%=0:X0%=15:Y0%=15:BA%=15
    CIRCLE (X0%,Y0%),BA%,2:PAINT (X0%,Y0%),CO%,2
    GET (X0%-BA%,Y0%-BA%)-(X0%+BA%,Y0%+BA%),B
    XR%=1:YR%=1
    DO WHILE T%=0 AND V$=""
     IF KU%>5   THEN PUT (XO%,YO%),B 'Kugel
     IF X+INC%+30>XMA% THEN XR%=-1
     IF X-INC%   <YMI% THEN XR%= 1
     X=X+INC%*XR%
     IF Y+INC%+30>YMA% THEN YR%=-1
     IF Y-INC%   <YMI% THEN YR%= 1
     Y=Y+INC%*YR%
     PUT (X,Y),B:XO%=X:YO%=Y:DELAY .03
     CALL MouseGet(X%,Y%,T%)
     V$=INKEY$
    LOOP
    SCREEN 0:CALL LoadFont
    IF MS% THEN CALL MouseOn
    CALL SaveScreen("W",4)
    END SUB

TASTE_INVERS:
    CALL SaveScreen("R",4)
    LOCATE Y%-1,X%-2:COLOR CL%,CB%:?"ÚÄÄÄ";:                 COLOR CB%+8,CB%:?   "¿";
    LOCATE Y%  ,X%-2:COLOR CL%,CB%:?"³"   ;:LOCATE Y%  ,X%+2:COLOR CB%+8,CB%:?   "³";
    LOCATE Y%+1,X%-2:COLOR CL%,CB%:?"À"   ;:LOCATE Y%+1,X%-1:COLOR CB%+8,CB%:?"ÄÄÄÙ";
    COLOR 15,CM%:DELAY .1
    CALL SaveScreen("W",4)
    RETURN

FUNCTION SL$(N%,Y$)
    X$=Y$:T%=TALLY(X$,ANY "~")
    X$=LEFT$(X$,N%+T%):SL$=X$+STRING$(N%-LEN(X$)+T%,32)
    END FUNCTION

'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ ExeName - gibt den Namen und Pfad der EXE des aktuellen Programms zurck ³
'³         - ntzlich, wenn Programm mit DOS-PATH gestartet wurde und Daten ³
'³           oder die Konfiguration aus Originalverzeichnis ben”tigt werden ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ

FUNCTION ExeName$
    ASM MOV  AX,&H6200      ;Adresse des PSP holen
    ASM INT  &H21           ;DOS (INT21) aufrufen
    ASM MOV  ES,BX          ;ES mit PSP-Segment laden
    ASM MOV  AX,ES:[&H2C]   ;Segment der DOS-Umgebung in AX ablegen
    ASM MOV PbvDefSeg,AX
    FOR I%=0 TO 1024
     IF PEEK$(I%,4)=CHR$(0,0,1,0) THEN EXIT FOR
    NEXT
    WHILE PEEK(I%+4)<>0
     TMP$=TMP$+CHR$(PEEK(I%+4))
     INCR I%
    WEND
    DEF SEG
    FUNCTION=TMP$
    END FUNCTION

SUB LoadFont
    DATA  16
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  1,  2,  4,  8, 16, 32, 64,128,  0,  0
    DATA   0,254,226,198,142, 30, 62,126, 62, 30,142,198,226,254,  0,  0
    DATA   0,  0,  0,  0,108,254,254,254,254,124, 56, 16,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 16, 56,124,254,124, 56, 16,  0,  0,  0,  0,  0
    DATA   0,  0,  0, 24, 60, 60,231,231,231,153, 24, 60,  0,  0,  0,  0
    DATA   0,  0,  0, 24, 60,126,255,255,126, 24, 24, 60,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0, 24, 60, 60, 24,  0,  0,  0,  0,  0,  0
    DATA 255,255,255,255,255,255,231,195,195,231,255,255,255,255,255,255
    DATA   0,  0,  0,  0,  0, 60,102, 66, 66,102, 60,  0,  0,  0,  0,  0
    DATA 255,255,255,255,255,195,153,189,189,153,195,255,255,255,255,255
    DATA   0,  0, 30, 14, 26, 50,120,204,204,204,204,120,  0,  0,  0,  0
    DATA   0,  0, 60,102,102,102,102, 60, 24,126, 24, 24,  0,  0,  0,  0
    DATA   0,  0, 63, 48, 63, 48, 48, 48, 48,112,240,224,  0,  0,  0,  0
    DATA   0,  0,127, 99,127, 99, 99, 99, 99,103,231,230,192,  0,  0,  0
    DATA   0,  0,  0, 24, 24,219, 60,231, 60,219, 24, 24,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,128,224,248,224,128,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  2,  6, 14, 30, 62,126, 62, 30, 14,  6,  2,  0,  0,  0
    DATA   0,  0,  0, 24, 60,126,255, 60, 60, 60, 60, 60, 60, 60,  0,  0
    DATA   0,  0,102,102,102,102,102,102,102,  0,102,102,  0,  0,  0,  0
    DATA   0,  0,127,219,219,219,123, 27, 27, 27, 27, 27,  0,  0,  0,  0
    DATA   0,124,198, 96, 56,108,198,198,108, 56, 12,198,124,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,254,254,254,254,  0,  0,  0,  0
    DATA   0, 16, 56,124,254, 56, 56, 56, 56,254,124, 56, 16,  0,  0,  0
    DATA   0,  0, 24, 60,126, 24, 24, 24, 24, 24, 24, 24,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24, 24, 24, 24, 24,126, 60, 24,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 12,  6,255,  6, 12,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 48, 96,255, 96, 48,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,192,192,192,192,254,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0, 32, 96,255, 96, 32,  4,  6,255,  6,  4,  0,  0,  0
    DATA   0,  0,  0,  0, 16, 56, 56,124,124,254,254,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,254,254,124,124, 56, 56, 16,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24, 24, 24, 24, 24,  0, 24, 24,  0,  0,  0,  0
    DATA   0, 99, 99, 99, 34,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,108,108,254,108,108,108,254,108,108,  0,  0,  0,  0
    DATA  40, 40,124,206,202,200,124, 38, 38,166,238,124, 40, 40,  0,  0
    DATA   0,  0,  0,  0,194,198, 12, 24, 48, 96,198,134,  0,  0,  0,  0
    DATA   0,  0, 56,108,108, 56,118,220,204,204,204,118,  0,  0,  0,  0
    DATA   0, 48, 48, 48, 96,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0, 12, 24, 48, 48, 48, 48, 48, 48, 24, 12,  0,  0,  0,  0
    DATA   0,  0, 48, 24, 12, 12, 12, 12, 12, 12, 24, 48,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,102, 60,255, 60,102,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 24, 24,255, 24, 24,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0, 24, 24, 24, 48,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,255,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0, 24, 24,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  2,  6, 12, 24, 48, 96,192,128,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99,103,107,107,115, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 12, 28, 60, 12, 12, 12, 12, 12, 12, 12,  0,  0,  0,  0
    DATA   0,  0, 62, 99,  3,  6, 12, 24, 48, 96, 96,127,  0,  0,  0,  0
    DATA   0,  0, 62, 99,  3,  3, 30,  3,  3,  3, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 48, 54,102,102,127,  6,  6,  6,  0,  0,  0,  0
    DATA   0,  0,127, 96, 96, 96,126,  7,  3,  3, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 30, 51, 96, 96,126, 99, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0,127,  3,  3,  6,  6, 12, 12, 24, 24, 48,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 99, 62, 99, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 99, 63,  3,  3,  3,102, 60,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 24, 24,  0,  0,  0, 24, 24,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 24, 24,  0,  0,  0, 24, 24, 48,  0,  0,  0,  0
    DATA   0,  0,  0,  6, 12, 24, 48, 96, 48, 24, 12,  6,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,254,  0,  0,254,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0, 96, 48, 24, 12,  6, 12, 24, 48, 96,  0,  0,  0,  0
    DATA   0,  0,124,198,198, 12, 24, 24, 24,  0, 24, 24,  0,  0,  0,  0
    DATA   0,  0,  0,124,198,198,222,210,210,220,192,124,  0,  0,  0,  0
    DATA   0,  0, 24, 60,102,195,195,255,195,195,195,195,  0,  0,  0,  0
    DATA   0,  0,124,102,102,102,124,102,102,102,102,124,  0,  0,  0,  0
    DATA   0,  0, 60,102,194,192,192,192,192,194,102, 60,  0,  0,  0,  0
    DATA   0,  0,124,102, 99, 99, 99, 99, 99, 99,102,124,  0,  0,  0,  0
    DATA   0,  0,127, 96, 96, 96,124, 96, 96, 96, 96,127,  0,  0,  0,  0
    DATA   0,  0,127, 96, 96, 96,126, 96, 96, 96, 96, 96,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 96, 96,111, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 99, 99, 99, 99,127, 99, 99, 99, 99, 99,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24,  0,  0,  0,  0
    DATA   0,  0,  6,  6,  6,  6,  6,  6,102,102,102, 60,  0,  0,  0,  0
    DATA   0,  0,102,102,108,108,120,120,108,102,102,102,  0,  0,  0,  0
    DATA   0,  0, 96, 96, 96, 96, 96, 96, 96, 96, 96,127,  0,  0,  0,  0
    DATA   0,  0,195,231,255,219,219,195,195,195,195,195,  0,  0,  0,  0
    DATA   0,  0, 99,115,123,127,111,103, 99, 99, 99, 99,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 99, 99, 99, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0,124,102,102,102,124, 96, 96, 96, 96, 96,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 99, 99, 99, 99,107,107, 62,  6,  6,  0,  0
    DATA   0,  0,126, 99, 99, 99,126,108,102, 99, 99, 99,  0,  0,  0,  0
    DATA   0,  0, 62, 99, 99, 48, 28,  6,  3, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0,127, 12, 12, 12, 12, 12, 12, 12, 12, 12,  0,  0,  0,  0
    DATA   0,  0, 99, 99, 99, 99, 99, 99, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 99, 99, 99, 99, 99, 99, 99, 54, 28,  8,  0,  0,  0,  0
    DATA   0,  0,195,195,195,195,195,219,219,255,102,102,  0,  0,  0,  0
    DATA   0,  0, 99, 99, 54, 54, 28, 28, 54, 54, 99, 99,  0,  0,  0,  0
    DATA   0,  0, 51, 51, 51, 51, 30, 12, 12, 12, 12, 12,  0,  0,  0,  0
    DATA   0,  0,255,  3,  3,  6, 12, 24, 48, 96,192,255,  0,  0,  0,  0
    DATA   0,  0, 62, 48, 48, 48, 48, 48, 48, 48, 48, 62,  0,  0,  0,  0
    DATA   0,  0,  0,128,192,224,112, 56, 28, 14,  6,  2,  0,  0,  0,  0
    DATA   0,  0, 62,  6,  6,  6,  6,  6,  6,  6,  6, 62,  0,  0,  0,  0
    DATA  16, 56,108,198,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,126,  0,  0,  0,  0
    DATA  48, 48, 24,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 60,102,102,102,102,102, 59,  0,  0,  0,  0
    DATA   0,  0, 96, 96, 96,124,102,102,102,102,102,124,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 62, 99, 96, 96, 96, 99, 62,  0,  0,  0,  0
    DATA   0,  0,  6,  6,  6, 62,102,102,102,102,102, 62,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 62, 99,127, 96, 96, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 28, 54, 50, 48,120, 48, 48, 48, 48, 48,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 60,102,102,102,102,102, 62,  6,102, 60,  0
    DATA   0,  0, 96, 96, 96,108,118,102,102,102,102,102,  0,  0,  0,  0
    DATA   0,  0, 12, 12,  0, 12, 12, 12, 12, 12, 12, 12,  0,  0,  0,  0
    DATA   0,  0,  6,  6,  0,  6,  6,  6,  6,  6,  6,  6,102,102, 60,  0
    DATA   0,  0, 96, 96, 96,102,108,120,120,108,102,102,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24, 24, 24, 24, 24, 24, 24, 15,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,230,255,219,219,219,219,219,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 92,102,102,102,102,102,102,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 62, 99, 99, 99, 99, 99, 62,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 92,102,102,102,102,102,124, 96, 96, 96,  0
    DATA   0,  0,  0,  0,  0, 58,102,102,102,102,102, 62,  6,  6,  6,  0
    DATA   0,  0,  0,  0,  0, 92,118, 98, 96, 96, 96, 96,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 62, 99, 48, 28,  6, 99, 62,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24,126, 24, 24, 24, 24, 27, 14,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,102,102,102,102,102,102, 59,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 51, 51, 51, 51, 51, 30, 12,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,195,195,195,219,219,255,102,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 99, 54, 28, 28, 28, 54, 99,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 99, 99, 99, 99, 99, 99, 63,  3,  6,124,  0
    DATA   0,  0,  0,  0,  0,127,  6, 12, 24, 48, 96,127,  0,  0,  0,  0
    DATA   0,  0, 14, 24, 24, 24,112, 24, 24, 24, 24, 14,  0,  0,  0,  0
    DATA   0,  0, 24, 24, 24, 24,  0, 24, 24, 24, 24, 24,  0,  0,  0,  0
    DATA   0,  0,112, 24, 24, 24, 14, 24, 24, 24, 24,112,  0,  0,  0,  0
    DATA   0,  0,118,220,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,255,129,129,129,129,129,255,  0,  0,  0,  0,  0
    DATA   0,  0, 60, 36, 36, 36, 36,231, 66, 36, 24,255,  0,  0,  0,  0
    DATA   0,  0,204,204,  0,204,204,204,204,204,204,118,  0,  0,  0,  0
    DATA   0,  0,  0,  0,192,160,144,136,144,160,192,  0,  0,  0,  0,  0
    DATA   0,  0,255, 24, 36, 66,231, 36, 36, 36, 36, 60,  0,  0,  0,  0
    DATA   0,  0,102,102,  0, 60,102,102,102,102,102, 59,  0,  0,  0,  0
    DATA   0,  0, 60, 36, 36, 36, 36, 36,231, 66, 36, 24,  0,  0,  0,  0
    DATA   0,  0,255,128,129,130,133,138,149,170,212,128,255,  0,  0,  0
    DATA  60, 66,153,161,153, 66, 60,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0, 16, 48,112,255,255,112, 48, 16,  0,  0,  0,  0,  0
    DATA   0,  0, 16, 56,124,254, 56, 56, 56, 56, 56, 56,  0,  0,  0,  0
    DATA   0,  0, 24, 36, 66,231, 36, 36, 36, 36, 36, 60,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,128,128,128,144,160,192,160,144,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,176,200,136,136,136,  0
    DATA   0,  0,  0,  0,  0, 16, 40, 40, 68, 68,130,254,  0,  0,  0,  0
    DATA   0,198,198, 16, 56,108,198,198,254,198,198,198,  0,  0,  0,  0
    DATA   0,  0,  0,  8, 12, 14,255,255, 14, 12,  8,  0,  0,  0,  0,  0
    DATA   0,  0, 56, 56, 56, 56, 56, 56,254,124, 56, 16,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,110, 59, 27,126,216,220,119,  0,  0,  0,  0
    DATA   0,254,254,254,  6,254,  6,254,254,254,254,254,254,254,  0,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0,  4, 12,  4,  4,  4,  4,  4,  0
    DATA   0,  0,198,198,  0,124,198,198,198,198,198,124,  0,  0,  0,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 28, 34,  4,  8, 16, 32, 62,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 28, 34,  2, 28,  2, 34, 28,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0,  4,  8, 18, 62,  2,  2,  2,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 62, 32, 32, 60,  2, 34, 28,  0
    DATA   0,198,198,  0,124,198,198,198,198,198,198,124,  0,  0,  0,  0
    DATA   0,198,198,  0,198,198,198,198,198,198,198,124,  0,  0,  0,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 28, 34, 32, 60, 34, 34, 28,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 62,  4,  4,  8,  8, 16, 16,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 28, 34, 34, 28, 34, 34, 28,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 28, 34, 34, 30,  2, 34, 28,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 78,209, 81, 81, 81, 81, 78,  0
    DATA   0,  0, 12, 24,  0, 60,102,102,102,102,102, 59,  0,  0,  0,  0
    DATA 254,254,252,252,248,248,240,240,224,224,192,192,128,128,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0, 86, 73, 73, 73, 73,  0,  0,  0,  0
    DATA   0,  0,  0, 64, 64, 64, 72, 80, 96, 80, 72, 68,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,252,  0,252,  0,  0,  0,  0,  0,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 34,102, 34, 34, 34, 34, 34,  0
    DATA  62, 32, 32, 62, 32, 32, 32,  0, 38,105, 33, 34, 36, 40, 47,  0
    DATA   0,  0,  0,  0,255,129,165,153,165,129,255,  0,  0,  0,  0,  0
    DATA   2,  6, 10,  2,  2,  2,  2,  0,  2,  6, 10,  2,  2,  2,  2,  0
    DATA  30, 33, 33, 31,  1, 33, 30,  0, 30, 33, 33, 31,  1, 33, 30,  0
    DATA  30, 33,  1, 30,  1, 33, 30,  0, 63,  1,  2,  4,  8, 16, 32,  0
    DATA   0,192,192,194,198,204, 24, 48, 96,206,147,  6, 12, 31,  0,  0
    DATA   0,192,192,194,198,204, 24, 48,102,206,154, 63,  6, 15,  0,  0
    DATA   0,  0,255,  1,129, 65,161, 81,169, 85, 43,  1,255,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 51,102,204,102, 51,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,204,102, 51,102,204,  0,  0,  0,  0,  0,  0
    DATA  17, 68, 17, 68, 17, 68, 17, 68, 17, 68, 17, 68, 17, 68, 17, 68
    DATA  85,170, 85,170, 85,170, 85,170, 85,170, 85,170, 85,170, 85,170
    DATA 221,119,221,119,221,119,221,119,221,119,221,119,221,119,221,119
    DATA  24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  24, 24, 24, 24, 24, 24, 24,248, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  24, 24, 24, 24, 24,248, 24,248, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  54, 54, 54, 54, 54, 54, 54,246, 54, 54, 54, 54, 54, 54, 54, 54
    DATA   0,  0,  0,  0,  0,  0,  0,254, 54, 54, 54, 54, 54, 54, 54, 54
    DATA   0,  0,  0,  0,  0,248, 24,248, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  54, 54, 54, 54, 54,246,  6,246, 54, 54, 54, 54, 54, 54, 54, 54
    DATA  54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54, 54
    DATA   0,  0,  0,  0,  0,254,  6,246, 54, 54, 54, 54, 54, 54, 54, 54
    DATA  54, 54, 54, 54, 54,246,  6,254,  0,  0,  0,  0,  0,  0,  0,  0
    DATA  54, 54, 54, 54, 54, 54, 54,254,  0,  0,  0,  0,  0,  0,  0,  0
    DATA  24, 24, 24, 24, 24,248, 24,248,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,248, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  24, 24, 24, 24, 24, 24, 24, 31,  0,  0,  0,  0,  0,  0,  0,  0
    DATA  24, 24, 24, 24, 24, 24, 24,255,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,255, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  24, 24, 24, 24, 24, 24, 24, 31, 24, 24, 24, 24, 24, 24, 24, 24
    DATA   0,  0,  0,  0,  0,  0,  0,255,  0,  0,  0,  0,  0,  0,  0,  0
    DATA  24, 24, 24, 24, 24, 24, 24,255, 24, 24, 24, 24, 24, 24, 24, 24
    DATA   1,  3,  7, 15, 31, 63,127,255,255,255,255,255,255,255,255,255
    DATA  54, 54, 54, 54, 54, 54, 54, 55, 54, 54, 54, 54, 54, 54, 54, 54
    DATA  54, 54, 54, 54, 54, 55, 48, 63,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0, 63, 48, 55, 54, 54, 54, 54, 54, 54, 54, 54
    DATA 255,255,254,254,252,252,248,248,240,240,224,224,192,192,128,128
    DATA 128,128,192,192,224,224,240,240,248,248,252,252,254,254,255,255
    DATA   0,255,255,255,192,  0,  0,192,255,255,255,127,255,255,  0,  0
    DATA   0,  0,  0,  0,  0,255,  0,255,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  1,  3,  7, 15, 31, 63,127,255
    DATA  24, 24, 24, 24, 24,255,  0,255,  0,  0,  0,  0,  0,  0,  0,  0
    DATA 255,254,252,248,240,224,192,128,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,255,  0,255, 24, 24, 24, 24, 24, 24, 24, 24
    DATA 255,255,255,255,255,255,255,255,255,254,252,248,240,224,192,128
    DATA   0,  0,  0,  8, 24, 56,120,255,120, 56, 24,  8,  0,  0,  0,  0
    DATA   0,127,127,127,127, 96, 96,127,127,127,127,124,127,127,  0,  0
    DATA   0,127,127,127, 96,127, 96,127,127,127,124,124,127,127,  0,  0
    DATA   0,255,255,255,  0,255,  0,255,255,255,255,255,255,255,  0,  0
    DATA 255,255,127,127, 63, 63, 31, 31, 15, 15,  7,  7,  3,  3,  1,  1
    DATA   1,  1,  3,  3,  7,  7, 15, 15, 31, 31, 63, 63,127,127,255,255
    DATA  24, 24, 24, 24, 24, 24, 24,248,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0, 31, 24, 24, 24, 24, 24, 24, 24, 24
    DATA 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255
    DATA   0,  0,  0,  0,  0,  0,  0,255,255,255,255,255,255,255,255,255
    DATA   0,127, 87,107,117,122,125,126,125,122,117,107, 87,127,  0,  0
    DATA   0,255,255,255,  7,  0,  0,  7,255,255,255,248,248,255,  0,  0
    DATA 255,255,255,255,255,255,255,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,127,128,191,160,160,191,160,160,191,128,127, 63,  0,  0
    DATA   0,  0,  0, 62, 99, 99,126, 99, 99, 99,126, 96, 96, 96,  0,  0
    DATA   0,  0,255,  0, 60, 64, 64, 60,  2,  2, 60,  0,255,255,  0,  0
    DATA   0,  0,252,  2,123,131,131,131,131,131,123,  3,255,254,  0,  0
    DATA   0,  0,255,195, 96, 48, 24, 24, 48, 96,195,255,  0,  0,  0,  0
    DATA   0,  0,127,128,190,161,161,161,161,161,190,128,127, 63,  0,  0
    DATA   0,  0,  0,  0,102,102,102,102,102,124, 96, 96,192,  0,  0,  0
    DATA   0,  0,255,  0,124, 64, 64,124, 64, 64,124,  0,255,255,  0,  0
    DATA   0,  0,252,  2,131,131,131,131,131,131,251,  3,255,254,  0,  0
    DATA   0,  0,127,128,191,160,160,191,160,160,160,128,127, 63,  0,  0
    DATA   0,  0,  0, 28, 34, 65, 65, 65, 54, 20, 85,119,  0,  0,  0,  0
    DATA   0,  0,252,  2, 35,163, 35, 35, 35, 35, 35,  3,255,254,  0,  0
    DATA   0,  0,127,128,128,128,128,156,162,162,156,128,127, 63,  0,  0
    DATA   0,  0,  0,  3,  6,126,207,219,243,126, 96,192,  0,  0,  0,  0
    DATA   0,  0,252,  2,  3,131,131,163,195,163,147,  3,255,254,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,254,  0,  0,254,  0,  0,254,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 24, 24,255, 24, 24,  0,  0,255,  0,  0,  0,  0
    DATA   0,  0,  0, 48, 24, 12,  6, 12, 24, 48,  0,126,  0,  0,  0,  0
    DATA   0,  0,  0, 12, 24, 48, 96, 48, 24, 12,  0,126,  0,  0,  0,  0
    DATA   0,  0, 14, 27, 27, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24
    DATA  24, 24, 24, 24, 24, 24, 24, 24,216,216,216,112,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 24, 24,  0,255,  0, 24, 24,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,118,220,  0,118,220,  0,  0,  0,  0,  0,  0
    DATA   0, 56,108,108, 56,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0, 24, 24,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0, 24,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  1,  3,  2,  6,  4, 12,136,216, 80,112, 32,  0,  0,  0,  0
    DATA   0,254,254,254,254, 14, 14,254,254,254,254, 30, 30,254,  0,  0
    DATA   0,112,152, 48, 96,200,248,  0,  0,  0,  0,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0, 62, 62, 62, 62, 62, 62, 62,  0,  0,  0,  0,  0
    DATA   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0    '
    RESTORE
    READ Height%
    FOR N%=0 TO 255
     FOR M%=1 TO Height%
      READ K%:Font$=Font$+CHR$(K%)
     NEXT
    NEXT
    '
    FSS&=STRSEG(Font$)
    FSP&=STRPTR(Font$)
    ASM PUSH BP
    ASM MOV  AH,&H11     ;EGA-text mode character generator
    ASM MOV  AL,&H00     ;load user defined font
    ASM XOR  BL,BL       ;select active page
    ASM MOV  BH,Height%  ;heigth in pixel
    ASM MOV  CX,256      ;all 256 characters
    ASM XOR  DX,DX       ;first char in ASCII-set to modify
    ASM MOV  ES,FSS&     ;STRSEG(Font$)
    ASM MOV  BP,FSP&     ;STRPTR(Font$)
    ASM INT  &H10        ;video interrupt
    ASM POP  BP
    END SUB

