DECLARE SUB PrintText (Te$)
DECLARE SUB SetTAttr (VFa%, HFa%, Stil%)
DECLARE SUB SetScreen (XZei%, YZei%, Tiefe%, ZeiBrei%, ZeiHoeh%)
' Grafik-Modulbibliothek
' (c) 1994 by Andreas Meile

SetScreen 320, 200, 2, 40, 25
FOR i% = 0 TO 3
  FOR j% = 0 TO 3
    SetTAttr j%, i%, 0
    PrintText " Andreas "
  NEXT j%
  PRINT
NEXT i%
PRINT
FOR i% = 0 TO 7
  SetTAttr 3, 0, i%
  PrintText "Test"
NEXT i%

LINE (0, 120)-(79, 199), 2, BF
FOR i% = 0 TO 12
  CIRCLE (40, 160), 39 - 3 * i%, 3 + i% MOD 2 AND 3, , , 1!
NEXT i%
LOCATE 17, 2
SetTAttr 1, -1, 6
PrintText "Quer �ber die Grafik"
LOCATE 19, 2
SetTAttr -1, 1, 6
PrintText "und erst noch kursiv"
DO WHILE INKEY$ = ""
LOOP

SetScreen 640, 480, 4, 80, 30
FOR i% = 0 TO 15
  FOR j% = 0 TO 15
    SetTAttr i%, j%, 4
    PrintText "Andy"
  NEXT j%
  PRINT
NEXT i%

Pi! = 4! * ATN(1!)

FOR i% = 0 TO 99
  w! = CSNG(i%) * Pi! / 50!
  LINE (112, 368)-STEP(CINT(111! * COS(w!)), CINT(111! * SIN(w!))), 1 + i% MOD 5
NEXT i%

LOCATE 18, 2
SetTAttr 14, -1, 0
PrintText "Jetzt wird einfach"
LOCATE 19, 2
SetTAttr 14, -1, 4
PrintText "quer"
SetTAttr 12, -1, 4
PrintText " �ber die"
LOCATE 20, 2
SetTAttr 10, -1, 2
PrintText "Grafik geschrieben"

LOCATE 22, 2
SetTAttr -1, 9, 2
PrintText "Aber selbstverst„ndlich"
LOCATE 23, 2
PrintText "ist das Ganze auch in"
LOCATE 24, 2
SetTAttr -1, 12, 5
PrintText "reverser Darstellung"
SetTAttr -1, 7, 6
PrintText " m”glich!!"

DO WHILE INKEY$ = ""
LOOP

CLS
DO WHILE INKEY$ = ""
  LINE (CINT(INT(640! * RND)), CINT(INT(480! * RND)))-(CINT(INT(640! * RND)), CINT(INT(480! * RND))), CINT(INT(16! * RND))
LOOP
FOR i% = 1 TO 364
  SetTAttr -1 + CINT(INT(17! * RND)), -1 + CINT(INT(17! * RND)), CINT(INT(8! * RND))
  PrintText "Hallo!"
  IF i% MOD 13 = 12 THEN
    PRINT
  END IF
NEXT i%

DO WHILE INKEY$ = ""
LOOP

SetScreen 320, 200, 2, 40, 25
DO WHILE INKEY$ = ""
  LINE (CINT(INT(320! * RND)), CINT(INT(200! * RND)))-(CINT(INT(320! * RND)), CINT(INT(200! * RND))), CINT(INT(4! * RND))
LOOP
FOR i% = 1 TO 207
  SetTAttr -1 + CINT(INT(5! * RND)), -1 + CINT(INT(5! * RND)), CINT(INT(8! * RND))
  PrintText "Puh!"
  IF i% MOD 9 = 8 THEN
    PRINT
  END IF
NEXT i%

DO WHILE INKEY$ = ""
LOOP

SUB PrintText (Te$) STATIC
  ' Dies Routine gibt an der aktuellen Cursorposition den
  ' Text Te$ aus, dabei werden alle eingestellten Attribute beachtet
  SHARED ScrMode%, ZeiBr%, ZeiHoe%, Tief%, StilAttr%, VFar%, HFar%, MColor%
  IF Te$ <> "" THEN
    x1% = (POS(0) - 1) * ZeiBr%
    y1% = (CSRLIN - 1) * ZeiHoe%
    TeBr% = LEN(Te$) * ZeiBr%
    x2% = x1% + TeBr% - 1
    y2% = y1% + ZeiHoe% - 1
    FGr% = (TeBr% * ZeiHoe% * Tief% \ 8 + 1) \ 2 + 1
    DIM TPuf%(FGr%), TPu2%(FGr%), TPu3%(FGr%)
    IF HFar% = -1 THEN
      GET (x1%, y1%)-(x2%, y2%), TPu3%
      XFa% = MColor%
      GOSUB VerarbeiteAttribute
      GET (x1%, y1%)-(x2%, y2%), TPuf%
      LINE (x1%, y1%)-(x2%, y2%), VFar% XOR MColor%, BF
      GET (x1%, y1%)-(x2%, y2%), TPu2%
      PUT (x1%, y1%), TPu3%, XOR
      PUT (x1%, y1%), TPuf%, OR
      PUT (x1%, y1%), TPu2%, XOR
    ELSEIF VFar% = -1 THEN
      GET (x1%, y1%)-(x2%, y2%), TPu3%
      XFa% = MColor%
      GOSUB VerarbeiteAttribute
      GET (x1%, y1%)-(x2%, y2%), TPuf%
      LINE (x1%, y1%)-(x2%, y2%), HFar%, BF
      GET (x1%, y1%)-(x2%, y2%), TPu2%
      PUT (x1%, y1%), TPu3%, XOR
      PUT (x1%, y1%), TPuf%, AND
      PUT (x1%, y1%), TPu2%, XOR
    ELSE
      LINE (x1%, y1%)-(x2%, y2%), HFar%, BF
      GET (x1%, y1%)-(x2%, y2%), TPu3%
      XFa% = VFar% XOR HFar%
      GOSUB VerarbeiteAttribute
      PUT (x1%, y1%), TPu3%, XOR
    END IF
  END IF
  ERASE TPuf%, TPu2%, TPu3%
EXIT SUB

VerarbeiteAttribute:
  SELECT CASE ScrMode%
  CASE IS < 6, 11
    LINE (x1%, y1%)-(x2%, y2%), XFa%, BF
    GET (x1%, y1%)-(x2%, y2%), TPu2%
  CASE ELSE
    COLOR XFa%
  END SELECT
  PRINT Te$;
  IF StilAttr% AND 1 THEN
    GET (x1%, y1%)-(x2% - 1, y2%), TPuf%
    PUT (x1% + 1, y1%), TPuf%, OR
  END IF
  IF StilAttr% AND 2 THEN
    xV% = 2
    h% = ZeiHoe% \ 4
    FOR i% = 0 TO ZeiHoe% - 1
      IF i% MOD h% = 1 THEN
        xV% = xV% - 1
      END IF
      j% = y1% + i%
      IF xV% > 0 THEN
        GET (x1%, j%)-(x2% - xV%, j%), TPuf%
        LINE (x1%, j%)-(x2%, j%), 0, BF
        PUT (x1% + xV%, j%), TPuf%, XOR
      ELSE
        GET (x1% - xV%, j%)-(x2%, j%), TPuf%
        LINE (x1%, j%)-(x2%, j%), 0, BF
        PUT (x1%, j%), TPuf%, XOR
      END IF
    NEXT i%
  END IF
  IF StilAttr% AND 4 THEN
    SELECT CASE ZeiHoe%
    CASE 8
      LINE (x1%, y1% + 7)-STEP(TeBr% - 1, 0), , BF
    CASE 14
      LINE (x1%, y1% + 12)-STEP(TeBr% - 1, 0), , BF
    CASE 16
      LINE (x1%, y1% + 13)-STEP(TeBr% - 1, 0), , BF
    END SELECT
  END IF
  SELECT CASE ScrMode%
  CASE IS < 6, 11
    PUT (x1%, y1%), TPu2%, AND
  END SELECT
RETURN
END SUB

SUB SetScreen (XAufl%, YAufl%, Tiefe%, XZei%, YZei%) STATIC
  ' Dieses Programm setzt den Grafikmodus anhand der vom
  ' Programmierer geforderten Eigenschaften
  SHARED ScrMode%, MColor%, ZeiBr%, ZeiHoe%, Tief%
  ScrMode% = -1
  SELECT CASE XAufl%
  CASE 320
    SELECT CASE YAufl%
    CASE 200
      SELECT CASE Tiefe%
      CASE 2
        ScrMode% = 1
      CASE 4
        ScrMode% = 7
      CASE 8
        ScrMode% = 13
      END SELECT
    END SELECT
  CASE 640
    SELECT CASE YAufl%
    CASE 200
      SELECT CASE Tiefe%
      CASE 1
        ScrMode% = 2
      CASE 4
        ScrMode% = 8
      END SELECT
    CASE 350
      SELECT CASE Tiefe%
      CASE 2
        ScrMode% = 10
      CASE 4
        ScrMode% = 9
      END SELECT
    CASE 480
      SELECT CASE Tiefe%
      CASE 1
        ScrMode% = 11
      CASE 4
        ScrMode% = 12
      END SELECT
    END SELECT
  CASE 720
    SELECT CASE YAufl%
    CASE 348
      SELECT CASE Tiefe%
      CASE 1
        ScrMode% = 3
      END SELECT
    END SELECT
  END SELECT
  IF ScrMode% = -1 THEN
    PRINT "Fehler: Grafikmodus mit gew�nschten Eigenschaften nicht vorhanden"
    ERROR 5
  ELSE
    SCREEN ScrMode%
    'WIDTH XZei%, YZei%
    ZeiBr% = XAufl% \ XZei%
    ZeiHoe% = YAufl% \ YZei%
    Tief% = Tiefe%
    MColor% = 1
    FOR i% = 1 TO Tiefe%
      MColor% = 2 * MColor%
    NEXT i%
    MColor% = MColor% - 1
  END IF
END SUB

SUB SetTAttr (VFa%, HFa%, Stil%) STATIC
  SHARED VFar%, HFar%, StilAttr%, MColor%
  ' Parameter:
  ' VFa% : Vordergrundfarbe
  ' HFa% : Hintergrundfarbe
  ' >=0 : Farbe (wird bei Bedarf abgeschnitten)
  ' -1 : transparent, d.h. die betroffenen Pixel behalten ihre Farbe
  ' Stil% : kombinierbare Attribute: Bedeutung der Bits:
  ' 0 (Wert 1) : Fett
  ' 1 (Wert 2) : Kursiv
  ' 2 (Wert 4) : Unterstrichen

  StilAttr% = -1
  SELECT CASE VFa%
  CASE -1
    VFar% = -1
  CASE IS > -1
    VFar% = VFa% AND MColor%
  CASE ELSE
    PRINT "Fehler: Unzul„ssige Vordergrundfarbe"
    ERROR 5
  END SELECT
  SELECT CASE HFa%
  CASE -1
    HFar% = -1
  CASE IS > -1
    HFar% = HFa% AND MColor%
  CASE ELSE
    PRINT "Fehler: Unzul„ssige Hintergrundfarbe"
    ERROR 5
  END SELECT
  StilAttr% = Stil%
END SUB