home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / AllPlaton / Gamedisk3 / F.T.C / FTCRecompile.AMOS / FTCRecompile.amosSourceCode
Encoding:
AMOS Source Code  |  1997-05-30  |  65.8 KB  |  2,493 lines
  1. Set Buffer 60
  2. 'Break Off 
  3. 'Amos To Back : Amos Lock : Wait Vbl 
  4. Load "Gamedata.dat"
  5. Close Workbench 
  6. On Error Goto GOTCHA
  7. MUS=1 : SOU=1
  8. Dim ICN(40,5),PL$(3,1),PL(3,35),F(3,39,24),F2(39,24),IN(3,15,2)
  9. Dim MON$(11),WET$(6),PRO$(4),EH$(4),SVGM$(9)
  10. Global TB,ICN(),UP,SOU,MUS,PAG,WX,WY,B1,B2,S
  11. GRABICONS
  12. Restore MONATE
  13. For A=0 To 11
  14.   Read MON$(A)
  15. Next 
  16. Restore WETTER
  17. For A=0 To 6
  18.   Read WET$(A)
  19. Next 
  20. Restore PRODUKTE
  21. For A=0 To 4
  22.   Read PRO$(A),EH$(A)
  23. Next 
  24. Screen Open 0,320,200,32,0
  25. Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 0
  26. Get Sprite Palette 
  27. Colour Back Colour(0)
  28. Gr Writing 0
  29. Multi Wait : Limit Mouse 
  30.  Extension_8_1204 66
  31. TB=Text Base+2
  32. Gosub UPFREE
  33. 'Amos To Front 
  34. WINDO[0,1,40,25,%111111,"Workbench"]
  35. PASICON[1,2,16,32,15,14,"Spiele"]
  36. DEFICON[0,0,8,7,15]
  37. IS=-1 : TIMOUT=25 : UP=0
  38. Do 
  39.   Multi Wait : BP=-1
  40.   Inc UP : If UP=200 Then Gosub UPFREE : UP=0
  41.   If PAG=0 Then Gosub WORKCLICKING : Gosub INRO
  42.   If PAG>0 Then CLICKING : B=Param : BP=B
  43.   If PAG=1 Then Gosub INITMENU
  44.   If PAG=2 Then Gosub MAINMENU
  45.   If PAG=3 Then Gosub ARBEITSMENU
  46.   If PAG=4 Then Gosub KARTMENU
  47.   If BP=0
  48.     ALERT["Free Trading Company","Wollen Sie wirklich","F.T.C. beenden?","Ja!","Nein!"]
  49.     If Param=1 : Gosub RETWORKBENCH : End If 
  50.   End If 
  51. Loop 
  52. Stop 
  53. AUTOTEST:
  54.   Inc UP : If UP=200 Then Gosub UPFREE : UP=0
  55.   If BP=0
  56.     ALERT["Free Trading Company","Wollen Sie wirklich","F.T.C. beenden?","Ja!","Nein!"]
  57.     If Param=1 : Pop : Gosub RETWORKBENCH : End If 
  58.   End If 
  59. Return 
  60. GOTCHA:
  61.   SSSS=Screen
  62.   Screen Open 4,320,32,2,0
  63.   Curs Off : Palette 0,$FFF
  64.   SSSSER=Errn
  65.   Print "Error"+Str$(SSSSER)+" ("+Err$(SSSSER)+") trapped!"
  66.   Print "Please call me: 089/8005856!"
  67.   Print "Press a key to continue...";
  68.   Wait Key 
  69.   Screen Close 4
  70.   If SSSS=>0 Then Screen SSSS
  71. Resume Next 
  72. UPFREE:
  73.   If PAG=4 Then Return 
  74.   Ink 2 : Bar 0,0 To 311,7
  75.   Put Cblock 25,312,0
  76.   T$="Amiga Workbench "+Str$(Chip Free)+" graphics mem "+Str$(Fast Free)+" other mem  CPU:"+Str$( Extension_8_060E )
  77.   Ink 0 : Text 1,TB-1,T$
  78. Return 
  79. WORKCLICKING:
  80.   X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  81.   If M>1 Then Ink 2 : Bar 0,0 To 319,7 : UP=198
  82.   B=-1 : BB=-1
  83.   Inc TIMOUT
  84.   If M=0 Then MP=0
  85.   If MP=1 and M=1 Then M=0
  86.   If M=1 Then MP=1
  87.   If M=1 Then CHECKICONS[X,Y] : B=Param
  88.   If M=1 and B=-1 and IS>-1 Then PRESSICON[IS] : IS=-1
  89.   If B>-1
  90.     If IS>-1 : PRESSICON[IS] : End If 
  91.     If IS=B and TIMOUT<25
  92.       BB=B : TIMOUT=25
  93.     Else 
  94.       TIMOUT=0
  95.     End If 
  96.     IS=B
  97.     PRESSICON[B]
  98.   End If 
  99. Return 
  100. INRO:
  101.   If B=0
  102.     PRESSICON[B]
  103.     IS=-1 : TIMOUT=25
  104.     ALERT["Workbench Request","Do you really want","to quit workbench?","OK","Cancel"]
  105.     If Param=1 : Pop : Gosub QUIT : End If 
  106.   End If 
  107.   If BB=1 and ICN(2,0)=0
  108.     WINDO[10,5,30,20,%111111,"Spiele"]
  109.     Wait 20
  110.     DEFICON[3,80,40,87,47]
  111.     PASICON[2,1,160,100,64,48,"Free Trading Company"]
  112.   End If 
  113.   If B=3
  114.     PRESSICON[B]
  115.     IS=-1 : TIMOUT=25
  116.     UNDEFICON[2]
  117.     UNDEFICON[3]
  118.     WINCLO[10,5,30,20]
  119.   End If 
  120.   If BB=2
  121.     IS=-1
  122.     UNDEFICON[1]
  123.     UNDEFICON[2]
  124.     Wait 10
  125.     WINDO[0,5,40,15,%1110,"IconX"]
  126.     Wait 5
  127.     Ink 2 : Text 4,47+TB,"Lade Free Trading Company... Bitte warten!"
  128.     If Length(5)=0
  129.        Extension_8_0EA2 "KartSounds.sam",-6
  130.        Extension_8_0FF2 6
  131.        Extension_8_0EA2 "WorkSounds.sam",-5
  132.        Extension_8_0FF2 5
  133.        Extension_8_142A 5
  134.        Extension_8_0EA2 "mod.InGame",-3
  135.     End If 
  136.     TITLE
  137.      Extension_8_108E 3
  138.     WINDO[0,1,40,25,%11,"Free Trading Company Version 1.27"]
  139.     PAG=1
  140.     Ink 1 : CT[18,"Willkommen zu"]
  141.     Ink 3 : CT[28,"Free Trading Company"]
  142.     Ink 2 : Text 4,70+TB,"Wieviele Spieler:"
  143.     DEFGADGET[2,80,58,112,90,"1"]
  144.     DEFGADGET[3,114,58,146,90,"2"]
  145.     DEFGADGET[4,148,58,180,90,"3"]
  146.     DEFGADGET[5,182,58,214,90,"4"]
  147.     PASICON[1,9,40,176,32,24,"Spielstand laden"]
  148.   End If 
  149.   B=-1 : BB=-1
  150. Return 
  151. INITMENU:
  152.   If B>1 and B<6
  153.     Gosub GAMEINIT
  154.   End If 
  155.   If B=1
  156.     For A=0 To 5
  157.       DISABLEICON[A]
  158.     Next 
  159.     Gosub SPIELLOAD
  160.     For A=0 To 5
  161.       ENABLEICON[A]
  162.     Next 
  163.     If LOA
  164.       WINCLR[0,1,40,25]
  165.       UNDEFICON[1]
  166.       UNDEFICON[2]
  167.       UNDEFICON[3]
  168.       UNDEFICON[4]
  169.       UNDEFICON[5]
  170.       PAG=2 : Gosub UPDATSCREEN1
  171.     End If 
  172.   End If 
  173.   B=-1 : BB=-1
  174. Return 
  175. MAINMENU:
  176.   If B=1
  177.     For A=1 To 20
  178.       DISABLEICON[A]
  179.     Next 
  180.     MO=1
  181.     Get Cblock 998,24,40,144,72
  182.     WINDO[3,5,21,14,%110,"Ankauf von Waren"]
  183.     For A=0 To 4
  184.       DEFGADGET[10+A,28,50+A*10,72,58+A*10,PRO$(A)]
  185.     Next 
  186.     DEFGADGET[15,28,100,162,108,"Zur�ck"]
  187.   End If 
  188.   If B=2
  189.     For A=1 To 20
  190.       DISABLEICON[A]
  191.     Next 
  192.     MO=2
  193.     Get Cblock 998,24,40,144,64
  194.     WINDO[3,5,21,13,%110,"Verkauf von Waren"]
  195.     For A=1 To 4
  196.       DEFGADGET[10+A,28,40+A*10,72,48+A*10,PRO$(A)]
  197.     Next 
  198.     DEFGADGET[15,28,90,162,98,"Zur�ck"]
  199.   End If 
  200.   If B=3
  201.     Fade 2
  202.     For A=0 To 31
  203.       Colour Back Colour(0) : View : Wait Vbl 
  204.     Next 
  205.     WINCLO[1,3,20,16]
  206.     WINCLO[20,17,39,24]
  207.     WINCLO[1,17,19,24]
  208.     For A=1 To 20
  209.       UNDEFICON[A]
  210.     Next 
  211.     PAG=4 : Gosub KARTE
  212.   End If 
  213.   If B>9 and B<15 Then Gosub KAUF
  214.   If B=9
  215.     For A=1 To 20
  216.       DISABLEICON[A]
  217.     Next 
  218.     Get Cblock 998,16,40,160,88
  219.     WINDO[2,5,22,16,%110,"Optionen"]
  220.     PASICON[20,9,56,63,32,24,"Spielstand laden"]
  221.     PASICON[21,10,56,95,32,24,"Spielstand sichern"]
  222.     PASICON[22,11+MUS,136,63,32,24,"Musik "+ Extension_8_16A4("an|aus",1-MUS)+"schalten"]
  223.     PASICON[23,13+SOU,136,95,32,24,"Sound "+ Extension_8_16A4("an|aus",1-SOU)+"schalten"]
  224.     DEFGADGET[15,20,116,170,124,"Zur�ck"]
  225.   End If 
  226.   If B=21 Then Gosub SPIELSAVE
  227.   If B=20 Then Gosub SPIELLOAD : If LOA Then B=-15
  228.   If Abs(B)=15
  229.     Put Cblock 998
  230.     Del Cblock 998
  231.     For A=10 To 25
  232.       UNDEFICON[A]
  233.     Next 
  234.     For A=1 To 20
  235.       ENABLEICON[A]
  236.     Next 
  237.     MO=0
  238.   End If 
  239.   If B=-15 Then Gosub UPDATSCREEN1
  240.   If B=22
  241.     ERAICON[B]
  242.     MUS=1-MUS
  243.     PASICON[B,11+MUS,136,63,32,24,"Musik "+ Extension_8_16A4("an|aus",1-MUS)+"schalten"]
  244.     If MUS=0
  245.        Extension_8_10A8 
  246.     Else 
  247.        Extension_8_108E 3
  248.     End If 
  249.   End If 
  250.   If B=23
  251.     ERAICON[B]
  252.     SOU=1-SOU
  253.     PASICON[B,13+SOU,136,95,32,24,"Sound "+ Extension_8_16A4("an|aus",1-SOU)+"schalten"]
  254.   End If 
  255.   B=-1 : BB=-1
  256. Return 
  257. ARBEITSMENU:
  258.   If B>0 and B<5
  259.     Get Cblock 998,24,64,144,40
  260.     If B<3 : A$="Arbeiter" : P=0 : Else A$="Facharbeiter" : P=1 : End If 
  261.     If B and 1 : B$="einstellen" : Else B$="entlassen" : End If 
  262.     WINDO[3,8,21,13,%110,A$+" "+B$]
  263.     Ink 2
  264.     If PL(CP,30)
  265.       If(P=0 and PL(CP,30)<0) or(P=1 and PL(CP,30)>0)
  266.         If SOU : Extension_8_142A 6 : Extension_8_1450 8,9 : Extension_8_142A 5 : End If 
  267.         Text 28,71+TB,"Die "+A$+" streiken doch!"
  268.         Wait 50
  269.         Put Cblock 998
  270.         Del Cblock 998
  271.         B=-1 : BB=-1 : Return 
  272.       End If 
  273.     End If 
  274.     If(B and 1)=0 and PL(CP,8+P)=0
  275.       If SOU : Extension_8_1450 8,2 : End If 
  276.       Text 28,71+TB,"Sie haben keine "+A$+"!"
  277.       Wait 50
  278.     Else 
  279.       Text 28,71+TB,"Wieviele "+A$+" wollen Sie"
  280.       Text 28,77+TB,B$+"?"
  281.       If(B and 1)=0
  282.         Ink 1 : Text 28,83+TB,"(Das kostet Sie"+Str$(PL(CP,10+P)*4)+" $ pro Person!)"
  283.         Ink 2
  284.         TEX$=Str$(Max(PL(CP,8+P)-PL(CP,13+P),0))-" "
  285.       Else 
  286.         Ink 1 : Text 28,83+TB,"(Das kostet Sie"+Str$(PL(CP,10+P))+" $ pro Person!)"
  287.         Ink 2
  288.         TEX$=Str$(Max(PL(CP,13+P)-PL(CP,8+P),0))-" "
  289.       End If 
  290.       If TEX$="0" : TEX$="" : End If 
  291.       EINGABE[TEX$,28,89,6,5,1]
  292.       A=Val(Param$)
  293.       If B and 1
  294.         A=Min(99999-PL(CP,8+P),A)
  295.         Add PL(CP,8+P),A
  296.         Add PL(CP,0),-PL(CP,10+P)*A
  297.         PL(CP,0)=Max(PL(CP,0),-9000000)
  298.       Else 
  299.         If SOU : Extension_8_1450 8,3 : End If 
  300.         A=Min(A,PL(CP,8+P))
  301.         Add PL(CP,0),-PL(CP,10+P)*4*A
  302.         PL(CP,0)=Max(PL(CP,0),-9000000)
  303.         Add PL(CP,8+P),-A
  304.       End If 
  305.     End If 
  306.     Put Cblock 998
  307.     Del Cblock 998
  308.     Gosub UPDATARBEITER
  309.     Gosub UPDATLOHNKOSTEN
  310.   End If 
  311.   If B=5
  312.     WINCLO[1,3,20,16]
  313.     WINCLO[1,17,22,24]
  314.     WINCLO[23,17,39,24]
  315.     For A=1 To 20
  316.       UNDEFICON[A]
  317.     Next 
  318.     PAG=5 : Gosub UPDATSCREEN3
  319.     Gosub BEWASSERUNG
  320.   End If 
  321.   B=-1 : BB=-1
  322. Return 
  323. KARTE:
  324.   DISABLEICON[0]
  325.    Extension_8_142A 6
  326.   Unpack 13 To 1 : Screen To Back 
  327.   Curs Off : Flash Off : Paper 0 : Pen 1
  328.   Colour 16,0
  329.   KART=-1 : Gr Writing 0
  330.   Ink 31,0
  331.   A$="Aktions Menu"
  332.   OT[160-Len(A$)*4,8,4,20,A$]
  333.   For A=0 To 8
  334.     X1=39 : Y1=17+Min(A,7)*20 : X2=56 : Y2=34+Min(A,7)*20
  335.     If A=8 Then Add X1,128 : Add X2,128
  336.     Ink 26 : Draw X1-1,Y2+1 To X1-1,Y1-1 : Draw To X2+1,Y1-1
  337.     Ink 31 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  338.     Ink 20 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  339.     Ink 23 : Draw X1,Y2+1 To X2+1,Y2+1 : Draw To X2+1,Y1
  340.     DEFICON[A+1,X1-1,Y1-1,X2,Y2]
  341.   Next 
  342.   Paste Bob 40,18,39
  343.   Paste Bob 40,38,42
  344.   Paste Bob 40,58,44
  345.   Paste Bob 40,78,43
  346.   Paste Bob 40,98,41
  347.   Paste Bob 40,118,38
  348.   Paste Bob 40,138,40
  349.   Paste Bob 40,158,47
  350.   Paste Bob 168,158,45
  351.   PM=PL(CP,15)*500
  352.   OT[64,28,31,20,"Roden                  "+ Extension_8_0EC8(PM+1500,6)+" $"]
  353.   OT[64,48,31,20,"Dattelplantage pflanzen"+ Extension_8_0EC8(PM+3000,6)+" $"]
  354.   OT[64,68,31,20,"Tabak anbauen          "+ Extension_8_0EC8(PM+4000,6)+" $"]
  355.   OT[64,88,31,20,"Zigarettenfabrik bauen "+ Extension_8_0EC8(PM+20000,6)+" $"]
  356.   OT[64,108,31,20,"�lturm errichten       "+ Extension_8_0EC8(PM+30000,6)+" $"]
  357.   OT[64,128,31,20,"Insektizide verspr�hen "+ Extension_8_0EC8(PM+10000,6)+" $"]
  358.   OT[64,148,31,20,"Mitspieler angreifen   "+ Extension_8_0EC8(PM+40000,6)+" $"]
  359.   OT[64,168,31,20,"Karte"]
  360.   OT[192,168,31,20,"Weiter"]
  361.   Get Cblock 998,64,178,240,16
  362.   Paste Bob 40,178,46
  363.   OT[64,188,31,20,"Geld"+Space$(15)+ Extension_8_0EC8(PL(CP,0),10)+" $"]
  364.   Screen Open 3,320,200,32,0 : Screen To Back 
  365.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  366.   Get Palette 1
  367.   Screen To Front 
  368.   WX=Screen Width : WY=Screen Height : B1=1 : B2=3
  369.   A=Rnd(13)+1 : S=8
  370.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  371.   Screen To Front 1
  372.   Screen Close 3
  373.   Screen 1
  374.   PAG=4
  375. Return 
  376. KARTMENU:
  377.   If B>0 and B<9
  378.     If B=1 : P=1500+PM : End If 
  379.     If B=2 : P=3000+PM : End If 
  380.     If B=3 : P=4000+PM : End If 
  381.     If B=4 : P=20000+PM : End If 
  382.     If B=5 : P=30000+PM : End If 
  383.     If B=6 : P=10000+PM : End If 
  384.     If B=7 : P=40000+PM : End If 
  385.     If B=8 : P=-99999999 : End If 
  386.     If PL(CP,0)<P
  387.       Gosub NOMONEY
  388.     Else 
  389.       If B<>7
  390.         MO=B : Gosub EDIKARTE
  391.       Else 
  392.         If PL>1
  393.           Gosub ANGRIFF
  394.         Else 
  395.           If SOU : Extension_8_1450 8,2 : End If 
  396.         End If 
  397.       End If 
  398.     End If 
  399.   End If 
  400.   If B=9
  401.     If KART>-1 : Screen Close 2 : End If 
  402.     Screen Open 3,320,200,32,0 : Screen To Back 
  403.     Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  404.     Get Palette 1
  405.     Screen To Front 1
  406.     WX=Screen Width : WY=Screen Height : B1=3 : B2=1
  407.     A=Rnd(13)+1 : S=8
  408.     On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  409.     Screen Close 3
  410.     Screen Close 1
  411.     Screen 0
  412.     ENABLEICON[0]
  413.     For A=1 To 20
  414.       UNDEFICON[A]
  415.     Next 
  416.     Gosub COMPUTE3
  417.     PAG=3 : Gosub UPDATSCREEN2
  418.   End If 
  419.   B=-1 : BB=-1
  420. Return 
  421. NOMONEY:
  422.   If SOU : Extension_8_1450 8,2 : End If 
  423.   For A=0 To 7
  424.     OT[64,188,Abs((A and 1)*31),20,"Geld"+Space$(15)+ Extension_8_0EC8(PL(CP,0),10)+" $"]
  425.     Wait 5
  426.   Next 
  427. Return 
  428. EDIKARTE:
  429.   Gosub INITKARTE
  430.   Screen Open 3,320,10,32,0 : Screen Hide 
  431.   Flash Off : Curs Off : Paper 0 : Pen 31
  432.   Cls : Gr Writing 0
  433.   OT[1,7,31,20," "+ Extension_8_0EC8(PL(CP,0),10)+" $"]
  434.   Get Bob 48,0,0 To 112,10
  435.   OLMN=PL(CP,0) : OLPO=1
  436.   Screen 2
  437.   Hide On 
  438.   Repeat 
  439.     X=X Screen(X Mouse)/8 : Y=Y Screen(Y Mouse)/8 : M=Mouse Key
  440.     If OLMN<>PL(CP,0)
  441.       Bob Off 20
  442.       Screen 3
  443.       Cls 
  444.       OT[1,7,31,20," "+ Extension_8_0EC8(PL(CP,0),10)+" $"]
  445.       Get Bob 48,0,0 To 112,10
  446.       OLMN=PL(CP,0)
  447.       Screen 2
  448.       OLPO=1
  449.     End If 
  450.     If OLPO=1 or((Y*8)>99)=OLPO
  451.       Wait Vbl : Bob 20,208,-((Y*8)<100)*190,48
  452.       OLPO=(Y*8)<100
  453.     End If 
  454.     Sprite 0,X Hard(X*8)+2,Y Hard(Y*8)+2,2
  455.     If M=1
  456.       F=F(CP,X,Y)
  457.       If MO=1
  458.         Gosub CINS
  459.         If DD=16 and((F>9 and F<42) or(F>65))
  460.           If SOU : Extension_8_1450 8,4 : End If 
  461.           GX=X : GY=Y : F=Rnd(1) : Gosub PASBLOCK
  462.           Add PL(CP,0),-P
  463.         Else 
  464.           If SOU : Extension_8_1450 8,2 : End If 
  465.         End If 
  466.       End If 
  467.       If MO=2
  468.         If F<2
  469.           If SOU : Extension_8_1450 8,8 : End If 
  470.           F(CP,X,Y)=67 : Inc PL(CP,17)
  471.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  472.           Add PL(CP,0),-P
  473.         Else 
  474.           If SOU : Extension_8_1450 8,2 : End If 
  475.         End If 
  476.       End If 
  477.       If MO=3
  478.         If F<2
  479.           If SOU : Extension_8_1450 8,8 : End If 
  480.           F(CP,X,Y)=69 : Inc PL(CP,18)
  481.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  482.           Add PL(CP,0),-P
  483.         Else 
  484.           If SOU : Extension_8_1450 8,2 : End If 
  485.         End If 
  486.       End If 
  487.       If MO=4
  488.         If F<2
  489.           If SOU : Extension_8_1450 8,5 : End If 
  490.           F(CP,X,Y)=68 : Inc PL(CP,19)
  491.           Put Cblock F(CP,X,Y)+50,X*8,Y*8
  492.           Add PL(CP,0),-P
  493.         Else 
  494.           If SOU : Extension_8_1450 8,2 : End If 
  495.         End If 
  496.       End If 
  497.       If MO=5
  498.         If F<2
  499.           If SOU
  500.             For A=0 To 29
  501.                Extension_8_145A 8,6,6000+ Extension_8_1106(A*30+256,1000)
  502.               Wait 5
  503.             Next 
  504.           End If 
  505.           If Rnd(2)=1
  506.             If SOU : Extension_8_1450 8,7 : End If 
  507.             F(CP,X,Y)=70 : Inc PL(CP,16)
  508.             Put Cblock F(CP,X,Y)+50,X*8,Y*8
  509.             Add PL(CP,0),-P
  510.           Else 
  511.             If SOU : Extension_8_1450 8,9 : End If 
  512.             Add PL(CP,0),-P
  513.           End If 
  514.         Else 
  515.           If SOU : Extension_8_1450 8,2 : End If 
  516.         End If 
  517.       End If 
  518.       If MO=6
  519.         Gosub CINS
  520.         If DD<16
  521.           If SOU : Extension_8_1450 8,6 : End If 
  522.           IN(CP,DD,0)=-1 : IN(CP,DD,1)=-1 : IN(CP,DD,2)=0
  523.           Add PL(CP,0),-P
  524.           Bob Off DD
  525.         Else 
  526.           If SOU : Extension_8_1450 8,2 : End If 
  527.         End If 
  528.       End If 
  529.       While Mouse Key : Multi Wait : Wend 
  530.     End If 
  531.     If MO=8 and M=1 Then M=2
  532.     Multi Wait 
  533.   Until PL(CP,0)<P or M>1
  534.   Show On 
  535.   Bob Off 20
  536.   Screen Close 3
  537.   Gosub QUITKARTE
  538. Return 
  539. CINS:
  540.   For DD=0 To 15
  541.     If IN(CP,DD,0)=X and IN(CP,DD,1)=Y : Exit : End If 
  542.   Next 
  543. Return 
  544. ANGRIFF:
  545.   OP=CP
  546.   For A=1 To 20
  547.     DISABLEICON[A]
  548.   Next 
  549.   Get Cblock 997,40,50,240,100
  550.   Ink 26 : Bar 40,50 To 279,149
  551.   Ink 31 : Draw 40,149 To 40,50 : Draw To 279,50
  552.   Ink 20 : Draw 41,149 To 279,149 : Draw To 279,51
  553.   OT[104,60,31,20,"Wen angreifen?"]
  554.   Y=0
  555.   For A=0 To PL-1
  556.     If OP<>A Then DEFGADGET2[10+A,48,72+Y*16,271,84+Y*16,PL$(A,1)] : Inc Y
  557.   Next 
  558.   DEFGADGET2[14,48,72+Y*16,271,84+Y*16,"Abbruch"]
  559.   CP=-1
  560.   Repeat 
  561.     Multi Wait 
  562.     CLICKING : B=Param
  563.     If B>0 Then CP=B-10
  564.   Until CP>-1
  565.   Put Cblock 997
  566.   Del Cblock 997
  567.   For A=10 To 14
  568.     UNDEFICON[A]
  569.   Next 
  570.   For A=1 To 20
  571.     ENABLEICON[A]
  572.   Next 
  573.   If CP=4 Then CP=OP : Return 
  574.   Hide On 
  575.   Add PL(OP,0),-P
  576.   If MUS Then Extension_8_10A8 
  577.   If SOU
  578.     For A=0 To 2
  579.        Extension_8_1450 8,10
  580.       Wait 60
  581.     Next 
  582.   End If 
  583.   Gosub INITKARTE
  584.   For A=0 To 4
  585.     X=320 : Y=Rnd(22)+1
  586.     TX=Rnd(35)+2 : H=12
  587.     If SOU Then Extension_8_1450 8,11
  588.     Repeat 
  589.       If Mouse Key=0 Then Wait Vbl 
  590.       Sprite 2,X Hard(X),Y Hard(Y*8-H+4),50+(X and 1)
  591.       Dec X : BX=X/8
  592.       If BX<TX+2 Then Dec H
  593.     Until H=0
  594.     If SOU Then Extension_8_1450 8,3
  595.     For C=0 To 27
  596.       Sprite 2,X Hard(X-4),Y Hard(Y*8-8),C+10
  597.       Wait 3
  598.     Next 
  599.     F=66
  600.     GX=TX : GY=Y : Gosub PASBLOCK
  601.     GX=TX+1 : GY=Y : Gosub PASBLOCK
  602.     GX=TX : GY=Y-1 : Gosub PASBLOCK
  603.     GX=TX+1 : GY=Y-1 : Gosub PASBLOCK
  604.     For C=15 To 0 Step -1
  605.       Colour 31,$FF0+C : Wait 2
  606.     Next 
  607.     Sprite Off : Multi Wait 
  608.     Colour 31,$FFF
  609.   Next 
  610.   CP=OP
  611.   Gosub QUITKARTE
  612.   If MUS Then Extension_8_108E 3
  613.   Show On 
  614. Return 
  615. INITKARTE:
  616.   If KART<>CP
  617.     Screen Open 2,320,200,32,0 : Screen To Back 
  618.     Curs Off : Flash Off : Cls 0
  619.     Get Palette 1
  620.     For Y=0 To 24
  621.       For X=0 To 39
  622.         Put Cblock F(CP,X,Y)+50,X*8,Y*8
  623.       Next 
  624.     Next 
  625.     For A=0 To 15
  626.       If IN(CP,A,0)>-1 : Bob A,IN(CP,A,0)*8,IN(CP,A,1)*8,56 : End If 
  627.     Next 
  628.   Else 
  629.     Screen 2
  630.   End If 
  631.   Screen Open 3,320,200,32,0 : Screen To Back 
  632.   Curs Off : Flash Off : Paper 0 : Pen 1
  633.   Get Palette 2
  634.   Screen Copy 1 To 3
  635.   Screen To Front 
  636.   WX=Screen Width : WY=Screen Height : B1=2 : B2=3
  637.   A=Rnd(13)+1 : S=8
  638.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  639.   Screen To Front 2
  640.   Screen Close 3
  641.   Screen 2
  642.   KART=CP
  643. Return 
  644. PASBLOCK:
  645.   GF=F(CP,GX,GY)
  646.   For DD=0 To 15
  647.     If IN(CP,DD,0)=X and IN(CP,DD,1)=Y Then IN(CP,DD,0)=-1 : IN(CP,DD,1)=-1 : IN(CP,DD,2)=0 : Bob Off DD
  648.   Next 
  649.   If GF=67 Then Dec PL(CP,17)
  650.   If GF=68 Then Dec PL(CP,19)
  651.   If GF=69 Then Dec PL(CP,18)
  652.   If GF=70 Then Dec PL(CP,16)
  653.   F(CP,GX,GY)=F
  654.   Put Cblock F+50,GX*8,GY*8
  655.   If F=67 Then Inc PL(CP,17)
  656.   If F=68 Then Inc PL(CP,19)
  657.   If F=69 Then Inc PL(CP,18)
  658.   If F=70 Then Inc PL(CP,16)
  659. Return 
  660. QUITKARTE:
  661.   Screen 1 : Put Cblock 998 : OT[64,188,31,20,"Geld"+Space$(15)+ Extension_8_0EC8(PL(CP,0),10)+" $"]
  662. QUITKARTE2:
  663.   Screen Open 3,320,200,32,0 : Screen To Back 
  664.   Curs Off : Flash Off : Paper 0 : Pen 1
  665.   Get Palette 2
  666.   Screen Copy 2 To 3
  667.   Screen To Front 
  668.   WX=Screen Width : WY=Screen Height : B1=1 : B2=3
  669.   A=Rnd(13)+1 : S=8
  670.   On A Proc S1,S2,S3,S4,S5,S6,S7,S8,S9,S10,S11,S12,S13,S14
  671.   Screen To Front 1
  672.   Screen Close 3
  673.   Screen 1
  674. Return 
  675. UPDATSCREEN3:
  676.    Extension_8_142A 5
  677.   WINDO[1,3,20,16,%10,"Feldbew�sserung "+PL$(CP,1)]
  678.   Ink 1 : Text 12,31+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  679.   Ink 2
  680.   Text 12,40+TB,Str$(PL(CP,1))-" "+EH$(0)+" "+PRO$(0)+" sind im Turm."
  681.   Gosub BENWASSER
  682.   Text 12,47+TB,A$
  683.   Text 12,53+TB,B$
  684.   Text 12,59+TB,C$
  685.   Text 12,66+TB,"Mit wieviel"+EH$(0)+" "+PRO$(0)+" wollen"
  686.   Text 12,72+TB,"Sie bew�ssern?"
  687.   Gosub ZEIGWASSERTURM
  688. Return 
  689. BEWASSERUNG:
  690.   TEX$=Str$(Min(PL(CP,12),PL(CP,1)))-" "
  691.   EINGABE[TEX$,12,78,7,6,1]
  692.   A=Min(Val(Param$),PL(CP,1))
  693.   PL(CP,29)=A
  694.   Add PL(CP,1),-A
  695.   Gosub WASSERSTAND
  696.   WINCLO[1,3,20,16]
  697.   WINCLO[21,3,39,16]
  698.   Gosub COMPUTE1
  699.   Gosub COMPUTE2
  700.   PAG=2 : Gosub UPDATSCREEN1
  701. Return 
  702. UPDATSCREEN2:
  703.    Extension_8_142A 5
  704.   WINDO[1,3,20,16,%10,"Arbeitsmarkt "+PL$(CP,1)]
  705.   Ink 1 : Text 12,31+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  706.   Gosub UPDATARBEITER
  707.   PASICON[1,7,38,76,32,24,"Arbeiter ein."]
  708.   PASICON[2,6,96,76,32,24,"Arbeiter ent."]
  709.   PASICON[3,7,38,107,32,24,"Facharb. ein."]
  710.   PASICON[4,6,96,107,32,24,"Facharb. ent."]
  711.   PASICON[5,5,136,107,32,24,"Weiter"]
  712.   WINDO[1,17,22,24,%10,"Informationen"]
  713.   Ink 1
  714.   Text 12,143+TB,"Immobilie           Ben�tigte Arbeiter"
  715.   Ink 2
  716.   Text 12,151+TB,"�lfelder         30 Arbeiter 25 Facharb."
  717.   Text 12,157+TB,"Dattelplantage   20 Arbeiter  0 Facharb."
  718.   Text 12,163+TB,"Tabakplantage    30 Arbeiter  0 Facharb."
  719.   Text 12,169+TB,"Zigarettenfabrik 40 Arbeiter 10 Facharb."
  720.   Draw 12,151 To 172,151
  721.   Draw 125,151 To 125,175
  722.   Ink 1
  723.   Text 12,176+TB,"Ben�tigte Arbeiter    "+ Extension_8_0EC8(PL(CP,13),7)
  724.   Text 12,182+TB,"Ben�tigte Facharbeiter"+ Extension_8_0EC8(PL(CP,14),7)
  725.   Gosub UPDATLOHNKOSTEN
  726.   Fade 2 To -1
  727.   For A=0 To 31
  728.     Colour Back Colour(0) : View : Wait Vbl 
  729.   Next 
  730.   If(Rnd(20)=0) or(PL(CP,30)<>0) Then Gosub LOHNERHOHUNG
  731. Return 
  732. LOHNERHOHUNG:
  733.   Ink 2
  734.   If PL(CP,30)
  735.     G=Abs(PL(CP,30))+1
  736.     If PL(CP,30)<0 : P=0 : Else P=1 : End If 
  737.   Else 
  738.     G=Rnd(4)+1 : P=Rnd(1)
  739.     If PL(CP,P+8)=0 : Return : End If 
  740.   End If 
  741.   If P=0
  742.     PL(CP,30)=-G : A$="Arbeiter"
  743.   Else 
  744.     PL(CP,30)=G : A$="Facharbeiter"
  745.   End If 
  746.   Get Cblock 998,24,40,144,64
  747.   WINDO[3,5,21,13,%110,"Lohnerh�hung"]
  748.   For A=0 To 20
  749.     DISABLEICON[A]
  750.   Next 
  751.   Text 28,47+TB,"Die "+A$+" fordern eine"
  752.   Text 28,53+TB,"Gehaltserh�hung um"+Str$(G)+"$."
  753.   Text 28,60+TB,"Sind Sie einverstanden?"
  754.   DEFGADGET[6,28,68,94,76,"Ja"]
  755.   DEFGADGET[7,96,68,163,76,"Nein!"]
  756.   Repeat 
  757.     Multi Wait 
  758.     CLICKING : B=Param
  759.   Until B>-1
  760.   If B=6
  761.     Add PL(CP,10+P),G
  762.     PL(CP,30)=0
  763.     Text 28,78+TB,"Die "+A$+" freuen sich sehr"
  764.     Text 28,84+TB,"�ber Ihre Entscheidung!"
  765.     If SOU : Extension_8_1450 8,3 : End If 
  766.   Else 
  767.     If Rnd(20)<6
  768.       Text 28,78+TB,"Die "+A$+" sind sehr, sehr"
  769.       Text 28,84+TB,"entt�uscht!"
  770.       PL(CP,30)=0
  771.       If SOU : Extension_8_1450 8,2 : End If 
  772.     Else 
  773.       G=(PL(CP,8+P)*(Rnd(50)+25))/100
  774.       Add PL(CP,8+P),-G
  775.       Text 28,78+TB,"Die "+A$+" sind sehr w�tend!"
  776.       Text 28,84+TB,Str$(G)-" "+" "+A$+" k�ndigen,"
  777.       Text 28,90+TB,"und die anderen streiken!"
  778.       If SOU : Extension_8_142A 6 : Extension_8_1450 8,9 : Extension_8_142A 5 : End If 
  779.     End If 
  780.   End If 
  781.   Wait 200
  782.   UNDEFICON[6]
  783.   UNDEFICON[7]
  784.   For A=0 To 20
  785.     ENABLEICON[A]
  786.   Next 
  787.   Put Cblock 998
  788.   Del Cblock 998
  789.   Gosub UPDATARBEITER
  790.   Gosub UPDATLOHNKOSTEN
  791. Return 
  792. UPDATARBEITER:
  793.   Ink 0 : Bar 12,38 To 156,63
  794.   Ink 2
  795.   Text 12,38+TB,"Geld"+ Extension_8_0EC8(PL(CP,0),10)+" $"
  796.   Text 12,44+TB,"�lfelder "+ Extension_8_0EC8(PL(CP,16),5)+" Tabakplantagen  "+ Extension_8_0EC8(PL(CP,18),5)
  797.   Text 12,50+TB,"Datteln  "+ Extension_8_0EC8(PL(CP,17),5)+" Zigarettenfab.  "+ Extension_8_0EC8(PL(CP,19),5)
  798.   Text 12,56+TB,"Arbeiter"+ Extension_8_0EC8(PL(CP,8),6)+" Facharbeiter   "+ Extension_8_0EC8(PL(CP,9),6)
  799. Return 
  800. UPDATLOHNKOSTEN:
  801.   WINDO[23,17,39,24,%10,"Lohnkosten und -preise"]
  802.   Ink 2
  803.   Text 188,143+TB,"Arbeiter    "+ Extension_8_0EC8(PL(CP,10),5)+" $"
  804.   Text 188,150+TB,"Facharbeiter"+ Extension_8_0EC8(PL(CP,11),5)+" $"
  805.   Ink 1 : Text 204,157+TB,"Lohnkosten pro Monat:"
  806.   Ink 2
  807.   P1=PL(CP,8)*PL(CP,10)
  808.   P2=PL(CP,9)*PL(CP,11)
  809.   Text 188,164+TB,"Arbeiter"+ Extension_8_0EC8(PL(CP,8),6)+"*"+ Extension_8_0EC8(PL(CP,10),3)+"$="+ Extension_8_0EC8(P1,8)+" $"
  810.   Text 188,171+TB,"Facharb."+ Extension_8_0EC8(PL(CP,9),6)+"*"+ Extension_8_0EC8(PL(CP,11),3)+"$="+ Extension_8_0EC8(P2,8)+" $"
  811.   Ink 1 : Text 188,178+TB,"Zusammen"+Space$(10)+ Extension_8_0EC8(P1+P2,10)+" $"
  812.   Draw 275,186 To 306,186
  813.   Draw 275,188 To 306,188
  814. Return 
  815. KAUF:
  816.   D=B-10
  817.   Ink 2
  818.   If MO=1
  819.     P=(PL(CP,20+D)*6)/5
  820.     If P<=PL(CP,0)
  821.       If D=0
  822.         Gosub ZEIGWASSERTURM : Ink 2
  823.       End If 
  824.       If D=1
  825.         Gosub ZEIGOL : Ink 2
  826.       End If 
  827.       Text 78,50+TB,"Wieviel"+EH$(D)+" "+PRO$(D)
  828.       Text 78,56+TB,"wollen Sie kaufen?"
  829.       MX=Min(PL(CP,0)/P,PL(0,31+D))
  830.       If D=0 : MX=Min(MX,100000-PL(CP,1)) : End If 
  831.       Text 78,62+TB,"(max."+Str$(MX)+")"
  832.       EINGABE["",78,68,7,6,1]
  833.       A=Val(Param$)
  834.       If D=0 and A>MX : A=MX : End If 
  835.       If A*P<=PL(CP,0)
  836.         If A<=MX
  837.           If SOU : Extension_8_1450 8,3 : End If 
  838.           Add PL(CP,0),-A*P
  839.           Add PL(CP,D+1),A
  840.           Add PL(0,D+31),-A
  841.           If D>0
  842.             G=PL(0,24+D)
  843.             If G<90 or G>270 : G=(540-G) mod 360 : End If 
  844.             G=Min(G-Min(A/10,90),90)
  845.             PL(0,24+D)=G
  846.           End If 
  847.           Gosub UPDATBESITZ
  848.         Else 
  849.           If SOU : Extension_8_1450 8,2 : End If 
  850.           Text 78,74+TB,"Soviele Waren sind"
  851.           Text 78,80+TB,"nicht auf dem Markt!"
  852.           Wait 50
  853.         End If 
  854.       Else 
  855.         If SOU : Extension_8_1450 8,2 : End If 
  856.         Text 78,74+TB,"Soviel Geld haben"
  857.         Text 78,80+TB,"Sie nicht!"
  858.         Wait 50
  859.       End If 
  860.       If D=0
  861.         Gosub WASSERSTAND
  862.       End If 
  863.       Gosub ZEIGPLANTAGE
  864.     Else 
  865.       If SOU : Extension_8_1450 8,2 : End If 
  866.       Text 78,50+TB,"Das k�nnen Sie sich"
  867.       Text 78,56+TB,"nicht leisten!"
  868.       Wait 50
  869.     End If 
  870.   Else 
  871.     P=PL(CP,20+D)
  872.     If PL(CP,D+1)>0
  873.       If D=1
  874.         Gosub ZEIGOL : Ink 2
  875.       End If 
  876.       Text 78,50+TB,"Wieviel"+EH$(D)+" "+PRO$(D)
  877.       Text 78,56+TB,"wollen Sie verkaufen?"
  878.       If P>0 : Text 78,62+TB,"(max."+Str$(PL(CP,D+1))+")" : End If 
  879.       EINGABE["",78,68,7,6,1]
  880.       A=Min(Val(Param$),PL(CP,D+1))
  881.       If SOU : Extension_8_1450 8,3 : End If 
  882.       Add PL(CP,0),A*P
  883.       Add PL(CP,D+1),-A
  884.       Add PL(0,D+31),A
  885.       If D>0
  886.         G=PL(0,24+D)
  887.         If G>90 and G<270 : G=(540-G) mod 360 : End If 
  888.         G=Min((G-Min(A/40,90)+360) mod 360,270)
  889.         PL(0,24+D)=G
  890.       End If 
  891.       Gosub ZEIGPLANTAGE
  892.       Gosub UPDATBESITZ
  893.     Else 
  894.       If SOU : Extension_8_1450 8,2 : End If 
  895.       Text 78,50+TB,"Davon haben Sie"
  896.       Text 78,56+TB,"doch nichts!"
  897.       Wait 50
  898.     End If 
  899.   End If 
  900.   Ink 0 : Bar 78,50 To 160,86
  901. Return 
  902. ZEIGWASSERTURM:
  903.   WINDO[21,3,39,16,%10,"Der Wasserturm"]
  904.   Paste Bob 171,33,4
  905.   OWA=85-((PL(CP,1)*37)/100000)
  906.   If OWA=85 Then Return 
  907.   For Y=85 To OWA Step -1
  908.     X1=220 : X2=258
  909.     For X=0 To 5
  910.       If Point(X+220,Y)<>2 Then Inc X1
  911.       If Point(258-X,Y)<>2 Then Dec X2
  912.     Next 
  913.     Ink 3 : Draw X1,Y To X2,Y
  914.   Next 
  915. Return 
  916. WASSERSTAND:
  917.   NWA=85-((PL(CP,1)*37)/100000)
  918.   If NWA=OWA Then Return 
  919.   If SOU Then Extension_8_1450 8,-4
  920.   For Y=OWA To NWA Step Sgn(NWA-OWA)
  921.     X1=220 : X2=258
  922.     For X=0 To 5
  923.       If Point(X+220,Y)/2<>1 Then Inc X1
  924.       If Point(258-X,Y)/2<>1 Then Dec X2
  925.     Next 
  926.     If NWA>OWA
  927.       Ink 2
  928.       Draw X1,Y To X2,Y
  929.     Else 
  930.       Ink 3
  931.       Draw 253,46 To 254,46
  932.       If Y>47
  933.         Bar 253,47 To Min(257,X2),Y
  934.         Draw X1,Y To X2,Y
  935.       Else 
  936.         Draw 253,47 To 258,47
  937.         Draw X1,Y To X2,Y
  938.       End If 
  939.       If Y>50
  940.         XX=Rnd(3)+253 : Y1=47+Rnd(Max(Y-50,0)) : Y2=47+Rnd(Max(Y-50,0))
  941.         Ink 1+Rnd(1)*6 : Draw XX,Min(Y1,Y2) To XX,Max(Y1,Y2)
  942.       End If 
  943.     End If 
  944.     Multi Wait 
  945.   Next 
  946.   If NWA<OWA
  947.     Ink 2
  948.     Draw 253,46 To 254,46
  949.     If Y>47
  950.       Bar 253,47 To 257,Y
  951.     Else 
  952.       Draw 253,47 To 258,47
  953.     End If 
  954.   End If 
  955.   OWA=NWA
  956.   Wait 25
  957.   If SOU Then Extension_8_1400 8
  958. Return 
  959. ZEIGPLANTAGE:
  960.   WINDO[21,3,39,16,%10,"Die Plantage von "+PL$(CP,0)]
  961.   Paste Bob 171,33,3
  962. Return 
  963. ZEIGOL:
  964.   WINDO[21,3,39,16,%10,"Der ï¿½lvorat"]
  965.   Paste Bob 171,33,5
  966. Return 
  967. SPIELLOAD:
  968.   Get Cblock 997,24,32,160,136
  969.   WINDO[3,4,23,21,%110,"Spielstand laden"]
  970.   FF$="Save/SavedGames.dat"
  971.   If Exist(FF$)=0
  972.     Ink 2 : Text 28,39+TB,"Keine Spielstande vorhanden!!!"
  973.     Wait 25
  974.     Put Cblock 997
  975.     Del Cblock 997
  976.     LOA=0 : Return 
  977.   End If 
  978.   For A=15 To 25
  979.     DISABLEICON[A]
  980.   Next 
  981.    Extension_8_0456 FF$,10
  982.   For A=0 To 9
  983.     SVGM$(A)=""
  984.     For D=0 To 39
  985.       P=Peek(Start(10)+A*40+D)
  986.       If P>0 Then SVGM$(A)=SVGM$(A)+Chr$(P)
  987.     Next 
  988.   Next 
  989.   Erase 10
  990.   Ink 2 : Text 28,39+TB,"Welchen Spielstand laden?"
  991.   Y=0
  992.   For A=0 To 9
  993.     If SVGM$(A)<>"" Then DEFGADGET[30+A,28,50+Y*10,179,58+Y*10,SVGM$(A)] : Inc Y
  994.   Next 
  995.   DEFGADGET[29,28,50+Y*10,179,58+Y*10,"Abbruch"]
  996.   Repeat 
  997.     Multi Wait 
  998.     CLICKING : B=Param
  999.   Until B>-1
  1000.   For A=0 To 10
  1001.     UNDEFICON[A+29]
  1002.   Next 
  1003.   For A=15 To 25
  1004.     ENABLEICON[A]
  1005.   Next 
  1006.   Put Cblock 997
  1007.   Del Cblock 997
  1008.   If B=29 Then LOA=0 : Return 
  1009.   F$="Save/SavedGame"+Str$(B-29)-" "+".ftc"
  1010.   If Exist(F$)=0 Then LOA=0 : Return 
  1011.    Extension_8_0456 F$,9
  1012.   ST=Start(9) : LE=Length(9)
  1013.   A$="FTC-Save"
  1014.   For A=0 To 7
  1015.     If Peek(ST+A)<>Asc(Mid$(A$,A+1,1)) Then Erase 9 : LOA=0 : Return 
  1016.   Next 
  1017.   CK=0
  1018.   For A=ST To ST+LE-6 Step 2
  1019.     CK=(CK+Deek(A)) mod $10000
  1020.   Next 
  1021.   If Deek(ST+LE-4)<>$10000-CK Then Erase 9 : LOA=0 : Return 
  1022.   Add ST,8
  1023.   YEAR=Deek(ST)
  1024.   MON=Deek(ST+2)
  1025.   OP=Deek(ST+4)
  1026.   PL=Deek(ST+6) : Add ST,8
  1027.   For CP=0 To PL-1
  1028.     PL$(CP,0)=""
  1029.     For A=1 To 16
  1030.       If Peek(ST)>0 Then PL$(CP,0)=PL$(CP,0)+Chr$(Peek(ST))
  1031.       Inc ST
  1032.     Next 
  1033.     PL$(CP,1)=""
  1034.     For A=1 To 20
  1035.       If Peek(ST)>0 Then PL$(CP,1)=PL$(CP,1)+Chr$(Peek(ST))
  1036.       Inc ST
  1037.     Next 
  1038.     For A=0 To 35
  1039.       PL(CP,A)=Leek(ST) : Add ST,4
  1040.     Next 
  1041.     For A=0 To 15
  1042.       IN(CP,A,0)=Leek(ST)
  1043.       IN(CP,A,1)=Leek(ST+4)
  1044.       IN(CP,A,2)=Leek(ST+8) : Add ST,12
  1045.     Next 
  1046.     For Y=0 To 24
  1047.       For X=0 To 39
  1048.         F(CP,X,Y)=Peek(ST) : Inc ST
  1049.       Next 
  1050.     Next 
  1051.   Next 
  1052.   LOA=1
  1053.   CP=OP
  1054.   Erase 9
  1055. Return 
  1056. SPIELSAVE:
  1057.   Get Cblock 997,24,32,160,136
  1058.   WINDO[3,4,23,21,%110,"Spielstand speichern"]
  1059.   If Exist("Save")=0 Then Mkdir "Save"
  1060.   FF$="Save/SavedGames.dat"
  1061.   If Exist(FF$)=0
  1062.     Reserve As Work 10,400
  1063.   Else 
  1064.      Extension_8_0456 FF$,10
  1065.   End If 
  1066.   For A=15 To 29
  1067.     DISABLEICON[A]
  1068.   Next 
  1069.   For A=0 To 9
  1070.     SVGM$(A)=""
  1071.     For D=0 To 39
  1072.       P=Peek(Start(10)+A*40+D)
  1073.       If P>0 Then SVGM$(A)=SVGM$(A)+Chr$(P)
  1074.     Next 
  1075.   Next 
  1076.   Ink 2 : Text 28,39+TB,"Welchen Spielstand speichern?"
  1077.   For A=0 To 9
  1078.     DEFGADGET[30+A,28,50+A*10,179,58+A*10,SVGM$(A)]
  1079.   Next 
  1080.   DEFGADGET[29,28,150,179,158,"Abbruch"]
  1081.   Repeat 
  1082.     Multi Wait 
  1083.     CLICKING : B=Param
  1084.   Until B>-1
  1085.   Ink 1
  1086.   If B>29
  1087.     D=B-30
  1088.     EINGABE[SVGM$(D),30,50+D*10,40,37,0]
  1089.     TEX$=Param$
  1090.     If TEX$="" : TEX$="1. "+MON$(MON)+Str$(YEAR) : End If 
  1091.     SVGM$(D)=TEX$
  1092.     For A=0 To 39
  1093.       If A<Len(SVGM$(D))
  1094.         Poke Start(10)+D*40+A,Asc(Mid$(SVGM$(D),A+1,1))
  1095.       Else 
  1096.         Poke Start(10)+D*40+A,0
  1097.       End If 
  1098.     Next 
  1099.      Extension_8_0472 FF$,10
  1100.   End If 
  1101.   Erase 10
  1102.   For A=0 To 10
  1103.     UNDEFICON[A+29]
  1104.   Next 
  1105.   For A=15 To 25
  1106.     ENABLEICON[A]
  1107.   Next 
  1108.   Put Cblock 997
  1109.   Del Cblock 997
  1110.   If B=29 Then Return 
  1111.   F$="Save/SavedGame"+Str$(B-29)-" "+".ftc"
  1112.   Reserve As Work 9,5500
  1113.   ST=Start(9)
  1114.   A$="FTC-Save"
  1115.   For A=1 To 8
  1116.     Poke ST,Asc(Mid$(A$,A,1)) : Inc ST
  1117.   Next 
  1118.   Doke ST,YEAR
  1119.   Doke ST+2,MON
  1120.   Doke ST+4,CP
  1121.   Doke ST+6,PL : Add ST,8
  1122.   OP=CP
  1123.   For CP=0 To PL-1
  1124.     For A=1 To 16
  1125.       If A<=Len(PL$(CP,0)) Then Poke ST,Asc(Mid$(PL$(CP,0),A,1)) Else Poke ST,0
  1126.       Inc ST
  1127.     Next 
  1128.     For A=1 To 20
  1129.       If A<=Len(PL$(CP,1)) Then Poke ST,Asc(Mid$(PL$(CP,1),A,1)) Else Poke ST,0
  1130.       Inc ST
  1131.     Next 
  1132.     For A=0 To 35
  1133.       Loke ST,PL(CP,A) : Add ST,4
  1134.     Next 
  1135.     For A=0 To 15
  1136.       Loke ST,IN(CP,A,0)
  1137.       Loke ST+4,IN(CP,A,1)
  1138.       Loke ST+8,IN(CP,A,2) : Add ST,12
  1139.     Next 
  1140.     For Y=0 To 24
  1141.       For X=0 To 39
  1142.         Poke ST,F(CP,X,Y) : Inc ST
  1143.       Next 
  1144.     Next 
  1145.   Next 
  1146.   CK=0
  1147.   For A=Start(9) To ST-2 Step 2
  1148.     CK=(CK+Deek(A)) mod $10000
  1149.   Next 
  1150.   Doke ST,$10000-CK : Add ST,4
  1151.   Bsave F$,Start(9) To ST
  1152.   Erase 9
  1153.   CP=OP : B=-1 : BB=-1
  1154. Return 
  1155. GAMEINIT:
  1156.   PL=B-1
  1157.   WINCLR[0,1,40,25]
  1158.   UNDEFICON[1]
  1159.   UNDEFICON[2]
  1160.   UNDEFICON[3]
  1161.   UNDEFICON[4]
  1162.   UNDEFICON[5]
  1163.   YEAR=1970 : MON=0
  1164.   Ink 2
  1165.   For CP=0 To PL-1
  1166.     Text 4,15+TB+CP*32,"Spieler"+Str$(CP+1)
  1167.     Text 12,23+TB+CP*32,"Name des Spielers:"
  1168.     EINGABE[PL$(CP,0),90,23+CP*32,20,15,0]
  1169.     TEX$=Param$
  1170.     If TEX$="" Then TEX$="Spieler"+Str$(CP+1)
  1171.     PL$(CP,0)=TEX$
  1172.     Text 12,31+TB+CP*32,"Name der Firma   :"
  1173.     EINGABE[PL$(CP,1),90,31+CP*32,25,20,0]
  1174.     TEX$=Param$
  1175.     If TEX$="" Then TEX$=PL$(CP,0)+" co."
  1176.     PL$(CP,1)=TEX$
  1177.   Next 
  1178.   WINCLR[0,1,40,25]
  1179.   Ink 2
  1180.   CT[80,"Bitte Warten..."]
  1181.   For CP=0 To PL-1
  1182.     Gosub RESETPLAYER
  1183.   Next 
  1184.   WINCLR[0,1,40,25]
  1185.   PAG=2 : CP=0 : Gosub UPDATSCREEN1
  1186. Return 
  1187. RESETPLAYER:
  1188.   PL(CP,0)=10000
  1189.   PL(CP,1)=500
  1190.   For B=2 To 5
  1191.     PL(CP,B)=0
  1192.   Next 
  1193.   For B=8 To 19
  1194.     PL(CP,B)=0
  1195.   Next 
  1196.   If CP=0 Then PL(CP,7)=Min(Rnd(7),6)
  1197.   PL(CP,10)=10
  1198.   PL(CP,11)=25
  1199.   For A=0 To 15
  1200.     IN(CP,A,0)=-1 : IN(CP,A,1)=-1 : IN(CP,A,2)=0
  1201.   Next 
  1202.   If CP=0 Then PL(CP,6)=PL(CP,7)*(Rnd(20)+10)
  1203.   Add PL(CP,1),PL(CP,6)
  1204.   Gosub COMPUTE2
  1205.   Gosub GENERATE
  1206. Return 
  1207. COMPUTE1:
  1208.   WINDO[1,3,39,24,%10,"Nachrichten an "+PL$(CP,0)]
  1209.   A$="30"
  1210.   If MON=1 Then A$="28"
  1211.   If MON=1 and(YEAR mod 4)=0 Then A$="29"
  1212.   If MON=0 or MON=2 or MON=4 or MON=6 or MON=7 or MON=9 or MON=11 Then A$="31"
  1213.   Ink 1 : Text 12,31+TB,A$+". "+MON$(MON)+Str$(YEAR)+"."
  1214.   Gosub INSECTS
  1215.   Y=38
  1216.   PL(CP,6)=PL(CP,7)*(Rnd(5)+5)
  1217.   R=PL(CP,6)*(1+PL(CP,17)+PL(CP,18))
  1218.   Add PL(CP,12),-Min(R,PL(CP,12))
  1219.   Add PL(CP,1),R
  1220.   RST=Max(PL(CP,18)-(PL(CP,19)*4),0)
  1221.   If PL(CP,12)>0 Then WE=Min((PL(CP,29)*100)/PL(CP,12),125) Else WE=150
  1222.   If PL(CP,13)>0 Then EF1=Min((PL(CP,8)*100)/PL(CP,13),150) Else EF1=100
  1223.   If PL(CP,14)>0 Then EF2=Min((PL(CP,9)*100)/PL(CP,14),150) Else EF2=100
  1224.   If PL(CP,19)>0 Then EF3=((PL(CP,18)-RST)*100)/(PL(CP,19)*4) Else EF3=100
  1225.   If PL(CP,30)<0 Then EF1=0
  1226.   If PL(CP,30)>0 Then EF2=0
  1227.   Gosub OTHEREVENTS
  1228.   P1=(Max(EF1+EF2-Rnd(50),0)*PL(CP,16)*(Rnd(5)+5))/5
  1229.   P2=(Max(EF1-Rnd(25),0)*WE*PL(CP,17)*(10-PL(CP,7)))/750
  1230.   P3=(Max(EF1-Rnd(10),0)*WE*RST*(9-PL(CP,7)))/1000
  1231.   P4=(Max(EF1+EF2-Rnd(25),0)*EF3*WE*PL(CP,19)*(10-PL(CP,7)))/40000
  1232.   L1=PL(CP,8)*PL(CP,10)
  1233.   L2=PL(CP,9)*PL(CP,11)
  1234.   If PL(CP,0)<0 Then L3=Abs((PL(CP,0)*4)/10) Else L3=0
  1235.   Add PL(CP,0),-(L1+L2+L3)
  1236.   Ink 2
  1237.   If VER Then Text 12,Y+TB,"Die Insekten haben sich vermehrt!" : Add Y,6
  1238.   If INS=1 Then Text 12,Y+TB,"Es ist nur ein Insektenschwarm auf Ihrem Grundst�ck!" : Add Y,6
  1239.   If INS>1 Then Text 12,Y+TB,"Es befinden sich"+Str$(INS)+" Insektenschw�rme auf Ihrem Grundst�ck!" : Add Y,6
  1240.   If DES=1 Then Text 12,Y+TB,"Au�erdem wurde ein Feld zerst�rt!" : Add Y,6
  1241.   If DES>1 Then Text 12,Y+TB,"Au�erdem wurden"+Str$(DES)+" Felder zerst�rt!" : Add Y,6
  1242.   If P1>0 and PL(CP,16)>1 Then Text 12,Y+TB,"Die ï¿½lt�rme konnten"+Str$(P1)+EH$(1)+" "+PRO$(1)+" f�rdern." : Add Y,6
  1243.   If P1>0 and PL(CP,16)=1 Then Text 12,Y+TB,"Der ï¿½lturm konnte"+Str$(P1)+EH$(1)+" "+PRO$(1)+" f�rdern." : Add Y,6
  1244.   If P2>0 Then Text 12,Y+TB,"Es wurden"+Str$(P2)+EH$(2)+" "+PRO$(2)+" geerntet." : Add Y,6
  1245.   If P3>0 Then Text 12,Y+TB,"Es wurden"+Str$(P3)+EH$(3)+" "+PRO$(3)+" geerntet." : Add Y,6
  1246.   If P4>0 Then Text 12,Y+TB,Str$(P4)-" "+" "+PRO$(4)+" konnten produziert werden." : Add Y,6
  1247.   Add PL(CP,2),P1
  1248.   Add PL(CP,3),P2
  1249.   Add PL(CP,4),P3
  1250.   Add PL(CP,5),P4
  1251.   If P1=0 and P2=0 and P3=0 and P4=0
  1252.     A$="Es wurde ï¿½berhaupt nichts produziert! " : B$=""
  1253.     If PL(CP,30)
  1254.       A$=A$+"Geben Sie halt den "
  1255.       If PL(CP,30)<0 : A$=A$+"Arbeitern" : Else A$=A$+"Facharbeitern" : End If 
  1256.       B$="Ihre Lohnerh�hung und Sie k�nnen wieder etwas produzieren!"
  1257.     Else 
  1258.       If PL(CP,17)+PL(CP,18)=0
  1259.         A$=A$+"Sie sollten endlich etwas anbauen!"
  1260.         If PL(CP,8)+PL(CP,9)=0
  1261.           B$="und dann Arbeiter einstellen!"
  1262.         End If 
  1263.       Else 
  1264.         If PL(CP,8)+PL(CP,9)=0
  1265.           A$=A$+"Sie sollten Arbeiter einstellen!"
  1266.         End If 
  1267.       End If 
  1268.     End If 
  1269.     Text 12,Y+TB,A$ : Add Y,6
  1270.     If B$<>"" : Text 12,Y+TB,B$ : Add Y,6 : End If 
  1271.   End If 
  1272.   If MON=11 Then L1=L1*2 : L2=L2*2
  1273.   If L1>0 and L2>0
  1274.     Text 12,Y+TB,"Die Ausgaben f�r die Arbeiter und Facharbeiter betrugen"+Str$(L1+L2)+" $." : Add Y,6
  1275.   Else 
  1276.     If L1>0
  1277.       Text 12,Y+TB,"Der Lohn f�r die Arbeiter betrug"+Str$(L1)+" $." : Add Y,6
  1278.     End If 
  1279.     If L2>0
  1280.       Text 12,Y+TB,"Der Lohn f�r die Facharbeiter betrug"+Str$(L1)+" $." : Add Y,6
  1281.     End If 
  1282.   End If 
  1283.   If MON=11 and L1+L2>0 Then Text 12,Y+TB,"(Inklusive Weihnachtsgeld.)" : Add Y,6
  1284.   If L3>0
  1285.     Text 12,Y+TB,"Abz�glich 4% Zins betr�gt "+PL$(CP,0)+"s Guthaben nun"+Str$(PL(CP,0))+" $." : Add Y,6
  1286.     If PL(CP,0)<-100000 : Gosub PFANDUNG : End If 
  1287.   Else 
  1288.     Text 12,Y+TB,"Ihr Guthaben betr�gt nun"+Str$(PL(CP,0))+" $." : Add Y,6
  1289.   End If 
  1290.   DISABLEICON[0]
  1291.   DEFGADGET[1,12,178,158,188,"Weiter"]
  1292.   DEFGADGET[2,160,178,307,188,"Karte anschauen"]
  1293.   Repeat 
  1294.     Multi Wait 
  1295.     CLICKING : B=Param
  1296.     If B=2 Then Gosub AFTERMAP
  1297.     BP=B : Gosub AUTOTEST
  1298.   Until B=1
  1299.   UNDEFICON[1]
  1300.   ENABLEICON[0]
  1301.   WINCLO[1,3,39,24]
  1302.   Inc CP
  1303.   If CP=PL
  1304.     CP=0
  1305.     Add MON,1,0 To 11
  1306.     If MON=0
  1307.       Inc YEAR
  1308.       If(YEAR and 2)=0
  1309.         For A=0 To PL-1
  1310.           Inc PL(A,15)
  1311.         Next 
  1312.       End If 
  1313.     End If 
  1314.   End If 
  1315. Return 
  1316. OTHEREVENTS:
  1317.   Ink 1
  1318.   If Rnd(150)=0 and PL(CP,0)>5000
  1319.     Text 12,Y+TB,"Achtung: In Ihrem B�ro wurde eingebrochen. Das ganze Geld aus Ihrem" : Add Y,6
  1320.     Text 12,Y+TB,"Safe wurde entwendet!" : Add Y,6
  1321.     PL(CP,0)=0
  1322.   End If 
  1323.   If Rnd(75)=0
  1324.     P=Rnd(9)*10000+10000
  1325.     Text 12,Y+TB,"Gl�ckwunsch: Sie haben im Lotto"+Str$(P)+" $ gewonnen!" : Add Y,6
  1326.     Add PL(CP,0),P
  1327.   End If 
  1328.   If Rnd(25)=0
  1329.     D=Rnd(2)
  1330.     If D=0 : A$="Zehn" : P=10 : End If 
  1331.     If D=1 : A$="Hundert" : P=100 : End If 
  1332.     If D=2 : A$="Tausend" : P=1000 : End If 
  1333.     Text 12,Y+TB,"Gl�ckwunsch: Sie haben einen "+A$+"-Dollar Schein gefunden!" : Add Y,6
  1334.     Add PL(CP,0),P
  1335.   End If 
  1336.   If Rnd(100)=0
  1337.     D=Rnd(3)
  1338.     P=Rnd(10000)*500+500
  1339.     If D=0 : A$="Ihrem Vater" : End If 
  1340.     If D=1 : A$="Ihrem Mutter" : End If 
  1341.     If D=2 : A$="Ihrer Tante" : End If 
  1342.     If D=3 : A$="Ihrem Onkel" : End If 
  1343.     Text 12,Y+TB,"Gl�ckwunsch: Sie erben von "+A$+Str$(P)+" $." : Add Y,6
  1344.     Add PL(CP,0),P
  1345.   End If 
  1346.   If Rnd(10)=0 and PL(CP,7)=6 Then Gosub FLOODING
  1347.   If Rnd(200)=0 Then Gosub ERDBEBEN
  1348.   D=Rnd(3)
  1349.   If Rnd(50)=0 and PL(CP,16+D)>0 Then Gosub ZERSTORGEBAUDE
  1350.   If Rnd(50)=0
  1351.     For A=0 To 15
  1352.       If IN(CP,A,0)=-1 : Exit : End If 
  1353.     Next 
  1354.     If A<16
  1355.       IN(CP,A,0)=Rnd(39) : IN(CP,A,1)=Rnd(24) : IN(CP,A,2)=10
  1356.       Text 12,Y+TB,"Achtung: Ein Insektenschwarm wurde auf Ihrem Gebiet gesichtet!" : Add Y,6
  1357.       Inc INS
  1358.     End If 
  1359.   End If 
  1360.   If Rnd(100)=0
  1361.     Text 12,Y+TB,"Achtung: Ein Atomkrieg bricht aus!" : Add Y,6
  1362.     Text 12,Y+TB,"Das Land wird von Atomraketen bombadiert!" : Add Y,6
  1363.     Wait 100
  1364.     Gosub AOMKRIEG
  1365.   End If 
  1366.   If Rnd(50)=0
  1367.     D=Rnd(2)
  1368.     P=Rnd(50)+10
  1369.     If D=0
  1370.       Text 12,Y+TB,"Achtung: Durch eine Grippewelle wurden"+Str$(P)+"% Ihrer Arbeiter" : Add Y,6
  1371.       Text 12,Y+TB,"und Facharbeiter krank."
  1372.     End If 
  1373.     If D=1
  1374.       Text 12,Y+TB,"Achtung: Durch ï¿½berm��igen Alkoholkonsum fallen"+Str$(P)+"% Ihrer" : Add Y,6
  1375.       Text 12,Y+TB,"Arbeiter und Facharbeiter aus."
  1376.     End If 
  1377.     If D=2
  1378.       Text 12,Y+TB,"Achtung: Durch eine Lebensmittelvergiftung k�nnen"+Str$(P)+"% Ihrer" : Add Y,6
  1379.       Text 12,Y+TB,"Arbeiter und Facharbeiter nicht kommen."
  1380.     End If 
  1381.     Add Y,6
  1382.     Add EF1,-((P*EF1)/100)
  1383.     Add EF2,-((P*EF2)/100)
  1384.   End If 
  1385.   D=Rnd(4)
  1386.   If Rnd(50)=0 and PL(CP,D+1)
  1387.     P=Rnd(60)+30
  1388.     If D=0
  1389.       B=0
  1390.       Text 12,Y+TB,"Achtung: Durch einen Bedienungsfehler wurden"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1391.       Text 12,Y+TB,"verschwendet."
  1392.     End If 
  1393.     If D=1
  1394.       B=Rnd(P+50)*500
  1395.       Text 12,Y+TB,"Achtung: Bei einer Explosion im ï¿½llager sind"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1396.       Text 12,Y+TB,"verbrannt. Schaden am Lager:"+Str$(B)+" $."
  1397.     End If 
  1398.     If D=2
  1399.       B=Rnd(P+50)*100
  1400.       Text 12,Y+TB,"Achtung:"+Str$(P)+"% Ihrer "+PRO$(D)+" wurden von Ratten aufgefressen." : Add Y,6
  1401.       Text 12,Y+TB,"Lohn f�r den Rattenf�nger:"+Str$(B)+" $."
  1402.     End If 
  1403.     If D=3
  1404.       B=Rnd(P+50)*200
  1405.       Text 12,Y+TB,"Achtung: Bei einem Feuer im Tabaklager wurden"+Str$(P)+"% Ihres "+PRO$(D)+"s" : Add Y,6
  1406.       Text 12,Y+TB,"zerst�rt. Schaden am Lager:"+Str$(B)+" $."
  1407.     End If 
  1408.     If D=4
  1409.       B=Rnd(P+50)*300
  1410.       Text 12,Y+TB,"Achtung: Durch eine glimmende Zigarette wurde ein Feuer im Zigaretten-" : Add Y,6
  1411.       Text 12,Y+TB,"lager entfacht."+Str$(P)+"% Ihrer "+PRO$(D)+" wurden zerst�rt." : Add Y,6
  1412.       Text 12,Y+TB,"Schaden am Lager:"+Str$(B)+" $."
  1413.     End If 
  1414.     Add Y,6
  1415.     Add PL(CP,D+1),-(P*PL(CP,D+1)/100)
  1416.     Add PL(CP,0),-B
  1417.   End If 
  1418.   Ink 2
  1419. Return 
  1420. ZERSTORGEBAUDE:
  1421.   A$="Achtung: Durch ein Feuer wurde ein" : 
  1422.   If D=0
  1423.     Text 12,Y+TB,A$+" ï¿½lturm zerst�rt." : P=70
  1424.   End If 
  1425.   If D=1
  1426.     Text 12,Y+TB,A$+"e Dattelplantage zerst�rt." : P=67
  1427.   End If 
  1428.   If D=2
  1429.     Text 12,Y+TB,A$+"e Tabakplantage zerst�rt." : P=69
  1430.   End If 
  1431.   If D=3
  1432.     Text 12,Y+TB,A$+"e Zigarettenfabrik zerst�rt." : P=68
  1433.   End If 
  1434.   Add Y,6
  1435.   YY=Y
  1436.   For X=0 To 39
  1437.     For Y=0 To 24
  1438.       F=F(CP,X,Y)
  1439.       If F=P Then GX=X : GY=Y : F=66 : Gosub CHGBLOCK : Exit 2
  1440.     Next 
  1441.   Next 
  1442.   Y=YY
  1443. Return 
  1444. FLOODING:
  1445.   Text 12,Y+TB,"Achtung: Durch den starken Regenfall tritt der Flu� ï¿½ber die Ufer." : Add Y,6
  1446.   Text 12,Y+TB,"Alles in Ufern�he befindliche wird weggeschwemmt!" : Add Y,6
  1447.   YY=Y
  1448.   For X=0 To 39
  1449.     For Y=0 To 24
  1450.       F=F(CP,X,Y)
  1451.       If(F>1 and F<10) or(F>41 and F<66)
  1452.         If F>41
  1453.           F(CP,X,Y)=2+(F-42)/3
  1454.         End If 
  1455.         GX=X-1 : GY=Y-1 : Gosub FLOODBLK
  1456.         GX=X : GY=Y-1 : Gosub FLOODBLK
  1457.         GX=X+1 : GY=Y-1 : Gosub FLOODBLK
  1458.         GX=X+1 : GY=Y : Gosub FLOODBLK
  1459.         GX=X+1 : GY=Y+1 : Gosub FLOODBLK
  1460.         GX=X : GY=Y+1 : Gosub FLOODBLK
  1461.         GX=X-1 : GY=Y+1 : Gosub FLOODBLK
  1462.         GX=X-1 : GY=Y : Gosub FLOODBLK
  1463.       End If 
  1464.     Next 
  1465.   Next 
  1466.   Y=YY
  1467. Return 
  1468. FLOODBLK:
  1469.   If GX<0 or GX>39 or GY<0 or GY>24 Then Return 
  1470.   GF=F(CP,GX,GY)
  1471.   If(GF>1 and GF<10) or(GF>41 and GF<66) Then Return 
  1472.   If GF=67 Then Dec PL(CP,17)
  1473.   If GF=68 Then Dec PL(CP,19)
  1474.   If GF=69 Then Dec PL(CP,18)
  1475.   If GF=70 Then Dec PL(CP,16)
  1476.   F(CP,GX,GY)=Rnd(1)
  1477. Return 
  1478. AOMKRIEG:
  1479.   If MUS Then Extension_8_10A8 
  1480.    Extension_8_142A 6
  1481.   Hide On 
  1482.   OP=CP : YY=Y
  1483.   For CP=0 To PL-1
  1484.     Gosub NACHINITKARTE
  1485.     For A=0 To 14
  1486.       X=320 : Y=Rnd(22)+1
  1487.       TX=Rnd(35)+2 : H=12
  1488.       If SOU Then Extension_8_1450 8,11
  1489.       Repeat 
  1490.         If Mouse Key=0 Then Wait Vbl 
  1491.         Sprite 2,X Hard(X),Y Hard(Y*8-H+4),50+(X and 1)
  1492.         Dec X : BX=X/8
  1493.         If BX<TX+2 Then Dec H
  1494.       Until H=0
  1495.       If SOU Then Extension_8_1450 8,3
  1496.       For C=0 To 27
  1497.         Sprite 2,X Hard(X-4),Y Hard(Y*8-8),C+10
  1498.         Wait 3
  1499.       Next 
  1500.       F=66
  1501.       GX=TX : GY=Y : Gosub PASBLOCK
  1502.       GX=TX+1 : GY=Y : Gosub PASBLOCK
  1503.       GX=TX : GY=Y-1 : Gosub PASBLOCK
  1504.       GX=TX+1 : GY=Y-1 : Gosub PASBLOCK
  1505.       For C=15 To 0 Step -1
  1506.         Colour 31,$FF0+C : Wait 2
  1507.       Next 
  1508.       Sprite Off : Multi Wait 
  1509.       Colour 31,$FFF
  1510.     Next 
  1511.   Next 
  1512.   CP=OP : Y=YY
  1513.   Gosub NACHQUITKARTE
  1514.   Show On 
  1515.    Extension_8_142A 5
  1516.   If MUS Then Extension_8_108E 3
  1517. Return 
  1518. ERDBEBEN:
  1519.   If PL(CP,19) or PL(CP,16)
  1520.     A$=""
  1521.     If PL(CP,19) : A$=A$+"Fabriken" : End If 
  1522.     If PL(CP,19)>0 and PL(CP,16)>0 : A$=A$+" und " : End If 
  1523.     If PL(CP,16) : A$=A$+"�lt�rme" : End If 
  1524.     Text 12,Y+TB,"Achtung: Durch ein Erdbeben wurden viele Ihrer "+A$ : Add Y,6
  1525.     Text 12,Y+TB,"v�llig zerst�rt." : Add Y,6
  1526.     YY=Y
  1527.     For Y=0 To 24
  1528.       For X=0 To 39
  1529.         F=F(CP,X,Y)
  1530.         If(F=68 or F=70) and Rnd(30)<24
  1531.           GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1532.         End If 
  1533.       Next 
  1534.     Next 
  1535.     Y=YY
  1536.     P=(PL(CP,19)+PL(CP,16))*10000
  1537.     Text 12,Y+TB,"Reparaturkosten anderer Geb�ude betragen"+Str$(P)+" $" : Add Y,6
  1538.     Add PL(CP,0),-P
  1539.   Else 
  1540.     Text 12,Y+TB,"Bei einem kleineren Erdbeben wurde nichts zerst�rt!" : Add Y,6
  1541.   End If 
  1542. Return 
  1543. AFTERMAP:
  1544.   Gosub NACHINITKARTE
  1545.   While Mouse Key=0 : Multi Wait : Wend 
  1546.   Gosub NACHQUITKARTE
  1547. Return 
  1548. NACHINITKARTE:
  1549.   Fade 1
  1550.   For A=0 To 16
  1551.     Colour Back Colour(0) : View : Wait Vbl 
  1552.   Next 
  1553.   Unpack 13 To 1 : Screen To Back 
  1554.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  1555.   Colour 16,0
  1556.   KART=-1 : Gr Writing 0
  1557.   Gosub INITKARTE
  1558. Return 
  1559. NACHQUITKARTE:
  1560.   Gosub QUITKARTE2
  1561.   Screen Close 2
  1562.   Screen Close 1
  1563.   Screen 0
  1564.   Fade 2 To -1
  1565.   For A=0 To 31
  1566.     Colour Back Colour(0) : View : Wait Vbl 
  1567.   Next 
  1568. Return 
  1569. PFANDUNG:
  1570.   Add Y,6
  1571.   If PL(CP,16)+PL(CP,17)+PL(CP,18)+PL(CP,19)=0 Then Pop : Goto GAMEOVER
  1572.   Ink 1 : Text 12,Y+TB,"Um Sie vor einem Bankrott zu bewahren, werden Sie gepf�ndet!"
  1573.   Add Y,6 : Ink 2
  1574.   For A=0 To 3
  1575.     If PL(CP,2+A)
  1576.       P=PL(CP,2+A)*PL(CP,21+A) : PL(CP,2+A)=0
  1577.       Add PL(CP,0),P
  1578.       If PL(CP,0)<0
  1579.         Text 12,Y+TB,PRO$(1+A)+" im Wert von"+Str$(P)+" $ verkauft. Restschuld"+Str$(-PL(CP,0))+" $."
  1580.       Else 
  1581.         Text 12,Y+TB,PRO$(1+A)+" im Wert von"+Str$(P)+" $ verkauft. Guthaben"+Str$(PL(CP,0))+" $."
  1582.       End If 
  1583.       Add Y,6
  1584.     End If 
  1585.     If PL(CP,0)>-10000
  1586.       Text 12,Y+TB+6,"Noch mal Schwein gehabt!" : Add Y,12
  1587.       Return 
  1588.     End If 
  1589.   Next 
  1590.   PM=PL(CP,15)*250
  1591.   A=1 : YY=Y
  1592.   Repeat 
  1593.     If A=1 and PL(CP,16)=0 Then Inc A
  1594.     If A=2 and PL(CP,19)=0 Then Inc A
  1595.     If A=3 and PL(CP,18)=0 Then Inc A
  1596.     For Y=0 To 24
  1597.       For X=0 To 39
  1598.         F=F(CP,X,Y)
  1599.         If F>66 and F<71
  1600.           If F=67 : A$="Eine Dattelplantage" : P=1500+PM : D=4 : End If 
  1601.           If F=68 : A$="Eine Zigarettenfabrik" : P=10000+PM : D=2 : End If 
  1602.           If F=69 : A$="Eine Tabakplantage" : P=2000+PM : D=3 : End If 
  1603.           If F=70 : A$="Ein ï¿½lturm" : P=15000+PM : D=1 : End If 
  1604.           If D=A
  1605.             GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1606.             Add PL(CP,0),P
  1607.             If PL(CP,0)<0
  1608.               B$=A$+" wurde f�r"+Str$(P)+" $ verkauft. Restschuld"+Str$(-PL(CP,0))+" $."
  1609.             Else 
  1610.               B$=A$+" wurde f�r"+Str$(P)+" $ verkauft. Guthaben"+Str$(PL(CP,0))+" $."
  1611.             End If 
  1612.             Gosub ST
  1613.           End If 
  1614.         End If 
  1615.         Exit If PL(CP,16)+PL(CP,17)+PL(CP,18)+PL(CP,19)=0 or PL(CP,0)>-10000,2
  1616.       Next 
  1617.     Next 
  1618.     Inc A
  1619.   Until A>4
  1620.   Y=YY
  1621.   If PL(CP,0)<-10000 Then Pop : Goto GAMEOVER
  1622.   B$="" : Gosub ST
  1623.   B$="Noch mal Schwein gehabt!" : Gosub ST
  1624.   Y=YY
  1625. Return 
  1626. ST:
  1627.   If YY>170
  1628.     Screen Copy 0,12,46,307,188 To 0,12,40
  1629.     Multi Wait : Add YY,-6
  1630.   End If 
  1631.   Text 12,YY+TB,B$ : Add YY,6
  1632. Return 
  1633. GAMEOVER:
  1634.   YY=Y
  1635.   B$="" : Gosub ST
  1636.   Ink 1 : B$="Schlechte Nachrichten, "+PL$(CP,0)+"! Sie sind bankrott!" : Gosub ST
  1637.   Ink 2 : B$="Sie d�rfen wieder von vorne anfangen." : Gosub ST
  1638.   B$="" : Gosub ST
  1639.   Ink 1 : B$="Bitte Warten..." : Gosub ST
  1640.   Gosub RESETPLAYER
  1641.   DISABLEICON[0]
  1642.   DEFGADGET[1,12,178,307,188,"Weiter"]
  1643.   Repeat 
  1644.     Multi Wait 
  1645.     CLICKING : B=Param
  1646.     BP=B : Gosub AUTOTEST
  1647.   Until B>-1
  1648.   UNDEFICON[1]
  1649.   ENABLEICON[0]
  1650.   WINCLO[1,3,39,24]
  1651.   Inc CP
  1652.   If CP=PL
  1653.     CP=0
  1654.     Add MON,1,0 To 11
  1655.     If MON=0 : Inc YEAR : End If 
  1656.     If(YEAR and 2)=0
  1657.       For A=0 To PL-1
  1658.         Inc PL(A,15)
  1659.       Next 
  1660.     End If 
  1661.   End If 
  1662.   B=-1
  1663. Return 
  1664. INSECTS:
  1665.   VER=0 : DES=0 : INS=0
  1666.   For A=0 To 15
  1667.     X=IN(CP,A,0) : Y=IN(CP,A,1) : FU=IN(CP,A,2)
  1668.     If FU>0
  1669.       F=F(CP,X,Y)
  1670.       If(F>1 and F<10) or(F>41 and F<66) : FU=Max(FU-10,0) : End If 
  1671.       If F>9 and F<42 : Add FU,5 : End If 
  1672.       If F=67 : Add FU,40 : End If 
  1673.       If F=69 : Add FU,25 : End If 
  1674.       If F>66 and F<71 : Inc DES : End If 
  1675.       If(F>9 and F<42) or(F>66 and F<71)
  1676.         GX=X : GY=Y : F=66 : Gosub CHGBLOCK
  1677.       End If 
  1678.       DD=999
  1679.       For GY=Max(Y-5,0) To Min(Y+5,24)
  1680.         For GX=Max(X-5,0) To Min(X+5,39)
  1681.           D=Abs(GX-X)+Abs(GY-Y)
  1682.           If F(CP,GX,GY)>66 and D<DD : XX=GX : YY=GY : DD=D : End If 
  1683.         Next 
  1684.       Next 
  1685.       If DD<999
  1686.         RX=Sgn(XX-X) : RY=Sgn(YY-Y)
  1687.       Else 
  1688.         RX=Rnd(2)-1 : RY=Rnd(2)-1
  1689.       End If 
  1690.       For D=0 To 19
  1691.         For DD=0 To 15
  1692.           If DD<>A and IN(CP,A,0)=IN(CP,DD,0) and IN(CP,A,1)=IN(CP,DD,1)
  1693.             RX=Rnd(2)-1 : RY=Rnd(2)-1
  1694.             Exit 
  1695.           End If 
  1696.         Next 
  1697.         Exit If DD=8
  1698.       Next 
  1699.       If FU>20
  1700.         For D=0 To 15
  1701.           If IN(CP,D,0)=-1
  1702.             FU=FU/2 : Inc VER
  1703.             IN(CP,D,0)=X : IN(CP,D,1)=Y : IN(CP,D,2)=-FU
  1704.             Exit 
  1705.           End If 
  1706.         Next 
  1707.       End If 
  1708.       Add X,RX : Add Y,RY : Add FU,-2
  1709.       IN(CP,A,0)=X : IN(CP,A,1)=Y : IN(CP,A,2)=FU
  1710.     End If 
  1711.   Next 
  1712.   For A=0 To 15
  1713.     If IN(CP,A,2)<0 Then IN(CP,A,2)=Abs(IN(CP,A,2))
  1714.     If IN(CP,A,0)<0 or IN(CP,A,0)>39 or IN(CP,A,1)<0 or IN(CP,A,1)>24 or IN(CP,A,2)<1
  1715.       IN(CP,A,0)=-1 : IN(CP,A,1)=-1 : IN(CP,A,2)=0
  1716.     Else 
  1717.       Inc INS
  1718.     End If 
  1719.   Next 
  1720. Return 
  1721. CHGBLOCK:
  1722.   GF=F(CP,GX,GY)
  1723.   If GF=67 Then Dec PL(CP,17)
  1724.   If GF=68 Then Dec PL(CP,19)
  1725.   If GF=69 Then Dec PL(CP,18)
  1726.   If GF=70 Then Dec PL(CP,16)
  1727.   F(CP,GX,GY)=F
  1728.   If F=67 Then Inc PL(CP,17)
  1729.   If F=68 Then Inc PL(CP,19)
  1730.   If F=69 Then Inc PL(CP,18)
  1731.   If F=70 Then Inc PL(CP,16)
  1732. Return 
  1733. COMPUTE2:
  1734.   If CP>0 Then Gosub COMPUTE3 : Return 
  1735.   PL(CP,7)=Min(Rnd(7),6)
  1736.   PL(CP,20)=7-PL(CP,7)
  1737.   Gosub COMPUTE3
  1738.   For B=25 To 28
  1739.     PL(CP,B)=(PL(CP,B)+Rnd(45)+5) mod 360
  1740.   Next 
  1741.   PL(CP,21)= Extension_8_1106((PL(CP,25)*1024)/360,10)+40
  1742.   PL(CP,22)= Extension_8_1106((PL(CP,26)*1024)/360,3)+9
  1743.   PL(CP,23)= Extension_8_1106((PL(CP,27)*1024)/360,4)+12
  1744.   PL(CP,24)= Extension_8_1106((PL(CP,28)*1024)/360,5)+16
  1745.   PL(CP,31)=(7-PL(CP,20))*(Rnd(15000)+7500)
  1746.   PL(CP,32)=(51-PL(CP,21))*(Rnd(150)+75)
  1747.   PL(CP,33)=(13-PL(CP,22))*(Rnd(1500)+750)
  1748.   PL(CP,34)=(16-PL(CP,23))*(Rnd(1000)+500)
  1749.   PL(CP,35)=(21-PL(CP,24))*(Rnd(750)+500)
  1750.   If PL=1 Then Return 
  1751.   For CP=1 To PL-1
  1752.     PL(CP,6)=PL(0,6)
  1753.     PL(CP,7)=PL(0,7)
  1754.     For B=20 To 28
  1755.       PL(CP,B)=PL(0,B)
  1756.     Next 
  1757.     For B=31 To 35
  1758.       PL(CP,B)=PL(0,B)
  1759.     Next 
  1760.     Gosub COMPUTE3
  1761.   Next 
  1762.   CP=0
  1763. Return 
  1764. COMPUTE3:
  1765.   PL(CP,13)=PL(CP,16)*30+PL(CP,17)*20+PL(CP,18)*30+PL(CP,19)*40
  1766.   PL(CP,14)=PL(CP,16)*25+PL(CP,19)*10
  1767.   PL(CP,1)=Min(PL(CP,1),100000)
  1768.   PL(CP,0)=Max(PL(CP,0),-9000000)
  1769.   PL(CP,12)=(PL(CP,17)*50+PL(CP,18)*30)*PL(CP,20)
  1770. Return 
  1771. UPDATSCREEN1:
  1772.    Extension_8_142A 5
  1773.   WINDO[1,3,20,16,%10,PL$(CP,1)]
  1774.   PASICON[1,3,30,107,32,24,"Ankauf"]
  1775.   PASICON[2,4,66,107,32,24,"Verkauf"]
  1776.   PASICON[3,5,102,107,32,24,"Weiter"]
  1777.   PASICON[9,8,138,107,32,24,"Optionen"]
  1778.   Ink 1 : Text 12,32+TB,"1. "+MON$(MON)+Str$(YEAR)+"."
  1779.   Ink 2
  1780.   If PL(CP,6)>0
  1781.     Text 12,40+TB,"Im "+MON$((MON+11) mod 12)+" sind"+Str$(PL(CP,6))+EH$(0)+"/ha Regen"
  1782.     Text 12,46+TB,"gefallen."
  1783.   Else 
  1784.     Text 12,40+TB,"Im "+MON$((MON+11) mod 12)+" hat es nicht geregnet!"
  1785.   End If 
  1786.   Text 12,54+TB,"Im Moment "+WET$(PL(CP,7))
  1787.   Gosub BENWASSER
  1788.   Text 12,62+TB,A$
  1789.   Text 12,68+TB,B$
  1790.   Text 12,74+TB,C$
  1791.   Gosub ZEIGPLANTAGE
  1792.   Gosub UPDATBESITZ
  1793.   Gosub UPDATPREISLISTE
  1794. Return 
  1795. BENWASSER:
  1796.   If PL(CP,12)>0
  1797.     A$="Um die"
  1798.     If PL(CP,17)>0
  1799.       A$=A$+Str$(PL(CP,17))+" ha "+PRO$(2)+" "
  1800.       If PL(CP,18)>0
  1801.         A$=A$+"und die"+Str$(PL(CP,18))+" ha"
  1802.         B$=PRO$(3)+" optimal bew�ssern zu k�nnen,"
  1803.         C$="werden"+Str$(PL(CP,12))+EH$(0)+" "+PRO$(0)+" ben�tigt."
  1804.       Else 
  1805.         A$=A$+"optimal be-"
  1806.         B$="w�ssern zu k�nnen, werden"+Str$(PL(CP,12))+EH$(0)
  1807.         C$=PRO$(0)+" ben�tigt."
  1808.       End If 
  1809.     Else 
  1810.       A$=A$+Str$(PL(CP,18))+" ha "+PRO$(3)+" optimal be-"
  1811.       B$="w�ssern zu k�nnen, werden"+Str$(PL(CP,12))+EH$(0)
  1812.       C$=PRO$(0)+" ben�tigt."
  1813.     End If 
  1814.   Else 
  1815.     A$="Zur Bew�sserung der Felder wird kein"
  1816.     B$=PRO$(0)+" ben�tigt!"
  1817.     C$=""
  1818.   End If 
  1819. Return 
  1820. UPDATPREISLISTE:
  1821.   WINDO[20,17,39,24,%10,"Preisliste"]
  1822.   Ink 1 : Text 164,143+TB,"        Verkaufspreis/Ankaufspreis"
  1823.   Ink 2
  1824.   Text 164,152+TB,PRO$(0)+Space$(12-Len(PRO$(0)))+"              "+ Extension_8_0EC8(PL(CP,20),3)+" $"
  1825.   For A=1 To 4
  1826.     A$=PRO$(A)+Space$(12-Len(PRO$(A)))+ Extension_8_0EC8(PL(CP,A+20),3)+" $         "+ Extension_8_0EC8((PL(CP,A+20)*6)/5,3)+" $"
  1827.     Text 164,152+A*7+TB,A$
  1828.   Next 
  1829.   Draw 164,151 To 306,151
  1830.   Draw 249,151 To 249,188
  1831. Return 
  1832. UPDATBESITZ:
  1833.   WINDO[1,17,19,24,%10,"Besitz"]
  1834.   Ink 2
  1835.   F$=Chr$(173)+Chr$(187)
  1836.   Text 12,144+TB,"Geld     "+ Extension_8_0EC8(PL(CP,0),9)+" $"
  1837.   Text 12,152+TB,PRO$(0)+Space$(9-Len(PRO$(0)))+ Extension_8_0EC8(PL(CP,1),9)+EH$(0)
  1838.   For A=1 To 4
  1839.     A$=PRO$(A)+Space$(11-Len(PRO$(A)))+ Extension_8_0EC8(PL(CP,A+1),7)
  1840.     A$=A$+EH$(A)+Space$(3-Len(EH$(A)))+" "+F$
  1841.     A$=A$+ Extension_8_0EC8(PL(CP,A+1)*PL(CP,A+20),8)+" $"
  1842.     Text 12,152+A*7+TB,A$
  1843.   Next 
  1844. Return 
  1845. RETWORKBENCH:
  1846.   If MUS=1 Then Extension_8_10A8 
  1847.   IS=-1 : TIMOUT=25
  1848.   For A=1 To 40
  1849.     UNDEFICON[A]
  1850.   Next 
  1851.   WINDO[0,1,40,25,%111111,"Workbench"]
  1852.   PASICON[1,2,16,32,15,14,"Spiele"]
  1853.   WINDO[10,5,30,20,%111111,"Spiele"]
  1854.   DEFICON[3,80,40,87,47]
  1855.   PASICON[2,1,160,100,64,48,"Free Trading Company"]
  1856.   PAG=0
  1857. Return 
  1858. GENERATE:
  1859.   L=0
  1860.   For Y=0 To 24
  1861.     For X=0 To 39
  1862.       F(CP,X,Y)=Rnd(1)
  1863.     Next 
  1864.   Next 
  1865.   Repeat 
  1866.     If Rnd(1)=0
  1867.       X=Rnd(1)*39 : Y=Rnd(17)+1
  1868.       If X=0 : RX=1 : Else RX=-1 : End If 
  1869.       RY=0
  1870.     Else 
  1871.       X=Rnd(39) : Y=Rnd(1)*24
  1872.       If Y=0 : RY=1 : Else RY=-1 : End If 
  1873.       RX=0
  1874.     End If 
  1875.     RXA=RX : RYA=RY : B=20
  1876.     Repeat 
  1877.       If RY Then A=Rnd(1)+2
  1878.       If RX Then A=Rnd(1)+4
  1879.       F(CP,X,Y)=A : C=0
  1880.       Repeat 
  1881.         F=0
  1882.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1883.         If F>1 Then B=Max(B-1,6)
  1884.         If Rnd(B)=1 or F>1
  1885.           R=Rnd(1)
  1886.           If R=0
  1887.             If RX
  1888.               RY=RX : RX=0
  1889.             Else 
  1890.               RX=-RY : RY=0
  1891.             End If 
  1892.           Else 
  1893.             If RX
  1894.               RY=-RX : RX=0
  1895.             Else 
  1896.               RX=RY : RY=0
  1897.             End If 
  1898.           End If 
  1899.         End If 
  1900.         F=0
  1901.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1902.         Inc C : If C>10 Then Exit 2
  1903.       Until F<2
  1904.       If RY<>RYA or RX<>RXA
  1905.         If(RYA=-1 and RX=1) or(RXA=-1 and RY=1) : A=6 : End If 
  1906.         If(RYA=-1 and RX=-1) or(RXA=1 and RY=1) : A=7 : End If 
  1907.         If(RYA=1 and RX=1) or(RXA=-1 and RY=-1) : A=8 : End If 
  1908.         If(RYA=1 and RX=-1) or(RXA=1 and RY=-1) : A=9 : End If 
  1909.       End If 
  1910.       B=Max(B-1,6)
  1911.       RXA=RX : RYA=RY : F(CP,X,Y)=A
  1912.       Add X,RX : Add Y,RY : Inc L
  1913.     Until X<0 or X>39 or Y<0 or Y>24
  1914.   Until L>30
  1915.   LL=L : L=0
  1916.   Repeat 
  1917.     Repeat 
  1918.       X=Rnd(37)+1
  1919.       Y=Rnd(22)+1
  1920.     Until F(CP,X,Y)<2
  1921.     If F(CP,X,Y)<2 Then F(CP,X,Y)=A
  1922.     F(CP,X,Y)=Rnd(1)+10
  1923.     RX=Rnd(1)*2-1 : RY=Rnd(1)*2-1
  1924.     Do 
  1925.       A=Rnd(1)+10 : F(CP,X,Y)=A : C=0
  1926.       Repeat 
  1927.         RX=Rnd(2)-1 : RY=Rnd(2)-1
  1928.         F=2
  1929.         If X+RX<40 and X+RX>-1 and Y+RY<25 and Y+RY>-1 Then F=F(CP,X+RX,Y+RY)
  1930.         Inc C : If C>10 Then Exit 2
  1931.       Until F<2
  1932.       Add X,RX : Add Y,RY : Inc L
  1933.     Loop 
  1934.   Until L>800-LL
  1935.   For Y=0 To 24
  1936.     For X=0 To 39
  1937.       F=F(CP,X,Y) : F2(X,Y)=F
  1938.       If X>0 Then F01=F(CP,X-1,Y)>9 Else F01=0
  1939.       If X<39 Then F21=F(CP,X+1,Y)>9 Else F21=0
  1940.       If Y>0 Then F10=F(CP,X,Y-1)>9 Else F10=0
  1941.       If Y<24 Then F12=F(CP,X,Y+1)>9 Else F12=0
  1942.       If F(CP,X,Y)<2 Then Gosub SMOOTHPLAIN
  1943.       If F(CP,X,Y)>1 and F(CP,X,Y)<10 Then Gosub SMOOTHRIVER
  1944.     Next 
  1945.   Next 
  1946.   For Y=0 To 24
  1947.     For X=0 To 39
  1948.       F(CP,X,Y)=F2(X,Y)
  1949.     Next 
  1950.   Next 
  1951. Return 
  1952. SMOOTHRIVER:
  1953.   If(F=2 or F=3) and(F01 or F21) Then F=38+F-F01*2-F21*4
  1954.   If(F=4 or F=5) and(F10 or F12) Then F=42+F-F12*2-F10*4
  1955.   If(F=6) and(F10 or F01) Then F=53-F10-F01*2
  1956.   If(F=7) and(F10 or F21) Then F=56-F10-F21*2
  1957.   If(F=8) and(F12 or F01) Then F=59-F01-F12*2
  1958.   If(F=9) and(F12 or F21) Then F=62-F21-F12*2
  1959.   F2(X,Y)=F
  1960. Return 
  1961. SMOOTHPLAIN:
  1962.   If X>0 and Y>0 Then F00=F(CP,X-1,Y-1)>9 Else F00=0
  1963.   If X<39 and Y>0 Then F20=F(CP,X+1,Y-1)>9 Else F20=0
  1964.   If X>0 and Y<24 Then F02=F(CP,X-1,Y+1)>9 Else F02=0
  1965.   If X<39 and Y<24 Then F22=F(CP,X+1,Y+1)>9 Else F22=0
  1966.   D=-F00-F20*2-F02*4-F22*8
  1967.   If D>0 Then F=26+D
  1968.   D=-F10-F01*2-F21*4-F12*8
  1969.   If D>0 Then F=11+D
  1970.   F2(X,Y)=F
  1971. Return 
  1972. QUIT:
  1973.   Pop 
  1974.   Fade 2
  1975.   For A=0 To 31
  1976.     Colour Back Colour(0) : View : Wait Vbl 
  1977.   Next 
  1978.   Screen Close 0
  1979.   Erase 5
  1980.   Erase 6
  1981. End 
  1982.  
  1983. MONATE:
  1984.   Data "Januar","Februar","M�rz","April","Mai","Juni","Juli","August"
  1985.   Data "September","Oktober","November","Dezember"
  1986.  
  1987. WETTER:
  1988.   Data "herrscht D�rre!","ist es sehr hei�.","ist es hei�."
  1989.   Data "ist es relativ warm.","ist es feucht."
  1990.   Data "regnet es oft.","regnet es in Str�men!"
  1991.  
  1992. PRODUKTE:
  1993.   Data "Wasser"," Hl","�l"," Ba","Datteln"," Kg"
  1994.   Data "Tabak"," Kg","Zigaretten"," St"
  1995.  
  1996. Procedure TITLE
  1997.   Hide On 
  1998.   Dim S1(2),S2(1),C2(3)
  1999.    Extension_8_0EA2 "mod.title",-8
  2000.   Unpack 11 To 2 : Screen Hide 2
  2001.   For A=0 To 2 : S1(A)=Logbase(A) : Next 
  2002.   Unpack 7 To 1 : Screen Hide 1
  2003.   For A=0 To 58
  2004.     Get Block A+1,(A mod 20)*16,(A/20)*16,16,16
  2005.   Next 
  2006.   For A=0 To 3 : C2(A)=Colour(A) : Next 
  2007.   Screen Open 1,320,400,4,0 : Screen Hide 1
  2008.   Curs Off : Flash Off : Paper 0 : Pen 1 : Cls 
  2009.   For A=0 To 1 : S2(A)=Logbase(A) : Next 
  2010.   Amos Lock 
  2011.   Copper Off 
  2012.   Cop Reset 
  2013.   Cop Move $100,0
  2014. '  Cop Wait $FE,$FF
  2015.   Cop Swap 
  2016.   Cop Reset 
  2017.   AD=Cop Logic
  2018.   Reserve As Chip Work 10,16
  2019.   Cop Move $100,0
  2020.   Cop Movel $EC,S2(0) : Rem 6
  2021.   Cop Movel $F0,S2(1) : Rem 14 
  2022.   Cop Movel $E0,S1(0)
  2023.   Cop Movel $E4,S1(1)
  2024.   Cop Movel $E8,S1(2)
  2025.   Cop Move $1FC,0 : Rem AGA protection     
  2026.   For A=0 To 7
  2027.     Cop Movel $120+A*4,Start(10)
  2028.   Next 
  2029.   Cop Wait $0,$2E
  2030.   Cop Movel $102,0 : Rem    BPLCON1 BPLCON2   
  2031.   Cop Move $8E,$3081 : Rem  DIWSTRT   
  2032.   Cop Move $90,$F8C1 : Rem  DIWSTOP 
  2033.   Cop Move $92,$38 : Rem    DDFSTRT 
  2034.   Cop Move $94,$D0 : Rem    DFFSTOP 
  2035.   For A=0 To 3
  2036.     Cop Move $180+A*16,C2(A)
  2037.   Next 
  2038.   For A=1 To 7
  2039.     For B=0 To 3
  2040.       Cop Move $180+A*2+B*16,A*$222
  2041.     Next 
  2042.   Next 
  2043.   Cop Move $100,$5200 : Rem BLPCON0  
  2044.   Cop Move $96,$8180 : Rem  DMACON  
  2045.   Cop Wait $0,$7F
  2046.   For A=1 To 7
  2047.     Cop Move $180+A*2,A*$10
  2048.   Next 
  2049.   For A=1 To 3
  2050.     For B=0 To 7
  2051.       F1=Max(C2(A)/$100-B/2,0)
  2052.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2053.       F3=Max(C2(A) mod $10-B/2,0)
  2054.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2055.     Next 
  2056.   Next 
  2057.   Cop Wait $0,$90
  2058.   For A=1 To 7
  2059.     Cop Move $180+A*2,A*$110
  2060.   Next 
  2061.   For A=1 To 3
  2062.     For B=0 To 7
  2063.       F1=Min(C2(A)/$100+B/2,15)
  2064.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2065.       F3=Max(C2(A) mod $10-B/2,0)
  2066.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2067.     Next 
  2068.   Next 
  2069.   Cop Wait $0,$A0
  2070.   For A=1 To 7
  2071.     Cop Move $180+A*2,A*$11
  2072.   Next 
  2073.   For A=1 To 3
  2074.     For B=0 To 7
  2075.       F1=Max(C2(A)/$100-B/2,0)
  2076.       F2=Min((C2(A) and $F0)/$10+B/2,15)
  2077.       F3=Min(C2(A) mod $10+B/2,15)
  2078.       Cop Move $180+A*16+B*2,F1*$100+F2*$10+F3
  2079.     Next 
  2080.   Next 
  2081.   Cop Wait $0,$B0
  2082.   For A=1 To 7
  2083.     For B=0 To 3
  2084.       Cop Move $180+A*2+B*16,A*$222
  2085.     Next 
  2086.   Next 
  2087. '  Cop Wait $FE,$FF
  2088.   Cop Swap 
  2089.   S$="WILLKOMMEN ZU##FREE TRADING COMPANY####EIN SPIEL VON##PETER HODGES #UND#CHRISTOPHER HODGES###"
  2090. '  S$=S$+"SPEZIELLE VERSION##FUER DIE##BERLINER SPIELEKISTE###"
  2091.   S$=S$+"KONZEPT UND DESIGN##PETER HODGES###PROGRAMM##CHRISTOPHER HODGES###"
  2092.   S$=S$+"GRAFIKEN##PETER HODGES###WEITERE GRAFIKEN##CHRISTOPHER HODGES###"
  2093.   S$=S$+"MUSIK UND SOUND##CHRISTOPHER HODGES###DOKUMENTATION##PETER HODGES###"
  2094.   S$=S$+"COPYRIGHT 1993##CHRIS HODGES##ALL RIGHTS RESERVED!#####"
  2095.   S$=S$+"VIEL SPASS!####DRUECKEN SIE DIE##LINKE MAUSTASTE!################"
  2096.    Extension_8_10F2 0
  2097.    Extension_8_108E 8
  2098.   BP=1
  2099.   YP=0
  2100.   Repeat 
  2101.     Timer=0
  2102.     COPL[AD+6,S2(0)+YP*40]
  2103.     COPL[AD+14,S2(1)+YP*40]
  2104.     Add YP,1,0 To 175
  2105.     If(YP mod 16)=0 Then Gosub PT Else Wait Vbl 
  2106.     If Timer<1 Then Wait Vbl 
  2107.   Until Mouse Key
  2108.   Copper On 
  2109.   Amos Unlock 
  2110.    Extension_8_10A8 
  2111.   Erase 8
  2112.   Erase 10
  2113.   Screen Close 1
  2114.   Screen Close 2
  2115.   Show On 
  2116. Pop Proc
  2117. PT:
  2118.   A$=""
  2119.   Do 
  2120.     If BP=Len(S$) Then BP=1
  2121.     B$=Mid$(S$,BP,1)
  2122.     If B$="#" Then Exit 
  2123.     A$=A$+B$ : Inc BP
  2124.   Loop 
  2125.   Inc BP
  2126.   X=144-Len(A$)*8
  2127.   Ink 0 : Bar 0,YP To 319,YP+15
  2128.   Wait Vbl 
  2129.   If A$="" Then Ink 0 : Bar 0,YP+176 To 319,YP+191 : Return 
  2130.   For A=1 To Len(A$)
  2131.     Put Block Asc(Mid$(A$,A,1))-31,X+A*16,YP
  2132.   Next 
  2133.   Screen Copy 1,0,YP,319,YP+16 To 1,0,YP+176
  2134. Return 
  2135. End Proc
  2136. Procedure GRABICONS
  2137.   Unpack 14 To 0 : Screen Hide 0
  2138.   For A=0 To 70
  2139.     Get Cblock A+50,(A mod 40)*8,(A/40)*8,8,8
  2140.   Next 
  2141.   Screen Close 0
  2142.   Change Mouse 5
  2143.   Unpack 15 To 0 : Screen Hide 0
  2144.   For A=0 To 24
  2145.     Get Cblock A+1,A*8,0,8,8
  2146.   Next 
  2147.   Screen Close 0
  2148. End Proc
  2149. Procedure WINDO[X1,Y1,X2,Y2,FL,T$]
  2150.   XX1=X1*8 : YY1=Y1*8 : XX2=X2*8-8 : YY2=Y2*8-8
  2151.   Ink 0 : Bar XX1,YY1 To XX2+7,YY2+7
  2152.   If FL and 1
  2153.     Put Cblock 10,XX1,YY1
  2154.     Put Cblock 7,XX1+8,YY1
  2155.   Else 
  2156.     Put Cblock 7,XX1,YY1
  2157.     Put Cblock 8,XX1+8,YY1
  2158.   End If 
  2159.   If FL and 2
  2160.     If FL and 4
  2161.       Put Cblock 9,XX2-16,YY1
  2162.       Put Cblock 13,XX2-8,YY1
  2163.       Put Cblock 12,XX2,YY1
  2164.     Else 
  2165.       Put Cblock 8,XX2-16,YY1
  2166.       Put Cblock 9,XX2-8,YY1
  2167.       Put Cblock 12,XX2,YY1
  2168.     End If 
  2169.   Else 
  2170.     If FL and 4
  2171.       Put Cblock 8,XX2-16,YY1
  2172.       Put Cblock 9,XX2-8,YY1
  2173.       Put Cblock 13,XX2,YY1
  2174.     Else 
  2175.       Put Cblock 8,XX2-16,YY1
  2176.       Put Cblock 8,XX2-8,YY1
  2177.       Put Cblock 9,XX2,YY1
  2178.     End If 
  2179.   End If 
  2180.   For A=X1+2 To X2-4
  2181.     Put Cblock 8,A*8,YY1
  2182.   Next 
  2183.   For A=Y1+1 To Y2-1
  2184.     Put Cblock 2,XX1,A*8
  2185.   Next 
  2186.   If FL and 16
  2187.     A1=14 : A2=15 : A3=16 : EP=X2-5
  2188.   Else 
  2189.     A1=4 : A2=5 : A3=5 : EP=X2-3
  2190.   End If 
  2191.   Put Cblock A1,XX1,YY2
  2192.   For A=X1+1 To EP
  2193.     Put Cblock A2,A*8,YY2
  2194.   Next 
  2195.   Put Cblock A3,EP*8+8,YY2
  2196.   If FL and 16
  2197.     Put Cblock 17,EP*8+16,YY2
  2198.     Put Cblock 18,EP*8+24,YY2
  2199.   End If 
  2200.   If FL and 8
  2201.     Put Cblock 11,XX2,YY2
  2202.   Else 
  2203.     Put Cblock 6,XX2,YY2
  2204.   End If 
  2205.   If FL and 32
  2206.     A1=19 : A2=20 : A3=21 : EP=Y2-5
  2207.   Else 
  2208.     If FL and 8
  2209.       A1=24 : A2=24 : A3=24 : EP=Y2-3
  2210.     Else 
  2211.       A1=3 : A2=3 : A3=3 : EP=Y2-3
  2212.     End If 
  2213.   End If 
  2214.   Put Cblock A1,XX2,YY1+8
  2215.   For A=Y1+2 To EP
  2216.     Put Cblock A2,XX2,A*8
  2217.   Next 
  2218.   Put Cblock A3,XX2,EP*8+8
  2219.   If FL and 32
  2220.     Put Cblock 22,XX2,EP*8+16
  2221.     Put Cblock 23,XX2,EP*8+24
  2222.   End If 
  2223.   Ink 1
  2224.   If FL and 1
  2225.     Text XX1+10,YY1+TB,T$
  2226.   Else 
  2227.     Text XX1+2,YY1+TB,T$
  2228.   End If 
  2229. End Proc
  2230. Procedure WINCLR[X1,Y1,X2,Y2]
  2231.   Ink 0 : Bar X1*8+2,Y1*8+8 To X2*8-9,Y2*8-3
  2232. End Proc
  2233. Procedure WINCLO[X1,Y1,X2,Y2]
  2234.   Ink 0 : Bar X1*8,Y1*8 To X2*8-1,Y2*8-1
  2235. End Proc
  2236. Procedure PASICON[N,I,X1,Y1,X2,Y2,T$]
  2237.   GX=X2/2 : GY=Y2/2
  2238.   ICN(N,0)=X1-GX : ICN(N,1)=Y1-GY
  2239.   ICN(N,2)=X1-GX+X2-1 : ICN(N,3)=Y1-GY+Y2-1
  2240.   ICN(N,4)=I : ICN(N,5)=(Text Length(T$))/2
  2241.   Paste Icon X1-GX,Y1-GY,I
  2242.   Ink 1 : Text X1-ICN(N,5),Y1+GY+5,T$
  2243. End Proc
  2244. Procedure DEFICON[N,X1,Y1,X2,Y2]
  2245.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2246.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2247. End Proc
  2248. Procedure DEFGADGET[N,X1,Y1,X2,Y2,T$]
  2249.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2250.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2251.   Ink 1 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  2252.   Ink 2 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  2253.   Text(X1+X2)/2-(Text Length(T$))/2,(Y1+Y2)/2+TB/2-1,T$
  2254. End Proc
  2255. Procedure DEFGADGET2[N,X1,Y1,X2,Y2,T$]
  2256.   ICN(N,0)=X1 : ICN(N,1)=Y1
  2257.   ICN(N,2)=X2 : ICN(N,3)=Y2
  2258.   Ink 31 : Draw X1,Y2 To X1,Y1 : Draw To X2,Y1
  2259.   Ink 20 : Draw X1+1,Y2 To X2,Y2 : Draw To X2,Y1+1
  2260.   Text(X1+X2)/2-(Text Length(T$))/2,(Y1+Y2)/2+TB/2-1,T$
  2261. End Proc
  2262. Procedure PRESSICON[N]
  2263.   X1=ICN(N,0) : Y1=ICN(N,1)
  2264.   X2=ICN(N,2) : Y2=ICN(N,3)
  2265.   Screen Copy Screen,X1,Y1,X2+1,Y2+1 To Screen,X1,Y1,%110000
  2266. End Proc
  2267. Procedure UNDEFICON[N]
  2268.   ICN(N,0)=0 : ICN(N,1)=0
  2269.   ICN(N,2)=0 : ICN(N,3)=0
  2270. End Proc
  2271. Procedure DISABLEICON[N]
  2272.   ICN(N,2)=-Abs(ICN(N,2))
  2273.   ICN(N,3)=-Abs(ICN(N,3))
  2274. End Proc
  2275. Procedure ENABLEICON[N]
  2276.   ICN(N,2)=Abs(ICN(N,2))
  2277.   ICN(N,3)=Abs(ICN(N,3))
  2278. End Proc
  2279. Procedure ERAICON[N]
  2280.   Ink 0 : Bar ICN(N,0),ICN(N,1) To ICN(N,2),ICN(N,3)
  2281.   MX=(ICN(N,0)+ICN(N,2))/2
  2282.   Bar MX-ICN(N,5),ICN(N,3)+2 To MX+ICN(N,5),ICN(N,3)+6
  2283.   ICN(N,0)=0 : ICN(N,1)=0
  2284.   ICN(N,2)=0 : ICN(N,3)=0
  2285. End Proc
  2286. Procedure CHECKICONS[X,Y]
  2287.   BB=-1
  2288.   For A=0 To 40
  2289.     If ICN(A,0)<X and ICN(A,2)>X and ICN(A,1)<Y and ICN(A,3)>Y Then BB=A : Exit 
  2290.   Next 
  2291. End Proc[BB]
  2292. Procedure ALERT[TI$,T1$,T2$,YES$,NO$]
  2293.   Get Cblock 999,0,0,128,56
  2294.   WINDO[0,0,16,7,%1110,TI$]
  2295.   Ink 1
  2296.   Text 60-(Text Length(T1$))/2,10+TB,T1$
  2297.   Text 60-(Text Length(T2$))/2,16+TB,T2$
  2298.   For A=0 To 40
  2299.     DISABLEICON[A]
  2300.   Next 
  2301.   DEFGADGET[39,10,32,56,48,YES$]
  2302.   DEFGADGET[40,64,32,110,48,NO$]
  2303.   Repeat 
  2304.     Wait Vbl : CLICKING : B=Param
  2305.   Until B>-1
  2306.   Put Cblock 999
  2307.   Del Cblock 999
  2308.   UNDEFICON[39]
  2309.   UNDEFICON[40]
  2310.   For A=0 To 40
  2311.     ENABLEICON[A]
  2312.   Next 
  2313. End Proc[40-B]
  2314. Procedure CLICKING
  2315.   X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  2316.   B=-1
  2317.   If M>1 and PAG<>4 Then Ink 2 : Bar 0,0 To 319,7 : UP=198
  2318.   If M=1 Then CHECKICONS[X,Y] : B=Param
  2319.   If B>-1
  2320.     If SOU>0 and PAG>0 : Extension_8_1450 8,1 : End If 
  2321.     IS=0
  2322.     While M=1
  2323.       Wait Vbl : X=X Screen(X Mouse) : Y=Y Screen(Y Mouse) : M=Mouse Key
  2324.       CHECKICONS[X,Y]
  2325.       If Param=B and IS=0 : IS=1 : PRESSICON[B] : End If 
  2326.       If Param<>B and IS=1 : IS=0 : PRESSICON[B] : End If 
  2327.     Wend 
  2328.     If IS=0
  2329.       B=-1
  2330.     Else 
  2331.       PRESSICON[B]
  2332.     End If 
  2333.   End If 
  2334. End Proc[B]
  2335. Procedure CT[Y,T$]
  2336.   Text 160-(Text Length(T$))/2,Y+TB,T$
  2337. End Proc
  2338. Procedure OT[X,Y,C1,C2,T$]
  2339.   Ink C2 : Text X-1,Y,T$ : Text X-1,Y-1,T$ : Text X,Y-1,T$
  2340.   Text X+1,Y-1,T$ : Text X+1,Y,T$ : Text X+1,Y+1,T$
  2341.   Text X,Y+1,T$ : Text X-1,Y+1,T$
  2342.   Ink C1 : Text X,Y,T$
  2343. End Proc
  2344. Procedure EINGABE[TTEX$,TX,TY,WX,MC,NUMS]
  2345.   Gr Writing 1 : Ink 2,0 : Clear Key 
  2346.   TEXX=Len(TTEX$) : TEXOF=0 : ALT$="x" : RET=0
  2347.   Do 
  2348.     Multi Wait : I$=Inkey$ : AC=Asc(I$) : SC=Scancode : KS=Key Shift
  2349.     If AC=13 Then RET=1
  2350.     Exit If AC=13 or AC=27
  2351.     If(NUMS and 1) and AC>31 and(AC<48 or AC>57) Then AC=0
  2352.     If AC>31 and Len(TTEX$)<MC Then TTEX$=Left$(TTEX$,TEXX)+I$+Mid$(TTEX$,TEXX+1) : Inc TEXX
  2353.     If SC=65 and KS=0 and TEXX>0 Then TTEX$=Left$(TTEX$,TEXX-1)+Mid$(TTEX$,TEXX+1) : Dec TEXX
  2354.     If SC=70 and KS=0 and TEXX<Len(TTEX$) Then TTEX$=Left$(TTEX$,TEXX)+Mid$(TTEX$,TEXX+2)
  2355.     If SC=65 and KS and TEXX>0 Then TTEX$=Mid$(TTEX$,TEXX+1) : TEXX=0
  2356.     If SC=70 and KS and TEXX<Len(TTEX$) Then TTEX$=Left$(TTEX$,TEXX) : TEXX=Len(TTEX$)
  2357.     If AC=29 and TEXX>0 Then Dec TEXX
  2358.     If AC=28 and TEXX<Len(TTEX$) Then Inc TEXX
  2359.     If SC=79 and KS Then TEXX=0
  2360.     If SC=78 and KS Then TEXX=Len(TTEX$)
  2361.     If TEXX-TEXOF>WX-1 Then TEXOF=TEXX-WX+1
  2362.     If TEXX-TEXOF<0 Then TEXOF=Max(0,TEXX)
  2363.     If(ALT$<>TTEX$) or(ALTOF<>TEXOF) or(ALTXX<>TEXX)
  2364.       If SOU : Extension_8_1450 8,5 : End If 
  2365.       ALT$=TTEX$ : ALTOF=TEXOF : ALTXX=TEXX
  2366.       Text TX,TY+TB,Mid$(TTEX$,TEXOF+1,Min(Len(TTEX$)+TEXOF,WX))+String$(".",Max(0,Min(WX,MC)-Len(TTEX$)+TEXOF))
  2367.       XX=TX+TEXX*4-TEXOF*4
  2368.       If TEXX-TEXOF<MC : Screen Copy 0,XX,TY+2,XX+4,TY+8 To 0,XX,TY+2,%110000 : End If 
  2369.     End If 
  2370.   Loop 
  2371.   If NUMS and 1
  2372.     A=Val(TTEX$)
  2373.     TTEX$=Str$(A)-" "
  2374.   End If 
  2375.   Text TX,TY+TB,Left$(TTEX$,Min(Len(TTEX$),WX))+Space$(Max(0,Min(WX,MC)-Len(TTEX$)))
  2376.   If SOU : Extension_8_1450 8,1 : End If 
  2377.   Wait Vbl 
  2378.   Gr Writing 0
  2379. End Proc[TTEX$]
  2380. Procedure COPL[ADR,V]
  2381.   Doke ADR,V/$10000
  2382.   Doke ADR+4,V and $FFFF
  2383. End Proc
  2384. Procedure S1
  2385.   For Y=0 To WY+S Step S
  2386.     Screen Copy B1,0,Y,WX,Y+S To B2,0,Y : Wait Vbl 
  2387.   Next 
  2388. End Proc
  2389. Procedure S2
  2390.   For Y=WY To -S Step -S
  2391.     Screen Copy B1,0,Y,WX,Y+S To B2,0,Y : Wait Vbl 
  2392.   Next 
  2393. End Proc
  2394. Procedure S3
  2395.   For X=0 To WX+S Step S
  2396.     Screen Copy B1,X,0,X+S,WY To B2,X,0 : Wait Vbl 
  2397.   Next 
  2398. End Proc
  2399. Procedure S4
  2400.   For X=WX To -S Step -S
  2401.     Screen Copy B1,X,0,X+S,WY To B2,X,0 : Wait Vbl 
  2402.   Next 
  2403. End Proc
  2404. Procedure S5
  2405.   For YY=0 To S-1
  2406.     For Y=0 To WY+S Step S
  2407.       Screen Copy B1,0,Y+YY,WX,Y+YY+1 To B2,0,Y+YY
  2408.     Next 
  2409.     Wait Vbl 
  2410.   Next 
  2411. End Proc
  2412. Procedure S6
  2413.   For YY=S-1 To 0 Step -1
  2414.     For Y=WY To -S Step -S
  2415.       Screen Copy B1,0,Y+YY,WX,Y+YY+1 To B2,0,Y+YY
  2416.     Next 
  2417.     Wait Vbl 
  2418.   Next 
  2419. End Proc
  2420. Procedure S7
  2421.   For XX=0 To S-1
  2422.     For X=0 To WX+S Step S
  2423.       Screen Copy B1,X+XX,0,X+XX+1,WY To B2,X+XX,0
  2424.     Next 
  2425.     Wait Vbl 
  2426.   Next 
  2427. End Proc
  2428. Procedure S8
  2429.   For XX=S-1 To 0 Step -1
  2430.     For X=WX To -S Step -S
  2431.       Screen Copy B1,X+XX,0,X+XX+1,WY To B2,X+XX,0
  2432.     Next 
  2433.     Wait Vbl 
  2434.   Next 
  2435. End Proc
  2436. Procedure S9
  2437.   B=0 : A=0 : X=0 : Y=0 : RX=16 : RY=0 : BX1=-16 : BX2=WX-16 : BY1=0 : BY2=WY+8
  2438.   Repeat 
  2439.     Screen Copy B1,X,Y,X+16,Y+16 To B2,X,Y : Add B,1,0 To 3 : If B=0 Then Wait Vbl 
  2440.     If Y+RY<BY1 and A=3 Then Add A,1,0 To 3 : RY=0 : RX=16 : Add BX2,-16
  2441.     If X+RX<BX1 and A=2 Then Add A,1,0 To 3 : RX=0 : RY=-16 : Add BY1,16
  2442.     If Y+RY>BY2 and A=1 Then Add A,1,0 To 3 : RY=0 : RX=-16 : Add BX1,16
  2443.     If X+RX>BX2 and A=0 Then Add A,1,0 To 3 : RX=0 : RY=16 : Add BY2,-16
  2444.     Add X,RX : Add Y,RY
  2445.   Until BX2<=BX1 or BY2<BY1
  2446. End Proc
  2447. Procedure S10
  2448.   X=0 : Y=0 : RY=16 : A=0
  2449.   Repeat 
  2450.     Screen Copy B1,X,Y,X+16,Y+16 To B2,X,Y : Add A,1,0 To 3 : If A=0 Then Wait Vbl 
  2451.     If Y>WY or Y<0 Then RY=-RY : Add X,16
  2452.     Add Y,RY
  2453.   Until X>WX
  2454. End Proc
  2455. Procedure S11
  2456.   Dim F(WX/S) : B=WX/S
  2457.   Repeat 
  2458.     Repeat : A=Rnd(WX/S-1) : Until F(A)<WY
  2459.     C=Rnd(S)+1
  2460.     Screen Copy B1,A*S,F(A),A*S+S,F(A)+C To B2,A*S,F(A)
  2461.     Add F(A),C : If F(A)=>WY Then Dec B
  2462.   Until B=0
  2463. End Proc
  2464. Procedure S12
  2465.   Dim F(WX/S) : B=WX/S
  2466.   For A=0 To WX/S
  2467.     F(A)=WY
  2468.   Next 
  2469.   Repeat 
  2470.     Repeat : A=Rnd(WX/S-1) : Until F(A)>0
  2471.     C=Rnd(S)+1
  2472.     Add F(A),-C
  2473.     Screen Copy B1,A*S,F(A),A*S+S,F(A)+C To B2,A*S,F(A)
  2474.     If F(A)<1 Then Dec B
  2475.   Until B=0
  2476. End Proc
  2477. Procedure S13
  2478.   For Y=0 To 400 Step S
  2479.     For X=0 To WX/64-1
  2480.       YY=Y-(4-X)*32
  2481.       Screen Copy B1,X*64,YY,X*64+64,YY+S To B2,X*64,YY
  2482.     Next 
  2483.     Wait Vbl 
  2484.   Next 
  2485. End Proc
  2486. Procedure S14
  2487.   For Y=0 To 408 Step S
  2488.     For X=0 To WX/16-1
  2489.       Screen Copy B1,X*16,Y-X*8,X*16+16,Y-X*8+S To B2,X*16,Y-X*8
  2490.     Next 
  2491.     Wait Vbl 
  2492.   Next 
  2493. End Proc