SCREEN 1,595,185,4,2
WINDOW 1,,,0,1
FOR i%=0 TO 15
  PALETTE i%,0,0,0
NEXT i%
DIM hf$(3,3)
DIM mf&(278),ow&(278),suz&(278),a&(278),b&(278),c&(278),d&(278),e&(278),f&(278)
OPEN "DYSPEPSIA.HIGH" FOR INPUT AS #1
  FOR i%=1 TO 5
    INPUT #1,renam$(i%),repun(i%)
  NEXT i%
CLOSE #1   
LINE(0,0)-(44,22),3,b
LINE(0,0)-(43,21),4,b
LINE(1,1)-(43,21),5,bf
GET(0,0)-(44,22),ow&
LINE(22,11)-(42,11),2:LINE(22,11)-(22,20),2
GET(0,0)-(44,22),a&
LINE(1,1)-(43,21),5,bf
LINE(2,11)-(22,11),2:LINE(22,11)-(22,20),2
GET(0,0)-(44,22),b&
LINE(1,1)-(43,21),5,bf
LINE(2,11)-(22,11),2:LINE(22,11)-(22,2),2
GET(0,0)-(44,22),c&
LINE(1,1)-(43,21),5,bf
LINE(22,2)-(22,11),2:LINE(22,11)-(42,11),2
GET(0,0)-(44,22),d&
LINE(1,1)-(43,21),5,bf
LINE(22,2)-(22,20),2
GET(0,0)-(44,22),f&
LINE(0,0)-(44,22),6,b
LINE(0,0)-(43,21),7,b
LINE(1,1)-(43,21),8,bf
CIRCLE(22,11),10,0,,,.5
PAINT(22,11),0,0             
GET(0,0)-(44,22),suz&
CLS
ON TIMER(.5) GOSUB Zeit
Main:
  GOSUB Farbe
  COLOR 9
  PRINT"Time:"
  LINE(50,2)-(585,4),15,bf
  LOCATE 6,29:PRINT"D.Y.S.P.E.P.S.I.A."
  LOCATE 8,33:PRINT"written by"
  LOCATE 10,30:PRINT"Volker Stepprath" 
  COLOR 9,12
  LINE(0,149)-(64,161),13,b:LINE(1,150)-(64,161),11,b:LINE(2,150)-(63,160),12,bf
  LINE(76,149)-(138,161),13,b:LINE(77,150)-(138,161),11,b:LINE(77,150)-(137,160),12,bf
  LINE(150,149)-(201,161),13,b:LINE(151,150)-(201,161),11,b:LINE(151,150)-(200,160),12,bf
  LINE(532,149)-(585,161),13,b:LINE(533,150)-(585,161),11,b:LINE(533,150)-(584,160),12,bf
  LINE(213,149)-(519,161),13,b:LINE(214,150)-(519,161),11,b:LINE(214,150)-(518,160),12,bf
  LOCATE 20,2:PRINT"Time +"TAB(12);"FX-on"TAB(21);"C-on"TAB(69);"Exit"
  LOCATE 20,29:PRINT"Score:     0    No: 1     Bonus:1000"
  PALETTE 2,0,0,0
  WHILE MOUSE(0)=0:SLEEP:WEND
  LINE(210,36)-(380,82),0,bf
  coo=1:fxo=1
AufBau:
  lev%=lev%+1
  IF lev%=13 THEN
    PUT(116,24),e&
    LINE(138,26)-(138,44),2
    GET(116,24)-(160,48),e&
    LINE(116,24)-(160,48),0,bf
  END IF
  IF lev%=1 THEN
    PUT(116,24),ow&
    LINE(118,35)-(158,35),2
    GET(116,24)-(160,48),e&
    LINE(116,24)-(160,48),0,bf
  END IF
  LOCATE 20,48:PRINT USING"##";lev%
  LOCATE 20,61:PRINT"1000"
  a%=70:x=1:t%=0:zf2$="":lns2$="":lns$=""
  FOR i3%=1 TO 2
    FOR i%=1 TO 4
      READ zf$
      FOR i2%=1 TO 4
        zf2$=RIGHT$(LEFT$(zf$,i2%),1)
        IF x THEN hf$(i%-1,i2%-1)=zf2$
        IF x=0 THEN lns$=lns$+zf2$
        IF VAL(zf2$)>0 THEN
          ON VAL(zf2$) GOSUB Pa,Pb,Pc,Pd,Pe,Pf
        ELSE
          IF zf2$="0" THEN GOSUB Pow
          IF zf2$="S" THEN GOSUB Psuz
        END IF
      NEXT i2%
    NEXT i%
    a%=290:x=0
  NEXT i3%
  PAINT(140,35),14,8:PAINT(500,108),14,8
  GOSUB FeldOn
  FOR t%=0 TO 536
    LINE(50+t%,2)-(50+t%+2,4),10,bf
  NEXT t%
  t%=0:bon=1000
  x=0:y=0
  IF fxo THEN
    FOR i%=255 TO 0 STEP -15
      SOUND 262,2,i%,0
      SOUND 330,2,i%,1
      SOUND 392,2,i%,2
      SOUND 523,2,i%,3
    NEXT i%
  END IF
  TIMER ON
Viereck:
  IF MOUSE(0)<>0 THEN GOSUB CheckDieLage
  xm=INT((MOUSE(1)-120)/46):ym=INT((MOUSE(2)-24)/24)
  IF xm=x AND ym=y THEN Viereck
  xm=xm+(xm<0)*xm-(xm>11)*(11-xm)
  ym=ym+(ym<0)*ym-(ym>11)*(11-ym)
  IF xm>3 THEN xm=3
  IF ym>3 THEN ym=3
  IF xm=x AND ym=y THEN Viereck
  IF coo>0 THEN GOSUB Vau
  x=xm:y=ym
  IF coo>0 THEN GOSUB Von
GOTO Viereck
Von:
  IF t%<436 THEN f%=10 ELSE f%=15
  LINE(69+(x+1)*46,23+y*24)-(115+(x+1)*46,47+y*24),f%,b
  IF fxo>0 THEN SOUND 2000,1,40
RETURN
Vau:
  LINE(69+(x+1)*46,23+y*24)-(115+(x+1)*46,47+y*24),0,b
RETURN
CheckDieLage:
  IF MOUSE(2)>148 THEN Optionen
  IF hf$(x,y)="S" OR hf$(x,y)="F" THEN RETURN
  LOCATE 10,1
  IF x>0 AND x<3 AND y>0 AND y<3 THEN
    IF hf$(x-1,y)="F" THEN GOSUB Nehmen:GOTO MoveL
    IF hf$(x+1,y)="F" THEN GOSUB Nehmen:GOTO MoveR
    IF hf$(x,y-1)="F" THEN GOSUB Nehmen:GOTO MoveU
    IF hf$(x,y+1)="F" THEN GOSUB Nehmen:GOTO MoveD
  END IF
  IF x<3 THEN
    IF hf$(x+1,y)="F" THEN GOSUB Nehmen:GOTO MoveR
  END IF
  IF y<3 THEN
    IF hf$(x,y+1)="F" THEN GOSUB Nehmen:GOTO MoveD
  END IF
  IF x>0 THEN
    IF hf$(x-1,y)="F" THEN GOSUB Nehmen:GOTO MoveL
  END IF
  IF y>0 THEN
    IF hf$(x,y-1)="F" THEN GOSUB Nehmen:GOTO MoveU
  END IF
  WHILE MOUSE(0)<>0:SLEEP:WEND
  IF fxo>0  THEN
    FOR i%=100 TO 10 STEP -10
      SOUND 1046.5,.5,i%,0
    NEXT i%
  END IF
RETURN
Nehmen::
  GET(70+(x+1)*46,24+y*24)-(114+(x+1)*46,46+y*24),mf&
RETURN
MoveL:
  PUT(70+(x+1)*46,24+y*24),mf&
  PUT(70+x*46,24+y*24),mf&
  GOSUB Klack
  hf$(x-1,y)=hf$(x,y)
  hf$(x,y)="F"
  GOSUB Test
RETURN
MoveR:
  PUT(70+(x+1)*46,24+y*24),mf&
  PUT(70+(x+2)*46,24+y*24),mf&
  GOSUB Klack
  hf$(x+1,y)=hf$(x,y)
  hf$(x,y)="F"
  GOSUB Test
RETURN
MoveU:
  PUT(70+(x+1)*46,24+y*24),mf&
  PUT(70+(x+1)*46,24+(y-1)*24),mf&
  GOSUB Klack
  hf$(x,y-1)=hf$(x,y)
  hf$(x,y)="F"
  GOSUB Test
RETURN
MoveD:
  PUT(70+(x+1)*46,24+y*24),mf&
  PUT(70+(x+1)*46,24+(y+1)*24),mf&
  GOSUB Klack
  hf$(x,y+1)=hf$(x,y)
  hf$(x,y)="F"
  GOSUB Test
RETURN
Klack:
  IF fxo<1 THEN RETURN
  FOR i%=1 TO 12 STEP 4
    SOUND i%^2*12,.05,80
  NEXT i%
RETURN
Test: 
  FOR i%=0 TO 3
    FOR i2%=0 TO 3
      lns2$=lns2$+hf$(i%,i2%)
    NEXT i2%
  NEXT i%
  IF lns2$=lns$ THEN Ready
  lns2$=""
RETURN
Ready:
  TIMER OFF
  PAINT(140,35),0,8:PAINT(280,108),14,8
  WHILE t%<537
    LINE(585-t%,2)-(585-t%+2,4),15,bf
    t%=t%+2
    pun=pun+1
    LOCATE 20,35:PRINT USING"######";pun
  WEND
  bon2=INT(bon/10)
  FOR i%=bon TO 0 STEP -10
    pun=pun+lev%+bon2
    LOCATE 20,61:PRINT USING"####";bon
    LOCATE 20,35:PRINT USING"######";pun
    bon=bon-10
  NEXT i%
  GOSUB Lloeschen
  IF lev%=18 THEN AllPlayed
GOTO AufBau
Lloeschen:
  FOR i%=22 TO 120 STEP 2
    LINE(115,i%)-(303,i%),0
    LINE(336,142-i%)-(523,142-i%),0
  NEXT i%
  FOR i%=22 TO 120
    LINE(115,142-i%)-(303,142-i%),0
    LINE(336,i%)-(523,i%),0
  NEXT i%
  FOR i%=2 TO 8
    PALETTE i%,0,0,0
  NEXT i%
  PALETTE 14,0,0,0
RETURN
AllPlayed:
  COLOR 2,0
  LOCATE 6,20:PRINT"Congratulation you`ve solved every oracle."
  LOCATE 8,20:PRINT"And of course there is no dyspepsia left !"
  LINE(118,33)-(520,69),2,b
GOTO Restart2
Psuz:
  PUT(i%*46+a%,i2%*24),suz&
RETURN
Pow:
  PUT(i%*46+a%,i2%*24),ow&
RETURN
Pa:
  PUT(i%*46+a%,i2%*24),a&
RETURN
Pb:
  PUT(i%*46+a%,i2%*24),b&
RETURN
Pc:
  PUT(i%*46+a%,i2%*24),c&
RETURN
Pd:
  PUT(i%*46+a%,i2%*24),d&
RETURN
Pe:
  PUT(i%*46+a%,i2%*24),e&
RETURN
Pf:
  PUT(i%*46+a%,i2%*24),f&
RETURN
Optionen:
  IF MOUSE(2)>148 THEN
    IF MOUSE(1)<65 THEN 
      IF t%=0 OR bon<5 THEN RETURN
      IF coo>0 THEN GOSUB Vau
      TIMER OFF
      WHILE MOUSE(0)<>0
        IF MOUSE(1)<65 AND t%>=0 AND bon>4 THEN
          t%=t%-2:bon=bon-5
          LINE(585-t%,2)-(585-t%+2,4),10,bf
          LOCATE 20,61:PRINT USING"####";bon
        END IF
      WEND
      IF coo>0 THEN GOSUB Von
      TIMER ON
    END IF
    IF MOUSE(1)>75 AND MOUSE(1)<139 THEN 
      LOCATE 20,14
      IF fxo<1 THEN
        fxo=1:PRINT"-on"
      ELSE
        fxo=0:PRINT"off"
      END IF
    END IF
    IF MOUSE(1)>149 AND MOUSE(1)<204 THEN
      LOCATE 20,22
      IF coo<1 THEN
        coo=1:PRINT"-on"
        GOSUB Von
      ELSE
        coo=0:PRINT"off" 
        GOSUB Vau         
      END IF
    END IF 
    IF MOUSE(1)>531 AND MOUSE(1)<585 THEN TIMER OFF:ex=1:GOTO GoodNight
  END IF
  WHILE MOUSE(0)<>0:SLEEP:WEND
RETURN
Restart:
  TIMER OFF
  GOSUB Lloeschen
  COLOR 2,0
  LOCATE 8,35:PRINT"Time Out"
  LINE(240,50)-(368,68),2,b
Restart2:
  GOSUB AlertOn
  WHILE MOUSE(0)<>0:SLEEP:WEND
  WHILE MOUSE(0)=0:SLEEP:WEND
  GOSUB AlertOff
  LINE(100,20)-(580,69),0,bf
  GOSUB Highscore
  LOCATE 8,26:PRINT"Do you wish a new dyspepsia ?"
  LINE(164,50)-(465,68),2,b
  GOSUB AlertOn
  WHILE fr$=""
    fr$=INKEY$
    IF UCASE$(fr$)="N" THEN GoodNight 
  WEND
  GOSUB AlertOff
  fr$="":lev%=0:pun=0:RESTORE
  LINE(164,50)-(465,68),0,bf
  COLOR 9,12
  LOCATE 20,35:PRINT"     0"
GOTO AufBau  
Highscore:
  IF pun>repun(5) THEN
    newsc=1
    LOCATE 6,22:PRINT"Well done you are one of the 5 bests !"
    LOCATE 8,22:PRINT"Please enter your name : ............."
    LINE(133,33)-(504,69),2,b
    GOSUB AlertOn
    LOCATE 8,47:INPUT"",renam$(5)
    renam$(5)=LEFT$(renam$(5),12)
    repun(5)=pun
    FOR i%=1 TO 4
      FOR i2%=i% TO 5
        IF repun(i2%)>repun(i%) THEN
          SWAP renam$(i2%),renam$(i%)
          SWAP repun(i2%),repun(i%)
        END IF
      NEXT i2%
    NEXT i%
    GOSUB AlertOff
    LINE(133,33)-(595,69),0,bf
  END IF
  LINE(180,43)-(450,106),2,b
  LOCATE 6,35:PRINT" HIGHSCORE "
  FOR i%=1 TO 5
    LOCATE 7+i%,27:PRINT USING"##.";i%
    LOCATE 7+i%,31:PRINT renam$(i%)+STRING$(16-LEN(renam$(i%)),".");USING"######";repun(i%)
    n$="00000"
    IF repun(i%)>9 THEN n$="0000"
    IF repun(i%)>99 THEN n$="000"
    IF repun(i%)>999 THEN n$="00"
    IF repun(i%)>9999 THEN n$="0"
    IF repun(i%)>99999& THEN n$=""
    LOCATE 7+i%,47:PRINT n$
  NEXT i%
  FOR w!=0 TO 1 STEP .005
    PALETTE 2,w!*.33,w!*.87,0
  NEXT w!
  WHILE MOUSE(0)<>0:SLEEP:WEND
  WHILE MOUSE(0)=0:SLEEP:WEND
  FOR w!=1 TO 0 STEP -.005
    PALETTE 2,w!*.33,w!*.87,0
  NEXT w!
  LINE(180,35)-(450,106),0,bf
RETURN
FeldOn:
  FOR w!=0 TO 1 STEP .04
    PALETTE 2,w!,w!,w!
    PALETTE 3,w!*.3,w!*.3,w!*.3
    PALETTE 4,w!*.63,w!*.63,w!*.63
    PALETTE 5,w!*.4,w!*.4,w!*.4
    PALETTE 6,w!*.6,0,w!*.6
    PALETTE 7,w!*.98,w!*.3,w!*.98
    PALETTE 8,w!*.7,w!*.2,w!*.7
    PALETTE 14,w!*.7,w!*.7,w!*.03
  NEXT w!
RETURN
AlertOn:
  FOR w!=0 TO 1 STEP .005
    PALETTE 2,w!,w!*.3,w!
  NEXT w!
RETURN
AlertOff:
  FOR w!=1 TO 0 STEP -.005
    PALETTE 2,w!,w!*.3,w!
  NEXT w!
RETURN
Zeit:
  LINE(585-t%,2)-(585-t%+2,4),15,bf
  t%=t%+2
  IF t%=536 THEN Restart
RETURN
GoodNight:
  IF newsc>0 THEN
    OPEN "DYSPEPSIA.HIGH" FOR OUTPUT AS #1
      FOR i%=1 TO 5
        WRITE #1,renam$(i%),repun(i%)
      NEXT i%
    CLOSE #1
  END IF
  IF ex=1 THEN f=1 ELSE f=.3
  FOR w!=1 TO 0 STEP -.03
    PALETTE 2,w!,w!*f,w!
    PALETTE 3,w!*.3,w!*.3,w!*.3
    PALETTE 4,w!*.63,w!*.63,w!*.63
    PALETTE 5,w!*.4,w!*.4,w!*.4
    PALETTE 6,w!*.6,0,w!*.6
    PALETTE 7,w!*.98,w!*.3,w!*.98
    PALETTE 8,w!*.7,w!*.2,w!*.7
    PALETTE 9,w!,w!,w!
    PALETTE 10,w!*.5,w!,w!*.05
    PALETTE 11,0,w!*.2,w!*.7
    PALETTE 12,0,w!*.25,w!*.87
    PALETTE 13,0,w!*.48,w!
    PALETTE 13,0,w!*.48,w!
    PALETTE 14,w!*.7,w!*.7,w!*.03
    PALETTE 15,w!,w!*.1,0
  NEXT w!
  CLS:WINDOW CLOSE 1:SCREEN CLOSE 1:SYSTEM
END
Farbe:
  PALETTE 2,1,1,1
  PALETTE 9,1,1,1
  PALETTE 10,.5,1,.05
  PALETTE 11,0,.2,.7
  PALETTE 12,0,.25,.87
  PALETTE 13,0,.48,1
  PALETTE 15,1,.1,0
RETURN

DATA S00F,6000,5500,026S,S00F,5000,5000,266S
DATA S04F,0000,0220,065S,S00F,5000,2640,002S
DATA S00F,2500,0640,200S,S00F,2400,0500,026S
DATA S00F,2300,0640,126S,S00F,2400,1300,266S
DATA S00F,0202,4000,024S,S00F,2400,0240,002S
DATA S06F,2030,0246,010S,S00F,2664,0013,002S
DATA S06F,3240,0513,021S,S00F,5164,2313,002S
DATA S51F,5500,5554,232S,S14F,5550,5550,232S
DATA S14F,0314,2232,000S,S14F,2324,0013,002S
DATA S04F,6606,2663,126S,S00F,2664,1663,266S
DATA S31F,1045,3260,626S,S14F,2350,1630,266S
DATA S14F,6664,1332,622S,S14F,2324,1663,266S

DATA S00F,5004,2120,243S,S00F,2400,1540,232S
DATA S40F,2130,0425,002S,S00F,2414,0253,002S
DATA S01F,5450,3134,222S,S00F,2414,1553,232S
DATA S54F,2215,0234,500S,S14F,2554,0253,002S
DATA S53F,2541,2634,621S,S14F,2554,1323,266S
DATA S51F,5424,2535,123S,S14F,2554,1553,232S