'* -------------------------------- *
'*             ALCM V1.0a           *
'*            ------------          *
'*                                  *
'*       Amos Level Code Maker      *
'*                                  *
'* ® 24/02/1994 by Volker Stepprath *
'* ALCM V1.0a  © 1994  by Testaware *
'*                                  *
'* -------------------------------- *
'
Set Buffer 200
If Upper$(Command Line$-"-")="W" Then W=True
Close Workbench 
Close Editor 
Request Off 
'
_INSTALLLCM[W]
_LCMMAIN
'
Procedure _INSTALLLCM[W]
   Unpack 16 To 0
   If W
      N$=Space$(232)+Chr$(0)
      Areg(0)=Varptr(N$)
      Dreg(0)=232
      LVOGETPREFS=Intcall(-132)
      Colour 17,Deek(Varptr(N$)+106)
      Colour 18,Deek(Varptr(N$)+104)
      Colour 19,Deek(Varptr(N$)+102)
      Colour 0,Deek(Varptr(N$)+110)
      Colour 1,Deek(Varptr(N$)+112)
      Colour 2,Deek(Varptr(N$)+114)
      Colour 3,Deek(Varptr(N$)+116)
   End If 
   Colour Back Colour(0)
   Screen Show 
   Ink 1,0
   '* Buchstaben installieren 
   '* ----------------------- 
   For I=0 To 15
      For I2=0 To 15
         Text I2*15+23,I*12+20,Chr$(I*16+I2)
      Next I2
   Next I
   '
   '* Runde Schalter An/Aus 
   '* --------------------- 
   Get Block 1,306,197,15,8
   Get Block 2,320,197,15,8
   '
   Reserve Zone 24
   For I=0 To 15
      Set Zone 1+I,264,14+I*12 To 278,21+I*12
   Next I
   Set Zone 21,364,130 To 378,137
   Set Zone 22,508,130 To 522,137
   Set Zone 23,364,160 To 378,167
   Set Zone 24,508,160 To 522,167
   '
   _T[""]
   Amos To Front 
End Proc
Procedure _LCMMAIN
   On Error Goto _FEHLER
   '
   XLEVEL=1
   XLENGTH=1
   XCODE$=String$(Chr$(0),256)
   XCODE=Varptr(XCODE$)
   '
   Do 
      While Mouse Key=0 : Multi Wait : Wend 
      X=X Screen(X Mouse)
      Y=Y Screen(Y Mouse)
      N=Mouse Zone
      XERRN=0
      '
      '* Einzelne Ascii`s selektieren
      '* ----------------------------
      If X>19 and X<257 and Y>11 and Y<204
         Add X,-20 : X=X/15
         Add Y,-12 : Y=Y/12
         I2=Peek(XCODE+Y*16+X)
         Add I2,1,0 To 1
         Poke XCODE+Y*16+X,I2
         Ink 1+I2
         Text X*15+23,Y*12+20,Chr$(Y*16+X)
         _G[X*15+20,Y*12+12,X*15+34,Y*12+23,I2]
      End If 
      '
      '* Level bzw. Length 
      '* ----------------- 
      If Y>62 and Y<70
         '* Level - & + 
         '* ----------- 
         If X>364 and X<379
            _G[364,62,379,70,1]
            Ink 1
            Add XLEVEL,-1,1 To 999
            Text 384,69,String$("0",3-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" "
            Wait 15
            While Mouse Key<>0
               Add XLEVEL,-1,1 To 999
               Text 384,69,String$("0",3-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" "
            Wend 
            _G[364,62,379,70,0]
         End If 
         If X>412 and X<427
            _G[412,62,427,70,1]
            Ink 1
            Add XLEVEL,1,1 To 999
            Text 384,69,String$("0",3-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" "
            Wait 15
            While Mouse Key<>0
               Add XLEVEL,1,1 To 999
               Text 384,69,String$("0",3-Len(Str$(XLEVEL)-" "))+Str$(XLEVEL)-" "
            Wend 
            _G[412,62,427,70,0]
         End If 
         '
         '* Length - & +
         '* ------------
         If X>508 and X<523
            _G[508,62,523,70,1]
            Ink 1
            Add XLENGTH,-1,1 To 40
            Text 532,69,String$("0",2-Len(Str$(XLENGTH)-" "))+Str$(XLENGTH)-" "
            Wait 20
            While Mouse Key<>0
               Add XLENGTH,-1,1 To 40
               Text 532,69,String$("0",2-Len(Str$(XLENGTH)-" "))+Str$(XLENGTH)-" "
               Wait Vbl 
            Wend 
            _G[508,62,523,70,0]
         End If 
         If X>556 and X<571
            _G[556,62,571,70,1]
            Ink 1
            Add XLENGTH,1,1 To 40
            Text 532,69,String$("0",2-Len(Str$(XLENGTH)-" "))+Str$(XLENGTH)-" "
            Wait 20
            While Mouse Key<>0
               Add XLENGTH,1,1 To 40
               Text 532,69,String$("0",2-Len(Str$(XLENGTH)-" "))+Str$(XLENGTH)-" "
               Wait Vbl 
            Wend 
            _G[556,62,571,70,0]
         End If 
      End If 
      '
      '* Ascii Schalterstellung swapen 
      '* ----------------------------- 
      If N>0 and N<17
         Dec N
         _GA[264,14+N*12,1]
         For I=0 To 15
            I2=Peek(XCODE+N*16+I)
            Add I2,1,0 To 1
            Poke XCODE+N*16+I,I2
            Ink 1+I2
            Text I*15+23,N*12+20,Chr$(N*16+I)
            _G[I*15+20,N*12+12,I*15+34,N*12+23,I2]
         Next I
         _GA[264,14+N*12,0]
      End If 
      '
      '* Start 
      '* ----- 
      If N=21
         _GA[364,130,1]
         If Hunt(XCODE To XCODE+255,Chr$(1))
            XLEVEL2=XLEVEL
            XLENGTH2=XLENGTH
            XABORT=False
            S$=String$(" ",20-XLENGTH/2)
            '
            Erase 7
            Reserve As Data 7,XLEVEL*XLENGTH
            Ink 1
            Randomize Timer
            For I=0 To XLEVEL-1
               Text 385,107,String$("0",3-Len(Str$(XLEVEL-I-1)-" "))+Str$(XLEVEL-I-1)-" "
               I3=0
               N$=""
               N$=Space$(XLENGTH)
               Repeat 
                  I2=Rnd(255)
                  If Peek(XCODE+I2)=1
                     Poke Varptr(N$)+I3,I2
                     Inc I3
                  End If 
                  If Mouse Key<>0
                     N=Mouse Zone
                     If N=22
                        _GA[508,130,1]
                        XABORT=True
                        Wait 10
                        _GA[508,130,0]
                        Exit 2
                     End If 
                  End If 
               Until I3=XLENGTH
               _T[S$+N$]
               If Hunt(Start(7) To Start(7)+(XLEVEL*XLENGTH),N$)>0
                  Dec I
               Else 
                  For I2=0 To XLENGTH-1
                     Poke Start(7)+I*XLENGTH+I2,Peek(Varptr(N$)+I2)
                  Next I2
                  I2=(100.0/XLEVEL)*(I+1)
                  Text 525,107,String$("0",3-Len(Str$(I2)-" "))+Str$(I2)-" "
               End If 
            Next I
            If N<>22
               _T["Puuh... all done !"]
            Else 
               _T["Levelcode creating aborted !"]
            End If 
         Else 
            _T["Ooops... no codeletter is set !"]
         End If 
         _GA[364,130,0]
      End If 
      '
      '* Save as 
      '* ------- 
      If N=23
         N=False
         _GA[364,160,1]
         If Length(7)=0
            _T["Ooops... nothing to save !"]
            N=True
         End If 
         If XABORT=True
            _T["Rulala... can`t save, creating aborted !"]
            N=True
         End If 
         If N=False
            _T[XFILE$+Chr$(127)]
            Repeat 
               N=Asc(Inkey$)
               If N<>0
                  If N>31
                     Clear Key 
                     If Len(XFILE$)<40
                        XFILE$=XFILE$+Chr$(N)
                     End If 
                  End If 
                  If N=8 and Len(XFILE$)>0
                     XFILE$=Left$(XFILE$,Len(XFILE$)-1)
                  End If 
                  _T[XFILE$+Chr$(127)]
               End If 
            Until N=13
            _T[N$]
            Bsave XFILE$,Start(7) To Start(7)+XLEVEL2*XLENGTH2
            If XERRN<>0
               _T["Ooops... AMOS error #"+Str$(XERRN)-" "+" occurred !"]
            Else 
               XFILE$=XFILE$+Chr$(0)
               C$=Chr$($9B)+"33mDone with ALCM V1.0a by Testaware - Levels:"+Str$(XLEVEL2)+" / Length:"+Str$(XLENGTH2)+Chr$($9B)+"0m"+Chr$(0)
               Dreg(1)=Varptr(XFILE$)
               Dreg(2)=Varptr(C$)
               LVOSETCOMMENT=Doscall(-180)
               _T["Yeepiaaei... codefile successfull saved !"]
               XFILE$=XFILE$-Chr$(0)
            End If 
         End If 
         _GA[364,160,0]
      End If 
      '
      '* Exit
      '* ----
      If N=24
         _GA[508,160,1]
         _T["Have a nice day... bye !"]
         Request On 
         Erase 7
         Wait 50
         End 
      End If 
      '
      While Mouse Key<>0 : Wend 
      Wait 2
   Loop 
   '
_FEHLER: XERRN=Errn : Resume Next 
End Proc
'
Procedure _G[X,Y,XX,YY,S]
   If S=1 Then C1=1 : C2=2 Else C1=2 : C2=1
   Ink C1
   Draw X,Y To XX,Y
   Draw X,Y To X,YY
   Ink C2
   Draw XX,Y To XX,YY
   Draw X,YY To XX,YY
End Proc
Procedure _GA[X,Y,S]
   If S=0
      Put Block 1,X,Y
   Else 
      Put Block 2,X,Y
   End If 
End Proc
Procedure _T[N$]
   Ink 0
   Bar 306,197 To 636,205
   Ink 1,0
   Text 306,203,N$
End Proc