Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Optimisation level 3 Bug (*solved*)
#1
Hi Boriel,

I wrote the following little game (which is supposed to become a "Jewel Quest" clone one day :-):
Code:
dim a as uinteger
dim x as ubyte
dim y as ubyte
dim solv as ubyte
dim posx as uinteger
dim posy as uinteger


sub field(x as uinteger,y as uinteger,obj as ubyte)
  dim adr as uinteger
  dim adr1 as uinteger
  dim col as ubyte
  adr=22528+x*3+y*96
  adr1=50064+x+y*8
  col=56
  if obj=0 then col=2:end if
  if obj=1 then col=3:end if
  if obj=2 then col=4:end if
  if obj=3 then col=5:end if
  if obj=4 then col=6:end if
  if obj=5 then col=7:end if
  if obj=64 then col=48:end if
  if peek adr1 then col=col+8:end if
  poke adr,col:poke adr+1,col:poke adr+2,col
  poke adr+32,col:poke adr+33,col:poke adr+34,col
  poke adr+64,col:poke adr+65,col:poke adr+66,col
end sub
sub DisplayField()
  adr=50000
  for y=0 to 7
    for x=0 to 7
      a=peek(adr)
      adr=adr+1
      field(x,y,a)
    next x
  next y
end sub
sub ClearField(x as uinteger,y as uinteger)
  poke 50000+x+y*8,64
  poke 50064+x+y*8,1
end sub

function GetFieldObj(x as uinteger,y as uinteger) as ubyte
  return peek (50000+x+y*8)
end function
sub SetFieldObj(x as uinteger,y as uinteger,obj as ubyte)
  poke 50000+x+y*8,obj
end sub

function CheckBoard(x as integer,y as integer)
  solved=0
  dim current as ubyte
  dim c1 as ubyte
  dim c2 as ubyte
  current=GetFieldObj(x,y)
  c1=GetFieldObj(x-1,y)
  c2=GetFieldObj(x-2,y)
  if x>3 then
    if c1=current and c2=current and GetFieldObj(x-3,y)=current and GetFieldObj(x-4,y)=current then for a=0 to 4:ClearField(x-a,y):next a:solved=solved+1:end if
  end if
  if x>2 then
    if c1=current and c2=current and GetFieldObj(x-3,y)=current then for a=0 to 3:ClearField(x-a,y):next a:solved=solved+1:end if
  end if
  if x>1 then
    if c1=current and c2=current then for a=0 to 2:ClearField(x-a,y):solved=solved+1:next a:end if
  end if
  c1=GetFieldObj(x,y-1)
  c2=GetFieldObj(x,y-2)
  if y>3 then
    if c1=current and c2=current and GetFieldObj(x,y-3)=current and GetFieldObj(x,y-4)=current then for a=0 to 4:ClearField(x,y-a):next a:solved=solved+1:end if
  end if
  if y>2 then
    if c1=current and c2=current and GetFieldObj(x,y-3)=current then for a=0 to 3:ClearField(x,y-a):next a:solved=solved+1:end if
  end if
  if y>1 then
    if c1=current and c2=current then for a=0 to 2:ClearField(x,y-a):solved=solved+1:next a:end if
  end if
  return solved
end function
sub fieldupdate()
  for x=0 to 7
    for y=0 to 7
      if GetFieldObj(x,y)=64 then
        ypos=y
        while ypos>0
          SetFieldObj(x,ypos,GetFieldObj(x,ypos-1))
          ypos=ypos-1
        end while
        SetFieldObj(x,0,rnd*5)
      end if
    next y
  next x
end sub
function SolveField() as ubyte
  solv=0
  for y=0 to 7
    for x=0 to 7
      solv=solv+CheckBoard(x,y)
    next x
  next y
  return solv
end function
sub PutCoin(x as uinteger,y as uinteger)
  print at y,x;"\  \..\  "
  print at y+1,x;"\ :\::\: "
  print at y+2,x;"\  \''\  "
end sub

sub DisplayCursor(x as integer,y as integer,mode as byte)
  dim adr as uinteger
  dim newcol as ubyte
  adr=22528+x*3+y*96
  poke 65535,peek adr
  asm
    ld a,(65535)
    and 7
    ld (65535),a
  end asm
  if mode then
    poke 65535,(peek 65535)+56
  else
    adr1=50064+x+y*8
    if peek adr1 then
      poke 65535,peek 65535+8
    end if
  end if
  newcol=peek 65535
  poke adr,newcol
  poke adr+1,newcol
  poke adr+2,newcol
  poke adr+32,newcol
  poke adr+33,newcol
  poke adr+34,newcol
  poke adr+64,newcol
  poke adr+65,newcol
  poke adr+66,newcol
end sub






randomize

for a=0 to 63
  poke 50000+a,rnd*5
  poke 50064+a,0
next a
asm
  ld hl,50000
  ld de,50128
  ld bc,64
  ldir
end asm

paper 0:ink 7:border 0:cls
'poke 23607,127
'poke 23606,16

print at 2,0;"Controls"
print at 4,0;"1) Keyboard"
print at 5,0;"2) Sinclair Joystick"

controls1:
if inkey$="1" then
  up$="q"
  dw$="a"
  le$="o"
  ri$="p"
  fi$="m"
  goto controls2
end if
if inkey$="2" then
  up$="9"
  dw$="8"
  le$="6"
  ri$="7"
  fi$="0"
  goto controls2
end if
goto controls1
controls2:
cls



for y=0 to 7
  for x=0 to 7
    PutCoin(x*3,y*3)
  next x
next y
posx=4
posy=4

solveboard:
  solv=SolveField()
  DisplayField()
  fieldupdate()
  if solv then goto solveboard:end if
controlloop0:
DisplayCursor(posx,posy,1)
for a=0 to 5:pause 1:next a
controlloop1:

if inkey$=up$ and posy>0 then DisplayCursor(posx,posy,0):posy=posy-1:DisplayCursor(posx,posy,1):goto controlloop0:end if
if inkey$=dw$ and posy<7 then DisplayCursor(posx,posy,0):posy=posy+1:DisplayCursor(posx,posy,1):goto controlloop0:end if
if inkey$=le$ and posx>0 then DisplayCursor(posx,posy,0):posx=posx-1:DisplayCursor(posx,posy,1):goto controlloop0:end if
if inkey$=ri$ and posx<7 then DisplayCursor(posx,posy,0):posx=posx+1:DisplayCursor(posx,posy,1):goto controlloop0:end if
if inkey$=fi$ then gosub activate:end if

goto controlloop1
activate:
  asm
    ld hl,50000
    ld de,50128
    ld bc,64
    ldir
  end asm
  if inkey$=up$ and posy>0 then
    adr=50000+posx+posy*8
    a=peek adr
    b=peek (adr-8)
    poke adr,b
    poke adr-8,a
    gosub check
    return
  end if
  if inkey$=dw$ and posy<7 then
    adr=50000+posx+posy*8
    a=peek adr
    b=peek (adr+8)
    poke adr,b
    poke adr+8,a
    gosub check
    return
  end if
  if inkey$=le$ and posx>0 then
    adr=50000+posx+posy*8
    a=peek adr
    b=peek (adr-1)
    poke adr,b
    poke adr-1,a
    gosub check
    return
  end if
  if inkey$=ri$ and posx>0 then
    adr=50000+posx+posy*8
    a=peek adr
    b=peek (adr+1)
    poke adr,b
    poke adr+1,a
    gosub check
    return
  end if

  complete=0
  for a=0 to 63
    if peek(50064+a) then complete=complete+1:end if
  next a
  if complete=64 then
    goto won
  end if

goto activate
check:
  solv=SolveField()
  if solv then
    DisplayField()
    goto solveboard
  else
    asm
      ld hl,50128
      ld de,50000
      ld bc,64
      ldir
    end asm
    goto controlloop0
  end if
  return

won:
cls
print "Congratulations"

The Problem is:
It works with Optimisation Level 2, but on Optimisation level 3 it throws "Unexpected tokem IX [IX] at line 1208"
------------------------------------------------------------
http://lcd-one.da.ru redirector is dead
Visit my http://members.inode.at/838331/index.html home page!


Messages In This Thread

Forum Jump:


Users browsing this thread: 1 Guest(s)