'---------------------------------------------
' Kleines Ritterspiel fuer Johann
'---------------------------------------------

' Oma-Tutorial
' Teil 3, Exkurs
'
' for Freebasic Compiler FBC 0.17
'
' Needs bmp-files and wav-files for running

' Works roughly.

' Christof Schatz
' 08.02.2007


#include "fbgfx.bi"
#include "fmod.bi"

option explicit

dim a as string
dim ret as integer

const NULL=0
const FALSE=0
const TRUE=-1
const NAN=-99999
const xscreensize=320
const yscreensize=240
const figxsize=23
const figysize=19
const Cnsprite1=26
const Cright=0
const Cleft=1
const Cup=2
const Cdown=3
const Cstepsize=2
const Cstepsize_comp=8
const Cweapmaxdistance=70
const Cspritedelay=50
const Ccrossstep=3
const Cattackinterval=3
const Cenemypower=1.0
const Chealthinit=0
const Cmindist=40
const Cninitknight=20

const Cintrolab=52
const Cintroscr=53

dim shared activepage as integer=0
dim shared as any ptr sprites(Cnsprite1),img_cross,img_bullet,introlab,introscr
dim shared as integer dead0
dim shared as integer proceed
dim shared as integer block_keyevent
dim shared as integer nallknights
dim shared as integer allknightid
dim shared as integer current_enemy
dim shared as integer current_pass
dim shared as integer space_pressed
dim shared as integer debug1
dim shared AS FSOUND_SAMPLE ptr sword,animal,gun,explode,intro1,intro2


'-----------------------------------------------------

TYPE tsprite
  img(10) AS ANY PTR
  nimg as integer
  bg AS ANY PTR
  x AS INTEGER
  y AS INTEGER
  delay as integer
  xsize AS INTEGER
  ysize AS INTEGER
  x1bg as integer
  y1bg as integer
  x2bg as integer
  y2bg as integer
  name0 AS STRING*80
  bgsaved as integer
  parent as any ptr
END TYPE

'-----------------------------------------------------

TYPE tknight
  sprite as tsprite
  leftsprite as tsprite
  rightsprite as tsprite
  leftweapsprite as tsprite
  rightweapsprite as tsprite
  rightkackersprite as tsprite
  leftkackersprite as tsprite
  player as integer
  dir as integer
  weapon as integer
  cross as tsprite
  crosson as integer
  visible as integer
  health as integer
  lastattack as integer
  id as integer
END TYPE

'-----------------------------------------------------

'List with pointers to all knights in the system
dim shared as tknight ptr allknights(100)


'-----------------------------------------------------

FUNCTION min(i AS INTEGER, j AS INTEGER) AS INTEGER
  IF (i<j) THEN min=i ELSE min=j
END FUNCTION

'-----------------------------------------------------

FUNCTION max(i AS INTEGER, j AS INTEGER) AS INTEGER
  IF (i>j) THEN max=i ELSE max=j
END FUNCTION

'-----------------------------------------------------

FUNCTION dmin(i AS DOUBLE, j AS DOUBLE) AS DOUBLE
  IF (i<j) THEN dmin=i ELSE dmin=j
END FUNCTION

'-----------------------------------------------------

FUNCTION dmax(i AS DOUBLE, j AS DOUBLE) AS DOUBLE
  IF (i>j) THEN dmax=i ELSE dmax=j
END FUNCTION

'-----------------------------------------------------

DECLARE SUB keyevent
DECLARE FUNCTION colldetect(s as tsprite, k as tsprite, xnew as integer, ynew as integer) as integer
DECLARE SUB tsprite_report(s as tsprite)


'-----------------------------------------------------

FUNCTION gettime() as integer

  'Returns current system time in numbers of seconds since 01/01/2000.
  '1. Januar 2000 aus.

  dim as integer ye,mo,day,h,min1,sec,date1,dayyear,i,sum,time1,retval,monthday

  ye=val(right$(date$,4))
  mo=val(left$(date$,2))
  day=val(mid$(date$,4,2))
  sum=0
  for i=2000 to ye-1
    dayyear=365
    if ((i mod 4 = 0) and (i mod 100 <> 0)) then dayyear=366
    sum+=dayyear
  next i
  date1=sum

  dayyear=365
  if ((i mod 4 = 0) and (i mod 100 <> 0)) then dayyear=366

  sum=0
  for i=1 to mo-1
    monthday=31
    if (mo = 4 or mo=6 or mo=9 or mo=11) then monthday=30
    if (mo = 2) then
      if (dayyear=365) then monthday=28 else monthday=29
    end if
    sum+=monthday
  next i
  date1+=sum

  date1+=day

  h=val(left$(time$,2))
  min1=val(mid$(time$,4,2))
  sec=val(right$(time$,2))

  time1=h*3600+min1*60+sec

  retval=date1*3600*24+time1

  gettime=retval

END FUNCTION


'-----------------------------------------------------

SUB flipscreen

  'Switch active page to visible page
  activepage=1-activepage
  SCREENSET activepage,1-activepage

  'Update the currently visible and outdated page
  SCREENCOPY 1-activepage,activepage

  'All new actions affect activepage
END SUB



'-----------------------------------------------------

SUB logd(s as string, x as double)

  open "log.txt" for append as #9
  ? #9,s;":";x
  close #9

END SUB

'-----------------------------------------------------

SUB logdi(s as string, x as integer)

  open "log.txt" for append as #9
  ? #9,s;":";x
  close #9

END SUB


'-------------------------------------------------------

SUB soundload

  IF FSOUND_GetVersion <= FMOD_VERSION THEN
    print "FMOD version " + STR$(FMOD_VERSION) + " or greater required"
    sleep
    end
  End If

  If FSOUND_Init(44100, 32, 0) = FALSE Then
    print "Can't initialize FMOD"
    sleep
    end
  End If

  sword = FSOUND_Sample_Load(FSOUND_FREE,"sword2.wav", FSOUND_STEREO, 0, 0)
  if (sword=NULL) then
    ? "sword2.wav not found"
    sleep
    end
  end if
  gun = FSOUND_Sample_Load(FSOUND_FREE,"gun2.wav", FSOUND_STEREO, 0, 0)
  if (gun=NULL) then
    ? "gun2.wav not found"
    sleep
    end
  end if
  animal = FSOUND_Sample_Load(FSOUND_FREE,"animals8.wav", FSOUND_STEREO, 0, 0)
  if (animal=NULL) then
    ? "animals7.wav not found"
    sleep
    end
  end if
  explode=FSOUND_Sample_Load(FSOUND_FREE,"explos.wav", FSOUND_STEREO, 0, 0)
  if (explode=NULL) then
    ? "explos.wav not found"
    sleep
    end
  end if
  intro1=FSOUND_Sample_Load(FSOUND_FREE,"intro1.wav", FSOUND_STEREO, 0, 0)
  if (intro1=NULL) then
    ? "intro1.wav not found"
    sleep
    end
  end if
  intro2=FSOUND_Sample_Load(FSOUND_FREE,"intro2.wav", FSOUND_STEREO, 0, 0)
  if (intro2=NULL) then
    ? "intro2.wav not found"
    sleep
    end
  end if


END SUB




'-----------------------------------------------------

SUB global_init()

  nallknights=0
  allknightid=0

END SUB


'-----------------------------------------------------

SUB round_init()

  dead0=0
  block_keyevent=0
  current_enemy=-1
  current_pass=-1
  space_pressed=0
  proceed=1

END SUB



'-----------------------------------------------------

SUB loadsprites_frombmp(buf() as uinteger, n0 as integer, fname as string)

  'buf(): Buffer Array for the 3byte pixel colors of n0 sprites: n0 x 25 x 25
  'fname is the name of a bmp-file, containing the sprites one below the other, seperated by a 1-pixel yellow line.

  dim img1 as any ptr

  dim as uinteger ix,iy,iy2,col,colblack,isprite,h
  dim as integer found

  screen 18,24
  img1=imagecreate(25,450)
  found=open (fname for input as #1)
  close #1
  if (found=2) then
    ? "Sprite file not found"
    ? "Name: ";fname
    sleep
    end
  end if
  bload fname,img1
  put (1,1),img1,PSET
  iy2=0
  for iy=1 to n0*20
    isprite=int((iy-1)/20)
    if iy2=20 then iy2=0
    'Gelbe Linie auslassen
    if (iy2>0) then
      for ix=1 to 23
        col=point(ix,iy)
        if (iy=2 and ix=1) then colblack=col
        h=0
        if (col=colblack) then
          col=RGB(&hFF,0,&hFF)
          h=1
        end if
        buf(isprite,ix-1,iy2-1)=col
        'if (ix<10) then
        '  locate 5+ix,1
        '  ? isprite;" ";ix-1;" ";iy2-1;" ";buf(isprite,ix-1,iy2-1),h,col
        '  sleep
        'end if
      next ix
    end if
    iy2+=1
  next iy


END SUB



'-----------------------------------------------------

SUB loadsprites

  dim img1 as any ptr

  dim as uinteger ix,iy,iy2,col,colblack,isprite,h
  dim as uinteger buf1(20,25,25)
  dim as uinteger buf2(6,25,25)
  dim as integer found

  loadsprites_frombmp(buf1(),20,"sprite.bmp")
  loadsprites_frombmp(buf2(),6,"sprite3.bmp")

  screenres xscreensize,yscreensize,24,2,1

  for isprite=0 to Cnsprite1-1
    for ix=0 to 22
      for iy=0 to 18
        '? isprite,ix,iy,buf(isprite,ix,iy),RGB(&hFF,0,&hFF)
        if (isprite<=19) then
          pset (ix,iy),buf1(isprite,ix,iy)
        else
          pset (ix,iy),buf2(isprite-20,ix,iy)
        end if
        'sleep
      next iy
    next ix
    sprites(isprite)=imagecreate(23,19)
    if sprites(isprite)=NULL then
       ? "sprite allocation failed"
       sleep
       end
    end if
    GET (0,0)-(22,18),sprites(isprite)
  next isprite

  cls
  img_cross=imagecreate(11,11)
  line (0,0)-(10,10),RGB(255,0,255),BF
  line (0,5)-(10,5),RGB(255,255,255)
  line (5,0)-(5,10),RGB(255,255,255)
  GET (0,0)-(10,10),img_cross
  img_bullet=imagecreate(4,4)
  line (30,30)-(33,33),RGB(255,255,255),BF
  GET (30,30)-(33,33),img_bullet

  cls

  'Intro Label
  introlab=imagecreate(220,70)
  if (introlab=NULL) then
    ? "introlabel image allocation failed"
    sleep
    end
  end if
  found=open ("introlabel.bmp" for input as #1)
  close #1
  if (found=2) then
    ? "Sprite introlabel not found"
    sleep
    end
  end if
  bload "introlabel.bmp",introlab

  'Intro BMP
  introscr=imagecreate(240,170)
  if (introscr=NULL) then
    ? "intro image allocation failed"
    sleep
    end
  end if
  found=open ("intro.bmp" for input as #1)
  close #1
  if (found=2) then
    ? "Sprite intro.bmp not found"
    sleep
    end
  end if
  bload "intro.bmp",introscr


END SUB

'-----------------------------------------------------

SUB closesprites

  dim as uinteger ix,iy,iy2,col,colblack,isprite,h
  dim as uinteger buf(20,23,20)

  for isprite=0 to Cnsprite1-1
    imagedestroy(sprites(isprite))
  next isprite
  imagedestroy(img_cross)
  imagedestroy(img_bullet)
  imagedestroy(introlab)
  imagedestroy(introscr)

END SUB


'-----------------------------------------------------

SUB initsprite(sprite as tsprite)
  dim i as integer
  for i=0 to 9:sprite.img(i)=NULL:next i
  sprite.bg=0
  'Coords should be NAN except the sprite is used and valid.
  sprite.x=NAN:sprite.y=NAN
  sprite.xsize=0:sprite.ysize=0
  sprite.x1bg=NAN:sprite.x2bg=NAN:sprite.y1bg=NAN:sprite.y2BG=NAN
  sprite.bgsaved=NAN
  sprite.name0=""
  sprite.parent=NULL
  sprite.delay=Cspritedelay
END SUB


'-----------------------------------------------------
SUB loadsprite(byref sprite as tsprite, n as integer, i1 as integer, i2 as integer=-1, i3 as integer=-1)

  CONST pos_xsize=23
  CONST pos_ysize=19

  if (n<=0 or n>3) then
    ? "loadsprite() n out of range"
    end
    sleep
  end if

  'Read essential data into the allocated memory area.
  '%%1
  if (i1<Cnsprite1) then
    sprite.img(0) = sprites(i1)
    if (n>=2) then sprite.img(1) = sprites(i2)
    if (n>=3) then sprite.img(2) = sprites(i3)
    if (n<3) then sprite.img(2) = NULL
    if (n<2) then sprite.img(1) = NULL
    sprite.nimg=n
    sprite.xsize=figxsize
    sprite.ysize=figysize
    sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
    sprite.name0=""
    if (i3=5 or i3=11) then sprite.delay=15*Cspritedelay
    if (i1>=20) then sprite.delay=10*Cspritedelay
    'tsprite_report(sprite)
    'if (sprite.nimg=3) then
    '  logd("i1",i1*1.0)
    '  logd("i2",i2*1.0)
    '  logd("i3",i3*1.0)
    '  sleep
    'end if
  else
    if (i1=50) then
      sprite.img(0) = img_cross
      sprite.nimg=1
      sprite.xsize=11
      sprite.ysize=11
      sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
      sprite.name0="cross"
      sprite.delay=0
    elseif (i1=51) then
      sprite.img(0) = img_bullet
      sprite.nimg=1
      sprite.xsize=4
      sprite.ysize=4
      sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
      sprite.name0="bullet"
      sprite.delay=0
    elseif (i1=52) then
      sprite.img(0) = introlab
      sprite.nimg=1
      sprite.xsize=200
      sprite.ysize=51
      sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
      sprite.name0="introlab"
      sprite.delay=20
    elseif (i1=53) then
      sprite.img(0) = introscr
      sprite.nimg=1
      sprite.xsize=240
      sprite.ysize=162
      sprite.bg = IMAGECREATE(sprite.xsize+10, sprite.ysize+10)
      sprite.name0="introscr"
    end if
  end if

END SUB


'-----------------------------------------------------

SUB savegetbg(sprite as tsprite)

  'Save background such as the sprite may disappear partially at the screen border.
  'That means: Display only that clip region of the sprite, which is interior.

  dim x1 as integer,y1 as integer,x2 as integer,y2 as integer
  dim visible as integer

  'Stelle zunaechst den Ausschnitt des Sprites fest, der sich innerhalb
  'des Bildschirms befindet.
  x1=min(max(sprite.x,0),xscreensize-1)
  y1=min(max(sprite.y,0),yscreensize-1)
  x2=min(max(sprite.x+sprite.xsize-1,0),xscreensize-1)
  y2=min(max(sprite.y+sprite.ysize-1,0),yscreensize-1)

  '? sprite.x,sprite.xsize
  '? x1,y1,x2,y2
  'sleep

  'Befindet sich das Sprite komplett ausserhalb des Screens?
  visible=(sprite.x+sprite.xsize-1>=0 and sprite.y+sprite.ysize-1>=0)
  visible=visible and (sprite.x<=xscreensize-1) and (sprite.y<=yscreensize-1)

  'Speichere nun ab
  if (not visible) then
    sprite.bgsaved=0 'Zeigt an, ob ein Hintergrund gespeichert ist
  else
    get (x1,y1)-(x2,y2),sprite.bg
    sprite.bgsaved=1
  end if

  sprite.x1bg=x1:sprite.x2BG=x2:sprite.y1bg=y1:sprite.y2bg=y2

END SUB

'-----------------------------------------------------

SUB movesprite(sprite as tsprite, xnew AS INTEGER, ynew AS INTEGER)

  'Moves sprite to the position xnew/ynew.
  'xnew and ynew may be corrected in case, that the sprite doesn't fit to the screen in its whole.

  dim i as integer
  dim as integer wh
  dim as tknight ptr pk

  'logd("movesprite",0.0)

  'Sprite at the old position?
  IF (sprite.x<>NAN) THEN
    'Background saved, which refers to the old position?
    IF (sprite.bg>0 and sprite.bgsaved=1) THEN
      'Restore background
      PUT (sprite.x1bg,sprite.y1bg),sprite.bg,PSET
    ELSE
      'Sprite completly out of screen.
    END IF
  END IF

  'Save background
  sprite.x=xnew:sprite.y=ynew
  savegetbg(sprite)

  'logd("sprite.delay",sprite.delay*1.0)

  'Sprite to the new position
  for i=0 to sprite.nimg-1
    PUT (sprite.x,sprite.y),sprite.img(i),TRANS
    sleep sprite.delay,1
    if (i=0 and inkey$<>"" and block_keyevent=0 and sprite.name0<>"bullet") then keyevent()
    'Poor player was killed during keyevent():
    if proceed=0 then exit for
    'Poor knight was killed during keyevent():
    if (sprite.parent<>NULL) then
      pk=sprite.parent
      if (pk->visible=0) then
        'logd("Catched",0.0)
        exit for
      end if
    end if
    'Otherwise proceed our animation with the background:
    if (i<=sprite.nimg-2) then
      PUT (sprite.x1bg,sprite.y1bg),sprite.bg,PSET
    end if
    'We ommitted the general spritedelay for its minimum size is too long for the fast bullet.
    'Do it the dump way. (May be slower on slow computers, but that doesn't hurt).
    if (sprite.name0="bullet") then
      for wh=0 TO 1000000:next wh
    end if
  next i

  'if (debug1=1) then
    '%%6
    'logd("%%6",0.0)
  'end if


END SUB


'-----------------------------------------------------

SUB showsprite(sprite as tsprite, xnew AS INTEGER, ynew AS INTEGER)

  'Moves sprite to the position xnew/ynew.
  'xnew and ynew may be corrected in case, that the sprite doesn't fit to the screen in its whole.

  dim i as integer

  'Sprite at the old position?
  IF (sprite.x<>NAN) THEN
    'Background saved, which refers to the old position?
    IF (sprite.bg>0 and sprite.bgsaved=1) THEN
      'Restore background
      PUT (sprite.x1bg,sprite.y1bg),sprite.bg,PSET
    ELSE
      'Sprite befindet sich komplett ausserhalb des Screens
    END IF
  END IF

  'Save background
  sprite.x=xnew:sprite.y=ynew
  savegetbg(sprite)

  'Sprite to the new position
  PUT (sprite.x,sprite.y),sprite.img(sprite.nimg-1),TRANS

END SUB

'-----------------------------------------------------

SUB closesprite(sprite as tsprite)
  '%%1
  imagedestroy(sprite.bg)
END SUB

'-----------------------------------------------------

SUB sprite_copy1(byref dest as tsprite, byref src as tsprite)

  'Copy only images from source sprite to destination sprite

  Dim i as integer

  dest.nimg=src.nimg
  FOR i=0 to src.nimg-1
    dest.img(i)=src.img(i)
  next i
  dest.delay=src.delay
END SUB


'-----------------------------------------------------

SUB deletesprite(sprite as tsprite)

  'logd("deletesprite"+sprite.name0,0.0)
  'logd("sprite.x",sprite.x*1.0)
  'logd("sprite.y",sprite.y*1.0)
  'logd("sprite.x1bg",sprite.x1bg*1.0)
  'logd("sprite.y1bg",sprite.y1bg*1.0)
  'logd("sprite.x2bg",sprite.x2bg*1.0)
  'logd("sprite.y2bg",sprite.y2bg*1.0)
  'if (sprite.name0="k0") then
    'line (sprite.x,sprite.y)-(sprite.x+30,sprite.y+30),10000000,BF
    'logd("linebf",0.0)
  'else
  PUT (sprite.x,sprite.y),sprite.bg,PSET
  'end if
  'BSAVE "a.bmp",sprite.bg,2000

END SUB


'-----------------------------------------------------

SUB tsprite_report(s as tsprite)

  dim as integer i,a

  with s
    logd("name0 "+str(.name0),0.0)
    logd("nimg ",.nimg*1.0)
    for i=0 to .nimg-1
      a=.img(i)
      logd("img("+str(i)+")",a*1.0)
    next i
    logd("x",.x*1.0)
    logd("y",.y*1.0)
    logd("xsize",.xsize*1.0)
    logd("ysize",.ysize*1.0)
  end with

END SUB



'-----------------------------------------------------

SUB tknight_report(k as tknight)

  with k
    logd(".sprite.name0: "+str(.sprite.name0),0.0)
    logd("player",.player*1.0)
    logd("dir: ",.dir*1.0)
    logd("weapon: ",.weapon*1.0)
    logd("crosson: ",.crosson*1.0)
    logd("visible: ",.visible*1.0)
    logd("health: ",.health*1.0)
    logd("lastattack: ",.lastattack*1.0)
    logd("id: ",.id*1.0)
  end with

END SUB


'-----------------------------------------------------

SUB tknight_init(byref k as tknight, player as integer, x0 as integer, y0 as integer, dir0 as integer)

  with k
    .player=player
    if (.player=0) then
      initsprite(.leftsprite)
      loadsprite(.leftsprite,2,1,0)
      initsprite(.leftweapsprite)
      loadsprite(.leftweapsprite,2,3,2)
      initsprite(.rightsprite)
      loadsprite(.rightsprite,2,7,6)
      initsprite(.rightweapsprite)
      loadsprite(.rightweapsprite,2,9,8)
      initsprite(.rightkackersprite)
      loadsprite(.rightkackersprite,3,23,24,25)
      initsprite(.leftkackersprite)
      loadsprite(.leftkackersprite,3,20,21,22)
    else
      initsprite(.leftsprite)
      loadsprite(.leftsprite,2,16,18)
      initsprite(.leftweapsprite)
      loadsprite(.leftweapsprite,2,17,19)
      initsprite(.rightsprite)
      loadsprite(.rightsprite,2,12,14)
      initsprite(.rightweapsprite)
      loadsprite(.rightweapsprite,2,13,15)
    end if

    initsprite(.sprite)
    .sprite.parent=VARPTR(k)
    'Dummy Load for initializing .sprite elements:
    loadsprite(.sprite,2,1,0)
    if (dir0=Cright) then sprite_copy1(.sprite,.rightsprite) else sprite_copy1(.sprite,.leftsprite)
    showsprite(.sprite,x0,y0)
    .dir=dir0
    .weapon=0
    .id=allknightid
    .health=Chealthinit
    .lastattack=-1
    .visible=1
    allknightid+=1
  end with

END SUB



'-----------------------------------------------------

SUB tknight_init2(k as tknight, player as integer, dir0 as integer)

  'Like tknight_init(), but chooses initial positions (x,y) randomly such as that
  'the new knight doesn't overlap with any older

  dim as integer foundpos=0,i,j,freeway,x,y

  'logd("nallknights",nallknights*1.0)
  'logd("-----------------------------------------",0.0)

  while foundpos=0
    x=int(250+rnd*70)
    y=int(rnd*200)

    'Manually pre initialization, because colldetect() needs this, but
    'the sprite is initialized later in tknight_init()
    k.sprite.xsize=figxsize
    k.sprite.ysize=figysize

    freeway=1
    for i=0 to nallknights-1
      if (allknights(i)->id<>k.id) then
        'logd(str(i)+" colldetect",colldetect(allknights(i)->sprite,k.sprite,x,y)*1.0)
        if (colldetect(k.sprite,allknights(i)->sprite,x,y)=1) then freeway=0
        'logd(str(i)+" freeway",freeway*1.0)
       end if
    next i
    if (freeway=1) then
      foundpos=1
      tknight_init(k,player,x,y,dir0)
    end if
  wend

END SUB


'-----------------------------------------------------

SUB tknight_close(k as tknight)

  with k
    closesprite(.leftsprite)
    closesprite(.rightsprite)
    closesprite(.sprite)
  end with

END SUB

'-----------------------------------------------------

SUB tknight_move(k as tknight, dir1 as integer)

  dim as integer dx,dy,stepsize

  with k
    if (.visible=1) then
      if (dir1<>.dir) then
        if (.weapon=0) then
          if (dir1=Cleft) then sprite_copy1(.sprite,.leftsprite)
          if (dir1=Cright) then sprite_copy1(.sprite,.rightsprite)
        else
          if (dir1=Cleft) then sprite_copy1(.sprite,.leftweapsprite)
          if (dir1=Cright) then sprite_copy1(.sprite,.rightweapsprite)
        end if
      end if
      if (dir1=Cleft or dir1=Cright) then .dir=dir1
      if (.player=0) then stepsize=Cstepsize else stepsize=Cstepsize_comp
      with .sprite
        if (dir1=Cleft and .x>.xsize) then .x-=stepsize
        if (dir1=Cright and (.x+.xsize)<xscreensize) then .x+=stepsize
        if (dir1=Cup and .y>.ysize) then .y-=stepsize
        if (dir1=Cdown and (.y+.ysize)<yscreensize) then .y+=stepsize
      end with
      movesprite(.sprite,.sprite.x,.sprite.y)

    end if '.visible=1

  end with

END SUB

'-----------------------------------------------------

SUB tknight_kacker(k as tknight)

  with k
    if (.visible=1) then
        if (.weapon=0) then
          if (.dir=Cleft) then sprite_copy1(.sprite,.leftkackersprite)
          if (.dir=Cright) then sprite_copy1(.sprite,.rightkackersprite)
          movesprite(.sprite,.sprite.x,.sprite.y)
          if (.dir=Cleft) then sprite_copy1(.sprite,.leftsprite)
          if (.dir=Cright) then sprite_copy1(.sprite,.rightsprite)
        end if
    end if
  end with

END SUB


'-----------------------------------------------------

SUB cross_start(k as tknight)

  initsprite(k.cross)
  loadsprite(k.cross,1,50)
  '%%2

  if (k.dir=Cleft) then
    k.cross.x=k.sprite.x-30
  else
    k.cross.x=k.sprite.x+30
  end if
  k.cross.y=k.sprite.y

  showsprite(k.cross,k.cross.x,k.cross.y)

END SUB

'-----------------------------------------------------

SUB cross_stop(k as tknight)

  deletesprite(k.cross)
  closesprite(k.cross)

END SUB

'-----------------------------------------------------

SUB cross_move(k as tknight, dir1 as integer)

  if (dir1=Cup) then movesprite(k.cross,k.cross.x,k.cross.y-Ccrossstep)
  if (dir1=Cdown) then movesprite(k.cross,k.cross.x,k.cross.y+Ccrossstep)
END SUB



'-----------------------------------------------------

SUB tknight_weapon(k as tknight, weap as integer)

  dim as integer change0=0

  with k
    if (.weapon<>weap) then change0=1
    .weapon=weap

    if (.weapon=0) then
      if (.dir=Cleft) then sprite_copy1(.sprite,.leftsprite)
      if (.dir=Cright) then sprite_copy1(.sprite,.rightsprite)
    else
      if (.dir=Cleft) then sprite_copy1(.sprite,.leftweapsprite)
      if (.dir=Cright) then sprite_copy1(.sprite,.rightweapsprite)
    end if

    if (change0=1) then movesprite(.sprite,.sprite.x,.sprite.y)

    if (.player=0 and .weapon=1 and change0=1) then cross_start(k)
    if (.player=0 and .weapon=0 and change0=1) then cross_stop(k)

  end with

END SUB

'-----------------------------------------------------

FUNCTION testinterior(x11,x12,x21,x22) as integer

  'Check if x11 or x12 is within the interval (x21,x22) or
  'if x21 or x22 is within the interval (x1,x12)

  dim as integer retval=0

  if (x11>=x21 and x11<=x22) then retval=1
  if (x12>=x21 and x12<=x22) then retval=1
  if (x21>=x11 and x21<=x12) then retval=1
  if (x22>=x11 and x22<=x12) then retval=1

  testinterior=retval

  'if (retval=1) then logd("testint: x11="+str(x11)+"  x12="+str(x12)+"  x21="+str(x21)+"  x22="+str(x22),0.0)

END FUNCTION

'-----------------------------------------------------

SUB tknight_hide(k as tknight)

  'logd("tknight_hide",1.0)
  'BSAVE "b.bmp",k.sprite.bg,2000
  if (k.visible=1) then
    deletesprite(k.sprite)
    k.visible=0
  end if

END SUB


'-----------------------------------------------------

SUB tknight_show(k as tknight)

  showsprite(k.sprite,k.sprite.x,k.sprite.y)
  k.visible=1

END SUB

'-----------------------------------------------------

SUB tknight_destroy(k as tknight)

  tknight_hide(k)

END SUB

'-----------------------------------------------------

FUNCTION colldetect(s as tsprite, k as tsprite, xnew as integer, ynew as integer) as integer

  'Returns 1 if one edge of the s sprite touches or penetrates the k sprite
  'xnew,ynew relates to s

  dim as integer i,j,x1,x2,x01,x02,y1,y2,y01,y02,testx,testy

  x1=xnew
  x2=xnew+s.xsize-1
  x01=k.x
  x02=k.x+figxsize-1
  y1=ynew
  y2=ynew+s.ysize-1
  y01=k.y
  y02=k.y+figysize-1

  'logd("x1",x1*1.0)
  'logd("x2",x2*1.0)
  'logd("x01",x01*1.0)
  'logd("x02",x02*1.0)
  'logd("y1",y1*1.0)
  'logd("y2",y2*1.0)
  'logd("y01",y01*1.0)
  'logd("y02",y02*1.0)

  testx=testinterior(x1,x2,x01,x02)
  testy=testinterior(y1,y2,y01,y02)

  'logd("testx",testx*1.0)
  'logd("testy",testy*1.0)

  'Collision detected
  colldetect=0
  if (testx=1 and testy=1) then colldetect=1

END FUNCTION


'-----------------------------------------------------

FUNCTION movesprite2(s as tsprite, k0 as tknight, xnew as integer, ynew as integer) as integer

  'Check collision before move
  'k0 is the fighting knight
  'Return the number of the colliding knight
  'Return -1 if way is free


  dim as integer i,j,x1,x2,x01,x02,y1,y2,y01,y02,testx,testy,collision
  dim as tknight k

  'logd("k0.sprite.x",k0.sprite.x*1.0)

  'Check all knights
  collision=-1
  for i=0 to nallknights-1
    k=*(allknights(i))
    if (k.id<>k0.id and k.visible=1) then
      'logd("i",i*1.0)
      'logd("k0.sprite.x",k0.sprite.x*1.0)
      if colldetect(s,k.sprite,xnew,ynew)=1 then collision=i
      'logd("collision",collision*1.0)
    end if
    '%%3
  next i

  if (collision<0) then movesprite(s,xnew,ynew)

  movesprite2=collision

END FUNCTION

'-----------------------------------------------------

FUNCTION bullet_move(s as tsprite, k0 as tknight, xnew as integer, ynew as integer) as integer

  dim as integer collision,retval

  retval=0
  'logd("bull_move",0.0)
  collision=movesprite2(s,k0,xnew,ynew)
  if (collision>=0) then
    'Erase bullet from screen
    deletesprite(s)
    'Kill knight
    'tknight_report(*(allknights(collision)))
    tknight_destroy(*(allknights(collision)))
    retval=1
  end if

  bullet_move=retval

END FUNCTION



'-----------------------------------------------------

SUB tknight_fire(k as tknight)

  '%%2
  dim as tsprite bull
  dim as integer dir1,hit,ret
  dim as double xb,yb,xb0,yb0,dxlimit,slope,xc,yc


  if (k.player>0) then exit sub

  initsprite(bull)
  loadsprite(bull,1,51)
  deletesprite(k.cross)

  if (k.dir=Cleft) then
    bull.x=k.sprite.x-5
  else
    bull.x=k.sprite.x+20
  end if
  bull.y=k.sprite.y+4
  showsprite(bull,bull.x,bull.y)

  FSOUND_PlaySound(FSOUND_FREE,gun)

  'Calc track parameters:
  xc=k.cross.x
  yc=k.cross.y
  xb=bull.x
  yb=bull.y
  xb0=xb
  yb0=yb
  slope=(yc-yb0+4)/(xc-xb0)
  'logd("xc",xc)
  'logd("yc",yc)
  'logd("xb0",xb0)
  'logd("yb0",yb0)
  'logd("k.sprite.x",k.sprite.x*1.0)
  'logd("k.sprite.y",k.sprite.y*1.0)
  'logd("slope",slope)

  dxlimit=sqr(Cweapmaxdistance^2/(1+abs(slope^2)))

  'logd("k.sprite.x",int(k.sprite.x))
  'logd("k.sprite.y",int(k.sprite.y))
  'logd("cross.x",int(k.cross.x))
  'logd("cross.y",int(k.cross.y))
  'logd("slope",slope)
  'logd("dxlimit",dxlimit)

  hit=0
  if (abs(slope)<1.0) then
    if (k.dir=Cright) then
      while (xb < xb0 + dxlimit and xb < xscreensize-2 and hit=0)
        xb+=1
        yb+=slope
        hit=bullet_move(bull,k,int(xb),int(yb))
        'logd(str(xb)+" "+str(yb),0.0)
      wend
      '? "Hello2"
      'sleep
    else
      while(xb > 2 and xb > k.sprite.x - dxlimit and hit=0)
        xb-=1
        yb-=slope
        hit=bullet_move(bull,k,int(xb),int(yb))
      wend
    end if
  else
    dir1=1
    if (slope<0) then dir1=-1
    if (k.dir=Cright) then
      while (xb < xb0 + dxlimit and xb < xscreensize-2 and hit=0)
        xb+=1/abs(slope)
        yb+=dir1
        hit=bullet_move(bull,k,int(xb),int(yb))
        'logd(str(xb)+" "+str(yb),0.0)
      wend
      'logd("yb",yb)
    else
      while(xb>2 and xb > k.sprite.x - dxlimit and hit=0)
        xb-=1/abs(slope)
        yb-=dir1
        hit=bullet_move(bull,k,int(xb),int(yb))
      wend
    end if
  end if

  if (hit=0) then
    'logd("bullet max range reached",0.0)
    deletesprite(bull)
  end if
  closesprite(bull)
  showsprite(k.cross,k.cross.x,k.cross.y)


END SUB

'-----------------------------------------------------

SUB tknight_finish(k0 as tknight)

  dim as tsprite kfall
  dim as integer ret

  FSOUND_PlaySound(FSOUND_FREE,explode)

  tknight_destroy(k0)
  if (k0.dir=Cleft) then
    loadsprite(kfall,3,3,4,5)
  else
    loadsprite(kfall,3,9,10,11)
  end if
  movesprite(kfall,k0.sprite.x,k0.sprite.y)
  sleep
  closesprite(kfall)
END SUB



'-----------------------------------------------------

SUB tknight_attack(k0 as tknight, k1 as tknight)

  'k1 attacks k0
  ' Returns 1 if k0 is dead

  dim as integer lost,do_attack,tnow,dead,ret

  do_attack=0
  if (k0.visible=0) then exit sub
  tnow=gettime()
  if (k0.lastattack>0) then
    if ((tnow-Cattackinterval)>=k0.lastattack) then do_attack=1
  else
    do_attack=1
  end if

  if (do_attack) then
    FSOUND_PlaySound(FSOUND_FREE,sword)
    if (rnd<Cenemypower) then
      k0.lastattack=tnow
      k0.health-=1
      locate 25,1:? k0.health;
      if (k0.health<0) then
        tknight_finish(k0)
        dead0=1
        proceed=0
      end if
    end if
  end if

END SUB

'-----------------------------------------------------

SUB tknight_move2(k as tknight, dir1 as integer)

  dim as integer dx,dy,xnew,ynew,dead,collision,stepsize
  dim as tknight ptr k0
  dim as double dist,x0,x1,y0,y1

  with k
    if (.visible=1) then
      if (dir1<>.dir) then
        if (.weapon=0) then
          if (dir1=Cleft) then sprite_copy1(.sprite,.leftsprite)
          if (dir1=Cright) then sprite_copy1(.sprite,.rightsprite)
        else
          if (dir1=Cleft) then sprite_copy1(.sprite,.leftweapsprite)
          if (dir1=Cright) then sprite_copy1(.sprite,.rightweapsprite)
        end if
      end if
      if (dir1=Cleft or dir1=Cright) then .dir=dir1
      xnew=.sprite.x
      ynew=.sprite.y

      if (.player=0) then stepsize=Cstepsize else stepsize=Cstepsize_comp
      with .sprite
        if (dir1=Cleft and .x>.xsize) then xnew-=stepsize
        if (dir1=Cright and (.x+.xsize)<xscreensize) then xnew+=stepsize
        if (dir1=Cup and .y>.ysize) then ynew-=stepsize
        if (dir1=Cdown and (.y+.ysize)<yscreensize) then ynew+=stepsize
      end with

      '%%4
      k0=allknights(0)
      'logd("tknight_move21, collision",collision*1.0)
      collision=movesprite2(.sprite,k,xnew,ynew)
      if (collision=0) then
        tknight_attack(*k0,k)
      end if

      'Center coordinates of the knight sprites
      x0=k0->sprite.x+k.sprite.xsize/2
      y0=k0->sprite.y+k.sprite.ysize/2
      x1=k.sprite.x+k.sprite.xsize/2
      y1=k.sprite.y+k.sprite.ysize/2

      dist=sqr((x0-x1)^2+(y0-y1)^2)
      'logd("k0->sprite.x",k0->sprite.x*1.0)
      'logd("k.sprite.x",k.sprite.x*1.0)
      'logd("k0->sprite.y",k0->sprite.y*1.0)
      'logd("k.sprite.y",k.sprite.y*1.0)
      'logd("dist",dist)
      if (dist<Cmindist and k.visible=1 and k.weapon=0) then tknight_weapon(k,1)
      if (dist>=Cmindist and k.visible=1 and k.weapon=1) then tknight_weapon(k,0)

      'logd("tknight_move22, collision",collision*1.0)
     end if '.visible=1

  end with

END SUB


'-----------------------------------------------------

SUB tknight_refresh(k as tknight)

  'Just draws knight again on the screen.

  with k

    if .visible=0 then exit sub

    PUT (.sprite.x,.sprite.y),.sprite.img(.sprite.nimg-1),TRANS
    if (.player=0 and .weapon=1) then
      PUT (.cross.x,.cross.y),.cross.img(.cross.nimg-1),TRANS
    end if

  end with

END SUB


'-----------------------------------------------------

SUB refresh()

  'Refresh the screen

  dim i as integer

  cls
  FOR i=0 TO nallknights-1
    tknight_refresh(*allknights(i))
  NEXT i

END SUB



'-----------------------------------------------------

FUNCTION nvisibleknights as integer

  dim as integer sum=0,i

  FOR i=0 to nallknights-1
    if (allknights(i)->visible=1) then sum+=1
  next i

  nvisibleknights=sum

END FUNCTION

'-----------------------------------------------------

SUB enemymove()

  dim as integer i,x0,y0,x1,y1,dir1,dir1_i,pass0,pass_i,xold,yold,ret,nknight
  dim as tknight ptr k,k0
  dim as double p_up,p_down,p_left,p_right,pass_up,pass_down,pass_left,pass_right

  current_pass=0

  For i=1 TO nallknights-1
    k=allknights(i)
    k0=allknights(0)
    if (k->visible=1) then
      'Center coordinates of the knight sprites
      x0=k0->sprite.x+k->sprite.xsize/2
      y0=k0->sprite.y+k->sprite.ysize/2
      x1=k->sprite.x+k->sprite.xsize/2
      y1=k->sprite.y+k->sprite.ysize/2

      p_up=dmax(dmin((y1-y0)/150,1.0),0.0)
      p_down=dmax(dmin((y0-y1)/150,1.0),0.0)
      p_left=dmax(dmin((x1-x0)/100,1.0),0.1)
      p_right=dmax(dmin((x0-x1)/100,1.0),0.1)

      '%%5
      'logd("enemy",i*1.0)

      pass_up=1.0
      pass_down=1.0
      pass_left=1.0
      pass_right=1.0

      dir1=-1
      pass0=-1
      pass_i=0
      current_enemy=i
      while(pass0<0 and pass_i<=4)
        'Loop: Repeated effort if way is blocked by another knight
        dir1_i=0
        while (dir1<0 and dir1_i<=100)
          if (rnd<(p_up*pass_up)) then dir1=Cup
          if (rnd<(p_down*pass_down)) then dir1=Cdown
          if (rnd<(p_left*pass_left)) then dir1=Cleft
          if (rnd<(p_right*pass_right)) then dir1=Cright
          dir1_i+=1
        wend

        'logd("p_up",p_up)
        'logd("p_down",p_down)
        'logd("p_left",p_left)
        'logd("p_right",p_right)
        'logd("dir1_i",dir1_i*1.0)
        'if (dir1=Cup) then logd("dir1=C_up",0.0)
        'if (dir1=Cdown) then logd("dir1=C_down",0.0)
        'if (dir1=Cleft) then logd("dir1=C_left",0.0)
        'if (dir1=Cright) then logd("dir1=C_right",0.0)

        xold=k->sprite.x
        yold=k->sprite.y
        tknight_move2(*k,dir1)
        if (k->sprite.x<>xold or k->sprite.y<>yold) then pass0=1
        'logd("pass0",pass0*1.0)
        if (pass0<0) then
          if (dir1=Cup) then pass_up=0.0
          if (dir1=Cdown) then pass_down=0.0
          if (dir1=Cleft) then pass_left=0.0
          if (dir1=Cright) then pass_right=0.0
        end if
        pass_i+=1
        current_pass+=1
        if (proceed=0) then exit while
      wend

    end if

    if (proceed=0) then exit for
    if (i mod 2 = 0 and nvisibleknights()>1) then
      FSOUND_PlaySound(FSOUND_FREE,animal)
    end if


  next i

  'logd("nvisibleknights",nvisibleknights*1.0)

  nknight=nvisibleknights

  if (nknight=1) then
    sleep 200,1
    keyevent
  elseif (nknight>1) then
    refresh()
  end if

END SUB

'-----------------------------------------------------

SUB keyevent

  dim as tknight ptr k1
  dim as integer retval=0
  dim as string a

  k1=allknights(0)
  if (multikey(SC_SPACE) and space_pressed=1) then return
  space_pressed=0

  'sleep spritedelay
  block_keyevent=1

  if (not multikey(SC_ESCAPE) and dead0=0) then retval=1

  if (k1->weapon=1) then
    if (multikey(SC_UP)) then cross_move(*k1,Cup)
    if (multikey(SC_DOWN)) then cross_move(*k1,Cdown)
    if (multikey(SC_SPACE)) then
      if (space_pressed=0) then tknight_fire(*k1)
      space_pressed=1
    end if
  else
    if ((current_pass mod 2=0) or current_pass<0) then
    'logd("current_pass",current_pass*1.0)
      if (multikey(SC_LEFT)) then tknight_move(*k1,Cleft)
      if (multikey(SC_RIGHT)) then tknight_move(*k1,Cright)
      if (multikey(SC_UP)) then tknight_move(*k1,Cup)
      if (multikey(SC_DOWN)) then tknight_move(*k1,Cdown)
      if (multikey(SC_k)) then tknight_kacker(*k1)
    end if
  end if

  if (multikey(SC_w) and k1->weapon=0) then
    tknight_weapon(*k1,1)
  else
    if (multikey(SC_w) and k1->weapon=1) then tknight_weapon(*k1,0)
  end if

  a=inkey$

  block_keyevent=0

  proceed=retval

END SUB

'-----------------------------------------------------

SUB intro

  dim as tsprite scr,lab
  dim as integer i

  initsprite(scr)
  initsprite(lab)
  loadsprite(scr,1,Cintroscr)
  loadsprite(lab,1,Cintrolab)
  showsprite(scr,80,1)
  showsprite(lab,-40,160)
  FSOUND_PlaySound(0,intro1)
  for i=-40 to 40
    movesprite(lab,i,160)
    sleep 20
  next i
  sleep 3000
  FSOUND_PlaySound(1,intro2)
  FSOUND_SetLoopMode(1,FSOUND_LOOP_NORMAL)
  sleep
  FSOUND_SetLoopMode(1,FSOUND_LOOP_OFF)
  cls
  closesprite(scr)
  closesprite(lab)
  locate 5,1:?"Exit: ESC"
  locate 6,1:?"Move blue knight: Cursor keys"
  locate 7,1:?"Activate weapon: w"
  locate 8,1:?"Move crosshair: Cursor up/down"
  locate 9,1:?"Fire: Space"
  Sleep
  cls

END SUB



'-----------------------------------------------------

SUB test4

  dim as tsprite sp1
  dim as integer i,j
  dim as integer ix,iy

  loadsprites
  initsprite(sp1)
  loadsprite(sp1,2,1,0)
  cls
  ix=160
  iy=100
  showsprite(sp1,ix,iy)

  while (not multikey(SC_ESCAPE))
    sleep
    if (multikey(SC_LEFT)) then
      ix-=10
      if ix<20 then ix=20
    end if
    movesprite(sp1,ix,iy)
  wend

  closesprite(sp1)
  closesprites

END SUB


'-----------------------------------------------------

SUB test5

  dim as tknight k1

  loadsprites
  cls
  tknight_init(k1,1,160,100,Cright)
  sleep
  tknight_close(k1)
  closesprites

END SUB

'-----------------------------------------------------

SUB test6

  dim as tknight k1,k2
  dim as string a

  loadsprites
  cls
  nallknights=0
  allknightid=0
  dead0=0
  tknight_init(k1,0,160,100,Cright)
  tknight_init(k2,1,250,70,Cright)
  allknights(0)=varptr(k1)
  allknights(1)=varptr(k2)
  nallknights=2
  tknight_weapon(k1,1)

  while (not multikey(SC_ESCAPE) and dead0=0)
    sleep
    if (k1.weapon=0) then
      if (multikey(SC_LEFT)) then tknight_move(k1,Cleft)
      if (multikey(SC_RIGHT)) then tknight_move(k1,Cright)
      if (multikey(SC_UP)) then tknight_move(k1,Cup)
      if (multikey(SC_DOWN)) then tknight_move(k1,Cdown)
    else
      if (multikey(SC_UP)) then cross_move(k1,Cup)
      if (multikey(SC_DOWN)) then cross_move(k1,Cdown)
      if (multikey(SC_SPACE)) then tknight_fire(k1)
    end if
    if (multikey(SC_w) and k1.weapon=0) then
      tknight_weapon(k1,1)
    else
      if (multikey(SC_w) and k1.weapon=1) then tknight_weapon(k1,0)
    end if
    'a=inkey$
    'if (a="w" and k1.weapon=0) then

    'else
    '  if (a="w" and k1.weapon=1) then tknight_weapon(k1,0)
    'end if
  wend

 if (dead0=1) then
    cls
    locate 12,20
    ? "GAME OVER"
    sleep
  end if


  tknight_close(k1)
  tknight_close(k2)
  closesprites



END SUB


'-----------------------------------------------------

SUB test7

  dim as integer t

  while (not multikey(SC_ESCAPE))
    t=gettime()
    ? t
    sleep
  wend
END SUB

'--------------------------------------------------------

SUB test9

  dim as tknight k1,k2(10)
  dim as string a
  dim as integer i,x,y
  dim as integer nk=10

  debug1=0
  loadsprites
  cls
  global_init()
  tknight_init(k1,0,160,100,Cright)

  logd("New run",0.0)

  logd("-------------------",0.0)

  nallknights=1
  allknights(0)=varptr(k1)
  tknight_init(k2(0),1,200,100,Cleft)
  tknight_init(k2(1),1,200,50,Cleft)
  allknights(i+1)=varptr(k2(0))
  nallknights+=1
  k2(0).sprite.name0="k0"
  k2(0).sprite.parent=VARPTR(k2(0))
  k2(1).sprite.name0="k1"

  proceed=1
  while (proceed=1)
    tknight_move2(k2(0),Cleft)
    sleep 1000
    tknight_move2(k2(0),Cright)
    tknight_move2(k2(1),Cleft)
  wend

  tknight_close(k1)
  for i=0 to nk-1
    tknight_close(k2(i))
  next i
  closesprites

END SUB



'-----------------------------------------------------

SUB main

  dim as tknight k1,k2(Cninitknight+1)
  dim as string a
  dim as integer i,x,y

  proceed=1

  loadsprites
  cls
  global_init()
  soundload
  intro

  while (proceed=1)

    round_init()

    tknight_init(k1,0,160,100,Cright)

    'logd("New run",0.0)
    'logd("-------------------",0.0)

    nallknights=1
    allknights(0)=varptr(k1)
    for i=0 to Cninitknight-1
      tknight_init2(k2(i),1,Cleft)
      allknights(i+1)=varptr(k2(i))
      nallknights+=1
    next i
    'tknight_init(k2(1),1,160,10,Cleft)


    'tknight_weapon(k1,1)

    'tknight_finish(k1)
    'end

    while (proceed=1)
      enemymove()
    wend

    if (dead0=1) then
      cls
      locate 12,20
      ? "GAME OVER"
      sleep
    end if



    cls
    ? "Play once more?"
    ? "Yes: Press key"
    ? "No: Press q"
    sleep
    proceed=1
    if multikey(SC_q) then proceed=0
    cls
  wend

  tknight_close(k1)
  for i=0 to Cninitknight-1
    tknight_close(k2(i))
  next i
  closesprites

  FSOUND_Close()


END SUB



main