DECLARE FUNCTION HauptMenue% ()
DECLARE SUB ToggleSound ()
DECLARE SUB Help ()
DECLARE FUNCTION FeldOk% ()
DECLARE SUB Spiel ()
DECLARE SUB Click ()
DECLARE SUB ShowField ()
DECLARE SUB MakeGraphics ()
DECLARE SUB ClearField ()
REM
REM *******************
REM * DOS QUADRAZ 1.1 *
REM *******************
REM ein Sharewarespiel von Matthias Arndt
REM (C) 1996 by ASM Software
REM V1.1
REM
REM $INCLUDE: 'qbext.inc'
IF Config.MouseVorhanden = 0 THEN
 PRINT "DOS QUADRAZ  ben”tigt eine Maus."
 PRINT "Vergewissern Sie sich bitte , daá der Maustreiber geladen ist."
 PRINT
 END
END IF
Config.MouseFlag = Config.MouseVorhanden
Config.Grafik = 1
ON ERROR GOTO fehler
SCREEN 13
DIM SHARED f(9, 9), Stein(200, 6), logo(3520), men(16200), dreh(7), zug(7)
dreh(0) = 8: zug(0) = 40
dreh(1) = 13: zug(1) = 60
dreh(2) = 18: zug(2) = 85
dreh(3) = 23: zug(3) = 105
dreh(4) = 28: zug(4) = 130
dreh(5) = 33: zug(5) = 155
dreh(6) = 38: zug(6) = 180
dreh(7) = 43: zug(7) = 210
CALL MakeGraphics
Col.Tabelle:
DATA 16, 31, 32, 47, 48, 63, 64, 79, 112, 127, 128, 143
CALL ClearField
ef = -1
DO
 CALL ShowMouse(0)
 CLS
 CALL ShowField: CALL PutVideo(204, 0, 110, 64, VARSEG(logo(0)), VARPTR(logo(0)))
 COLOR 40: LOCATE 10, 27: PRINT "(C) 1996 by"
 COLOR 41: LOCATE 11, 27: PRINT "  M. Arndt"
 COLOR 33: LOCATE 12, 27: PRINT "ASM Software"
 COLOR 15: LOCATE 14, 27: PRINT "  SHAREWARE"
 CALL ShowMouse(-1)
 CALL Click
 Auswahl = HauptMenue
 SELECT CASE Auswahl - 7
 CASE 1
  CALL Spiel
 CASE 2
  CALL Help
 CASE 3
  CALL ToggleSound
 CASE 4
  CALL Click
  CALL ShowMouse(0)
  CALL GetVideo(80, 20, 165, 165, VARSEG(men(0)), VARPTR(men(0)))
  LINE (85, 25)-STEP(150, 150), 0, BF
  LINE (85, 25)-STEP(150, 150), 47, B
  COLOR 15: LOCATE 5, 13: PRINT "   Credits"
            LOCATE 9, 13: PRINT " Matthias Arndt"
            LOCATE 13, 13: PRINT "  Lars Struá"
            LOCATE 16, 13: PRINT "      ein"
  COLOR 14: LOCATE 14, 13: PRINT "(C) by StarLogic"
  COLOR 32: LOCATE 17, 15: PRINT "AS"
  COLOR 33: LOCATE 17, 17: PRINT "M"
  COLOR 34: LOCATE 17, 19: PRINT "SO"
  COLOR 35: LOCATE 17, 21: PRINT "FT"
  COLOR 36: LOCATE 17, 23: PRINT "WA"
  COLOR 37: LOCATE 17, 25: PRINT "RE"
  COLOR 42: LOCATE 18, 13: PRINT "    Produkt"
  COLOR 59: LOCATE 20, 13: PRINT "  (C) 1996 by"
  COLOR 60: LOCATE 21, 13: PRINT " Matthias Arndt"
  COLOR 74: LOCATE 7, 13: PRINT " Programm"
            LOCATE 8, 13: PRINT "    von"
  COLOR 70: LOCATE 11, 13: PRINT " div. Routinen"
            LOCATE 12, 13: PRINT "     von"
  CALL Click
  DO
   A$ = INKEY$
   CALL MousePos(dummyx, dummyy, k, 1)
  LOOP UNTIL A$ = zEsc$ OR k <> 0
  CALL PutVideo(80, 20, 165, 165, VARSEG(men(0)), VARPTR(men(0)))
  CALL ShowMouse(-1)
 CASE 5
  CALL Click
  CALL ShowMouse(0)
  CALL GetVideo(80, 20, 165, 165, VARSEG(men(0)), VARPTR(men(0)))
  LINE (80, 20)-STEP(160, 159), 0, BF
  LINE (80, 20)-STEP(160, 159), 1, B
  COLOR 15: LOCATE 5, 12: PRINT "Bestellinformation"
  COLOR 7
  LOCATE 7, 12: PRINT "Sie k”nnen sich"
  LOCATE 8, 12: PRINT "beim Autor regis-"
  LOCATE 9, 12: PRINT "trieren lassen."
  LOCATE 10, 12: PRINT "F�r nur 10.- DM"
  LOCATE 11, 12: PRINT "erhalten Sie dann"
  LOCATE 12, 12: PRINT "die Vollversion von"
  LOCATE 13, 12: COLOR 14: PRINT "DOS QUADRAZ.": COLOR 7
  LOCATE 14, 12: PRINT "Diese hat folgende"
  LOCATE 15, 12: PRINT "Zusatzfeatures:"
  LOCATE 16, 12: PRINT " - Soundblaster-"
  LOCATE 17, 12: PRINT "   unterst�tzung"
  LOCATE 18, 12: PRINT " - Titelmusik"
  LOCATE 19, 12: PRINT " - mehr Level"
  LOCATE 20, 12: PRINT " - neuen Spielmo-"
  LOCATE 21, 12: PRINT "   dus"
  CALL Click
  DO
   A$ = INKEY$
   CALL MousePos(dummyx, dummyy, k, 1)
  LOOP UNTIL k <> 0 OR A$ = zEsc$
  LINE (80, 20)-STEP(159, 160), 0, BF
  LINE (80, 20)-STEP(159, 160), 1, B
  COLOR 15: LOCATE 5, 12: PRINT "Bestellinformation"
  COLOR 7
  LOCATE 7, 12: PRINT "Falls Sie die Voll-"
  LOCATE 8, 12: PRINT "version bestellen"
  LOCATE 9, 12: PRINT "wollen,so schreiben"
  LOCATE 10, 12: PRINT "Sie bitte an fol-"
  LOCATE 11, 12: PRINT "gende Adresse und"
  LOCATE 12, 12: PRINT "legen dem Brief die"
  LOCATE 13, 12: PRINT "Registrierungsge-"
  LOCATE 14, 12: PRINT "b�hr (als Schein)"
  COLOR 7
  LOCATE 15, 12: PRINT "von         bei."
  COLOR 14
  LOCATE 15, 16: PRINT "10.- DM": COLOR 7
  LOCATE 16, 12: PRINT "Sie erhalten dann"
  LOCATE 17, 12: PRINT "die Diskette vom"
  LOCATE 18, 12: PRINT "Format 3«'' zuge-"
  LOCATE 19, 12: PRINT "schickt."
  LOCATE 21, 12: PRINT "(Click)"
  CALL Click
  DO
   A$ = INKEY$
   CALL MousePos(dummyx, dummyy, k, 1)
  LOOP UNTIL A$ = zEsc$ OR k <> 0
  CALL PutVideo(80, 20, 165, 165, VARSEG(men(0)), VARPTR(men(0)))
  LINE (80, 20)-STEP(159, 100), 0, BF
  LINE (80, 20)-STEP(159, 100), 1, B
  COLOR 15: LOCATE 5, 12: PRINT "Bestellinformation"
  COLOR 3
  LOCATE 7, 12: PRINT "Bestellungen an:"
  COLOR 5
  LOCATE 9, 12: PRINT "Matthias Arndt"
  LOCATE 10, 12: PRINT "Im Lahbusch 2"
  LOCATE 11, 12: PRINT "28832 Achim"
  LOCATE 12, 12: PRINT "Deutschland"
  CALL Click
  DO
   A$ = INKEY$
   CALL MousePos(dummyx, dummyy, k, 1)
  LOOP UNTIL k <> 0 OR A$ = zEsc$
  CALL PutVideo(80, 20, 165, 165, VARSEG(men(0)), VARPTR(men(0)))
 END SELECT
LOOP UNTIL Auswahl - 7 = 6
CALL ShowMouse(0)
FLAG = RND * 50
FOR Scr% = 0 TO 39
 IF FLAG > 25 THEN
  CALL VGAScrollUp(0, 3, 320, 100, 3)
  CALL VGAScrollDown(0, 100, 320, 100, 3)
  LINE (0, 96)-(319, 103), 0, BF
 ELSE
  CALL VGAScrollLeft(3, 0, 160, 200, 4)
  CALL VGAScrollRight(160, 0, 160, 200, 4)
  LINE (157, 0)-(164, 200), 0, BF
 END IF
 CALL Delay(1 / 72)
NEXT Scr%
SCREEN 0: WIDTH 80: CLS
PRINT "DOS QUADRAZ 1.0   Sharewareversion  (C) 1996 by Matthias Arndt  ASM Software"
PRINT
PRINT "Vielen Dank , daf�r daá Sie DOS QUADRAZ gespielt haben!"
PRINT "Sind Sie an einer Vollversion interessiert , so lesen Sie bitte im Haupt-"
PRINT "menue den Punkt BESTELLUNGEN."
PRINT
END
fehler:
SCREEN 0: WIDTH 80: CLS
PRINT "Es ist ein Fehler aufgetreten."
PRINT "Fehlernr. "; ERR
END
                     

SUB ClearField
 FOR IDx% = 0 TO 9
  FOR IDy% = 0 TO 9
   f(IDx%, IDy%) = 0
  NEXT IDy%
 NEXT IDx%
END SUB

SUB Click
 DO
  CALL MousePos(Xdummy%, Ydummy%, Taste%, 1)
 LOOP UNTIL Taste% = 0 AND INKEY$ = ""
END SUB

FUNCTION FeldOk
 FOR IDx% = 0 TO 9
  FOR IDy% = 0 TO 9
   cnt = cnt + f(IDx%, IDy%)
  NEXT IDy%
 NEXT IDx%
 FeldOk = cnt
END FUNCTION

FUNCTION HauptMenue
 SHARED ef
 CALL ShowMouse(0)
 CALL GetVideo(80, 20, 160, 120, VARSEG(men(0)), VARPTR(men(0)))
 LINE (80, 20)-STEP(159, 117), 0, BF
 FOR cl% = 0 TO 15
  LINE (80 + cl%, 20 + cl%)-STEP(159 - cl% * 2, 115 - cl% * 2), cl% + 16, B
 NEXT cl%
 COLOR 83: LOCATE 6, 13: PRINT "Bitte ausw„hlen:"
 COLOR 54
 LOCATE 8, 14: PRINT "Spiel beginnen"
 LOCATE 9, 14: PRINT "  Anleitung"
 LOCATE 10, 14: PRINT " Soundeffekte"
 LOCATE 11, 14: PRINT "   Credits"
 COLOR 70
 LOCATE 12, 14: PRINT " Bestellungen"
 COLOR 15
 LOCATE 13, 14: PRINT "Zur�ck zum DOS"
 CALL Click
 Config.Grafik = 0
 CALL ShowMouse(1)
 DO
  A$ = INKEY$
  CALL MousePos(Dummy%, wahl, k%, 1)
  IF A$ = zEsc$ THEN wahl = 13: k% = 1
 LOOP UNTIL (wahl > 7 AND wahl < 14) AND k% <> 0
 IF ef THEN SOUND 800, 1
 CALL Click
 CALL ShowMouse(0)
 Config.Grafik = 1
 CALL PutVideo(80, 20, 160, 120, VARSEG(men(0)), VARPTR(men(0)))
 CALL ShowMouse(1)
 HauptMenue = wahl
END FUNCTION

SUB Help
  CALL Click
  CALL ShowMouse(0)
  CALL GetVideo(80, 20, 180, 180, VARSEG(men(0)), VARPTR(men(0)))
  LINE (85, 25)-STEP(170, 170), 0, BF
  LINE (85, 25)-STEP(170, 170), 117, B
  COLOR 132: LOCATE 5, 13: PRINT "Kurzanleitung"
  COLOR 30
  LOCATE 7, 12: PRINT "DOS QUADRAZ ist ein"
  LOCATE 8, 12: PRINT "intelligentes Brett-"
  LOCATE 9, 12: PRINT "spiel f�r 1 Spieler."
  LOCATE 10, 12: PRINT "Der PC dreht eine"
  LOCATE 11, 12: PRINT "Anzahl Quadrate 3*3"
  LOCATE 12, 12: PRINT "auf dem Screen um."
  LOCATE 13, 12: PRINT "Sie sollen dann in-"
  LOCATE 14, 12: PRINT "nerhalb einer be-"
  LOCATE 15, 12: PRINT "stimmten Anzahl von"
  LOCATE 16, 12: PRINT "Z�gen das Chaos"
  LOCATE 17, 12: PRINT "wieder zur�ck sor-"
  LOCATE 18, 12: PRINT "tieren. D.h. alle"
  LOCATE 19, 12: PRINT "Felder wieder in"
  LOCATE 20, 12: PRINT "graue Steine zu sor-"
  LOCATE 21, 12: PRINT "tieren. Den Dreh-"
  LOCATE 22, 12: PRINT "punkt bestimmen Sie"
  LOCATE 23, 12: PRINT "durch Mausklick."
  CALL Click
  DO
   A$ = INKEY$
   CALL MousePos(dummyx, dummyy, k, 1)
  LOOP UNTIL k <> 0 OR A$ = zEsc$
  CALL PutVideo(80, 20, 180, 180, VARSEG(men(0)), VARPTR(men(0)))
  CALL ShowMouse(-1)
END SUB

SUB MakeGraphics
 CLS
 LINE (0, 0)-(109, 63), 48, B
 LINE (1, 1)-(108, 62), 49, B
 LINE (2, 2)-(107, 61), 50, B
 LINE (3, 3)-(106, 60), 51, B
 LINE (4, 4)-(105, 59), 52, B
 LOCATE 3, 3: COLOR 69: PRINT "   DOS"
 LOCATE 5, 3: COLOR 67: PRINT " QUADRAZ"
 LOCATE 7, 3: COLOR 54: PRINT "   1.1"
 CALL GetVideo(0, 0, 110, 64, VARSEG(logo(0)), VARPTR(logo(0)))
 RESTORE Col.Tabelle
 CLS
 FOR st = 0 TO 5
  READ cid1%, cid2%
  FOR cl = cid1% TO cid2%
   zw = cl - cid1%
   LINE (zw + 3, 3)-(3, zw + 3), cl
   LINE (18 - zw, 18)-(18, 18 - zw), cl
  NEXT cl
  CALL GetVideo(0, 0, 20, 20, VARSEG(Stein(0, st)), VARPTR(Stein(0, st)))
  CLS
 NEXT st
END SUB

SUB ShowField
 FOR IDx% = 0 TO 9
  FOR IDy% = 0 TO 9
   Typ% = f(IDx%, IDy%)
   CALL PutVideo(IDx% * 20, IDy% * 20, 20, 20, VARSEG(Stein(0, Typ%)), VARPTR(Stein(0, Typ%)))
  NEXT IDy%
 NEXT IDx%
END SUB

SUB Spiel
 SHARED ef
 IF FeldOk <> 0 THEN CALL ClearField
 CALL ShowMouse(0)
 CALL GetVideo(79, 60, 165, 65, VARSEG(men(0)), VARPTR(men(0)))
 LINE (80, 60)-STEP(160, 60), 0, BF
 LINE (80, 60)-STEP(160, 60), 14, B
 COLOR 15
 LOCATE 9, 12: PRINT "Bitte w„hlen Sie"
 LOCATE 10, 12: PRINT "den Spiellevel:"
 LOCATE 11, 12: PRINT "(Nur 1 - 5!)"
 COLOR 79
 LOCATE 13, 12: PRINT " 1 2 3 4 5 6 7 8"
 CALL Click
 Config.Grafik = 0
 CALL ShowMouse(1)
 level = 0
 DO
  CALL MousePos(xm, ym, km, 1)
  xm = INT(xm / 2)
  IF km <> 0 THEN
   IF xm > 11 AND xm < 28 THEN
    IF ym = 13 THEN
     level = INT((xm - 12) / 2) + 1
    END IF
   END IF
  END IF
 LOOP UNTIL level > 0 AND level < 6
 Config.Grafik = 1
 CALL ShowMouse(0)
 CALL PutVideo(79, 60, 165, 65, VARSEG(men(0)), VARPTR(men(0)))
 COLOR 50: LOCATE 15, 28: PRINT "Spielstufe"
 COLOR 51: LOCATE 18, 28: PRINT "Verdreht:"
 COLOR 52: LOCATE 21, 28: PRINT "verbliebene"
           LOCATE 22, 28: PRINT "   Z�ge:"
 COLOR 15: LOCATE 16, 30: PRINT level
 COLOR 87: LOCATE 25, 28: PRINT "<F1> Hilfe";
 COLOR 15
 CALL PutVideo(205, 0, 110, 64, VARSEG(logo(0)), VARPTR(logo(0)))
 dreh = dreh(level - 1)
 LOCATE 19, 30: PRINT STR$(dreh)
 FOR Z = 1 TO dreh
  DO
   X = INT(RND * 10)
   Y = INT(RND * 10)
  LOOP UNTIL X > 0 AND X < 9 AND Y > 0 AND Y < 9
  FOR IDx% = X - 1 TO X + 1
   FOR IDy% = Y - 1 TO Y + 1
    f(IDx%, IDy%) = f(IDx%, IDy%) + 1
    IF f(IDx%, IDy%) > 5 THEN f(IDx%, IDy%) = 0
   NEXT IDy%
  NEXT IDx%
 NEXT Z
 CALL ShowField
 REM zuege = INT((dreh - 2) ^ 2 + (4.2 * level))
 REM IF level > 1 THEN zuege = zuege - ((level - 1) * (45 + (level - 3) * 8))
 zuege = zug(level - 1)
 DO
  COLOR 15: LOCATE 23, 30: PRINT zuege; " ";
  CALL ShowMouse(1): escFlag = 0
  DO
   CALL Click
   DO
    A$ = INKEY$
    IF A$ = zF1$ THEN CALL Help
    IF A$ = zF2$ THEN CALL ToggleSound
    IF A$ = zEsc$ THEN escFlag = 1: GOTO spabbruch
    CALL MousePos(X, Y, k, 1)
    X = INT(X / 2)
    IF X > 200 AND Y < 64 AND k = 2 THEN escFlag = 1: GOTO spabbruch
   LOOP UNTIL X < 200 AND k <> 0
   CALL Click
   xf = INT(X / 20): yf = INT(Y / 20)
  LOOP UNTIL xf > 0 AND xf < 9 AND yf > 0 AND yf < 9
  CALL ShowMouse(0)
  zuege = zuege - 1: COLOR 15: LOCATE 23, 30: PRINT zuege; " ";
  FOR IDx% = xf - 1 TO xf + 1
   FOR IDy% = yf - 1 TO yf + 1
    f(IDx%, IDy%) = f(IDx%, IDy%) + 1
    IF f(IDx%, IDy%) > 5 THEN f(IDx%, IDy%) = 0
    Typ% = f(IDx%, IDy%)
    CALL PutVideo(IDx% * 20, IDy% * 20, 20, 20, VARSEG(Stein(0, Typ%)), VARPTR(Stein(0, Typ%)))
   NEXT IDy%
  NEXT IDx%
  IF zuege > 0 AND ef <> 0 THEN SOUND 1000, 2
 LOOP UNTIL zuege = 0 OR FeldOk = 0
 LINE (80, 80)-STEP(160, 40), 0, BF
 IF FeldOk = 0 THEN
  COLOR 14
  LOCATE 12, 13: PRINT "Sie haben dieses"
  LOCATE 13, 13: PRINT "R„tsel gel”st!"
  LINE (80, 80)-STEP(160, 40), 53, B
 ELSE
  COLOR 15
  LOCATE 12, 13: PRINT "Sie haben leider"
  LOCATE 13, 13: PRINT "verloren!"
  LINE (80, 80)-STEP(160, 40), 49, B
 END IF
 CALL ShowMouse(1)
spabbruch:
 IF escFlag = 1 THEN
  LINE (20, 180)-(240, 199), 0, BF
  LINE (20, 180)-(240, 199), 77, B
  COLOR 15: LOCATE 24, 4: PRINT "Spielabbruch:(click...)";
 END IF
 CALL Click
 DO
  CALL MousePos(X, Y, k, 1)
 LOOP UNTIL k <> 0
END SUB


SUB ToggleSound
  SHARED ef
  CALL ShowMouse(0)
  CALL GetVideo(0, 90, 160, 25, VARSEG(men(0)), VARPTR(men(0)))
  ef = NOT ef
  LINE (4, 94)-STEP(140, 12), 0, BF
  LINE (4, 94)-STEP(140, 12), 97, B
  COLOR 100
  LOCATE 13, 2: PRINT "Soundeffekte ";
  IF ef THEN
   COLOR 14: PRINT "AN"
  ELSE
   COLOR 12: PRINT "AUS"
  END IF
  CALL Click
  DO
   CALL MousePos(Mx, My, mk, 1)
  LOOP UNTIL mk <> 0
  CALL PutVideo(0, 90, 160, 25, VARSEG(men(0)), VARPTR(men(0)))
  CALL ShowMouse(-1)
END SUB