'****************************************
'*                                      *
'*                                      *
'*  K I C K S T A R T -  P U Z Z L E    *
'*                                      *
'*   with a KICK                        *
'*                                      *
'*   by Harald            8/87          *
'*                                      *
'*                                      *
'* in AMIGA Basic                       *
'*                                      *
'* Viel Spass  beim Puzzeln             *
'*                                      *
'****************************************


' Einer der folgenden CLEAR-Befehle muß im Direktmodus
' gegeben werden
'CLEAR ,60000&     ' low-res
'CLEAR ,100000&    ' med-res
'CLEAR ,200000&    ' Interlace will etwas mehr
PRINT "Willkommen zum KICKSTART PUZZLE"
INPUT "Wieviel Puzzleteile möchten Sie (x,y)";Nx,Ny
IF Nx>9 OR Ny>9 THEN PRINT "Wenn das gutgeht "

GOSUB main
Xmax=scrwidth% :Ymax=scrheight%
Planes=idepth% :Modus=kk

Xbild=Xmax/3 :Ybild=Ymax*.6   'Größe des Ausschnitts    

Xbild=(Xbild \ Nx)*Nx  ' Runden auf Zahl, die teil-
Ybild=(Ybild \ Ny)*Ny  ' bar ist durch nx bzw. ny
Xmax=(Xmax \ Nx)*Nx
Ymax=(Ymax\ Ny)*Ny

DEF FNmem(X,Y)=6+(Y+1)*INT((X+16)/16)*Planes  'Platz in Bytes/2

Gx=Xbild/Nx    ' Breite eines Puzzleteils
Gy=Ybild/Ny    ' Höhe eines Puzzleteils 

Mixx=Xmax/2    ' Bildschirmstelle, die beim Mischen
Mixy=Ybild/2   ' mißbraucht wid

DIM Z(Nx*Ny)   ' Feld zum Mischen
DIM Qx(Nx,Ny)  ' X-Position der einzelnen Teile  (rechts)
DIM Qy(Nx,Ny)  ' Y-    "     "       "       "   (links)
DIM Mr(Nx,Ny)  ' Merkt ob das betreffende Teil noch vorhanden ist
DIM Ml(Nx,Ny)  ' Merkt nach anwählen die alte Position des Teils 
DIM Mm(Nx,Ny)  ' Merkt ob betr. Platz im linken Feld noch frei ist
DIM A%(FNmem(Xbild,Ybild))    ' Kompletter Ausschnitt
DIM Hilf%(FNmem(Xbild,Ybild)) ' Enthält momentanes Puzzle (links)
                              ' beim Anzeigen
Blocklaenge=FNmem(Gx,Gy)      ' So viel Platz braucht ein Teil

DIM P%(Blocklaenge,Nx,Ny)     ' Enthält das Teilefeld 

DIM Select%(Blocklaenge)      ' Enthält das angewählte Teil

GOSUB Ausschnitt    '  gibt xeck und yeck

  GET (Xeck,Yeck)-(Xeck+Xbild-1,Yeck+Ybild-1),A%  'Hole Ausschnitt
  WINDOW CLOSE 2
  WINDOW 2,"            KICKSTART PUZZLE ",,0,2
  
  CLS
  PUT (5,5),A%,PSET   ' und zeige ihn an
 
  GOSUB Mischen        ' sonst wäre es ja zu leicht
  GOSUB Auslesen       ' Lies die Einzelteile aus dem Bild
  GOSUB Ausgabe        ' zeige die Teile rechts an
  LINE (5,5)-(5+Xbild-1,5+Ybild-1),0,bf  ' weg damit
  
  GOSUB Raster         ' Malt ein Raster 

  Label1:               ' Repeat Until gibt´s ja leider nicht

    Dum=MOUSE(0)        ' Wecke die Maus aus ihrem Schlaf
    In$=INKEY$          ' Tastendruck erfragen
    IF In$ <> "" THEN   ' Wurde eine Taste gedrueckt ?
 
      IF ASC(In$)=139 THEN ' War es auch noch die HELP-Taste     
        GET (5,5)-(5+Xbild-1,5+Ybild-1),Hilf%  ' sichere momen-
                                               ' tanes Bild
        PUT (5,5),A%,PSET ' zeige die Lösung
        WHILE INKEY$=""   ' und warte bis Taste gedrueckt wird
        WEND
        PUT (5,5),Hilf%,PSET  ' zeige wieder momentanes Bild an        
      END IF
     END IF
  
   IF MOUSE(0)<0 AND MOUSE(1)>Xmax/2  THEN 'Maus gedrueckt und in rechter Bildhälfte
      GOSUB Anwaehlen      ' Wähle ein Teil aus (rechts)
      GOSUB Positionieren  ' und positioniere es (links)
      WHILE MOUSE(0)<0 :WEND
    END IF
  
    IF MOUSE(0)<0 AND MOUSE(1)<Xbild+5 THEN
     
      GOSUB Aendern   
      WHILE MOUSE(0)<0 : WEND
  END IF  
  
GOTO Label1
  
END
'
Anwaehlen:
   Flag1=0
   GOSUB mausr
   X1=Qx(Mausx,Mausy)
   Y1=Qy(Mausx,Mausy)
   X2=X1+Gx
   Y2=Y1+Gy    
   IF Mr(Mausx,Mausy)=0 THEN
     Mr(Mausx,Mausy)=1
     Flag1=1
     GET (X1,Y1)-(X2-1,Y2-1),Select%
     LINE (X1,Y1)-(X2-1,Y2-1),0,bf
     Ml=Mausx+Mausy*Nx
   END IF
RETURN

Aendern:
'
  Flag1=0 
  GOSUB mausl
  IF Mm(Mausx,Mausy)=1 THEN ' teil vorhanden ?
    Flag1=1   ' angewählt
    X1=5+Mausx*Gx     : X2=X1+Gx-1
    Y1=5+Mausy*Gy     : Y2=Y1+Gy-1  
    Ml=Ml(Mausx,Mausy)
    Mm(Mausx,Mausy)=0  ' nix mehr drin   
    GET (X1,Y1)-(X2,Y2),Select%  ' Teil holen     
    LINE (X1,Y1)-(X2,Y2),0,bf    ' alten Platz löschen
    WHILE MOUSE(0)<0
    WEND  
    
    GOSUB Positionieren
    GOSUB neuaufbau
  END IF    
RETURN      
  

RETURN

'
Auslesen: 
 
  FOR X=0 TO Nx-1
    FOR Y=0 TO Ny-1
      We=X+Y*Nx      
      GET (5+Gx*X,5+Gy*Y)-(5+Gx*(X+1)-1,5+Gy*(Y+1)-1),P%(0,(Z(We) MOD Nx),(Z(We)\Nx))
      ' Ein Teil aus dem Gesamtbild herauslesen
    NEXT Y   
  NEXT X
RETURN
'
'
Ausgabe:
  FOR X=0 TO Nx-1
    FOR Y=0 TO Ny-1     
      Qx(X,Y)=INT(Xmax/2+Gx*X+X*(Xmax/2-Xbild)/Nx)-5  
      'X-Position berechnen
      Qy(X,Y)=INT(5+Y*Gy+Y*(Ymax-Ybild-Gy)/Ny)        
      'Y-Position berechnen
      PUT (Qx(X,Y),Qy(X,Y)),P%(0,X,Y),PSET            
      'dorthin ausgeben
      LINE (Qx(X,Y)-1,Qy(X,Y)-1)-(Qx(X,Y)+Gx,Qy(X,Y)+Gy),1,b  
      'Rahmen darum ziehen
    NEXT Y
  NEXT X
RETURN
'

mausr:
  Dum=MOUSE(0)
' Rechnet die Mauskoordinaten um auf die Zahlen 0..nx-1 ,bzw. 0..ny-1
  Mausx=INT((MOUSE(3)-Xmax/2)/Xmax*2*Nx )
  Mausy=INT(MOUSE(4)/(Ymax-Gy)*Ny)
  IF Mausy>=Ny OR Mausy<0 THEN Dum=MOUSE(0):GOTO mausr  
  'Falls außerhalb: nochmal
  IF Mausx>=Nx OR Mausx<0 THEN Dum=MOUSE(0):GOTO mausr
RETURN
'
'
mausl:
 'wie oben, aber fuer linkes Feld
  Dum=MOUSE(0)
  Mausx=INT((MOUSE(3)-5)/Xbild*Nx)
  Mausy=INT((MOUSE(4)-5)/Ybild*Ny)
  IF Mausy>=Ny OR Mausy<0 THEN Dum=MOUSE(0):GOTO mausl
  IF Mausx>=Nx OR Mausx<0 THEN Dum=MOUSE(0):GOTO mausl
RETURN   
'
'
'
Raster:
' Legt ueber das Bild (links) ein Raster
  COLOR 1
  FOR X=0 TO Nx
    LINE (5+Gx*X,5)-(5+Gx*X,5+Ybild)  '
  NEXT X
  FOR Y=0 TO Ny
    LINE (5,5+Gy*Y)-(5+Xbild,5+Gy*Y)
  NEXT Y
RETURN
'
'
'
Positionieren:
  
  Flag2=0
  IF Flag1=1 THEN
    
   WHILE -1
      Dum=MOUSE(0)
      In$=INKEY$
       IF In$<>"" THEN
        IF ASC(In$)=127 THEN 
          GOSUB Loeschen
          GOTO Lab3
        END IF
      ELSE  
        IF MOUSE(0)<0 AND MOUSE(1)<Xbild +5 THEN 
          GOSUB mausl     
          IF Mm(Mausx,Mausy)=0 THEN
            Mm(Mausx,Mausy)=1
            Ml(Mausx,Mausy)=Ml
            PUT (5+Gx*Mausx,5+Gy*Mausy),Select%,PSET
            GOTO Lab3        
          END IF
        END IF
      END IF
    WEND
    Lab3:
     Flag1=0
  END IF
RETURN
'
'
Loeschen:
  GOSUB mausl
  
  LINE (5+Gx*Mausx,5+Gy*Mausy)-(5+Gx*(Mausx+1),5+Gy*(Mausy+1)),0,bf
  
  Ky=INT(Ml(Mausx,Mausy) \ Nx)
  Kx=INT(Ml(Mausx,Mausy) MOD Nx)
  PUT (Qx(Kx,Ky),Qy(Kx,Ky)),P%(0,Kx,Ky),PSET
  Mr(Kx,Ky)=0
  Mm(Mausx,Mausy)=0
  REM GOSUB neuaufbau
RETURN
'
'
neuaufbau:
  GOSUB Raster
  FOR X=0 TO Nx-1
    FOR Y=0 TO Ny-1
      IF Mm(X,Y)=1 THEN
        Ky=INT(Ml(X,Y) \ Nx)
        Kx=INT(Ml(X,Y) MOD Nx)
        PUT (5+Gx*X,5+Gy*Y),P%(0,Kx,Ky),PSET
      END IF
    NEXT Y
  NEXT X
RETURN
'
'
'
Ausschnitt:
  '  Zeichnet eine inbertieremde Box zum Ausschnitt wählen
 
  WHILE MOUSE(0)>-1  OR MOUSE(1)>Xmax-Xbild OR MOUSE(2)>Ymax-Ybild
    X=MOUSE(1):Y=MOUSE(2)
    GET (X,Y)-(X+Xbild-1,Y+Ybild-1),A%
    PUT (X,Y),A%,XOR
    PUT (X,Y),A%,XOR
  WEND
  Xeck=MOUSE(3):Yeck=MOUSE(4)               
RETURN
'
Mischen:

 RANDOMIZE TIMER  ' Zufallsgenerator initialisieren

   FOR I=0 TO Nx*Ny-1 : Z(I)=I :NEXT I
     FOR I=0 TO Nx*Ny-1
     zuf=INT(RND*Nx*Ny)
     SWAP Z(I),Z(zuf) 
   NEXT I
RETURN
'

' *******************************************************


' Der folgende Programmteil kann von der EXTRAD-Diskette 
' hinzugemergt werden   (siehe Anleitung)

main:

DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
               
DECLARE FUNCTION xOpen&  LIBRARY
DECLARE FUNCTION xRead&  LIBRARY
DECLARE FUNCTION xWrite& LIBRARY
DECLARE FUNCTION AllocMem&() LIBRARY
PRINT:PRINT "Suchen nach .bmap-Dateien ... ";
LIBRARY "dos.library"
LIBRARY "exec.library"
LIBRARY "graphics.library"
PRINT "Libraries gefunden"

PRINT "ACBM-Datei-Namen eingeben (ggf. incl. Zugriffspfad):"
INPUT "   ACBM-Dateiname = ";ACBMname$
REM - ACBM-Bild laden
loadError$ = ""
GOSUB LoadACBM
IF loadError$ <> "" THEN GOTO Mcleanup

RETURN




Mcleanup:
FOR de = 1 TO 20000:NEXT
WINDOW CLOSE 2
SCREEN CLOSE 2
LIBRARY CLOSE
IF loadError$ <> "" THEN PRINT loadError$
END



LoadACBM:
   REM - Variablen initialisieren
   F$ = ACBMname$
   fHandle& = 0
   mybuf& = 0
   foundBMHD = 0
   foundCMAP = 0
   foundCAMG = 0
   foundCCRT = 0
   foundABIT = 0

   filename$ = F$ + CHR$(0)
   fHandle& = xOpen&(SADD(filename$),1005)
   IF fHandle& = 0 THEN
      loadError$ = "Eingabedatei nicht gefunden/lesbar."
      GOTO Lcleanup
   END IF


   REM - Pufferspeicherplatz reservieren
   ClearPublic& = 65537&
   mybufsize& = 360
   mybuf& = AllocMem&(mybufsize&,ClearPublic&)
   IF mybuf& = 0 THEN
      loadError$ = "Pufferspeicherplatz nicht verfuegbar."
      GOTO Lcleanup
   END IF

   inbuf& = mybuf&
   cbuf& = mybuf& + 120
   ctab& = mybuf& + 240


   REM - Eingabe sollte lauten  FORMnnnnACBM
   rLen& = xRead&(fHandle&,inbuf&,12)
   tt$ = ""
   FOR kk = 8 TO 11
      tt% = PEEK(inbuf& + kk)
      tt$ = tt$ + CHR$(tt%)
   NEXT

   IF tt$ <> "ACBM" THEN 
      loadError$ = "Keine ACBM-Grafikdatei."
      GOTO Lcleanup
   END IF

   REM - ACBM-Datei Chunk-weise lesen

   ChunkLoop:
   REM - Chunk-Name/Länge ermitteln
   rLen& = xRead&(fHandle&,inbuf&,8)
   icLen& = PEEKL(inbuf& + 4)
   tt$ = ""
   FOR kk = 0 TO 3
      tt% = PEEK(inbuf& + kk)
      tt$ = tt$ + CHR$(tt%)
   NEXT   
    
   IF tt$ = "BMHD" THEN  'BitMap-Header 
      foundBMHD = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   iWidth%  = PEEKW(inbuf&)
   iHeight% = PEEKW(inbuf& + 2)
   idepth%  = PEEK(inbuf& + 8)  
   iCompr%  = PEEK(inbuf& + 10)
   scrwidth%  = PEEKW(inbuf& + 16)
   scrheight% = PEEKW(inbuf& + 18)

   iRowBytes% = iWidth% /8
   scrRowBytes% = scrwidth% / 8
   nColors%  = 2^(idepth%)

   '" - Genug Platz fuer Videospeicher ?
   AvailRam& = FRE(-1)
   NeededRam& = ((scrwidth%/8)*scrheight%*(idepth%+1))+5000
   IF AvailRam& < NeededRam& THEN
      loadError$ = "Speicherplatz reicht nicht aus."
      GOTO Lcleanup
   END IF

   kk = 1
   IF scrwidth% > 320 THEN kk = kk + 1
   IF scrheight% > 200  THEN kk = kk + 2
   SCREEN 2,scrwidth%,scrheight%,idepth%,kk
   WINDOW 2,ACBMname$,,0,2       ' <--------- Änderung

   REM - Adressen von Screen-Structures ermitteln
   GOSUB GetScrAddrs

   REM - Schirm während Ladevorgang dunkel
   CALL LoadRGB4&(sViewPort&,ctab&,nColors%)


ELSEIF tt$ = "CMAP" THEN  'Farbpalette
   foundCMAP = 1
   rLen& = xRead&(fHandle&,cbuf&,icLen&)

   REM - Farbpalette aufbauen
   FOR kk = 0 TO nColors% - 1
      red% = PEEK(cbuf&+(kk*3))
      gre% = PEEK(cbuf&+(kk*3)+1)
      blu% = PEEK(cbuf&+(kk*3)+2)
      regTemp% = (red%*16)+(gre%)+(blu%/16)
      POKEW(ctab&+(2*kk)),regTemp%
   NEXT


ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
   foundCAMG = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   camgModes& = PEEKL(inbuf&)


ELSEIF tt$ = "CCRT" THEN 'Graphicraft-Farbzyklus-Daten
   foundCCRT = 1
   rLen& = xRead&(fHandle&,inbuf&,icLen&)
   ccrtDir%    = PEEKW(inbuf&)
   ccrtStart%  = PEEK(inbuf& + 2)
   ccrtEnd%    = PEEK(inbuf& + 3)
   ccrtSecs&   = PEEKL(inbuf& + 4)
   ccrtMics&   = PEEKL(inbuf& + 8)


ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
   foundABIT = 1
   plSize& = (scrwidth%/8) * scrheight%
   FOR pp = 0 TO idepth% -1
      rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
   NEXT


ELSE 
   REM - unbekannten Chunk-Typ lesen  
   FOR kk = 1 TO icLen&
      rLen& = xRead&(fHandle&,inbuf&,1)
   NEXT
   '" - Wenn Länge ungerade, noch 1 Byte lesen
   IF (icLen& OR 1) = icLen& THEN 
      rLen& = xRead&(fHandle&,inbuf&,1)
   END IF
      
END IF


   REM - Fertig, wenn alle Chunks gelesen
   IF foundBMHD AND foundCMAP AND foundABIT THEN
      GOTO GoodLoad
   END IF

   REM - Lesen ok, nächsten Chunk lesen
   IF rLen& > 0 THEN GOTO ChunkLoop

   IF rLen& < 0 THEN  ' Lesefehler
      loadError$ = "Lesefehler."
      GOTO Lcleanup
   END IF   

   REM - rLen& = 0  heißt EOF (Dateiende)
   IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
      loadError$ = "Wichtige IFF-Chunks nicht gefunden."
      GOTO Lcleanup
   END IF


GoodLoad:
   loadError$ =""

   REM  Farbpalette
   IF foundCMAP THEN 
      CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
   END IF

Lcleanup:
   IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
   IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
RETURN


GetScrAddrs:
   REM - Adressen von Screen-Structures ermitteln
   sWindow&   = WINDOW(7)
   sScreen&   = PEEKL(sWindow& + 46)
   sViewPort& = sScreen& + 44
   sRastPort& = sScreen& + 84
   sColorMap& = PEEKL(sViewPort& + 4)
   colorTab&  = PEEKL(sColorMap& + 4)
   sBitMap&   = PEEKL(sRastPort& + 4)

   REM - Screen-Parameter ermitteln
   scrwidth%  = PEEKW(sScreen& + 12)
   scrheight% = PEEKW(sScreen& + 14)
   scrDepth%  = PEEK(sBitMap& + 5)
   nColors%   = 2^scrDepth%

   REM - Adressen der BitPlanes ermitteln
   FOR kk = 0 TO scrDepth% - 1
      bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
   NEXT
RETURN