DECLARE SUB checkKey (keyboard$, speedUp%, map() AS ANY, camx%, camy%, castlex%, castley%, showMenu%, mouse AS ANY)
DECLARE SUB clearPrint (Char$, X%, Y%, TextColor%)
DECLARE SUB changeMenu (showMenu%, refresh%)
DECLARE SUB thingWork (thing AS ANY, thingAr() AS ANY, map() AS ANY, barrierAhead%, ntile%, ware() AS ANY)
DECLARE SUB thingRotate (thing AS ANY, D%)
DECLARE SUB thingFollow (thing AS ANY, targx%, targy%)
DECLARE SUB show (camx%, camy%, map() AS ANY, thing() AS ANY, tileEffect() AS ANY)
DECLARE SUB sleepClick (seconds%, mouse AS ANY)
DECLARE SUB pickObject (mx%, my%, cx%, cy%, map() AS ANY, thing() AS ANY, showMenu%, camTarget%)
DECLARE SUB handleCamera (camera AS ANY, X%, Y%, speedUp%, refresh%, showMenu%, thing() AS ANY)
DECLARE SUB checkMenuThing (button() AS ANY, mouse AS ANY, showMenu%, refreshScreen%, thing() AS ANY, camera AS ANY)
DECLARE SUB checkMenuCastle (button() AS ANY, mouse AS ANY, showMenu%, refreshScreen%, map() AS ANY)
DECLARE SUB checkClicked (mouse AS ANY, leftReleased%, rightReleased%)
DECLARE SUB clickedIfReleased (mouse AS ANY, leftCl%, rightCl%)
DECLARE SUB setButtons (button() AS ANY, menuType%)
DECLARE SUB thingSearch (map() AS ANY, thing AS ANY, thingAr() AS ANY, ware() AS ANY, ntile%, giveUpFast%, lookForSpecial%)
DECLARE SUB setHouse (house() AS ANY, n%)
DECLARE SUB checkMenuBuild (button() AS ANY, mouse AS ANY, showMenu%, refreshScreen%, flagMarker AS ANY, n%, ware() AS ANY, map() AS ANY)
DECLARE SUB setPicLink (picLink() AS ANY)
DECLARE SUB setMap (map() AS ANY, nr%, ware() AS ANY, tileEffect() AS ANY, castlex%, castley%)
DECLARE SUB setThing (prsn() AS ANY, castlex%, castley%)
DECLARE SUB fade (value AS INTEGER)
DECLARE SUB playFX (Num%)
DECLARE SUB playSound (nameOf AS STRING, mode%, X%, Y%)
DECLARE SUB prnt (px%, py%, sent$, foreCol%, backCol%, italic%)
DECLARE SUB setEffect (tileEffect() AS ANY, n AS INTEGER, ware() AS ANY)
DECLARE SUB main (mapNum%)
DECLARE SUB setAnim (tileAnim() AS ANY, n%)
DECLARE SUB thingFindPlace (thing AS ANY, map() AS ANY, foundPlace%, ware() AS ANY, ntile%)
DECLARE SUB thingHandle (thing AS ANY, thingAr() AS ANY, map() AS ANY, tileEffect() AS ANY, ware() AS ANY)
DECLARE SUB thingMove (thing AS ANY, thingAr() AS ANY, map() AS ANY, tileEffect() AS ANY, ware() AS ANY)
DECLARE SUB setWare (ware() AS ANY, n%)
DECLARE SUB thingLooseWork (thing AS ANY)
DECLARE SUB thingCell (thing AS ANY)
DECLARE SUB thingRandom (thing AS ANY)
DECLARE SUB cliparray (hostArray%(), newArray%(), x1%, y1%, x2%, y2%)
DECLARE SUB getSprPic (picSprite%(), n1%, n2%)
DECLARE SUB emptyPicMem ()
DECLARE SUB putButton (button() AS ANY, i%)
DECLARE SUB mouseHide ()
DECLARE SUB getPic (picTile%(), n1%, n2%)
DECLARE SUB mouseShow ()
DECLARE SUB mouseGet ()
DECLARE SUB mousePut ()
DECLARE SUB mouseStatus (m AS ANY)
DECLARE SUB mouseDriver (ax%, bx%, cx%, dx%)
DECLARE SUB setCol (n%)
DECLARE SUB setPal ()
DECLARE SUB getPal (fileName$)
DECLARE SUB setOptions (setn AS ANY)
DECLARE SUB setGame (game AS ANY)
DECLARE SUB setScreen (scrn AS ANY)
DECLARE SUB setTile (tile AS ANY)
DECLARE FUNCTION getName$ (status$)
DECLARE FUNCTION thingBarrier% (X%, Y%, map() AS ANY, tileEffect() AS ANY, thing AS ANY)
DECLARE FUNCTION question% (x1%, y1%, quest$, mouse AS ANY)
DECLARE FUNCTION pickField% (mx%, my%, cx%, cy%, map() AS ANY, showMenu%, tileEffect() AS ANY, flagMarker AS ANY, ware() AS ANY, camTarget%, thing() AS ANY)
DECLARE FUNCTION checkButton$ (button() AS ANY, mouse AS ANY)
DECLARE FUNCTION form$ (i%)
DECLARE FUNCTION LoadFX% (fileName$)
DECLARE FUNCTION insideRect% (X%, Y%, x1%, y1%, x2%, y2%)
DECLARE FUNCTION checkScreenChange% (X%, Y%, nWorld%, nObject%, nChanged%)
DECLARE FUNCTION getDimSize% (X%, Y%)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
CONST root = "" '"c:\main\sprache\qb45\mine\rpg\"
' $INCLUDE: 'c:\main\sprache\qb45\mine\rpg\header.bas'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

DEFINT A-Z

' $DYNAMIC
DIM soundLab(1 TO 100) AS STRING * 30
IF LoadFX("sounds.snd") <> -1 THEN BEEP

' $STATIC
DIM SHARED tileValues AS worldValues
DIM setting AS gameOptions
setTile tileValues
setOptions setting

DIM SHARED mouseDat AS STRING
DIM mouse AS mouseType
mouseGet
mousePut

DIM col(byteVal) AS pal
DIM screenMem(tileValues.viewx1 TO tileValues.viewx2, tileValues.viewy1 TO tileValues.viewy2) AS layer
DIM SHARED byteNone AS STRING
byteNone = CHR$(0)

main 1

END

mouseData:
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B,5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07
DATA CD,33,53,8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F,8B,5E,06,89,17,5D,CA,08,00

SUB changeMenu (showMenu, refresh)
 
  IF showMenu > menuClear THEN
    tileValues.viewy1 = -1
    mouseHide
    LINE (scrnMinX, scrnMinY)-(scrnMaxX, tileSizeY * 3 - 1), 0, BF
  END IF
 
  SELECT CASE showMenu
    CASE menuClear
      tileValues.viewy1 = -4
      refresh = true
      showMenu = menuNone
      menuText1$ = ""
      menuText2$ = ""
    CASE menuCastle
      menuText1$ = "Options"
      menuText2$ = ""
    CASE menuBuild
      menuText1$ = "Building menu"
      menuText2$ = "Set a building flag"
    CASE menuThing
      menuText1$ = "Person menu"
      menuText2$ = "Move persons directly"
  END SELECT
  LOCATE 3, 5: COLOR TextColor + 1: PRINT menuText1$
  LOCATE 4, 5: COLOR TextColor:     PRINT menuText2$
 
  IF showMenu > menuClear THEN mouseShow
 
END SUB

FUNCTION checkButton$ (button() AS buttonType, mouse AS mouseType)

  active$ = "none"

  FOR i% = 1 TO UBOUND(button)
    oldStatus% = button(i%).status
    IF insideRect(mouse.X, mouse.Y, button(i%).x1, button(i%).y1, button(i%).x2, button(i%).y2) AND mouse.left THEN
      button(i%).status = true
    ELSE
      button(i%).status = false
    END IF
    IF button(i%).status <> oldStatus% THEN
      putButton button(), i%
      IF button(i%).status THEN active$ = RTRIM$(LCASE$(button(i%).text))
      'EXIT FOR
    END IF
  NEXT

  checkButton$ = active$

END FUNCTION

SUB checkClicked (mouse AS mouseType, leftReleased, rightReleased)

  STATIC lastLeft, lastRight
 
  IF mouse.left THEN
    leftReleased = false
  ELSEIF lastLeft THEN ' AND NOT left.right
    leftReleased = true
  END IF
  IF mouse.right THEN
    rightReleased = false
  ELSEIF lastRight THEN ' AND NOT mouse.right
    rightReleased = true
  END IF
 
  lastLeft = mouse.left
  lastRight = mouse.right

END SUB

SUB checkKey (keyboard$, speedUp, map() AS layer, camx, camy, castlex, castley, showMenu, mouse AS mouseType)

  SHARED setting AS gameOptions
  SELECT CASE keyboard$
    CASE CHR$(27)
      IF question%(scrnMidX - 40, scrnMidY - 40, "Really quit", mouse) THEN
        setting.quit = true
      END IF
      'setting.quit = true
    CASE " "
      speedUp = NOT speedUp '''' testing
    CASE CHR$(13)
      IF showMenu = menuNone THEN
        camx = castlex
        camy = castley
      END IF
  END SELECT

END SUB

SUB checkMenuBuild (button() AS buttonType, mouse AS mouseType, showMenu, refreshScreen, flagMarker AS simpleSprite, n, ware() AS wares, map() AS layer)
 
  STATIC init, house() AS menuItem

  IF NOT init THEN
    REDIM house(1) AS menuItem
    setHouse house(), 1 ' mapNum
  END IF
 
  STATIC flagChosen
  IF flagChosen = 0 THEN flagChosen = 1
  flagMax = UBOUND(house)
  
  SELECT CASE checkButton$(button(), mouse)
    CASE " -->"
      DO
        flagChosen = flagChosen + 1
        IF flagChosen > flagMax THEN flagChosen = 1
      LOOP UNTIL house(flagChosen).flagCol <> 0
      mouseHide
      LINE (scrnMinX, scrnMinY)-(scrnMaxX, tileSizeY * 2 - 1), 0, BF
      prnt 30, 10, house(flagChosen).building, 0, house(flagChosen).flagCol, false
      prnt 30, 21, "Job:  " + house(flagChosen).job, TextColor, 0, true
      prnt 30, 30, "Ware: " + house(flagChosen).needs, TextColor, 0, true
      mouseShow
    CASE " <--"
      DO
        flagChosen = flagChosen - 1
        IF flagChosen < 1 THEN flagChosen = flagMax
      LOOP UNTIL house(flagChosen).flagCol <> 0
      mouseHide
      LINE (scrnMinX, scrnMinY)-(scrnMaxX, tileSizeY * 2 - 1), 0, BF
      prnt 30, 10, house(flagChosen).building, 0, house(flagChosen).flagCol, false
      prnt 30, 21, "Job:  " + house(flagChosen).job, TextColor, 0, true
      prnt 30, 30, "Ware: " + house(flagChosen).needs, TextColor, 0, true
      mouseShow
    CASE "build"
      FOR i = LBOUND(ware) TO UBOUND(ware)
        IF ASC(ware(i).part) = workConstr AND ASC(ware(i).nval) = 1 AND ASC(ware(i).link) = flagChosen THEN
          EXIT FOR
        END IF
      NEXT
      map(flagMarker.X, flagMarker.Y).world = CHR$(i)
      showMenu = menuClear
      changeMenu showMenu, refreshScreen
  END SELECT

END SUB

SUB checkMenuCastle (button() AS buttonType, mouse AS mouseType, showMenu, refreshScreen, map() AS layer)

  SHARED setting AS gameOptions
  SELECT CASE checkButton$(button(), mouse)
    CASE "sound"
      setting.music = NOT setting.music
    CASE "music"
      setting.bgMusic = NOT setting.bgMusic
    CASE "show"
      setting.showPicked = NOT setting.showPicked
    CASE "pause"
      fade -fadeMax
      sleepClick 0, mouse
      fade fadeMax
    CASE "save"
      IF question%(scrnMidX - 40, scrnMidY - 40, "Overwrite old", mouse) THEN
        '
      END IF
    CASE "load"
      IF question%(scrnMidX - 40, scrnMidY - 40, "Exit old game", mouse) THEN
        '
      END IF
    CASE " new"
      IF question%(scrnMidX - 40, scrnMidY - 40, "Exit old game", mouse) THEN
        'setting.quit = true
      END IF
    CASE "quit"
      IF question%(scrnMidX - 40, scrnMidY - 40, "Really quit", mouse) THEN
        setting.quit = true
      END IF
  END SELECT

END SUB

SUB checkMenuThing (button() AS buttonType, mouse AS mouseType, showMenu, refreshScreen, thing() AS sprite, camera AS simpleSprite)

  SELECT CASE checkButton$(button(), mouse)
    CASE " -->"
      DO
        IF camera.target + 1 <= UBOUND(thing) THEN
          camera.target = camera.target + 1
        ELSE
          camera.target = LBOUND(thing)
        END IF
      LOOP UNTIL thing(camera.target).active
      refreshMenu = true
    CASE " <--"
      DO
        IF camera.target - 1 >= LBOUND(thing) THEN
          camera.target = camera.target - 1
        ELSE
          camera.target = UBOUND(thing)
        END IF
      LOOP UNTIL thing(camera.target).active
      refreshMenu = true
  END SELECT
 
  STATIC refresher
  refresher = refresher + 1
 
  IF refreshMenu OR refresher = 100 THEN
    refresher = 0
    LINE (scrnMinX, scrnMinY)-(scrnMaxX, tileSizeY * 2 - 1), 0, BF
    prnt 30, 10, RTRIM$(thing(camera.target).nameOf), 0, TextColor + 1, false
    SELECT CASE ASC(thing(camera.target).class)
      CASE classWorker:   class$ = "Worker"
      CASE classSoldier:  class$ = "Soldier"
      CASE classWizard:   class$ = "Wizard"
      CASE classPriest:   class$ = "Priest"
    END SELECT
    SELECT CASE ASC(thing(camera.target).bag)
      CASE 0: carries$ = "nothing"
      CASE ELSE:     carries$ = "bag"  '''
    END SELECT
    prnt 30, 21, "Class:   " + class$, TextColor, 0, true
    prnt 30, 30, "Carries: " + carries$, TextColor, 0, true
  END IF

END SUB

FUNCTION checkScreenChange (X, Y, nWorld, nObject, nChanged)

  SHARED screenMem() AS layer
  IF screenMem(X, Y).world <> CHR$(nWorld) OR screenMem(X, Y).object <> CHR$(nObject) OR (nObject <> 0 AND nChanged) THEN
    screenMem(X, Y).world = CHR$(nWorld)
    screenMem(X, Y).object = CHR$(nObject)
    changed = true
  ELSE
    changed = false
  END IF
 
  checkScreenChange = changed

END FUNCTION

SUB clearPrint (Char$, X, Y, TextColor) STATIC

  DIM E(7): E(0) = 1: FOR F = 1 TO 7: E(F) = E(F - 1) + E(F - 1): NEXT F
  X = X - 1: IF X = 319 THEN X = 160 - (4 * LEN(Char$))

  DEF SEG = &HFFA6
  FOR A = 1 TO LEN(Char$)
  X = X + 8
  D = ASC(UCASE$(MID$(Char$, A, 1))) * 8 + 14
  FOR B = 0 TO 7
    FOR C = 0 TO 7
    IF PEEK(B + D) AND E(C) THEN PSET (X - C, Y + B), TextColor
    NEXT C
  NEXT B
  NEXT A

END SUB

SUB cliparray (hostArray%(), newArray%(), x1%, y1%, x2%, y2%)

  HostWidth% = hostArray%(0) \ 8
  NewWidth% = x2% - x1% + 1
  newArray%(0) = NewWidth% * 8
  newArray%(1) = y2% - y1% + 1
  HostSeg% = VARSEG(hostArray%(0))
  HostOff% = VARPTR(hostArray%(0))
  NewSeg% = VARSEG(newArray%(0))
  NewOff% = VARPTR(newArray%(0))
  FOR i% = y1% TO y2%
    HostI% = i% * HostWidth%
    NewI% = (i% - y1%) * NewWidth%
    FOR J% = x1% TO x2%
      DEF SEG = HostSeg%
      byte% = PEEK(HostOff% + 4 + HostI% + J%)
      DEF SEG = NewSeg%
      POKE NewOff% + 4 + NewI% + (J% - x1%), byte%
    NEXT J%
  NEXT i%
  DEF SEG

END SUB

SUB emptyPicMem

  SHARED screenMem() AS layer
  FOR X = tileValues.viewx1 TO tileValues.viewx2
    FOR Y = tileValues.viewy1 TO tileValues.viewy2
      screenMem(X, Y).world = byteNone
      screenMem(X, Y).object = byteNone
    NEXT
  NEXT

END SUB

SUB fade (value AS INTEGER)

 SHARED col() AS pal
 DIM i AS INTEGER, n AS INTEGER, clock AS SINGLE
 fadeVal! = .9

  IF SGN(value) = -1 THEN
    FOR n = 0 TO ABS(value)
      FOR i = 0 TO byteVal
        col(i).red = col(i).red * fadeVal!
        col(i).green = col(i).green * fadeVal!
        col(i).blue = col(i).blue * fadeVal!
      NEXT
      clock = TIMER: DO UNTIL clock + .001 - TIMER <= 0: LOOP
      FOR nn% = 0 TO byteVal
        setCol nn%
      NEXT
    NEXT
  ELSE
    FOR n = 0 TO value
      FOR i = 0 TO byteVal
        col(i).red = col(i).red / fadeVal!
        col(i).green = col(i).green / fadeVal!
        col(i).blue = col(i).blue / fadeVal!
      NEXT
      clock = TIMER: DO UNTIL clock + .001 - TIMER <= 0: LOOP
      FOR nn% = 0 TO byteVal
        setCol nn%
      NEXT
    NEXT
  END IF

END SUB

FUNCTION form$ (i)

  form$ = RTRIM$(LTRIM$(STR$(i)))

END FUNCTION

FUNCTION getDimSize (X, Y)

  getDimSize = (X * Y + 4) \ 2

END FUNCTION

FUNCTION getName$ (status$)

  OPEN root + "data\names.dat" FOR INPUT AS #1
    DO WHILE NOT EOF(1)
      INPUT #1, dummy$
      names% = names% + 1
    LOOP
  CLOSE #1
  names% = RND * (names%)
  OPEN root + "data\names.dat" FOR INPUT AS #1
    FOR i% = 1 TO names%
      INPUT #1, dummy$
    NEXT
    nameOf$ = dummy$
  CLOSE #1
  
  names% = 0
  OPEN root + "data\snames_" + LEFT$(status$, 1) + ".dat" FOR INPUT AS #1
    DO WHILE NOT EOF(1)
      INPUT #1, dummy$
      names% = names% + 1
    LOOP
  CLOSE #1
  names% = RND * (names%)
  OPEN root + "data\snames_" + LEFT$(status$, 1) + ".dat" FOR INPUT AS #1
    FOR i% = 1 TO names%
      INPUT #1, dummy$
    NEXT
    snameOf$ = dummy$
  CLOSE #1

  getName$ = nameOf$ + " " + snameOf$

END FUNCTION

SUB getPal (fileName$)

  SHARED col() AS pal
  OPEN root + "pic\" + fileName$ + ".pal" FOR INPUT AS #1
    FOR i = 1 TO 3
      LINE INPUT #1, dummy$
    NEXT
    FOR n = 0 TO byteVal
      INPUT #1, dummy2
      col(n).red = dummy2 \ 4
      INPUT #1, dummy2
      col(n).green = dummy2 \ 4
      INPUT #1, dummy2
      col(n).blue = dummy2 \ 4
    NEXT
  CLOSE #1
 
  col(15).red = 58
  col(15).green = 58
  col(15).blue = 58
                           
END SUB

SUB getPic (picTile(), n1, n2)

  DIM picTmp(UBOUND(picTile))
  DEF SEG = VARSEG(picTmp(0))
    BLOAD root + "pic\tile\tle_" + form$(n1) + ".GRH", VARPTR(picTmp(0))
  DEF SEG
  FOR i = 0 TO UBOUND(picTile)
    picTile(i, n2) = picTmp(i)
  NEXT
 
END SUB

SUB getSprPic (picSprite(), n1, n2)

  DIM picTmp(UBOUND(picSprite))
 
  DIM abbr$(back2), extn$(layerSprt)
  abbr$(left1) = "lf1"
  abbr$(left2) = "lf2"
  abbr$(rght1) = "rt1"
  abbr$(rght2) = "rt2"
  abbr$(frnt1) = "fr1"
  abbr$(frnt2) = "fr2"
  abbr$(back1) = "bk1"
  abbr$(back2) = "bk2"
  extn$(layerMask) = "m"
  extn$(layerSprt) = ""

  FOR direction = left1 TO back2
    FOR layerType = layerMask TO layerSprt
      DEF SEG = VARSEG(picTmp(0))
        fileName$ = "pic\sprite\" + form$(n1) + "_" + abbr$(direction) + extn$(layerType) + ".GRH"
        BLOAD root + fileName$, VARPTR(picTmp(0))
      DEF SEG
      FOR i = 0 TO UBOUND(picTmp)
        picSprite(i, n2, direction, layerType) = picTmp(i)
      NEXT
    NEXT
  NEXT

END SUB

SUB handleCamera (camera AS simpleSprite, X, Y, speedUp, refresh, showMenu, thing() AS sprite)

  SHARED setting AS gameOptions
 
  camera.spdy = 0
  camera.spdx = 0
 
  IF showMenu = menuNone THEN
    IF X <= scrnMinX + camBorder THEN
      camera.spdx = -1
    ELSEIF X >= scrnMaxX - camBorder THEN
      camera.spdx = 1
    END IF
    IF Y <= scrnMinY + camBorder THEN
      camera.spdy = -1
    ELSEIF Y >= scrnMaxY - camBorder THEN
      camera.spdy = 1
    END IF
   
    IF (X <= scrnMinX + camSpeedUpBorder) OR (X >= scrnMaxX - camSpeedUpBorder) OR (Y <= scrnMinY + camSpeedUpBorder) OR (Y >= scrnMaxY - camSpeedUpBorder) THEN
      camera.spdx = camera.spdx * 2
      camera.spdy = camera.spdy * 2
    END IF
 
  ELSEIF showMenu = menuThing THEN
    targetx = thing(camera.target).X + thing(camera.target).dirx * 4 ' lookAhead cam
    targety = thing(camera.target).Y - 2 + thing(camera.target).diry * 2
    'targetx = thing(camera.target).targetx1 ' centering target cam
    'targety = thing(camera.target).targety1
    IF camera.X < targetx THEN
      camera.spdx = 1
    ELSEIF camera.X > targetx THEN
      camera.spdx = -1
    END IF
    IF camera.Y < targety THEN
      camera.spdy = 1
    ELSEIF camera.Y > targety THEN
      camera.spdy = -1
    END IF
 
  END IF
 
  IF camera.X + camera.spdx < -tileValues.limx - tileValues.viewx1 THEN
    crossx = true
  ELSEIF camera.X + camera.spdx > tileValues.limx - tileValues.viewx2 THEN
    crossx = true
  ELSE
    camera.X = camera.X + camera.spdx
  END IF
  IF camera.Y + camera.spdy < -tileValues.limy - tileValues.viewy1 THEN
    crossy = true
  ELSEIF camera.Y + camera.spdy > tileValues.limy - tileValues.viewy2 THEN
    crossy = true
  ELSE
    camera.Y = camera.Y + camera.spdy
  END IF
  
  IF refresh OR (camera.spdx <> 0 OR camera.spdy <> 0) THEN
    refresh = false
    emptyPicMem
  END IF
 
  IF setting.music THEN playSound "", true, camera.X, camera.Y

END SUB

FUNCTION insideRect (X%, Y%, x1%, y1%, x2%, y2%)

  IF X% >= x1% AND X% <= x2% AND Y% >= y1% AND Y% <= y2% THEN
    insideRect = true
  ELSE
    insideRect = false
  END IF

END FUNCTION

FUNCTION LoadFX (fileName$)

  SHARED soundLab() AS STRING * 30

  OPEN root + fileName$ FOR BINARY AS #1
  IF LOF(1) = 0 THEN LoadFX = 0: CLOSE #1: EXIT FUNCTION
  DIM id AS STRING * 4
  GET #1, , id
  IF MID$(id, 1, 2) <> "SL" THEN LoadFX = 1: CLOSE #1: EXIT FUNCTION
  IF MID$(id, 3, 2) <> "10" THEN LoadFX = 2: CLOSE #1: EXIT FUNCTION
  GET #1, , NumSound
  REDIM soundLab(1 TO NumSound) AS STRING * 30
  FOR i = 1 TO NumSound
    GET #1, , soundLab(i)
    temp$ = SPACE$(20)
    GET #1, , temp$
  NEXT i
  CLOSE #1
  LoadFX = -1

END FUNCTION

SUB main (mapNum)

  SHARED setting AS gameOptions
  DIM map(-tileValues.limx TO tileValues.limx, -tileValues.limy TO tileValues.limy) AS layer
  DIM thing(1 TO 20) AS sprite, tileEffect(byteVal) AS byte, ware(byteVal) AS wares
  DIM flagMarker AS simpleSprite
 
  setWare ware(), mapNum
  setEffect tileEffect(), mapNum, ware()
  getPal "def"
 
  SCREEN scrnNum
  setPal
  fade -fadeMax
  BLOAD root + "pic\title\title.grh"
  fade fadeMax
 
  setMap map(), mapNum, ware(), tileEffect(), castlex, castley
  RANDOMIZE TIMER
  setThing thing(), castlex, castley
 
  ' $DYNAMIC
  DIM button(1) AS buttonType
 
  SHARED mouse AS mouseType
 
  fade -fadeMax
 
  DIM camera AS simpleSprite
  camera.X = castlex: camera.Y = castley

  mouseShow
 
  refreshScreen = true
  FOR n = LBOUND(thing) TO UBOUND(thing)
    IF thing(n).active THEN thingHandle thing(n), thing(), map(), tileEffect(), ware()
  NEXT
  show (camera.X), (camera.Y), map(), thing(), tileEffect()
  fade fadeMax
 
  DO
   
    clock! = TIMER
   
    checkKey INKEY$, speedUp, map(), camera.X, camera.Y, castlex, castley, showMenu, mouse
   
    mouseStatus mouse
    checkClicked mouse, leftReleased, rightReleased
    IF leftReleased THEN
      leftReleased = false
      IF showMenu = menuNone OR showMenu = menuThing THEN
        pickObject (mouse.X), (mouse.Y), (camera.X), (camera.Y), map(), thing(), showMenu, (camera.target)
      END IF
    ELSEIF rightReleased THEN
      rightReleased = false
      IF showMenu > menuNone THEN
        showMenu = menuClear
      ELSE
        showMenu = pickField((mouse.X), (mouse.Y), (camera.X), (camera.Y), map(), showMenu, tileEffect(), flagMarker, ware(), camera.target, thing())
      END IF
      changeMenu showMenu, refreshScreen
      setButtons button(), showMenu
    END IF

    SELECT CASE showMenu
      CASE menuNone
      CASE menuClear
        changeMenu showMenu, refreshScreen
        setButtons button(), showMenu
      CASE menuThing
        checkMenuThing button(), mouse, showMenu, refreshScreen, thing(), camera
      CASE menuBuild
        checkMenuBuild button(), mouse, showMenu, refreshScreen, flagMarker, mapNum, ware(), map()
      CASE menuCastle
        checkMenuCastle button(), mouse, showMenu, refreshScreen, map()
    END SELECT
   
    IF setting.bgMusic THEN
      IF RND * 50 > 48 THEN playSound "tone bg", false, (camera.X), (camera.Y)
      IF RND * 20 > 18 THEN playSound "tone", false, (camera.X), (camera.Y)
    END IF
    
    FOR n = LBOUND(thing) TO UBOUND(thing)
      IF thing(n).active THEN thingHandle thing(n), thing(), map(), tileEffect(), ware()
    NEXT
    handleCamera camera, (mouse.X), (mouse.Y), speedUp, refreshScreen, showMenu, thing()
    show (camera.X), (camera.Y), map(), thing(), tileEffect()
   
    DO UNTIL clock! + .001 - TIMER <= 0 OR speedUp: LOOP '''
 
  LOOP UNTIL setting.quit
 
  fade -fadeMax
 
  SCREEN 1
  PRINT "(C) 1997 by Philipp Lenssen" + CHR$(13) + "(Jester@T-Online.de)"
  SLEEP 2

END SUB

REM $STATIC
SUB mouseDriver (ax%, bx%, cx%, dx%)

  DEF SEG = VARSEG(mouseDat)
  mouse% = SADD(mouseDat)
  CALL Absolute(ax%, bx%, cx%, dx%, mouse%)

END SUB

SUB mouseGet

  mouseDat = SPACE$(57)
  RESTORE mouseData
    FOR i% = 1 TO 57
      READ A$
      H$ = CHR$(VAL("&H" + A$))
      MID$(mouseDat, i%, 1) = H$
    NEXT
  

END SUB

SUB mouseHide

  ax% = 2
  mouseDriver ax%, 0, 0, 0

END SUB

SUB mousePut

  ax% = 4
  cx% = X%
  dx% = Y%
  mouseDriver ax%, 0, cx%, dx%

END SUB

SUB mouseShow

  ax% = 1
  mouseDriver ax%, 0, 0, 0

END SUB

SUB mouseStatus (m AS mouseType)

  lb% = m.left
  RB% = m.right
  xMouse% = m.X
  yMouse% = m.Y
  ax% = 3
  mouseDriver ax%, bx%, cx%, dx%
  lb% = ((bx% AND 1) <> 0)
  RB% = ((bx% AND 2) <> 0)
  xMouse% = cx%
  yMouse% = dx%
  m.left = ABS(lb%)
  m.right = ABS(RB%)
  m.X = xMouse% \ 2
  m.Y = yMouse%

END SUB

FUNCTION pickField (mx, my, cx, cy, map() AS layer, showMenu, tileEffect() AS byte, flagMarker AS simpleSprite, ware() AS wares, camTarget, thing() AS sprite)

  IF showMenu > menuNone THEN offy = -3
  tx = mx \ tileSizeX + cx + tileValues.viewx1
  ty = my \ tileSizeY + cy + tileValues.viewy1 + offy

  '''showmenu=menuNone
  SELECT CASE ASC(ware(ASC(map(tx, ty).world)).part)
    CASE workConstr ''' leaves wrong grass
      map(tx, ty).world = CHR$(11)
      pickField = menuClear
 
    CASE workCastle
      pickField = menuCastle
 
    CASE ELSE
      IF ASC(map(tx, ty).object) = 0 THEN
     
        tileSpace = 2 ' needed space around a building
        insideX = (tx >= -tileValues.limx + tileSpace AND tx <= tileValues.limx - tileSpace)
        insideY = (ty >= -tileValues.limy + tileSpace AND ty <= tileValues.limy - tileSpace)
        buildingPlace = true
        IF insideX AND insideY THEN
          FOR ax = -tileSpace TO tileSpace
            FOR ay = -tileSpace TO tileSpace
              IF NOT ASC(tileEffect(ASC(map(tx + ax, ty + ay).world)).B) = effectNone THEN
                buildingPlace = false
                EXIT FOR
              END IF
            NEXT
          NEXT
        END IF

        IF buildingPlace THEN
          flagMarker.X = tx
          flagMarker.Y = ty
          pickField = menuBuild
        ELSE
          pickField = menuClear
        END IF
      ELSE
        camTarget = ASC(map(tx, ty).object)
        pickField = menuThing
      END IF
   
  END SELECT
 
END FUNCTION

SUB pickObject (mx, my, cx, cy, map() AS layer, thing() AS sprite, showMenu, camTarget)

  IF showMenu > menuNone THEN offy = -3
  tx = mx \ tileSizeX + cx + tileValues.viewx1
  ty = my \ tileSizeY + cy + tileValues.viewy1 + offy

  IF showMenu = menuThing THEN
    IF my > tileSizeY * 3 THEN inView = true '''
  ELSE ' IF showMenu = menuNone
    inView = true
  END IF
  
  IF inView THEN
   
    n = ASC(map(tx, ty).object)
    IF NOT n = 0 THEN
      IF showMenu <> menuThing THEN
        IF thing(n).player THEN
          thing(n).picked = NOT thing(n).picked ''' else attack enemy
          thing(n).changed = true
        END IF
      END IF
    ELSEIF showMenu = menuThing THEN
      thing(camTarget).targetx1 = tx
      thing(camTarget).targety1 = ty
      thing(camTarget).tfollow = 1
    ELSE
      IF showMenu <> menuThing THEN
        FOR i = LBOUND(thing) TO UBOUND(thing)
          IF thing(i).picked THEN
            thing(i).picked = false
            thing(i).targetx1 = tx
            thing(i).targety1 = ty
            'thing(i).targetx2 = 0
            'thing(i).targety2 = 0
            thing(i).tfollow = 1
            thing(i).bag = byteNone  '''
            IF thing(i).class = CHR$(classWorker) THEN thing(i).body = 1 '''
            thing(i).working = 0
            thing(i).lazy = gameLazyDefault
            'thing(i).spdx = 0
            'thing(i).spdy = 0
            'thing(i).dirx = 0
            'thing(i).diry = 0
          END IF
        NEXT
      END IF
    END IF
 
  END IF

END SUB

SUB playFX (Num)

  SHARED soundLab() AS STRING * 30

  FOR i = 1 TO 15
    OUT &H388, ASC(MID$(soundLab(Num), (i * 2) - 1, 1))
    FOR ii = 1 TO 6: temp = INP(&H388): NEXT ii
    OUT &H389, ASC(MID$(soundLab(Num), (i * 2)))
    FOR ii = 1 TO 35: temp = INP(&H388): NEXT ii
  NEXT i

END SUB

SUB playSound (nameOf AS STRING, playNow, X, Y)

  STATIC sounds() AS pointer, init
 
  IF NOT init THEN
    REDIM sounds(1 TO 15) AS pointer
    init = true
  END IF
 
  STATIC n
 
  IF playNow THEN
    n = 0
    FOR i = LBOUND(sounds) TO UBOUND(sounds)
      IF sounds(i).nameOf = "" THEN EXIT FOR
      checkCamera = true
      soundNr = 0
      SELECT CASE RTRIM$(sounds(i).nameOf)
        CASE "step"
          IF RND * 10 > 5 THEN
            soundNr = 6
          ELSE
            soundNr = 7
          END IF
        CASE "hacking wood"
          IF RND * 10 > 5 THEN
            soundNr = 5
          ELSE
            soundNr = 14
          END IF
        CASE "mine work"
          IF RND * 10 > 5 THEN
            soundNr = 3
          ELSE
            soundNr = 4
          END IF
        CASE "lost work"
          soundNr = 0
        CASE "tone"
          soundNr = 8 + RND * 5
        CASE "tone bg"
          soundNr = 15 + RND * 5
        CASE "constructing"
          soundNr = 0
        CASE "constructed"
          soundNr = 0
        CASE "barrier ahead"
          soundNr = 0
        CASE "put to bag"
          soundNr = 0
        CASE "thing move"
          soundNr = 0
        CASE "drop bag content"
          soundNr = 0
        CASE "menu"
          soundNr = 1
          checkCamera = false
        CASE "starting"
          soundNr = 0
          checkCamera = false
        CASE "finish"
          soundNr = 0
          checkCamera = false
      END SELECT
      IF soundNr > 0 THEN
        IF checkCamera THEN
          insideX = (sounds(i).X >= X + tileValues.viewx1 AND sounds(i).X <= X + tileValues.viewx2)
          insideY = (sounds(i).Y >= Y + tileValues.viewy1 AND sounds(i).Y <= Y + tileValues.viewy2)
          IF insideX AND insideY THEN heard = true
        ELSE
          heard = true
        END IF
        IF heard AND soundNr > 0 THEN playFX soundNr '''
      END IF
      sounds(i).nameOf = ""
    NEXT
   
  ELSE
    IF n < UBOUND(sounds) THEN
      n = n + 1
      sounds(n).X = X
      sounds(n).Y = Y
      sounds(n).nameOf = nameOf
    END IF
  END IF

END SUB

SUB prnt (px%, py%, sent$, foreCol%, backCol%, italic)

  COLOR 1
  sent$ = UCASE$(RTRIM$(sent$))
  LOCATE 1: PRINT sent$
  FOR X% = -1 TO scrnLtrSizeX * LEN(sent$)
    FOR Y% = -1 TO scrnLtrSizeY
      col% = POINT(X%, Y%)
      IF italic THEN ax% = scrnLtrSzy \ 2 - Y% \ 2
      IF col% > 0 THEN
        PSET (px% + X% + ax%, py% + Y%), foreCol%
      ELSE
        PSET (px% + X% + ax%, py% + Y%), backCol%
      END IF
    NEXT
  NEXT
  COLOR 25
  LOCATE 1: PRINT SPACE$(LEN(sent$))

END SUB

SUB putButton (button() AS buttonType, i%)

  IF button(i%).baseCol = 0 THEN
    baseCol% = 20
  ELSE
    baseCol% = button(i%).baseCol
  END IF
  IF button(i%).status THEN
    foreCol% = baseCol% + 4: backCol% = baseCol% + 3
  ELSE
    foreCol% = baseCol% + 2: backCol% = baseCol% + 1
  END IF
  mouseHide
  LINE (button(i%).x1, button(i%).y1)-(button(i%).x2, button(i%).y2), backCol%, BF
  'prnt button(i%).x1 + 2 + offx%, button(i%).y1 + 2 + offy%, button(i%).text, foreCol%, backCol%, false
  clearPrint button(i%).text, button(i%).x1 + 2 + offx%, button(i%).y1 + 2 + offy%, foreCol%
  LINE (button(i%).x1, button(i%).y1)-(button(i%).x2 + 1, button(i%).y2), baseCol%, B
  mouseShow
  playSound "menu", false, 0, 0
 
END SUB

FUNCTION question% (x1%, y1%, quest$, mouse AS mouseType)

  DIM box AS rect
  box.x1 = x1%: box.y1 = y1%: box.x2 = box.x1 + 140: box.y2 = box.y1 + 30
  dimSize% = getDimSize%(box.x2 - box.x1, box.y2 - box.y1)
  DIM pic%(dimSize% * 2)
  DIM button(2) AS buttonType

  button(1).baseCol = TextColor - 1
  button(1).x1 = box.x1 + 3
  button(1).y1 = box.y2 - 12
  button(1).x2 = button(1).x1 + 30
  button(1).y2 = button(1).y1 + 10
  button(1).text = "ok"
  button(1).status = -2
  button(2).baseCol = TextColor - 1
  button(2).x1 = box.x1 + 3 + 64
  button(2).y1 = box.y2 - 12
  button(2).x2 = button(2).x1 + 64
  button(2).y2 = button(2).y1 + 10
  button(2).text = "cancel"
  button(2).status = -2

  mouseHide
  GET (box.x1, box.y1)-(box.x2, box.y2), pic%
  LINE (box.x1, box.y1)-(box.x2, box.y2), TextColor - 1, BF
  LINE (box.x1, box.y1)-(box.x2, box.y2), TextColor, B
  'prnt box.x1 + 2 + 4, box.y1 + 2, quest$ + "?", TextColor + 1, TextColor - 1, true
  clearPrint quest$ + "?", box.x1 + 2 + 4, box.y1 + 2, TextColor + 1
  mouseShow

  DO
    mouseStatus mouse
    status$ = checkButton$(button(), mouse)
    keyPressed$ = INKEY$
  LOOP UNTIL status$ <> "none" OR keyPressed$ <> ""

  mouseHide
  PUT (box.x1, box.y1), pic%, PSET
  mouseShow

  IF status$ = "ok" OR keyPressed$ = CHR$(13) THEN
    question% = true
  ELSE 'IF status$ = "cancel" or keyPressed$ = CHR$(27) THEN
    question% = false
  END IF

END FUNCTION

SUB setAnim (tileAnim() AS animation, n)

  FOR ntile = LBOUND(tileAnim) TO UBOUND(tileAnim)
    tileAnim(ntile).cell = byteNone
  NEXT
 
  OPEN root + "map\anim" + form$(n) + ".dat" FOR INPUT AS #1
    DO WHILE NOT EOF(1)
      INPUT #1, ntile, nanim, speed
      tileAnim(ntile).cell = CHR$(nanim)
      tileAnim(ntile).speed = CHR$(speed)
    LOOP
  CLOSE #1

END SUB

SUB setButtons (button() AS buttonType, menuType)

  SELECT CASE menuType
    CASE menuNone
      REDIM button(1) AS buttonType
    CASE menuCastle
      REDIM button(1 TO 8) AS buttonType
      FOR i = LBOUND(button) TO UBOUND(button)
        button(i).baseCol = TextColor - 1
        offy = 0
        SELECT CASE i
          CASE 1: buttonText$ = "sound": offy = -12
          CASE 2: buttonText$ = "music": offx = offx - 50
          CASE 3: buttonText$ = "show": offy = -12
          CASE 4: buttonText$ = "pause": offx = offx - 50
          CASE 5: buttonText$ = "save": offy = -24
          CASE 6: buttonText$ = "load": offy = -12: offx = offx - 50
          CASE 7: buttonText$ = " new": offx = offx - 50
          CASE 8: buttonText$ = "quit"
        END SELECT
        button(i).x1 = 50 * i - 39 + offx + 20
        button(i).y1 = 41 + offy
        button(i).text = buttonText$
        button(i).x2 = button(i).x1 + scrnLtrSizeX * LEN(button(i).text) + 2 + -25
        button(i).y2 = button(i).y1 + scrnLtrSizeY + 2
      NEXT
    CASE menuBuild
      REDIM button(1 TO 3) AS buttonType
      FOR i = LBOUND(button) TO UBOUND(button)
        button(i).baseCol = 41
        button(i).x1 = 50 * i - 20
        button(i).y1 = 41
        SELECT CASE i
          CASE 1: buttonText$ = " <--"
          CASE 2: buttonText$ = " -->"
          CASE 3: buttonText$ = "build"
        END SELECT
        button(i).text = buttonText$
        button(i).x2 = button(i).x1 + scrnLtrSizeX * LEN(button(i).text) + 2 + -25
        button(i).y2 = button(i).y1 + scrnLtrSizeY + 2
      NEXT
    CASE menuThing
      REDIM button(1 TO 2) AS buttonType
      FOR i = LBOUND(button) TO UBOUND(button)
        button(i).baseCol = 41
        button(i).x1 = 50 * i - 20
        button(i).y1 = 41
        SELECT CASE i
          CASE 1: buttonText$ = " <--"
          CASE 2: buttonText$ = " -->"
        END SELECT
        button(i).text = buttonText$
        button(i).x2 = button(i).x1 + scrnLtrSizeX * LEN(button(i).text) + 2 + -25
        button(i).y2 = button(i).y1 + scrnLtrSizeY + 2
      NEXT
  END SELECT
  FOR i = LBOUND(button) TO UBOUND(button)
    button(i).status = -2
  NEXT

END SUB

SUB setCol (n)

  SHARED col() AS pal
  OUT &H3C8, n
  OUT &H3C9, INT(col(n).red)
  OUT &H3C9, INT(col(n).green)
  OUT &H3C9, INT(col(n).blue)

END SUB

SUB setEffect (tileEffect() AS byte, n AS INTEGER, ware() AS wares)

  FOR i = LBOUND(tileEffect) TO UBOUND(tileEffect)
    IF ware(i).part <> byteNone THEN
      tileEffect(i).B = CHR$(effectWork)
    ELSE
      tileEffect(i).B = CHR$(effectNone)
    END IF
  NEXT

  OPEN root + "map\effect" + form$(n) + ".dat" FOR INPUT AS #1
    DO WHILE NOT EOF(1)
      INPUT #1, tilen, effectN
      tileEffect(tilen).B = CHR$(effectN)
    LOOP
  CLOSE #1

END SUB

SUB setHouse (house() AS menuItem, n)
 
  OPEN root + "map\menu" + form$(n) + ".dat" FOR INPUT AS #1
    INPUT #1, flagMax
    REDIM house(flagMax) AS menuItem
    DO
      INPUT #1, i
      INPUT #1, house(i).building, house(i).needs, house(i).job, house(i).flagCol
    LOOP UNTIL i = flagMax
  CLOSE #1

END SUB

SUB setMap (map() AS layer, nr, ware() AS wares, tileEffect() AS byte, castlex, castley)

  OPEN root + "map\map_" + form$(nr) + ".mpx" FOR BINARY AS #1
    FOR X = LBOUND(map) TO UBOUND(map)
      FOR Y = LBOUND(map, 2) TO UBOUND(map, 2)
        GET #1, , map(X, Y).world
        IF ASC(tileEffect(ASC(map(X, Y).world)).B) = effectWork THEN
          nWorld = ASC(map(X, Y).world)
          IF ASC(ware(nWorld).part) = workCastle AND ASC(ware(nWorld).link) = 3 THEN
            castlex = X - 1
            castley = Y + 1
          END IF
        END IF
      NEXT
    NEXT
  CLOSE #1

END SUB

SUB setOptions (setn AS gameOptions)

  setn.music = true
  setn.bgMusic = false
  setn.showPicked = true
 
END SUB

SUB setPal

  FOR i = 0 TO byteVal
    setCol i
  NEXT

END SUB

SUB setPicLink (picLink() AS picPointer)

  FOR i = LBOUND(picLink) TO UBOUND(picLink)
    picLink(i).tle = byteNone
    picLink(i).spr = byteNone
  NEXT

END SUB

SUB setThing (thing() AS sprite, castlex, castley)

  FOR n = LBOUND(thing) TO UBOUND(thing)
    thing(n).X = castlex + n - 1
    thing(n).Y = castley
    thing(n).spdx = 0
    thing(n).spdy = 0
    thing(n).tfollow = 1'0
    thing(n).bag = byteNone
    thing(n).cell = 0
    thing(n).body = 4
    thing(n).numb = n
    thing(n).player = true
    thing(n).lazy = 1
    IF n <= 4 THEN thing(n).active = true '''
    thing(n).targetx1 = thing(n).X
    thing(n).targety1 = thing(n).Y
    thing(n).nameOf = getName$("good")
    thing(n).class = CHR$(classWorker)
  NEXT

END SUB

SUB setTile (tile AS worldValues)

  tile.viewx1 = -7
  tile.viewy1 = -4
  tile.viewx2 = 8
  tile.viewy2 = 5
  tile.limx = 90
  tile.limy = 70

END SUB

SUB setWare (ware() AS wares, n)

  FOR i = LBOUND(ware) TO UBOUND(ware)
    ware(i).part = byteNone
    ware(i).link = byteNone
    ware(i).nval = byteNone
  NEXT

  OPEN root + "map\work" + form$(n) + ".dat" FOR INPUT AS #1
    DO WHILE NOT EOF(1)
      INPUT #1, ntile, ntype, nlink, nval
      ware(ntile).part = CHR$(ntype)
      ware(ntile).link = CHR$(nlink)
      ware(ntile).nval = CHR$(nval)
    LOOP
  CLOSE #1

END SUB

SUB show (camx, camy, map() AS layer, thing() AS sprite, tileEffect() AS byte)

  SHARED setting AS gameOptions
  STATIC init, picMem(), picSprMem(), tileAnim() AS animation, picTile(), picSprite(), picLink() AS picPointer
 
  IF NOT init THEN
    init = true
    dimSize = getDimSize(tileSizeX, tileSizeY)
    REDIM picLink(byteVal) AS picPointer
    REDIM picTile(dimSize, 1 TO gameTiles)
    REDIM picSprite(dimSize, 1 TO gameSprites, left1 TO back2, layerMask TO layerSprt)
    REDIM picMem(UBOUND(picTile, 2))
    REDIM picSprMem(UBOUND(picSprite, 2))
    REDIM tileAnim(byteVal) AS animation
    setAnim tileAnim(), 1 ' mapNum
    setPicLink picLink()
  END IF
 
  DIM picTmp(UBOUND(picTile)), picTmp2(UBOUND(picTile))
  STATIC picIndex, picSprIndex

  FOR X = tileValues.viewx1 TO tileValues.viewx2
    FOR Y = tileValues.viewy1 TO tileValues.viewy2
     
      nWorld = ASC(map(camx + X, camy + Y).world)
     
      ntilew$ = tileAnim(ASC(map(camx + X, camy + Y).world)).cell
      IF NOT ntilew$ = byteNone THEN
        IF RND * 100 > 98 \ ASC(tileAnim(nWorld).speed) THEN
          map(camx + X, camy + Y).world = ntilew$
        END IF
      END IF
     
      numbr = ASC(map(camx + X, camy + Y).object)
      IF numbr <> 0 THEN
        nObject = thing(numbr).body
      ELSE
        nObject = 0
      END IF
     
      IF numbr <> 0 THEN
        changed = thing(numbr).changed
      ELSE
        changed = false
      END IF
      IF checkScreenChange(X, Y, nWorld, numbr, changed) THEN
       
        IF NOT mouseHidden THEN
          mouseHide
          mouseHidden = true
        END IF
       
        IF NOT picLink(nWorld).tle = byteNone THEN
          newn = ASC(picLink(nWorld).tle)
        ELSE
          IF picIndex < UBOUND(picTile, 2) THEN
            picIndex = picIndex + 1
          ELSE
            picIndex = LBOUND(picTile, 2)
          END IF
          i = picIndex
          getPic picTile(), nWorld, i
          picLink(picMem(i)).tle = byteNone
          picMem(i) = nWorld
          picLink(nWorld).tle = CHR$(i)
          newn = i
        END IF
        PUT (scrnMidX + X * tileSizeX + offx, scrnMidY + Y * tileSizeY + offy), picTile(0, newn), PSET
       
        IF nObject <> 0 THEN
          IF NOT picLink(nObject).spr = byteNone THEN
            newn = ASC(picLink(nObject).spr)
          ELSE
            IF picSprIndex < UBOUND(picSprite, 2) THEN
              picSprIndex = picSprIndex + 1
            ELSE
              picSprIndex = LBOUND(picSprite, 2)
            END IF
            i = picSprIndex
            getSprPic picSprite(), nObject, i
            picLink(picSprMem(i)).spr = byteNone
            picSprMem(i) = nObject
            picLink(nObject).spr = CHR$(i)
            newn = i
          END IF
         
          IF thing(numbr).lazy <> 0 THEN
            offxs = tileSizeX - thing(numbr).lazy * (tileSizeX \ gameLazyDefault)
            offys = tileSizeY - thing(numbr).lazy * (tileSizeY \ gameLazyDefault)
          ELSE
            offxs = 0
            offys = 0
          END IF
          screenx = scrnMidX + X * tileSizeX + thing(numbr).spdx * offxs
          screeny = scrnMidY + Y * tileSizeY + thing(numbr).spdy * offys
         
          IF setting.showPicked AND thing(numbr).picked THEN
            IF ASC(tileEffect(nWorld).B) = effectHide THEN
              ySubtr = -4
            ELSE
              ySubtr = 0
            END IF
            LINE (scrnMidX + X * tileSizeX + offx + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + thing(numbr).spdy * offys)-STEP(tileSizeX - 1, tileSizeY - 1 + ySubtr), 0, B
            LINE (scrnMidX + X * tileSizeX + offx + 2 + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + 2 + thing(numbr).spdy * offys)-STEP(tileSizeX - 5, tileSizeY - 5 + ySubtr), 0, B
            LINE (scrnMidX + X * tileSizeX + offx + 1 + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + 1 + thing(numbr).spdy * offys)-STEP(tileSizeX - 3, tileSizeY - 3 + ySubtr), byteVal, B
          END IF

          borderTile = (X = tileValues.viewx1 OR X = tileValues.viewx2)
          borderTile = borderTile OR (Y = tileValues.viewy1 OR Y = tileValues.viewy2)
         
          IF borderTile AND thing(numbr).lazy <> 0 OR ASC(tileEffect(nWorld).B) = effectHide THEN
            IF X = tileValues.viewx1 AND SGN(thing(numbr).spdx) = -1 THEN  ' left
              clipx1 = offxs
              clipx2 = tileSizeX - 1
              screenx = scrnMidX + X * tileSizeX ' -> 0
            ELSEIF X = tileValues.viewx2 AND SGN(thing(numbr).spdx) = 1 THEN ' right
              clipx1 = 0
              clipx2 = tileSizeX - offxs - 1
            ELSE
              clipx1 = 0
              clipx2 = tileSizeX - 1
            END IF
            IF Y = tileValues.viewy1 AND SGN(thing(numbr).spdy) = -1 THEN  ' top
              clipy1 = offys
              clipy2 = tileSizeY - 1
              screeny = scrnMidY + Y * tileSizeY
            ELSEIF Y = tileValues.viewy2 AND SGN(thing(numbr).spdy) = 1 THEN ' bottom
              clipy1 = 0
              clipy2 = tileSizeY - offys - 1
            ELSE
              clipy1 = 0
              clipy2 = tileSizeY - 1
            END IF
           
            IF ASC(tileEffect(nWorld).B) = effectHide THEN
              IF clipy2 > tileSizeY \ 2 + 2 THEN clipy2 = tileSizeY \ 2 + 2
            END IF
           
            FOR pxl = 0 TO UBOUND(picTmp)
              picTmp(pxl) = picSprite(pxl, newn, thing(numbr).cell, layerMask)
            NEXT
            cliparray picTmp(), picTmp2(), clipx1, clipy1, clipx2, clipy2
            PUT (screenx, screeny), picTmp2(0), AND
            FOR pxl = 0 TO UBOUND(picTmp)
              picTmp(pxl) = picSprite(pxl, newn, thing(numbr).cell, layerSprt)
            NEXT
            cliparray picTmp(), picTmp2(), clipx1, clipy1, clipx2, clipy2
            PUT (screenx, screeny), picTmp2(0), OR
          ELSE
            PUT (screenx, screeny), picSprite(0, newn, thing(numbr).cell, layerMask), AND
            PUT (screenx, screeny), picSprite(0, newn, thing(numbr).cell, layerSprt), OR
          END IF
          thing(numbr).changed = false
       
          IF setting.showPicked AND thing(numbr).picked THEN
            LINE (scrnMidX + X * tileSizeX + offx + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + tileSizeY - 1 + ySubtr + thing(numbr).spdy * offys)-STEP(tileSizeX - 1, 0), 0', B
            LINE (scrnMidX + X * tileSizeX + offx + 2 + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + 2 + tileSizeY - 5 + ySubtr + thing(numbr).spdy * offys)-STEP(tileSizeX - 5, 0), 0', B
            LINE (scrnMidX + X * tileSizeX + offx + 1 + thing(numbr).spdx * offxs, scrnMidY + Y * tileSizeY + offy + 1 + tileSizeY - 3 + ySubtr + thing(numbr).spdy * offys)-STEP(tileSizeX - 3, 0), byteVal', B
          END IF

        END IF
        
      END IF
    NEXT
  NEXT
 
  IF mouseHidden THEN mouseShow

END SUB

SUB sleepClick (seconds, mouse AS mouseType)

  clock! = TIMER
  DO
    mouseStatus mouse
  LOOP UNTIL (mouse.left OR mouse.right) OR (seconds > 0 AND clock! + seconds - TIMER <= 0) OR INKEY$ <> ""

END SUB

FUNCTION thingBarrier (X, Y, map() AS layer, tileEffect() AS byte, thing AS sprite)

  tile = ASC(map(X, Y).world)
  SELECT CASE ASC(tileEffect(tile).B)
    CASE effectBarrier, effectWork
      barrier = true
  END SELECT
  IF barrier = false AND map(X, Y).object <> byteNone THEN
    barrier = true
  END IF

  thingBarrier = barrier

END FUNCTION

SUB thingCell (thing AS sprite)

  IF thing.dirx = -1 THEN
    IF thing.cell = left1 THEN
      thing.cell = left2
    ELSE
      thing.cell = left1
    END IF
  ELSEIF thing.dirx = 1 THEN
    IF thing.cell = rght1 THEN
      thing.cell = rght2
    ELSE
      thing.cell = rght1
    END IF
  ELSEIF thing.diry = -1 THEN
    IF thing.cell = back1 THEN
      thing.cell = back2
    ELSE
      thing.cell = back1
    END IF
  ELSEIF thing.diry = 1 THEN
    IF thing.cell = frnt1 THEN
      thing.cell = frnt2
    ELSE
      thing.cell = frnt1
    END IF
  ELSE
    thing.cell = frnt1
  END IF

END SUB

SUB thingFindPlace (thing AS sprite, map() AS layer, foundPlace, ware() AS wares, ntile)

  foundPlace = false
  FOR Y = -1 TO 0
    FOR X = -1 TO 1
      IF NOT (X = 0 AND Y = 0) AND NOT foundPlace THEN
        mx = thing.targetx1 + X
        my = thing.targety1 + Y
        IF map(mx, my).world <> ware(ntile).nval AND ASC(map(mx, my).object) = 0 THEN
          foundPlace = true
          map(mx, my).world = ware(ntile).nval
          playSound "drop bag content", false, thing.X, thing.Y
        END IF
      END IF
    NEXT
  NEXT

END SUB

SUB thingFollow (thing AS sprite, targx, targy)
 
  IF thing.X < targx THEN
    thing.spdx = 1
  ELSEIF thing.X > targx THEN
    thing.spdx = -1
  ELSE
    thing.spdx = 0
  END IF
  IF thing.Y < targy THEN
    thing.spdy = 1
  ELSEIF thing.Y > targy THEN
    thing.spdy = -1
  ELSE
    thing.spdy = 0
  END IF

  IF thing.spdx <> 0 AND thing.spdy <> 0 THEN
    IF RND * 10 > 5 THEN
      thing.spdx = 0
    ELSE
      thing.spdy = 0
    END IF
  END IF

  IF thing.findPath = 1 THEN
    IF RND * 10 > 5 THEN
      direction = 1
    ELSE
      direction = -1
    END IF
    thingRotate thing, direction
   
    IF RND * 16 > 14 THEN
      thingRandom thing
      IF thing.spdx <> 0 AND thing.spdy <> 0 THEN
        IF RND * 10 > 5 THEN
          thing.spdx = 0
        ELSE
          thing.spdy = 0
        END IF
      END IF
    ELSE
      thing.findPath = 0 'false
    END IF
 
  ELSEIF thing.findPath = 2 AND RND * 10 > 5 THEN
    thing.changed = true
    thingCell thing
  END IF

END SUB

SUB thingHandle (thing AS sprite, thingAr() AS sprite, map() AS layer, tileEffect() AS byte, ware() AS wares)

  IF thing.lazy = 0 THEN
    thing.lazy = gameLazyDefault
  ELSE
    thing.lazy = thing.lazy - 1
  END IF
 
  IF thing.spdx <> 0 OR thing.spdy <> 0 THEN
    IF NOT map(thing.X + thing.spdx, thing.Y + thing.spdy).object = byteNone THEN
      barrierAhead = true
      thing.findPath = 1
    END IF
  END IF
  ntile = ASC(map(thing.X + thing.spdx, thing.Y + thing.spdy).world)
  SELECT CASE ASC(tileEffect(ntile).B)
    CASE effectBarrier
      barrierAhead = true
      playSound "barrier ahead", false, thing.X, thing.Y
      thing.findPath = 1 ' true
    CASE effectWork
      barrierAhead = true
      thingWork thing, thingAr(), map(), relatedWork, ntile, ware()
      IF NOT relatedWork THEN
        thing.findPath = 1 ' true
      ELSE
        thing.findPath = 2 ' work
      END IF
  END SELECT
 
  IF thing.lazy = 0 THEN
   
    IF (NOT barrierAhead) AND map(thing.X + thing.spdx, thing.Y + thing.spdy).object = byteNone THEN
   
      map(thing.X, thing.Y).object = byteNone
      thing.X = thing.X + thing.spdx
      thing.Y = thing.Y + thing.spdy
      playSound "step", false, thing.X, thing.Y
      thing.changed = true
      map(thing.X, thing.Y).object = CHR$(thing.numb)
      thingCell thing
    
    END IF
     
    IF thing.tfollow = 1 THEN
      IF thing.X = thing.targetx1 AND thing.Y = thing.targety1 THEN getLazy = true
      thingFollow thing, thing.targetx1, thing.targety1
    ELSEIF thing.tfollow = 2 THEN
      IF RND * 100 > 98 THEN
        IF thing.X = thing.targetx2 AND thing.Y = thing.targety2 THEN getLazy = true
      END IF
      thingFollow thing, thing.targetx2, thing.targety2
    ELSE
      thingFollow thing, thing.targetx3, thing.targety3
      IF thing.X + thing.spdx = thing.targetx3 AND thing.Y + thing.spdy = thing.targety3 THEN thing.tfollow = 1
    END IF
    IF getLazy AND RND * 100 > 98 THEN
      DO
        thing.targetx3 = thing.X + (RND * (gameThingView * 2)) - gameThingView
        thing.targety3 = thing.Y + (RND * (gameThingView * 2)) - gameThingView
      LOOP UNTIL NOT thingBarrier(thing.targetx3, thing.targety3, map(), tileEffect(), thing)
      thing.tfollow = 3
    END IF
   
    thing.dirx = thing.spdx
    thing.diry = thing.spdy

  ELSEIF thing.spdx <> 0 OR thing.spdy <> 0 THEN
    thing.changed = true
 
  END IF

  IF barrierAhead THEN
    thing.spdx = 0
    thing.spdy = 0
  END IF
 
END SUB

SUB thingLooseWork (thing AS sprite)
 
  thing.targetx2 = thing.targetx1
  thing.targety2 = thing.targety1 + 1
  thing.tfollow = 2
  thing.changed = false
  playSound "lost work", false, thing.X, thing.Y

END SUB

SUB thingRandom (thing AS sprite)
       
  IF thing.spdx <> 0 AND thing.spdy <> 0 THEN
    IF RND * 10 > 5 THEN
      thing.spdx = 0
    ELSE
      thing.spdy = 0
    END IF
  ELSEIF thing.spdx <> 0 THEN
    IF RND * 10 > 5 THEN
      thing.spdy = -1
    ELSE
      thing.spdy = 1
    END IF
  ELSEIF thing.spdy <> 0 THEN
    IF RND * 10 > 5 THEN
      thing.spdx = -1
    ELSE
      thing.spdx = 1
    END IF
  END IF

END SUB

SUB thingRotate (thing AS sprite, D)

  IF thing.spdx = -1 THEN
    thing.spdx = 0
    thing.spdy = -1 * D
  ELSEIF thing.spdy = -1 * D THEN
    thing.spdx = 1 * D
    thing.spdy = 0
  ELSEIF thing.spdx = 1 * D THEN
    thing.spdx = 0
    thing.spdy = 1 * D
  ELSEIF thing.spdy = 1 * D THEN
    thing.spdx = -1 * D
    thing.spdy = 0
  END IF

END SUB

SUB thingSearch (map() AS layer, thing AS sprite, thingAr() AS sprite, ware() AS wares, ntile, giveUpFast, lookForSpecial)

  ' dummys had to be assigned before if expressions
  ' because of compiler error 'too complex'
 
  lastDistance = gameThingView * 2
 
  FOR X = -gameThingView TO gameThingView
    FOR Y = -gameThingView TO gameThingView
      mx = thing.X + X
      my = thing.Y + Y
      IF (mx >= -tileValues.limx AND mx <= tileValues.limx) AND (my >= -tileValues.limy AND my <= tileValues.limy) THEN
        
        dummy1$ = ware(ASC(map(mx, my).world)).part
        dummy2$ = ware(ASC(map(mx, my).world)).part
        
        IF dummy1$ = CHR$(workWare) OR dummy2$ = CHR$(workHouseWare) THEN
          wareTypeWare = true
        ELSE
          wareTypeWare = false
        END IF
        
        IF lookForSpecial <> 0 THEN
          dummy$ = CHR$(lookForSpecial)
        ELSE
          dummy$ = ware(ntile).link
        END IF
       
        IF ware(ASC(map(mx, my).world)).link = dummy$ THEN
          wareTypeType = true
        ELSE
          wareTypeType = false
        END IF

        IF wareTypeWare AND wareTypeType THEN
          workedOn = false
        
          FOR n = LBOUND(thingAr) TO UBOUND(thingAr)
            IF thingAr(n).targetx2 = mx AND thingAr(n).targety2 = my THEN
              workedOn = true
            END IF
          NEXT
          IF NOT workedOn THEN
            distance = ABS(X) + ABS(Y)
            IF distance < lastDistance THEN
              foundOne = true
              lastDistance = distance
              thing.targetx2 = mx
              thing.targety2 = my
              thing.tfollow = 2
            END IF
          END IF
        
        END IF
     
      END IF
    NEXT
  NEXT
 
  IF (NOT foundOne) AND giveUpFast THEN thingLooseWork thing
 
END SUB

SUB thingWork (thing AS sprite, thingAr() AS sprite, map() AS layer, relatedWork, ntile, ware() AS wares)

  SELECT CASE ASC(ware(ntile).part)
    CASE workHouse ' ware type needed, filled place tile
      IF (NOT thing.lazy) AND thing.tfollow = 1 AND (thing.X + thing.spdx = thing.targetx1 AND thing.Y + thing.spdy = thing.targety1) THEN
        relatedWork = true
        IF NOT thing.bag = byteNone THEN
          thingFindPlace thing, map(), foundPlace, ware(), ntile ''' function failed
        ELSE
          foundPlace = true
        END IF
        IF foundPlace THEN
          thing.body = 1
          thing.bag = byteNone
          FOR ay = -1 TO 0
            FOR ax = -1 TO 1
              IF NOT (ax = 0 AND ay = 0) THEN
                mx = thing.targetx1 + ax
                my = thing.targety1 + ay
                IF map(mx, my).world <> ware(ntile).nval THEN '''
                  stillFreePlace = true
                END IF
              END IF
            NEXT
          NEXT
          IF stillFreePlace THEN
            thingSearch map(), thing, thingAr(), ware(), ntile, true, 0
          ELSE
            thingLooseWork thing
          END IF
        ELSE
          thingLooseWork thing
        END IF
      END IF
       
    CASE workWare ' ware type, empty ware tile
      IF (NOT thing.lazy) AND thing.tfollow = 2 AND (thing.X + thing.spdx = thing.targetx2 AND thing.Y + thing.spdy = thing.targety2) THEN
        relatedWork = true
        IF ASC(ware(ASC(map(thing.targetx1, thing.targety1).world)).part) = 3 THEN
          thing.working = workLazy
        END IF
        IF thing.working < workLazy THEN ''' failed
          thing.working = thing.working + 1
          SELECT CASE ASC(ware(ntile).link)
            CASE 4
              thing.body = 4
            CASE 3
              thing.body = 2
              IF RND * 20 > 14 THEN playSound "mine work", false, thing.X, thing.Y
            CASE ELSE
              thing.body = 2
              IF RND * 20 > 14 THEN playSound "hacking wood", false, thing.X, thing.Y
          END SELECT
        ELSE
          playSound "put to bag", false, thing.X, thing.Y
          map(thing.targetx2, thing.targety2).world = ware(ntile).nval
          thing.bag = CHR$(1) '''
          thing.body = 3      '''
          thing.working = 0
          thing.tfollow = 1
        END IF
      END IF
   
    CASE workConstr ' ware type, construction part 1-3 -> needs always wood
      IF (NOT thing.lazy) AND thing.tfollow = 1 AND (thing.X + thing.spdx = thing.targetx1 AND thing.Y + thing.spdy = thing.targety1) THEN
        relatedWork = true
        IF thing.working = workLazy THEN thing.working = 0
        thing.working = thing.working + 1
       
         IF thing.bag <> byteNone THEN
          thing.body = 2
         
          IF thing.working = workLazy THEN
            thing.body = 1
            thing.bag = byteNone
           
            constructionPart = ASC(ware(ntile).nval)
            playSound "constructed", false, thing.X, thing.Y
            IF constructionPart < 3 THEN
              FOR n = LBOUND(ware) TO UBOUND(ware)
                IF n <> ntile AND ASC(ware(n).part) = 3 AND ware(n).link = ware(ntile).link THEN
                  IF ASC(ware(n).nval) = constructionPart + 1 THEN
                    map(thing.X + thing.spdx, thing.Y + thing.spdy).world = CHR$(n)
                    EXIT FOR
                  END IF
                END IF
              NEXT
              thingSearch map(), thing, thingAr(), ware(), ntile, false, workWood
            ELSE
              FOR n = LBOUND(ware) TO UBOUND(ware)
                IF (ASC(ware(n).part) = workHouse OR ASC(ware(n).part) = workHWHouse OR ASC(ware(n).part) = workClassHouse) AND ware(n).link = ware(ntile).link THEN '''
                  map(thing.X + thing.spdx, thing.Y + thing.spdy).world = CHR$(n)
                END IF
              NEXT
              thingLooseWork thing
            END IF
           
          ELSE
            playSound "constructing", false, thing.X, thing.Y
          END IF
       
        ELSE
          IF thing.working = workLazy THEN
            thingSearch map(), thing, thingAr(), ware(), ntile, false, workWood
          END IF
        END IF
      
      END IF
    
    'CASE workCastle
    CASE workHouseWare ' (ware type, ...empty ware tile...)
      IF (NOT thing.lazy) AND thing.tfollow = 2 AND (thing.X + thing.spdx = thing.targetx2 AND thing.Y + thing.spdy = thing.targety2) THEN
        relatedWork = true
        IF ASC(ware(ASC(map(thing.targetx1, thing.targety1).world)).part) = 3 THEN
          thing.working = 20
        END IF
        IF thing.working < 20 THEN ''' failed
          thing.working = thing.working + 1
          SELECT CASE ASC(ware(ntile).link)
            CASE ELSE
              thing.body = 3
              IF RND * 20 > 17 THEN playSound "put to bag", false, thing.X, thing.Y
          END SELECT
        ELSE
          playSound "put to bag", false, thing.X, thing.Y
          map(thing.targetx2, thing.targety2).world = ware(ntile).nval
          thing.bag = CHR$(1) '''
          thing.body = 3      ''''
          thing.working = 0
          thing.tfollow = 1
        END IF
      END IF
     
    CASE workHWHouse ' (houseWare needed, filled place tile)
      IF (NOT thing.lazy) AND thing.tfollow = 1 AND (thing.X + thing.spdx = thing.targetx1 AND thing.Y + thing.spdy = thing.targety1) THEN
        relatedWork = true
        IF thing.working = workLazy THEN thing.working = 0
        thing.working = thing.working + 1
        IF thing.bag <> byteNone THEN
             
          IF thing.working = workLazy THEN
            IF NOT thing.bag = byteNone THEN
              thingFindPlace thing, map(), foundPlace, ware(), ntile ''' function failed
            ELSE
              foundPlace = true
            END IF
            IF foundPlace THEN
              thing.body = 1
              thing.bag = byteNone
              FOR ay = -1 TO 0
                FOR ax = -1 TO 1
                  IF NOT (ax = 0 AND ay = 0) THEN
                    mx = thing.targetx1 + ax
                    my = thing.targety1 + ay
                    IF map(mx, my).world <> ware(ntile).nval THEN '''
                      stillFreePlace = true
                    END IF
                  END IF
                NEXT
              NEXT
              IF stillFreePlace THEN
                thingSearch map(), thing, thingAr(), ware(), ntile, true, 0
              ELSE
                thingLooseWork thing
              END IF
            ELSE
              thingLooseWork thing
            END IF
          ELSE
             playSound "constructing", false, thing.X, thing.Y
          END IF
       
        ELSE
          IF thing.working = workLazy THEN
            thingSearch map(), thing, thingAr(), ware(), ntile, false, 0 ''''
          END IF
        END IF
      END IF
 
    CASE workClassHouse ' houseWare needed, new class
      IF thing.class <> CHR$(classSoldier) AND (NOT thing.lazy) AND thing.tfollow = 1 AND (thing.X + thing.spdx = thing.targetx1 AND thing.Y + thing.spdy = thing.targety1) THEN
        relatedWork = true
        IF thing.working = workLazy THEN thing.working = 0
          thing.working = thing.working + 1
          IF thing.bag <> byteNone THEN
            
            IF thing.working = workLazy THEN
              thing.class = ware(ntile).nval ''''
              SELECT CASE ASC(thing.class)
                CASE classSoldier:  thing.body = 5
                CASE classWizard:   thing.body = 6
                CASE classPriest:   thing.body = 7
              END SELECT
              thing.bag = byteNone
              ''thingLooseWork thing
              playSound "new class", false, thing.X, thing.Y
            END IF
          ELSE
            IF thing.working = workLazy THEN
              thingSearch map(), thing, thingAr(), ware(), ntile, false, 0 ''''
            END IF
          END IF
         
        ELSE ''''
          ' look for enemy
        END IF
         
  END SELECT

END SUB