home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Apfelmonster / ApfelEdit.AMOS / ApfelEdit.amosSourceCode next >
Encoding:
AMOS Source Code  |  1992-08-30  |  22.3 KB  |  763 lines
  1. Set Buffer 14
  2. Dim F(29,29,1),T1(24),T2(24),BLK(16),B(81,4)
  3. Global B(),S$,T2(),F(),VIW
  4. Gosub INIT
  5. Gosub CLEAR
  6. Screen 0
  7. Gosub DEFUPDAT
  8. For A=0 To 31 : Colour A,0 : Next 
  9. Screen Show 0 : Fade 3 To 1 : Screen 1
  10. Wait 50
  11. Screen 1 : For A=0 To 31 : Colour A,0 : Next 
  12. Screen Show 1 : Fade 3 To 0
  13. Screen 0
  14. Doke Start(9)+20,0
  15. Call Start(9)
  16. Wait Vbl 
  17. SCROL["WELCOME TO APFELMONSTER EDITOR DELUXE VERSION 1.0!"]
  18. Repeat : Until Mouse Key or(Inkey$<>"") or Fire(1)
  19. PAGE=1 : NEWPAGE[0]
  20. Repeat : Until Mouse Key=0 and Fire(1)=0
  21. CORX=0 : CORY=0
  22. MD=1 : CHAR=1 : WALL=0 : IMAGE=0
  23. Gosub UPAPFEL : Gosub UPMONST
  24. Amal On 
  25. Do 
  26.   I$=Inkey$ : X=X Mouse-128 : Y=Y Mouse-40 : M=Mouse Key : B=0
  27.   RX=((I$=Cleft$)-(I$=Cright$))*2+Jleft(1)-Jright(1)+(X<10)-(X>309)
  28.   RY=((I$=Cup$)-(I$=Cdown$))*2+Jup(1)-Jdown(1)+(Y<10)-(Y>245)
  29. '  RX=(X<10)-(X>309) 
  30. '  RY=(Y<10)-(Y>245) 
  31.   If X>283 and Y>19 and X<314 and Y<50 and M Then OX=(X-294)*16 : OY=(Y-25)*16 : M=0 : RX=0 : RY=0
  32.   OX=Max(0,Min(160,OX+RX*2))
  33.   OY=Max(0,Min(304,OY+RY*2))
  34.   Amreg(0)=OX : Amreg(1)=OY
  35.   If Y>89 Then BX=(X+OX)/16 : BY=(Y-90+OY)/16 : If CORX<>BX or CORY<>BY Then Gosub UPCOR
  36.   If M and Y<89 Then Gosub CHECKBUT
  37.   If M and Y>89 Then Gosub SETBLOCKS
  38.   If B Then Gosub ACTION
  39.   If Fire(1) Then Gosub BLITZ : Repeat : Until Fire(1)=0
  40.   Screen Offset 1,OX,OY : Wait Vbl 
  41. Loop 
  42. End 
  43. ACTION:
  44.   If B<10 Then Gosub DEFAUL : Return 
  45.   If B=29 or B=63 Then MD=1 : PAGE=1 : NEWPAGE[0] : Gosub UPCHAR : Gosub UPWALL : Gosub UPAPFEL : Gosub UPMONST
  46.   If B=16 or B=45 or B=46 Then MD=7 : PAGE=2 : NEWPAGE[1] : Gosub UPFLGNUM : Gosub UPFLGBUT1 : Gosub UPFLGBUT2 : Gosub UPFLGBLK
  47.   If B=36 Then MD=8 : PAGE=3 : NEWPAGE[2] : Gosub UPTELE
  48.   If B=37 Then MD=9 : PAGE=4 : NEWPAGE[3] : Gosub UPSWI : Gosub UPFLGBLK
  49.   If B=17 Then MD=10 : PAGE=5 : NEWPAGE[4] : Gosub UPMFLGS : Gosub UPMATTR
  50.   If B=10 Then Screen 1 : Bob Off : Screen 0 : Gosub LADEN : Gosub UPBOBS
  51.   If B=11 Then Gosub SPEICHERN
  52.   If B=12 Then Screen 1 : Bob Off : Screen 0 : Gosub CLEAR : Gosub UPBOBS
  53.   If B=13 Then Pop : Goto QUIT
  54.   If B=14 Then Screen 1 : Bob Off : Screen 0 : Gosub MAKESH : Gosub UPBOBS
  55.   If B=15 Then Gosub FL
  56.   If B=18 and MD=4 Then Add DI,1,0 To 3 : Gosub UPAPFEL
  57.   If B=18 and MD<>4 Then MD=4
  58.   If B=19 Then MD=5
  59.   If B=20 Then Add MNR,-1,0 To 3 : Gosub UPMONST : MD=6
  60.   If B=21 Then MD=6
  61.   If B=22 Then Add MNR,1,0 To 3 : Gosub UPMONST : MD=6
  62.   If B=23 Then Add CHAR,-1,0 To 24 : Gosub UPCHAR : MD=1
  63.   If B=24 Then MD=1
  64.   If B=25 Then Add CHAR,1,0 To 24 : Gosub UPCHAR : MD=1
  65.   If B=26 Then Add WALL,-1,0 To 15 : Gosub UPWALL : MD=3
  66.   If B=27 Then MD=3
  67.   If B=28 Then Add WALL,1,0 To 15 : Gosub UPWALL : MD=3
  68.   If B=30 Then F(BBX,BBY,0)=((F(BBX,BBY,0)+2) and 6)+(F(BBX,BBY,0) and 249) : Gosub UPFLGBUT1
  69.   If B=31 Then F(BBX,BBY,0)=((F(BBX,BBY,0)+1) and 1)+(F(BBX,BBY,0) and 254) : Gosub UPFLGBUT2
  70.   If B=32 Then F(BBX,BBY,0)=(Max((F(BBX,BBY,0)-8),0) and 248)+(F(BBX,BBY,0) and 7) : Gosub UPFLGNUM
  71.   If B=33 Then F(BBX,BBY,0)=(Min((F(BBX,BBY,0)+8),232) and 248)+(F(BBX,BBY,0) and 7) : Gosub UPFLGNUM
  72.   If B=34 Then Gosub SUFLGBLK : Gosub UPFLGBLK
  73.   If B=35 Then Gosub ADFLGBLK : Gosub UPFLGBLK
  74.   If B=38 Then Add TELE,-1,0 To 29
  75.   If B=39 Then Poke ST+40+TELE*2,Max(Peek(ST+40+TELE*2)-1,1)
  76.   If B=40 Then Poke ST+41+TELE*2,Max(Peek(ST+41+TELE*2)-1,1)
  77.   If B=41 Then Add TELE,1,0 To 29
  78.   If B=42 Then Poke ST+40+TELE*2,Min(Peek(ST+40+TELE*2)+1,28)
  79.   If B=43 Then Poke ST+41+TELE*2,Min(Peek(ST+41+TELE*2)+1,28)
  80.   If B=44 Then Doke ST+40+TELE*2,0
  81.   If B>37 and B<45 Then Gosub UPTELE
  82.   If B=47 Then Add SWI,-1,0 To 14 : ACT=0
  83.   If B=48 Then Add SWI,1,0 To 14 : ACT=0
  84.   If B=49 Then Add ACT,-1,0 To 4
  85.   If B=50 Then Add ACT,1,0 To 4
  86.   If B=51 Then Poke ST+100+SWI*20+ACT*4,Max(Peek(ST+100+SWI*20+ACT*4)-1,1)
  87.   If B=52 Then Poke ST+100+SWI*20+ACT*4,Min(Peek(ST+100+SWI*20+ACT*4)+1,28)
  88.   If B=53 Then Poke ST+101+SWI*20+ACT*4,Max(Peek(ST+101+SWI*20+ACT*4)-1,1)
  89.   If B=54 Then Poke ST+101+SWI*20+ACT*4,Min(Peek(ST+101+SWI*20+ACT*4)+1,28)
  90.   If B>54 and B<61 Then A=ST+102+SWI*20+ACT*4
  91.   If B=55 Then Poke A,((Peek(A)+2) and 6)+(Peek(A) and 249) : Gosub UPFLGBUT1
  92.   If B=56 Then Poke A,((Peek(A)+1) and 1)+(Peek(A) and 254) : Gosub UPFLGBUT2
  93.   If B=57 Then Poke A,(Max((Peek(A)-8),0) and 248)+(Peek(A) and 7) : Gosub UPFLGNUM
  94.   If B=58 Then Poke A,(Min((Peek(A)+8),232) and 248)+(Peek(A) and 7) : Gosub UPFLGNUM
  95.   If B=59 Then Gosub SUFLGBLK2 : Gosub UPFLGBLK
  96.   If B=60 Then Gosub ADFLGBLK2 : Gosub UPFLGBLK
  97.   If B=61 Then For A=100 To 119 : Poke ST+SWI*20+A,0 : Next : ACT=0
  98.   If B=62 Then Loke ST+100+SWI*20+ACT*4,0
  99.   If(B>46 and B<51) or B=61 or B=62 Then Gosub UPFLGBUT1 : Gosub UPFLGBUT2 : Gosub UPFLGNUM : Gosub UPFLGBLK
  100.   If(B>46 and B<55) or B=61 or B=62 Then Gosub UPSWI
  101.   If B>63 and B<80 Then A=ST+24+MNR*4
  102.   If B=64 Then Poke A+2,Max(Peek(A+2)-1,0)
  103.   If B=65 Then Poke A+2,Min(Peek(A+2)+1,8)
  104.   If B=66 Then Poke A,Max(Peek(A)-1,1)
  105.   If B=67 Then Poke A,Min(Peek(A)+1,28)
  106.   If B=68 Then Poke A+1,Max(Peek(A+1)-1,1)
  107.   If B=69 Then Poke A+1,Min(Peek(A+1)+1,28)
  108.   If B=70 Then Poke A+3,Max((Peek(A+3) and 3)-1,0)+(Peek(A+3) and 252)
  109.   If B=71 Then Poke A+3,Min((Peek(A+3) and 3)+1,3)+(Peek(A+3) and 252)
  110.   If B=72 Then Add MNR,-1,0 To 3 : Gosub UPMATTR
  111.   If B=73 Then Add MNR,1,0 To 3 : Gosub UPMATTR
  112.   If B=74 Then Bchg 2,A+3
  113.   If B=75 Then Bchg 5,A+3
  114.   If B=76 Then Bchg 6,A+3
  115.   If B=77 Then Bchg 3,A+3
  116.   If B=78 Then Bchg 4,A+3
  117.   If B=79 Then Bchg 7,A+3
  118.   If B>63 and B<74 Then Gosub UPMFLGS : Gosub UPBOBS
  119. Return 
  120. ADFLGBLK:
  121.   If F(BBX,BBY,1)>219 Then Add F(BBX,BBY,1),1,220 To 235 : Return 
  122.   If F(BBX,BBY,1)>162 Then Return 
  123.   If F(BBX,BBY,1)=0 Then F(BBX,BBY,1)=1 : Gosub FLGBLK : Return 
  124.   F(BBX,BBY,1)=Min(F(BBX,BBY,1)+7,168)
  125.   Gosub FLGBLK
  126. Return 
  127. SUFLGBLK:
  128.   If F(BBX,BBY,1)>219 Then Add F(BBX,BBY,1),-1,220 To 235 : Return 
  129.   F(BBX,BBY,1)=Max(F(BBX,BBY,1)-7,0)
  130.   Gosub FLGBLK
  131. Return 
  132. ADFLGBLK2:
  133.   If Peek(A+1)<220 and Peek(A+1)>0 Then Poke A+1,Peek(A+1)+7
  134.   If Peek(A+1)>219 or Peek(A+1)=0 Then Poke A+1,Peek(A+1)+1
  135.   If Peek(A+1)>168 and Peek(A+1)<220 Then Poke A+1,220 : Return 
  136.   If Peek(A+1)>235 Then Poke A+1,0 : Return 
  137. Return 
  138. SUFLGBLK2:
  139.   If Peek(A+1)<220 and Peek(A+1)>1 Then Poke A+1,Peek(A+1)-7
  140.   If Peek(A+1)>219 or Peek(A+1)<2 Then Poke A+1,Peek(A+1)-1
  141.   If Peek(A+1)=255 Then Poke A+1,235 : Return 
  142.   If Peek(A+1)<220 and Peek(A+1)>167 Then Poke A+1,167 : Return 
  143. Return 
  144. FLGBLK:
  145.   BX=BBX : BY=BBY : Gosub CHECKBOBS
  146.   If REF=1 Then Screen 1 : Bob Off : Screen 0
  147.   XX=BBX : YY=BBY : Gosub MAKESHADOW
  148.   If REF Then Gosub UPBOBS
  149. Return 
  150. SETBLOCKS:
  151.   If MD=4 or MD=5 or MD=6 or MD>7 Then BX=Max(Min(BX,28),1) : BY=Max(Min(BY,28),1)
  152.   BBX=BX : BBY=BY
  153.   Gosub CHECKBOBS
  154.   If REF=1 Then Screen 1 : Bob Off : Screen 0
  155.   If MD=1 and M=1 Then XX=BX : YY=BY : F(BX,BY,0)=0 : F(BX,BY,1)=T1(CHAR) : Gosub MAKESHADOW
  156.   If(MD=1 or MD=3) and M=2 Then XX=BX : YY=BY : F(BX,BY,0)=0 : F(BX,BY,1)=1 : Gosub MAKESHADOW
  157.   If MD=2 Then Gosub FLOOD
  158.   If MD=3 and M=1 Then PB[WALL+221,BX*16,BY*16] : F(BX,BY,0)=1 : F(BX,BY,1)=WALL+220
  159.   If MD=4 Then AMX=BX : AMY=BY
  160.   If MD=5 Then HMX=BX : HMY=BY
  161.   If MD=6 Then Doke ST+24+4*MNR,BX*256+BY
  162.   If MD=7 Then Gosub UPFLGNUM : Gosub UPFLGBUT1 : Gosub UPFLGBUT2 : Gosub UPFLGBLK
  163.   If MD=8 Then Doke ST+40+TELE*2,BX*256+BY : Gosub UPTELE
  164.   If MD=9 Then Doke ST+100+SWI*20+ACT*4,BX*256+BY : Gosub UPSWI
  165.   If MD=10 Then Doke ST+24+MNR*4,BX*256+BY : REF=1
  166.   If REF Then Gosub UPBOBS
  167. Return 
  168. CHECKBOBS:
  169.   REF=0
  170.   For A=0 To 3
  171.     If BX=Peek(ST+24+A*4) and BY=Peek(ST+25+A*4) Then REF=1 : Exit 
  172.   Next 
  173.   If(BX=AMX and BY=AMY) or(BX=HMX and BY=HMY) Then REF=1
  174.   If MD=8 Then REF=0
  175. Return 
  176. BLITZ:
  177.   For A=1 To 31 : Colour A,$FFF : Next : Fade 2 To 1
  178. Return 
  179. QUIT:
  180.   Amal Off 
  181.   Sprite Off 
  182.   Call Start(9)+2
  183.   Screen Close 1
  184.   Screen Close 0
  185. End 
  186. TEX:
  187. '  Ink 6,CT : Text XT,YT+6,TT$ 
  188. 'Return  
  189.   For ABC=1 To Len(TT$)
  190.     BCD=Max(1,Instr(S$,Mid$(TT$,ABC,1)))
  191.     Cls CT,XT,YT To XT+7,YT+7
  192.     Put Block BCD+299,XT,YT
  193.     Add XT,8
  194.   Next 
  195. Return 
  196. DEFAUL:
  197.   Add TIME,((B=1)-(B=2))*10,0 To 590
  198.   Add LE,(B=3)-(B=4),0 To 99
  199.   Add SECR,(B=5)-(B=6),0 To 99
  200.   If B=1 or B=2 Then Gosub UPTIME
  201.   If B=3 or B=4 Then Gosub UPLEVEL
  202.   If B=5 or B=6 Then Gosub UPSECRET
  203.   If B=7 Then Gosub EDINAME
  204.   If B=8 and VIW=1 Then VIW=0 : Gosub LITTLMAP
  205.   If B=9 and VIW=0 Then VIW=1 : Gosub LITTLMAP
  206. Return 
  207. DEFUPDAT:
  208.   XT=182 : YT=62 : CT=0 : TT$=NAME$ : Gosub TEX
  209.   A$=Chr$(48+TIME/60)+":"+Chr$(48+(TIME-TIME/60*60)/10)+Chr$(48+(TIME-TIME/10*10))
  210.   XT=238 : YT=26 : CT=3 : TT$=A$ : Gosub TEX
  211.   If LE<10 Then A$="0"+Str$(LE)-" " Else A$=Str$(LE)-" "
  212.   XT=238 : YT=34 : CT=3 : TT$=A$ : Gosub TEX
  213.   If SECR<10 Then A$="0"+Str$(SECR)-" " Else A$=Str$(SECR)-" "
  214.   XT=238 : YT=42 : CT=3 : TT$=A$ : Gosub TEX
  215. Return 
  216. UPCOR:
  217.   CORX=BX : CORY=BY
  218.   If BX<10 Then A$="0"+Str$(BX)-" " Else A$=Str$(BX)-" "
  219.   If BY<10 Then A$=A$+" 0"+Str$(BY)-" " Else A$=A$+Str$(BY)
  220.   XT=238 : YT=18 : CT=3 : TT$=A$ : Gosub TEX
  221. Return 
  222. UPTIME:
  223.   A$=Chr$(48+TIME/60)+":"+Chr$(48+(TIME-TIME/60*60)/10)+Chr$(48+(TIME-TIME/10*10))
  224.   XT=238 : YT=26 : CT=3 : TT$=A$ : Gosub TEX
  225. Return 
  226. UPLEVEL:
  227.   If LE<10 Then A$="0"+Str$(LE)-" " Else A$=Str$(LE)-" "
  228.   XT=238 : YT=34 : CT=3 : TT$=A$ : Gosub TEX
  229. Return 
  230. UPSECRET:
  231.   If SECR<10 Then A$="0"+Str$(SECR)-" " Else A$=Str$(SECR)-" "
  232.   XT=238 : YT=42 : CT=3 : TT$=A$ : Gosub TEX
  233. Return 
  234. UPFLGNUM:
  235.   If MD=7 Then A=(F(BBX,BBY,0) and 248)/8
  236.   If MD=9 Then A=(Peek(ST+102+SWI*20+ACT*4) and 248)/8
  237.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  238.   XT=122 : YT=29 : CT=3 : TT$=A$ : Gosub TEX
  239. Return 
  240. UPTELE:
  241.   If TELE<10 Then A$="0"+Str$(TELE)-" " Else A$=Str$(TELE)-" "
  242.   XT=91 : YT=29 : CT=3 : TT$=A$ : Gosub TEX
  243.   A=Peek(ST+40+TELE*2)
  244.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  245.   If A=0 Then A$="NO"
  246.   XT=127 : YT=29 : CT=3 : TT$=A$ : Gosub TEX
  247.   A=Peek(ST+41+TELE*2)
  248.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  249.   If A=0 Then A$="NO"
  250.   XT=163 : YT=29 : CT=3 : TT$=A$ : Gosub TEX
  251. Return 
  252. UPSWI:
  253.   If SWI<10 Then A$="0"+Str$(SWI)-" " Else A$=Str$(SWI)-" "
  254.   XT=45 : YT=34 : CT=3 : TT$=A$ : Gosub TEX
  255.   TT$="0"+Str$(ACT)-" " : XT=45 : YT=42 : CT=3 : Gosub TEX
  256.   A=Peek(ST+100+SWI*20+ACT*4)
  257.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  258.   If A=0 Then A$="NO"
  259.   XT=29 : YT=50 : CT=3 : TT$=A$ : Gosub TEX
  260.   A=Peek(ST+101+SWI*20+ACT*4)
  261.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  262.   If A=0 Then A$="NO"
  263.   XT=70 : YT=50 : CT=3 : TT$=A$ : Gosub TEX
  264. Return 
  265. UPFLGBUT1:
  266.   If MD=7 Then A=(F(BBX,BBY,0) and 6)/2
  267.   If MD=9 Then A=(Peek(ST+102+SWI*20+ACT*4) and 6)/2
  268.   If A=0 Then Screen Copy 0,176,232,226,242 To 0,70,27
  269.   If A=1 Then Screen Copy 0,227,232,277,242 To 0,70,27
  270.   If A=2 Then Screen Copy 0,278,232,328,242 To 0,70,27
  271.   If A=3 Then Screen Copy 0,176,243,226,253 To 0,70,27
  272. Return 
  273. UPFLGBUT2:
  274.   If MD=7 Then A=F(BBX,BBY,0) and 1
  275.   If MD=9 Then A=Peek(ST+102+SWI*20+ACT*4) and 1
  276.   If A=0 Then Screen Copy 0,227,243,277,253 To 0,70,38
  277.   If A=1 Then Screen Copy 0,278,243,328,253 To 0,70,38
  278. Return 
  279. UPFLGBLK:
  280.   If MD=7 Then Put Block F(BBX,BBY,1)+1,150,30
  281.   If MD=9 Then Put Block Peek(ST+103+SWI*20+ACT*4)+1,150,30
  282. Return 
  283. UPMFLGS:
  284.   TT$="0"+Str$(Peek(ST+26+MNR*4))-" "
  285.   If Peek(ST+26+MNR*4)=0 Then TT$="NO"
  286.   XT=114 : YT=17 : CT=3 : Gosub TEX
  287.   A=Peek(ST+24+MNR*4)
  288.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  289.   XT=114 : YT=25 : CT=3 : TT$=A$ : Gosub TEX
  290.   A=Peek(ST+25+MNR*4)
  291.   If A<10 Then A$="0"+Str$(A)-" " Else A$=Str$(A)-" "
  292.   XT=114 : YT=33 : CT=3 : TT$=A$ : Gosub TEX
  293.   A=Peek(ST+27+MNR*4) and 3
  294.   If A=3 Then A=8
  295.   If A=2 Then A=4
  296.   If A=1 Then A=2
  297.   If A=0 Then A=1
  298.   TT$="0"+Str$(A)-" " : XT=114 : YT=41 : CT=3 : Gosub TEX
  299.   Ink 0 : Bar 150,30 To 165,44
  300.   If Peek(ST+26+MNR*4) Then Paste Bob 150,30,6+Peek(ST+26+MNR*4)
  301. Return 
  302. UPMATTR:
  303.   For A=74 To 79
  304.     If Point(B(A,0),B(A,1))=10 Then REALISE[A]
  305.   Next 
  306.   A=Peek(ST+27+MNR*4)
  307.   If A and 4 Then PRESS[74]
  308.   If A and 32 Then PRESS[75]
  309.   If A and 64 Then PRESS[76]
  310.   If A and 8 Then PRESS[77]
  311.   If A and 16 Then PRESS[78]
  312.   If A and 128 Then PRESS[79]
  313. Return 
  314. UPCHAR:
  315.   Put Block T1(CHAR)+1,150,31
  316. Return 
  317. UPWALL:
  318.   Put Block WALL+221,150,51
  319. Return 
  320. UPAPFEL:
  321.   Ink 0 : Bar 100,31 To 114,45
  322.   Paste Bob 100,31,2+DI
  323.   Gosub UPBOBS
  324. Return 
  325. UPMONST:
  326.   Ink 0 : Bar 109,51 To 123,65
  327.   If Peek(ST+26+MNR*4) Then Paste Bob 109,51,6+Peek(ST+26+MNR*4)
  328.   Gosub UPBOBS
  329. Return 
  330. UPBOBS:
  331.   Screen 1 : Wait Vbl 
  332.   Bob 1,AMX*16,AMY*16,DI+2
  333.   Bob 2,HMX*16,HMY*16,6
  334.   For A=0 To 3
  335.     If Peek(ST+26+A*4) Then Bob 3+A,Peek(ST+24+A*4)*16,Peek(ST+25+A*4)*16,Peek(ST+26+A*4)+6 Else Bob Off 3+A
  336.   Next 
  337.   Screen 0
  338. Return 
  339. EDINAME:
  340.   Hide 
  341.   SCROL["EDIT NAME!"]
  342.   POS=1 : POSA=2
  343.   A$=""
  344.   Repeat 
  345.     I$=Upper$(Inkey$) : M=Mouse Key
  346.     If M=2 Then NAME$=Space$(12) : I$=Chr$(13)
  347.     If Instr(S$,I$)>0 Then NAME$=Left$(NAME$,POS-1)+I$+Right$(NAME$,12-POS) : POS=Min(POS+1,12)
  348.     If I$=Chr$(8) Then POS=Max(POS-1,1) : NAME$=Left$(NAME$,POS-1)+" "+Right$(NAME$,12-POS)
  349.     If I$=Cleft$ Then POS=Max(POS-1,1)
  350.     If I$=Cright$ Then POS=Min(POS+1,12)
  351.     If POS<>POSA
  352.       Ink 0 : Draw 174+POSA*8,69 To 180+POSA*8,69
  353.       Ink 23 : Draw 174+POS*8,69 To 180+POS*8,69
  354.       POSA=POS
  355.     End If 
  356.     If NAME$<>A$ Then A$=NAME$ : XT=182 : YT=62 : CT=0 : TT$=NAME$ : Gosub TEX
  357.   Until I$=Chr$(13) or M=1
  358.   Ink 0 : Draw 174+POSA*8,69 To 181+POSA*8,69
  359.   Show 
  360. Return 
  361. INIT:
  362.   Close Editor : Close Workbench 
  363.   Unpack 8 To 0 : Screen Hide 0
  364.   For Y=0 To 11
  365.     For X=0 To 19
  366.       If(Point(X*16,Y*16)<>0) or(X+Y=0) Then Get Block X+Y*20+1,X*16,Y*16,16,16,0
  367.     Next 
  368.   Next 
  369.   Unpack 6 To 0 : Screen Hide 0
  370.   Screen Open 1,30*16,30*16,32,0 : Screen Hide 1
  371.   Curs Off : Paper 0 : Pen 1 : Flash Off : Cls 1
  372.   Get Palette 0
  373.   Screen Display 1,128,129,320,176
  374.   S$=" ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,:'/!"+Chr$(22)
  375.   Screen 0
  376.   For A=0 To 24
  377.     Read T1(A)
  378.   Next 
  379.   For A=0 To 24
  380.     Read T2(A)
  381.   Next 
  382.   For A=1 To 79
  383.     Read B(A,0),B(A,1),B(A,2),B(A,3)
  384. '    Box B(A,0),B(A,1) To B(A,2),B(A,3)
  385.   Next 
  386.   Reserve As Work 7,2200
  387.   ST=Start(7)
  388.   For A=0 To 399
  389.     Poke ST+A,0
  390.   Next 
  391.   For A=400 To 2198 Step 2
  392.     Poke ST+A,0 : Poke ST+A+1,1
  393.   Next 
  394.   For A=0 To Len(S$)-1
  395.     Get Block A+300,(A mod 4)*8+320,(A/4)*8,8,8,1
  396.   Next 
  397.   Sprite 2,0,0,41
  398.   Sprite 4,0,0,40
  399.   Channel 0 To Sprite 2
  400.   Channel 1 To Sprite 4
  401.   A$="A: L X=RA/16+411; L Y=RB/16+59; PP; J A; "
  402.   Amal 0,A$
  403.   A$="A: P; I YM<129 J B; "
  404.   A$=A$+"L R0=RA/16*16; L R0=RA-R0; L X=XM+R0/16*16-R0;"
  405.   A$=A$+" L R1=RB/16*16; L R1=RB-R1; L Y=YM-1+R1/16*16-R1+1; J A; "
  406.   A$=A$+"B: L X=0; L Y=0; P; J A; "
  407.   Amal 1,A$
  408.   Screen 0
  409.   OX=0 : OY=0 : X=0 : Y=0 : RZ=0 : Z=0 : LE=0
  410.   Limit Mouse 128,40 To 447,304
  411.   Change Mouse 2
  412.   S=Start(9)
  413.   Loke S+4,Logbase(1)+76*44+1
  414.   Loke S+8,Logbase(2)+76*44+1
  415.   Loke S+12,Logbase(1)+200*44+22
  416.   Loke S+16,Logbase(2)+200*44+22
  417. Return 
  418. LADEN:
  419.   If Exist("Levels/"+Str$(LE)-" ")=0 Then SCROL["LEVEL DOESN'T EXIST!"] : Return 
  420.   SCROL["LOADING..."]
  421.   Erase 7 : Reserve As Work 7,2200
  422.   Bload "Levels/"+Str$(LE)-" ",Start(7)
  423.   ST=Start(7)
  424.   AMX=Peek(ST) : AMY=Peek(ST+1) : DI=Deek(ST+2) : TIME=Deek(ST+6)
  425.   HMX=Peek(ST+22) : HMY=Peek(ST+23)
  426.   SECR=Deek(ST+8)
  427.   NAME$=""
  428.   For A=10 To 21 : NAME$=NAME$+Chr$(Peek(ST+A)) : Next 
  429.   For YY=0 To 29
  430.     For XX=0 To 29
  431.       F(XX,YY,0)=Peek(ST+400+YY*60+XX*2)
  432.       F(XX,YY,1)=Peek(ST+401+YY*60+XX*2)
  433.     Next 
  434.   Next 
  435.   Gosub ZEIGEN
  436.   Gosub DEFUPDAT
  437.   SCROL["DONE!"]
  438.   Gosub BLITZ
  439.   VIW=0
  440. Return 
  441. SPEICHERN:
  442.   SCROL["SAVING..."]
  443.   ST=Start(7)
  444.   Doke ST,AMX*256+AMY : Doke ST+2,DI : Doke ST+6,TIME
  445.   Doke ST+8,SECR
  446.   For A=1 To 12 : Poke ST+A+9,Asc(Mid$(NAME$,A,1)) : Next 
  447.   Doke ST+22,HMX*256+HMY
  448.   APPLES=0
  449.   For YY=0 To 29
  450.     For XX=0 To 29
  451.       If F(XX,YY,1)>7 and F(XX,YY,1)<22 Then Inc APPLES
  452.       Poke ST+400+YY*60+XX*2,F(XX,YY,0)
  453.       Poke ST+401+YY*60+XX*2,F(XX,YY,1)
  454.     Next 
  455.   Next 
  456.   Doke ST+4,APPLES
  457.   Bsave "Levels/"+Str$(LE)-" ",ST To ST+2200
  458.   SCROL["DONE!"]
  459.   Gosub BLITZ
  460. Return 
  461. MAKESHADOW:
  462.   SH=0
  463.   If XX<1 Then Goto SKIP1
  464.   F=F(XX-1,YY,1) : If F=220 or F=223 or F=225 or F=227 or F=233 Then SH=1
  465.   If F=225 or F=231 or F=232 or F=235 Then SH=5
  466. SKIP1:
  467.   If YY<1 Then Goto SKIP2
  468.   F=F(XX,YY-1,1) : If F=221 or F=223 or F=228 or F=235 Then SH=2
  469.   If F=222 or F=231 or F=233 or F=234 Then SH=6
  470. SKIP2:
  471.   If XX<1 or YY<1 Then Goto SKIP3
  472.   F=F(XX-1,YY-1,1) : If F=224 or F=226 or F=229 or F=230 Then SH=3
  473.   If F=223 or F=231 or F=233 or F=235 Then SH=4
  474. SKIP3:
  475.   If F(XX,YY,1)>0 Then A=((F(XX,YY,1)-1)/7)*7+SH Else A=-1
  476.   PB[A+2,XX*16,YY*16]
  477.   F(XX,YY,1)=A+1
  478. Return 
  479. FL:
  480.   SCROL["CLICK ON PLAYFIELD TO FILL..."] : MD=2
  481. Return 
  482. FLOOD:
  483.   Screen 1 : Bob Off : Screen 0
  484.   SCROL["FILLING..."]
  485.   Screen Open 2,320,32,4,0 : Screen Hide 2 : A=0
  486.   Curs Off : Flash Off : Cls 0
  487.   FA=F(BX,BY,0) : F=F(BX,BY,1) : If F>0 and F<219 Then F=(F-1)/7 : A=1
  488.   For YY=0 To 29
  489.     For XX=0 To 29
  490.       FF=F(XX,YY,1) : If FF>0 and A=1 Then FF=(FF-1)/7
  491.       If F=FF Then Plot XX,YY,1
  492.     Next 
  493.   Next 
  494.   Ink 2,0 : Paint BX,BY,1
  495.   For YY=0 To 29
  496.     For XX=0 To 29
  497.       F=F(XX,YY,1)
  498.       If Point(XX,YY)=2 Then F(XX,YY,0)=FA : F(XX,YY,1)=T1(CHAR)+(F-1) mod 7
  499.     Next 
  500.   Next 
  501.   Screen Close 2
  502.   Gosub ZEIGEN
  503.   SCROL["DONE!"]
  504.   Gosub BLITZ
  505.   Gosub UPBOBS
  506. Return 
  507. MAKESH:
  508.   Screen 1 : Bob Off : Screen 0
  509.   SCROL["MAKING SHADOWS..."]
  510.   For YY=0 To 29
  511.     For XX=0 To 29
  512.       F=F(XX,YY,1)
  513.       If F>0 and F<220 Then Gosub MAKESHADOW
  514.     Next 
  515.   Next 
  516.   SCROL["DONE!"]
  517.   Gosub BLITZ
  518.   Gosub UPBOBS
  519. Return 
  520. CLEAR:
  521.   Screen 1 : Bob Off : Screen 0
  522.   SCROL["CLEARING LEVEL..."]
  523.   For Y=0 To 29
  524.     For X=0 To 29
  525.       F(X,Y,0)=0 : F(X,Y,1)=1
  526.     Next 
  527.   Next 
  528.   For A=24 To 399
  529.     Poke ST+A,0
  530.   Next 
  531.   MNR=0
  532.   AMX=1 : AMY=1 : DI=0 : HMX=28 : HMY=28 : TIME=0 : SECR=0
  533.   TELE=0 : SWI=0 : ACT=0 : VIW=0
  534.   NAME$="APFELMONSTER"
  535.   Loke ST+24,$2020100 : Doke ST+28,257 : Doke ST+32,257 : Doke ST+36,257
  536.   Gosub ZEIGEN
  537.   SCROL["DONE!"]
  538.   Gosub BLITZ
  539.   Gosub UPBOBS
  540. Return 
  541. ZEIGEN:
  542.   Screen 1
  543.   For YZ=0 To 29
  544.     For XZ=0 To 29
  545.       Put Block F(XZ,YZ,1)+1,XZ*16,YZ*16
  546.     Next 
  547.   Next 
  548.   Screen 0
  549.   Gosub LITTLMAP1
  550. Return 
  551. LITTLMAP:
  552.   SCROL["UPDATING LITTLE MAP!"]
  553.   If VIW Then Gosub LITTLMAP2 Else Gosub LITTLMAP1
  554. Return 
  555. LITTLMAP1:
  556.   For YZ=0 To 29
  557.     For XZ=0 To 29
  558.       A=F(XZ,YZ,1)+1
  559.       If A<221 Then C=T2((A+6)/7) Else C=5
  560.       If A=1 Then C=0
  561.       Plot XZ+284,YZ+20,C
  562.     Next 
  563.   Next 
  564. Return 
  565. LITTLMAP2:
  566.   For YZ=0 To 29
  567.     For XZ=0 To 29
  568.       A=F(XZ,YZ,0)
  569.       If A and 1 Then C=5 Else C=1
  570.       A=A and 6
  571.       If A=1 Then C=27
  572.       If A=2 Then C=13
  573.       If A=3 Then C=28
  574.       Plot XZ+284,YZ+20,C
  575.     Next 
  576.   Next 
  577. Return 
  578. CHECKBUT:
  579.   B=0
  580.   If MD=2 Then MD=1 : SCROL["FILL ABORTED!"]
  581.   For A=1 To 9
  582.     If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) Then B=A : Exit 
  583.   Next 
  584.   If A<10 Then Goto SKIP
  585.   If PAGE=1 Then STA=10 : STO=28
  586.   If PAGE=2 Then STA=29 : STO=37
  587.   If PAGE=3 Then STA=38 : STO=45
  588.   If PAGE=4 Then STA=46 : STO=62
  589.   If PAGE=5 Then STA=63 : STO=79
  590.   For A=STA To STO
  591.     If X>B(A,0) and Y>B(A,1) and X<B(A,2) and Y<B(A,3) Then B=A : Exit 
  592.   Next 
  593.   If A>STO Then Return 
  594. SKIP:
  595.   P=0
  596.   Repeat 
  597.     M=Mouse Key : X=X Mouse-128 : Y=Y Mouse-40 : A=0
  598.     If X>B(B,0) and Y>B(B,1) and X<B(B,2) and Y<B(B,3) Then A=1
  599.     If B<7 and A=1 Then Gosub DEFAUL : Wait 4 : M=Mouse Key
  600.     If A=1 and P=0 Then P=1 : PRESS[B]
  601.     If A=0 and P=1 Then P=0 : REALISE[B]
  602.   Until M=0
  603.   If P=0 Then B=0 : Return 
  604.   If B<74 Then REALISE[B]
  605.   If B<7 Then B=0
  606. Return 
  607. ' Table 1 (Chartable)
  608. Data 0,1,8,15,22,29,36,43,50,57
  609. Data 64,71,78,85,92,99,106,113,120,127,134,141,148,155,162
  610. ' Table 2 (Colortable) 
  611. Data 0,2,10,22,29,29,29,29,29,29,19,9
  612. Data 24,13,30,30,30,30,30,30,30,30,30,26,0
  613. ' Menu Buttons Set 1 Default (1-9) 
  614. Data 229,26,236,33
  615. Data 270,26,277,33
  616. Data 229,34,236,41
  617. Data 254,34,261,41
  618. Data 229,42,236,49
  619. Data 254,42,261,49
  620. Data 180,60,278,70
  621. Data 280,55,317,65
  622. Data 280,66,317,76
  623. ' Menu Buttons Set 2 Main Menu (10-28) 
  624. Data 3,27,45,37
  625. Data 3,38,45,48
  626. Data 3,49,45,59
  627. Data 3,60,45,70
  628. Data 46,27,96,37
  629. Data 46,38,96,48
  630. Data 46,49,96,59
  631. Data 46,60,96,70
  632. Data 99,30,116,47
  633. Data 118,30,135,47
  634. Data 99,50,107,67
  635. Data 108,50,125,67
  636. Data 127,50,135,67
  637. Data 140,30,148,47
  638. Data 149,30,166,47
  639. Data 168,30,176,47
  640. Data 140,50,148,67
  641. Data 149,50,166,67
  642. Data 169,50,176,67
  643. ' Menu Buttons Set 3 Flags (29-37) 
  644. Data 3,16,68,47
  645. Data 70,27,120,37
  646. Data 70,38,120,48
  647. Data 122,16,137,26
  648. Data 122,38,137,48
  649. Data 140,29,148,46
  650. Data 168,29,176,46
  651. Data 32,49,178,59
  652. Data 32,60,178,70
  653. ' Menu Buttons Set 4 Teleporter (38-45)  
  654. Data 91,16,106,26
  655. Data 127,16,142,26
  656. Data 163,16,178,26
  657. Data 91,38,106,48
  658. Data 127,38,142,48
  659. Data 163,38,178,48
  660. Data 3,38,45,48
  661. Data 3,50,178,70
  662. ' Menu Buttons Set 5 Switch (46-62)  
  663. Data 3,16,68,32
  664. Data 36,34,43,41
  665. Data 61,34,68,41
  666. Data 36,42,43,49
  667. Data 61,42,68,49
  668. Data 20,50,27,57
  669. Data 45,50,52,57
  670. Data 61,50,68,57
  671. Data 86,50,93,57
  672. Data 70,27,120,37
  673. Data 70,38,120,48
  674. Data 122,16,137,26
  675. Data 122,38,137,48
  676. Data 140,29,148,46
  677. Data 168,29,176,46
  678. Data 3,60,45,70
  679. Data 46,60,111,70
  680. ' Menu Buttons Set 6 Monster (63-79) 
  681. Data 3,16,60,36
  682. Data 105,17,112,24
  683. Data 130,17,137,24
  684. Data 105,25,112,32
  685. Data 130,25,137,32
  686. Data 105,33,112,40
  687. Data 130,33,137,40
  688. Data 105,41,112,48
  689. Data 130,41,137,48
  690. Data 140,29,148,46
  691. Data 168,29,176,46
  692. Data 3,38,60,48
  693. Data 3,49,88,59
  694. Data 91,49,178,59
  695. Data 3,60,38,70
  696. Data 41,60,108,70
  697. Data 111,60,178,70
  698. Procedure PB[BLK,X,Y]
  699.   Screen 1 : Put Block BLK,X,Y
  700.   If VIW=0
  701.     If BLK<221 : C=T2((BLK+5)/7) : Else C=5 : End If 
  702.     If BLK=1 : C=0 : End If 
  703.   Else 
  704.     A=F(X/16,Y/16,0)
  705.     If A and 1 : C=5 : Else C=1 : End If 
  706.     A=A and 6
  707.     If A=1 : C=27 : End If 
  708.     If A=2 : C=13 : End If 
  709.     If A=3 : C=28 : End If 
  710.     Plot XZ+284,YZ+20,C
  711.   End If 
  712.   Screen 0 : Plot X/16+284,Y/16+20,C
  713. End Proc
  714. Procedure SCROL[T$]
  715. '  Repeat : Until Deek(Start(9)+20)=0
  716.   Loke Start(9)+26,0
  717.   Cls 0,176,200 To 352,230
  718.   T$=" "+T$ : XT=176 : YT=200 : TT$=Left$(T$,22) : Gosub TEX2
  719.   RASY=8 : SCL=Len(T$)*8
  720.   While Len(T$)>22
  721.     T$=Mid$(T$,23)
  722.     XT=176 : YT=200+RASY : TT$=Left$(T$,22) : Gosub TEX2
  723.     Add RASY,8
  724.   Wend 
  725.   Loke Start(9)+12,Logbase(1)+200*44+22
  726.   Loke Start(9)+16,Logbase(2)+200*44+22
  727.   Doke Start(9)+20,0
  728.   Loke Start(9)+22,0
  729.   Loke Start(9)+26,SCL
  730. Pop Proc
  731. TEX2:
  732.   For ABC=1 To Len(TT$)
  733.     BCD=Max(1,Instr(S$,Mid$(TT$,ABC,1)))
  734.     Put Block BCD+299,XT,YT
  735.     Add XT,8
  736.   Next 
  737. Return 
  738. End Proc
  739. Procedure NEWPAGE[A]
  740.   Screen Copy 0,(A and 1)*176,88+(A/2)*56,(A and 1)*176+176,144+(A/2)*56 To 0,3,16
  741.   If A=1 Then SCROL["ATTRIBUTES"]
  742.   If A=2 Then SCROL["TELEPORTERS"]
  743.   If A=3 Then SCROL["SWITCHES"]
  744.   If A=4 Then SCROL["MONSTERS"]
  745. End Proc
  746. Procedure PRESS[A]
  747.   B(A,4)=1
  748.   C1=Point(B(A,0),B(A,1))
  749.   C2=Point(B(A,2),B(A,3))
  750.   Ink C2 : Draw B(A,0),B(A,3)-1 To B(A,0),B(A,1)
  751.   Draw B(A,0),B(A,1) To B(A,2)-1,B(A,1)
  752.   Ink C1 : Draw B(A,0)+1,B(A,3) To B(A,2),B(A,3)
  753.   Draw B(A,2),B(A,1)+1 To B(A,2),B(A,3)
  754. End Proc
  755. Procedure REALISE[A]
  756.   B(A,4)=0
  757.   C1=Point(B(A,0),B(A,1))
  758.   C2=Point(B(A,2),B(A,3))
  759.   Ink C2 : Draw B(A,0),B(A,3)-1 To B(A,0),B(A,1)
  760.   Draw B(A,0),B(A,1) To B(A,2)-1,B(A,1)
  761.   Ink C1 : Draw B(A,0)+1,B(A,3) To B(A,2),B(A,3)
  762.   Draw B(A,2),B(A,1)+1 To B(A,2),B(A,3)
  763. End Proc