' $INCLUDE: 'qb.bi'
DIM dosIntEin AS RegType, dosIntAus AS RegType

DIM we%(100), lx%(7), ly%(7)
FOR i% = 0 TO 7
  READ lx%(i%), ly%(i%)
NEXT i%
DATA 28, 20, 19, 21, 21, 22, 26, 23, 12, 24, 3, 25, 11, 25, 19, 25

RANDOMIZE TIMER
INPUT "Modus"; sc%
INPUT "Breite"; xb%
INPUT "H”he"; yb%
SCREEN sc%
WIDTH xb%, yb%
CLS

palOf% = 0
cspos% = 0
GOSUB AllgemeineDatenNachfuehren

' Maske aufbauen
IF sc% = 0 THEN
  LOCATE 1, 1
  FOR i% = 0 TO 15
    FOR j% = 0 TO 31
      COLOR j%, i%
      PRINT "A";
    NEXT j%
    PRINT
  NEXT i%
  COLOR 7, 0
ELSE
  FOR i% = 0 TO 15
    FOR j% = 0 TO 15
      LINE (8 * j%, zh% * i%)-STEP(7, zh% - 1), 16 * i% + j%, BF
    NEXT j%
  NEXT i%
END IF
LOCATE 18, 1
PRINT "Videomodus: *** Gr”sse:"
PRINT "aktuelle Bildschirmseite:"
PRINT "Fonth”he: *** Rahmenfarbe:"
PRINT "Farbauswahlmodus:"
PRINT "DAC-Registergruppe:"
PRINT "DAC-Mask-Register (PEL):"
PRINT "DAC-Farbe: >***<";
LOCATE 25, 1
PRINT "R:>***< G:>***< B:>***<";

GOSUB AllgemeineDatenNachfuehren
GOSUB PaletteNachfuehren
GOSUB DACPaletteNachfuehren
GOSUB Ausgeben

DO
  DO
    t$ = INKEY$
  LOOP WHILE t$ = ""
  SELECT CASE t$
  CASE CHR$(0) + "H"
    palOf% = palOf% - 1 AND 255
    GOSUB PaletteNachfuehren
  CASE CHR$(0) + "P"
    palOf% = palOf% + 1 AND 255
    GOSUB PaletteNachfuehren
  CASE CHR$(0) + "I"
    palOf% = palOf% - yb% AND 255
    GOSUB PaletteNachfuehren
  CASE CHR$(0) + "Q"
    palOf% = palOf% + yb% AND 255
    GOSUB PaletteNachfuehren
  CASE CHR$(0) + "G"
    palOf% = 0
    GOSUB PaletteNachfuehren
  CASE CHR$(0) + "O"
    palOf% = 256 - yb%
    GOSUB PaletteNachfuehren
  CASE CHR$(9)
    cspos% = (cspos% + 1) MOD (8 + yb%)
  CASE CHR$(0) + CHR$(15)
    cspos% = (cspos% + 7 + yb%) MOD (8 + yb%)
  CASE CHR$(0) + ";" TO CHR$(0) + "B"
    h% = 1
    FOR i% = ASC(RIGHT$(t$, 1)) TO 65
      h% = 2 * h%
    NEXT i%
    we%(cspos%) = we%(cspos%) XOR h%  ' Bit ver„ndern
    GOSUB WertSetzen
  CASE CHR$(0) + "K"
    we%(cspos%) = we%(cspos%) - 1 AND 255
    GOSUB WertSetzen
  CASE CHR$(0) + "M"
    we%(cspos%) = we%(cspos%) + 1 AND 255
    GOSUB WertSetzen
  CASE "b", "B"
    dosIntEin.ax = &H1003
    dosIntEin.bx = -(t$ = "B")
    CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
    GOSUB AllgemeineDatenNachfuehren
    GOSUB PaletteNachfuehren
  CASE "R", "S"
    FOR i% = 0 TO 255
      dosIntEin.ax = &H1010
      dosIntEin.bx = i%
      IF t$ = "S" THEN
	r% = 63 - 9 * (i% AND 7)
	g% = 9 * (i% \ 8 AND 7)
	b% = 63 - 21 * (i% \ 64)
      ELSE
	r% = CINT(INT(256! * RND))
	g% = CINT(INT(256! * RND))
	b% = CINT(INT(256! * RND))
      END IF
      dosIntEin.cx = CVI(CHR$(b%) + CHR$(g%))
      dosIntEin.dx = CVI(" " + CHR$(r%))
      CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
    NEXT i%
    GOSUB DACPaletteNachfuehren
  CASE "r", "s"
    FOR i% = 0 TO 15
      IF t$ = "s" THEN
	fw% = i%
      ELSE
	fw% = CINT(INT(256! * RND))
      END IF
      dosIntEin.ax = &H1000
      dosIntEin.bx = CVI(CHR$(i%) + CHR$(fw%))
      CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
    NEXT i%
    IF t$ = "s" THEN
      fw% = 16
    ELSE
      fw% = CINT(INT(256! * RND))
    END IF
    dosIntEin.ax = &H1001
    dosIntEin.bx = CVI(" " + CHR$(fw%))
    CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
    GOSUB AllgemeineDatenNachfuehren
    GOSUB PaletteNachfuehren
  END SELECT
  GOSUB Ausgeben
LOOP UNTIL t$ = CHR$(27)
SCREEN 1
SCREEN 0
WIDTH 80, 25
CLS
END

AllgemeineDatenNachfuehren:
dosIntEin.ax = &HF00  ' AH=0Fh, d.h. Auslesen Videomodus
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
vmod% = dosIntAus.ax AND 255
xb% = ASC(RIGHT$(MKI$(dosIntAus.ax), 1))
bs% = ASC(RIGHT$(MKI$(dosIntAus.bx), 1))
dosIntEin.ax = &H1130
dosIntEin.bx = &H0
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
yb% = (dosIntAus.dx AND 255) + 1
zh% = dosIntAus.cx
dosIntEin.ax = &H1008
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
we%(0) = ASC(RIGHT$(MKI$(dosIntAus.bx), 1))
dosIntEin.ax = &H101A
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
we%(1) = dosIntAus.bx AND 255
we%(2) = ASC(RIGHT$(MKI$(dosIntAus.bx), 1))
dosIntEin.ax = &H1019
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
we%(3) = dosIntAus.bx AND 255
LOCATE 18, 13
PRINT USING "###"; vmod%;
LOCATE , 25
PRINT USING "###x###"; xb%; yb%
LOCATE 19, 27
PRINT USING "###"; bs%
LOCATE 20, 11
PRINT USING "###"; zh%
RETURN

PaletteNachfuehren:
FOR i% = 0 TO yb% - 1
  pp% = palOf% + i% AND 255
  dosIntEin.ax = &H1007
  dosIntEin.bx = pp%
  CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
  we%(8 + i%) = ASC(RIGHT$(MKI$(dosIntAus.bx), 1))
  LOCATE 1 + i%, 33
  PRINT USING "###:"; pp%;
NEXT i%
RETURN

DACPaletteNachfuehren:
dosIntEin.ax = &H1015
dosIntEin.bx = we%(4)
CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
we%(5) = ASC(RIGHT$(MKI$(dosIntAus.dx), 1))
we%(6) = ASC(RIGHT$(MKI$(dosIntAus.cx), 1))
we%(7) = dosIntAus.cx AND 255
RETURN

Ausgeben:
FOR i% = 0 TO 7 + yb%
  IF i% < 8 THEN
    LOCATE ly%(i%), lx%(i%)
    PRINT CHR$(32 - (i% = cspos%) * 30);
    PRINT USING "###"; we%(i%);
    PRINT CHR$(32 - (i% = cspos%) * 28);
  ELSE
    LOCATE i% - 7, 36
    PRINT CHR$(58 - (i% = cspos%) * 4);
    PRINT USING "###"; we%(i%);
  END IF
NEXT i%
RETURN

WertSetzen:
SELECT CASE cspos%
CASE 0
  dosIntEin.ax = &H1001
  dosIntEin.bx = CVI(" " + CHR$(we%(0)))
CASE 1
  dosIntEin.ax = &H1013
  dosIntEin.bx = CVI(CHR$(0) + CHR$(we%(1)))
CASE 2
  dosIntEin.ax = &H1013
  dosIntEin.bx = CVI(CHR$(1) + CHR$(we%(2)))
CASE 3
  dosIntEin.ax = &H1018
  dosIntEin.bx = we%(3)
CASE 4
  ' Nichts tun, da dies nur interne Wahl des DAC-Registers ist
CASE 5 TO 7
  dosIntEin.ax = &H1010
  dosIntEin.bx = we%(4)
  dosIntEin.cx = CVI(CHR$(we%(7)) + CHR$(we%(6)))
  dosIntEin.dx = CVI(" " + CHR$(we%(5)))
CASE ELSE
  dosIntEin.ax = &H1000
  dosIntEin.bx = CVI(CHR$(cspos% - 8 + palOf% AND 255) + CHR$(we%(cspos%)))
END SELECT
IF cspos% <> 4 THEN
  CALL INTERRUPT(&H10, dosIntEin, dosIntAus)
END IF
GOSUB DACPaletteNachfuehren
GOSUB AllgemeineDatenNachfuehren
GOSUB PaletteNachfuehren
RETURN