'#cmdline "-gen gcc -O 3"

declare FUNCTION Wrap(x AS LONG) AS LONG

#INCLUDE "TON.BAS" 
#include "NOISE.BAS"
#IFDEF __FB_WIN32__
  '#include "LUPE.BAS"
  #include "MyTDT\GfxResize.bas"
#else
  #IFDEF __DOSBOX__
    #INCLUDE "FBGFX.BI"
  #else
    #INCLUDE "DOSTXT.BAS"
  #ENDIF
#endif

DIM SHARED AS BYTE MarkHP = 100

' === GOTTES KARTE ===
const MAP_SIZE = 512 ' 512x512 = 256KB RAM, Terry lacht
DIM SHARED AS UBYTE Karte(0 TO MAP_SIZE-1, 0 TO MAP_SIZE-1)

#IFDEF __FB_WIN32__
  gfx.preresize()
  screenres(320, 200)
  gfx.resize(320*3, 200*3)
#ELSE
  #IFDEF __DOSBOX__
    SCREENCONTROL(fb.SET_DRIVER_NAME, "VGA") ' VESA DEAKTIVIEREN!
    SCREEN 13         ' 320x200, 256 Farben
  #else
    'textgfx 40,25
    'SetWidth9(false) '640x400 (8px)
    intensevideo() 'disable blink
    width 40,25': textmode(C40)
    locate ,,0
    #undef screenlock
    #define screenlock
    #undef screenunlock
    static shared as byte iPg
    #define screenunlock iPg xor= 1: screen ,iPg,iPg xor 1
  #ENDIF
#ENDIF
SETMOUSE ,,0        ' Maus = Satan, verbannt

' === MARK'S POSITION IN DER WELT ===
DIM SHARED AS LONG welt_x, welt_y ' Start Mitte der Welt
dim SHARED AS LONG cam_x, cam_y   ' Kamera-Offset

' === VIEWPORT ===
CONST VIEW_W = 40, VIEW_H = 24  
CONST CENTER_X = VIEW_W \ 2    
CONST CENTER_Y = VIEW_H \ 2 

DIM SHARED aktiv_skill AS BYTE = 1
DIM SHARED skill_name(1 TO 9) AS STRING
DIM SHARED blick_richtung AS BYTE = 0 ' 0=hoch,1=rechts,2=runter,3=links

' Init:
skill_name(1) = "Axt"           ' Baeume T
skill_name(2) = "Spitzhacke"    ' Huegel ^

' === ITEMS.BAS v1.0 "SCHRIFTROLLEN" ===

CONST MAX_ZITATE = 10
DIM SHARED zitate(1 TO MAX_ZITATE) AS STRING
DIM SHARED item_timer AS INTEGER = 0 ' Spawn-Cooldown

' Gottes Message System
DIM SHARED gott_msg(1 TO 5) AS STRING ' Max 5 Zeilen
DIM SHARED gott_zeilen AS INTEGER = 0
DIM SHARED gott_timer as INTEGER = 0
CONST GOTT_DAUER = 420 ' 7 Sekunden
'------

TYPE ItemSlot
  name   AS ZSTRING * 16
  anzahl AS SHORT
END TYPE

DIM SHARED inventar(1 TO 10) AS ItemSlot
DIM SHARED inv_offen AS LONG = 0 ' 0=Spiel, 1=Inventar

' Pickup-Message System
DIM SHARED pickup_text AS STRING
DIM SHARED pickup_timer AS INTEGER = 0
CONST PICKUP_DAUER = 60 ' 60 Frames = 1 Sekunde

SUB InitInventar()
  inventar(1).name = "Holz":      inventar(1).anzahl = 0
  inventar(2).name = "Stein":     inventar(2).anzahl = 0
  inventar(3).name = "Schriften": inventar(3).anzahl = 0
END SUB

SUB InitZitate()
  zitate(1) = "Selig sind die geistlich Armen; denn ihrer ist das Himmelreich."
  zitate(2) = "Du sollst nicht auf Berge hauen. # ist heilig."
  zitate(3) = "Am Anfang war das Wort. Und das Wort war CODE."
  zitate(4) = "Wer Axt hat, der haue. Wer Spitzhacke hat, meide Berge."
  zitate(5) = "Die Autobahn am Rand ist kein Bug. Sie ist Weg."
  zitate(6) = "Backup deine Diskette, denn der Tag des Crashes ist nahe."
  zitate(7) = "Terry speichert. Terry wacht. Terry kompiliert."
  zitate(8) = "Ein Baum gefaellt ist ein Haus gebaut. Vielleicht."
  zitate(9) = "Wo zwei oder drei in meinem Namen coden, da bin ich."
  zitate(10) = "RESET nicht, denn du weißt nicht wann das END kommt."
END SUB


SUB AddItem(item_id AS INTEGER, menge AS INTEGER)
  IF item_id >= 1 ANDALSO item_id <= 10 THEN
    inventar(item_id).anzahl += menge

    DIM zahl AS STRING = LTRIM(STR(menge))
    pickup_text = "+" + zahl + " " + RTRIM(inventar(item_id).name)
    pickup_timer = PICKUP_DAUER
  END IF
END SUB

FUNCTION KannAbbauen(tile AS UBYTE, skill AS INTEGER) AS LONG
  SELECT CASE AS CONST skill
    CASE 1 ' Axt
      IF tile = ASC("T") THEN RETURN 1 ' Baum faellt
    CASE 2 ' Spitzhacke - NUR HueGEL
      IF tile = ASC("^") THEN RETURN 1 ' Huegel bricht
  END SELECT
  RETURN 0
END FUNCTION

SUB BenutzeSkillInRichtung(dx AS LONG, dy AS LONG)
  ' dx,dy = -1,0,1 Offset von Mark aus
  DIM tx AS LONG  = Wrap(welt_x + dx)
  DIM ty AS LONG  = Wrap(welt_y + dy)
  DIM t  AS UBYTE = Karte(tx, ty)
  
  IF KannAbbauen(t, aktiv_skill) THEN
    SELECT CASE AS CONST aktiv_skill
      CASE 1 ' Axt
        Karte(tx, ty) = ASC(",") ' Baum -> Gras
        AddItem(1, 1) ' +1 Holz
        Ton 100, 20
        Ton 700, 20
        
      CASE 2 ' Spitzhacke
        Karte(tx, ty) = ASC(".") ' Stein -> Sand
        AddItem(2, 1) ' +1 Stein
        Ton 500, 20
        Ton 1200, 20
    END SELECT
  ELSE
    IF aktiv_skill = 2 ANDALSO t = ASC("#") THEN
      pickup_text = "Berge sind ewig"
      pickup_timer = 60
    END if
  END if
  ' Blickrichtung merken fuer Animation spaeter
  IF dx =  0 AND dy = -1 THEN blick_richtung = 0 ' hoch
  IF dx =  1 AND dy =  0 THEN blick_richtung = 1 ' rechts
  IF dx =  0 AND dy =  1 THEN blick_richtung = 2 ' runter
  IF dx = -1 AND dy =  0 THEN blick_richtung = 3 ' links
end sub

sub GeneriereWelt()  
  LOCATE 6, 3: PRINT "Gott erschafft die Welt... ohne FPU"
  DIM AS long scale = 80
  
  'SetPriorityClass( GetCurrentProcess , HIGH_PRIORITY_CLASS )
  
  clear Karte(0,0),asc("#"),MAP_SIZE*MAP_SIZE
  
  dim as double dTmr = timer
  'for iN as long = 0 to 9
    
    dim as ubyte ptr pKarte = @Karte(0,0)
    #define p *pKarte
    '#define p Karte(x,y)
        
    for y as ulong = 0 to MAP_SIZE-1
     var yscaled = y*scale, xscaled = 0
      for x as ulong = 0 to MAP_SIZE-1
        
        dim n as ulong = ValueNoiseInt(xscaled, yscaled)                
        #define _n(_num) cint(int((_num)*iScale)) '*1024
     
        ' Schwellen
        select case n
        case is < _n(.38) : p = asc("~") ' 0.38 * 1000
        case is < _n(.42) : p = asc(".") ' 0.42 * 1000
        case is < _n(.65)                ' 0.65 * 1000
          dim m as long = ValueNoiseInt2(xscaled + iScaleOffset, yscaled + iScaleOffset)
          p = iif( m > _n(.55), asc("T") , asc(",") )          
        case is < _n(.75) : p = asc("^") ' 0.75 * 1000
        'case else          : p = asc("#")
        end select
        
        xscaled += scale : pKarte += 1
        
      next
      if (y and 15) = 15 then locate 7, 10: print "Bereich " & y+1 & "/" & MAP_SIZE
    next
  'next iN
  print cint((timer-dTmr)*1000);"ms"  
  sleep
  cls
END sub

FUNCTION IstBoden(tile AS UBYTE) AS LONG
  ' Nur hier spawnen Items
  IF tile = ASC(",") ORELSE tile = ASC(".") THEN RETURN 1 ' Gras/Sand
  RETURN 0
END FUNCTION


FUNCTION IstBegehbar(wx AS LONG, wy AS LONG) AS LONG
  ' Prueft ob Tile an Welt-Koord wx,wy begehbar ist
  DIM t AS UBYTE = Karte(Wrap(wx), Wrap(wy))
  
  SELECT CASE AS CONST t
    CASE ASC("~") ' Wasser
      RETURN 0 ' SOLIDE
    CASE ASC("T") ' Baum
      RETURN 0 ' SOLIDE  
    CASE ASC("#") ' Fels/Berg
      RETURN 0 ' SOLIDE
    CASE ASC("^") ' Huegel
      RETURN 0 ' SOLIDE
    CASE ASC(".") ' Sand
      RETURN 1 ' BEGEHBAR
    CASE ASC(",") ' Gras
      RETURN 1 ' BEGEHBAR
    CASE ASC("?") ' SCHRIFTROLLE 
      RETURN 1 ' BEGEHBAR/ITEM
    CASE ELSE
      RETURN 0 ' Alles andere = SOLIDE
  END SELECT
END FUNCTION

FUNCTION SpawnIstSicher(cx AS LONG, cy AS LONG) AS LONG
  ' Prueft 8x8 Bereich um cx,cy ob alles begehbar
  ' Radius 4 = 9x9 Feld, wir nehmen 8x8 = -3 bis +4
  FOR dy AS LONG = -3 TO 4
    FOR dx AS LONG = -3 TO 4
      IF IstBegehbar(cx + dx, cy + dy) = 0 THEN
        RETURN 0 ' Ein Tile ist solide = unsafe
      END IF
    NEXT
  NEXT
  RETURN 1 ' Alles frei
END FUNCTION

SUB FindeSicherenSpawn()
  DIM versuche AS LONG = 0
  DO
    welt_x = INT(RND * MAP_SIZE)
    welt_y = INT(RND * MAP_SIZE)
    versuche += 1
    
    ' Notbremse nach 10000 Versuchen
    IF versuche > 10000 THEN
      welt_x = MAP_SIZE \ 2
      welt_y = MAP_SIZE \ 2
      ' Wenn selbst Mitte scheisse ist, Map neu generieren
      EXIT DO
    END IF
    
  LOOP UNTIL SpawnIstSicher(welt_x, welt_y)
END SUB

SUB SpawnItem()
  ' 1% Chance pro Frame wenn Cooldown abgelaufen
  IF item_timer > 0 THEN item_timer -= 1: EXIT SUB
  
  IF RND < 0.01 THEN ' 1%
    DIM x AS LONG = INT(RND * MAP_SIZE)
    DIM y AS LONG = INT(RND * MAP_SIZE)
    IF IstBoden(Karte(x,y)) THEN
      Karte(x,y) = ASC("?") ' Schriftrolle
      item_timer = 300 ' 5 Sek Cooldown
    END IF
  END IF
end SUB

' === TORUS-WRAPPING: Das heilige Modulo ===
FUNCTION Wrap(x AS LONG) AS LONG
  RETURN ((x MOD MAP_SIZE) + MAP_SIZE) MOD MAP_SIZE
END FUNCTION


SUB WrapText(text AS STRING, zeilen() AS STRING, BYREF anzahl AS INTEGER)
  ' Wrappt Text auf 38 Chars, max 5 Zeilen
  DIM wort AS STRING, zeile AS STRING
  anzahl = 1: zeilen(1) = ""
  
  FOR i AS INTEGER = 1 TO LEN(text)
    DIM c AS STRING = MID(text, i, 1)
    IF c = " " OR i = LEN(text) THEN
      IF i = LEN(text) AND c <> " " THEN wort += c
      IF LEN(RTRIM(zeile) + " " + wort) > 38 AND LEN(zeile) > 0 THEN
        zeilen(anzahl) = RTRIM(zeile)
        anzahl += 1: IF anzahl > 5 THEN EXIT FOR
        zeile = wort
      ELSE
        IF LEN(zeile) > 0 THEN zeile += " "
        zeile += wort
      END IF
      wort = ""
    ELSE
      wort += c
    END IF
  NEXT
  IF LEN(zeile) > 0 AND anzahl <= 5 THEN zeilen(anzahl) = RTRIM(zeile)
END SUB

SUB ZeigeGottMsg(zitat AS STRING)
  ' Bereite Multiline vor
  ERASE gott_msg
  WrapText("GOTT SAGT: " + zitat, gott_msg(), gott_zeilen)
  gott_timer = GOTT_DAUER
END SUB

sub ZeichneGottMsg()
  DIM fade AS INTEGER = 14 ' Gelb
  IF gott_timer < 60 THEN fade = 6 ' Dunkelorange letzte Sekunde
  ' Zeile 2-6, mit 10px Abstand
  IF gott_timer > 0 THEN
    FOR i AS INTEGER = 1 TO gott_zeilen
      IF LEN(gott_msg(i)) > 0 THEN
        DIM px AS INTEGER = (320 - LEN(gott_msg(i)) * 8) \ 2
        DIM py AS INTEGER = 16 + (i-1) * 10 
        ' Schwarzer Balken mit 2px mehr Hoehe
        LINE (px-6, py-2)-(px + LEN(gott_msg(i))*8 + 6, py+10), 0, BF
        locate (py\8)+1,(px\8):color fade:print gott_msg(i);
        'DRAW STRING (px, py), gott_msg(i), fade
      END IF
    NEXT
    gott_timer -= 1
  END IF
END SUB

SUB ZeichnePickupMsg()
  IF pickup_timer > 0 THEN
    DIM msg_len AS INTEGER = LEN(pickup_text)
    DIM px AS INTEGER = (320 - msg_len * 8) \ 2
    
    LINE (px-4, 22)-(px + msg_len*8 + 4, 33), 0, BF
   locate 24\3+1, px\8+1:color 15:print pickup_text;
   'DRAW STRING (px, 24), pickup_text, 15
    pickup_timer -= 1
  END IF
END SUB


SUB ZeichneInventar()
  ' Overlay: 3 Tile Rand = 24px
  ' Fenster: 24,24 bis 295,175
  SCREENLOCK
  
  ' Schwarzer Hintergrund mit Rahmen
  LINE (24,24)-(295,178), 0, BF ' Schwarz fuellen
  LINE (24,24)-(295,178), 7, B  ' Grauer Rahmen
  
  ' Titel
  DRAW STRING (128, 32), "INVENTAR", 15
  
  ' Items auflisten 1-10
  FOR i AS INTEGER = 1 TO 10
    DIM y AS INTEGER = 48 + (i-1)*12
    IF inventar(i).anzahl > 0 ANDALSO i <= 3 THEN ' Zeig Holz/Stein/zitate immer
      DRAW STRING (40, y), STR(i) & ".", 7
      DRAW STRING (64, y), inventar(i).name, 11
      DRAW STRING (240, y), "x" & STR(inventar(i).anzahl), 14
    END IF
  NEXT
  
  DRAW STRING (80, 168), "ESC = Zurueck", 8
  SCREENUNLOCK
END SUB

SUB ZeichneViewport()
  SCREENLOCK
    
  cam_x = welt_x - CENTER_X
  cam_y = welt_y - CENTER_Y
  
  ' === LAYER 0: TERRAIN MIT VOLLBLOCK ===
  FOR sy AS LONG = 0 TO VIEW_H-1
    FOR sx AS LONG = 0 TO VIEW_W-1
      DIM wx AS LONG = Wrap(cam_x + sx)
      DIM wy AS LONG = Wrap(cam_y + sy)
      
      DIM px AS INTEGER = sx * 8
      DIM py AS INTEGER = sy * 8
      DIM t AS UBYTE = Karte(wx, wy)
      
      DIM fg AS UBYTE ' Vordergrund = Zeichen
      DIM bg AS UBYTE ' Hintergrund = Vollblock
      
      SELECT CASE AS CONST t
        CASE ASC("~")
          fg = 9
          bg = 1
        CASE ASC(".")
          fg = 14
          bg = 6
        CASE ASC(",")
          fg = 10
          bg = 2
        CASE ASC("T")
          fg = 2
          bg = 10
        CASE ASC("^")
          fg = 6
          bg = 2
        CASE ASC("#")
          fg = 7
          bg = 8
        CASE ASC("?")
          fg = 15
          bg = 0 
        CASE ELSE
          fg = 0: bg = 0
      END SELECT
      
      
      ' SCHRITT 1: Hintergrund-Block malen
      'line (px,py)-step(7,7),bg,bf
      'DRAW STRING (px, py), CHR(219), bg ' Vollblock
      
      ' SCHRITT 2: Detail-Zeichen drueber
      'DRAW STRING (px, py), CHR(t), fg   ' ~ . , T ^ #
      LOCATE py\8+1,px\8+1
      COLOR fg, bg
      PRINT chr(t);
    NEXT
  NEXT
  
  ' === LAYER 1: ENTITIES ===
  DIM mark_px AS INTEGER = CENTER_X * 8
  DIM mark_py AS INTEGER = CENTER_Y * 8
  ' Mark braucht keinen BG, er steht auf Terrain
  
  'DRAW STRING (mark_px, mark_py), CHR(1), 14
  LOCATE mark_py\8+1, mark_px\8+1
  COLOR 14, 2
  PRINT CHR(1);
  
  ' Spaeter: Entities mit eigenem BG wenn sie "fliegen"
  ' DRAW STRING (npx, npy), CHR(219), 0 ' Schwarzer BG
  ' DRAW STRING (npx, npy), CHR(npc.char), npc.farbe
  
  ' === LAYER 2: UI ===
  'LINE (0,192)-(319,199), 0, BF
'  DRAW STRING (0, 192), "Skill:" & skill_name(aktiv_skill), 11
'  DRAW STRING (140, 192), "[" & aktiv_skill & "]", 14

  ' Blickrichtung als Pfeil
  DIM AS STRING richtung_char(0 TO 3) = {"^", ">", "v", "<"}
'  DRAW STRING (168, 192), richtung_char(blick_richtung), 15

  ' HP rechts
'  DRAW STRING (256, 192), CHR(3) & markHP, 12
  
  SCREENUNLOCK
END SUB

SUB CheckItemPickup()
  ' Wenn Mark auf Item steht
  DIM t AS UBYTE = Karte(Wrap(welt_x), Wrap(welt_y))
  IF t = ASC("?") THEN ' Schriftrolle
    Karte(Wrap(welt_x), Wrap(welt_y)) = ASC(",") ' Zu Gras
    inventar(3).anzahl += 1 ' Direkt ins Inventar, OHNE AddItem()
    DIM z AS INTEGER = INT(RND * MAX_ZITATE) + 1
    ZeigeGottMsg(zitate(z))
  END IF
END SUB

' === HAUPTPROGRAMM ===
CLS
GeneriereWelt()
FindeSicherenSpawn()
InitInventar()
InitZitate()

DIM AS STRING taste = ""
DO
  DIM AS LONG new_x = welt_x, new_y = welt_y
  DIM k AS STRING = INKEY
  
  SELECT CASE k
    ' === BEWEGUNG: WASD ===
    CASE "w", "W": new_y = welt_y - 1
    CASE "s", "S": new_y = welt_y + 1
    CASE "a", "A": new_x = welt_x - 1
    CASE "d", "D": new_x = welt_x + 1
    
    ' === AKTION: PFEILTASTEN ===
    CASE CHR(255,72) ' Pfeil Hoch
      BenutzeSkillInRichtung(0, -1)
    CASE CHR(255,80) ' Pfeil Runter
      BenutzeSkillInRichtung(0, 1)
    CASE CHR(255,75) ' Pfeil Links
      BenutzeSkillInRichtung(-1, 0)
    CASE CHR(255,77) ' Pfeil Rechts
      BenutzeSkillInRichtung(1, 0)
    
    ' === SKILL WAEHLEN ===
    CASE "1": aktiv_skill = 1
    CASE "2": aktiv_skill = 2

    CASE "i", "I" : inv_offen = 1
    
    CASE CHR(27)
        IF inv_offen = 1 THEN
            inv_offen = 0
            WHILE INKEY<> "": WEND
        ELSE
            EXIT DO 
        END IF
  END SELECT
  
  ' Kollision nur bei Bewegung
  IF new_x <> welt_x OR new_y <> welt_y THEN
    IF IstBegehbar(new_x, new_y) THEN
      welt_x = Wrap(new_x)
      welt_y = Wrap(new_y)
      CheckItemPickup()
    END IF
  END IF

  SpawnItem() 

  IF inv_offen = 0 THEN
    ZeichneViewport()
    ZeichneGottMsg()
    ZeichnePickupMsg()
  ELSE
    ZeichneInventar()
  END IF
  
  SLEEP 16, 1
LOOP

SCREEN 0
WIDTH 80,25
CLS
COLOR 15
PRINT "Mark verliess die Welt. Vorerst."
SLEEP 1000