'
' Map Creator V1.00, 1.01 - 280992 - Basic routines, Layering Routines 
'             V1.02       - 290992 - Map Trend Menu + LightSourcing
'
'        It's Here!!!!!, AMOS Professional!!!!!!!!!! (Arrived 161092)    
'
'             V1.03       - 181092 - Custom RND procedure added, allows
'                                    for true seeding of maps
'             V1.03a      - 211092 - A slightly tweaked version, I don't 
'                                    have much time for coding at the minute 
'                                    what with a report to write.
'             V1.1        - 140293 - All the speed critical code has been
'                                    examined and re-written where necessary 
'                                    resulting in faster operation. All we 
'                                    need now is the Pro Compiler! 
'             V1.11       - 140593 - Quite a break there, but I'm back, with 
'                                    AMOSPro1.1 and an A4000/030. Who needs
'                                    compilers when you've a 68030 under 
'                                    the hood?!?. Fixed that annoying palette
'                                    bug in the lightsource routine. 
'             V1.12       - 160593 - Fixed bug in seeding routine. Hitting   
'                                    Return now passes the correct seed value. 
'                                    Also tweaked code some more to shave a
'                                    bit off the execution time. 
'             V1.13       - 020494 - Replaced RND procedures with -ve Rnd
'                                    calls. Its about 25% faster.
'             V1.14       - 050494 - Added RIP routine.
'             V1.15       - 090494 - Fixed nonterminal bug in seedmap. 
'             V1.16       - 190594 - Changed water palette to show water 
'                                    water depth, and altered layering 
'                                    routine to layer water properly.  
'
' From Zoom Routines extracted from 3DMapV315  
'
Global SEED#,SEEDBACK#
Fix 15
MC_INIT
Do 
   Screen 0
   Limit Mouse 
   Wait Vbl 
   A$="L: L Y=YM ; P ; J L"
   Channel 1 To Screen Display 1
   Amal 1,A$
   Amal On 1
   MC_SEEDMAP
   TA#=Timer
   MC_BUILDMAP
   MC_RIP
   TB#=Timer
   XS=0
   YS=0
   XF=160
   YF=0
   MC_SMOOTH[XS,YS,XF,YF]
   TC#=Timer
   XS=0
   YS=0
   XF=0
   YF=130
   BAND=4
   MC_LAYER[XS,YS,XF,YF,BAND]
   TD#=Timer
   XS=160
   YS=0
   XF=160
   YF=130
   MC_SHADE[XS,YS,XF,YF]
   TE#=Timer
   Screen 1
   TA=TB#-TA#
   TB=TC#-TB#
   TC=TD#-TC#
   TD=TE#-TD#
   TE=TE#-TA#
   Print "Build Map  :";TA/3000;" :";(TA/50) mod 60
   Print "Smooth Map :";TB/3000;" :";(TB/50) mod 60
   Print "Layer Map  :";TC/3000;" :";(TC/50) mod 60
   Print "Shadow Map :";TD/3000;" :";(TD/50) mod 60
   Print "TOTAL      :";TE/3000;" :";(TE/50) mod 60
   Screen 0
   Do 
      Exit If Mouse Key>0
      Multi Wait 
   Loop 
   Multi Wait 
Loop 
Procedure MC_INIT
   '
   ' Initialisation Procedure 
   '
   ' Opens Screen 0, 320*256*5. Loads palette from binary file on disk
   ' Opens Screen 1, 640*48*1.
   '
   Screen Open 0,320,262,32,Lowres
   Curs Off 
   Hide On 
   Flash Off 
   Bload "MapCreatePalette.ABK",Screen Base+98
   Cls 0
   Screen Open 1,640,48,2,Hires
   Palette $0,$FFF
   SEEDBACK#=200773.0
   SEED#=SEEDBACK#
End Proc
Procedure MC_BUILDMAP
   '
   ' Buildmap Procedure 
   '
   ' Generates 128*128 map from 4*4 seed map
   ' Uses Midwinter Interpolation technique 
   '
   TP=2
   For LEVEL=1 To 5
      Rol.l 1,TP
      Screen Copy 0,0,0,TP+1,TP+1 To 0,128,128
      Screen 1
      Home 
      Print "Iteration";LEVEL
      Screen 0
      For Y=0 To TP
         For X=0 To TP
            CA=Point(X+128,Y+128)
            CB=Point(X+129,Y+128)
            CC=Point(X+128,Y+129)
            CD=Point(X+129,Y+129)
            If CA<1
               CA=1
            End If 
            Randomize(X*Y)
            RMOD=Rnd(-2)
            Dec RMOD
            AC=(CA+CB+CC+CD)/4+RMOD
            If AC<1
               AC=1
            End If 
            If AC>31
               AC=31
            End If 
            CE=Point(X*2+1,Y*2-1)
            RMOD=Rnd(-2)
            Dec RMOD
            AD=(CA+CB+CE+AC)/4+RMOD
            If AD<1
               AD=1
            End If 
            If AD>31
               AD=31
            End If 
            CF=Point(X*2-1,Y*2+1)
            RMOD=Rnd(-2)
            Dec RMOD
            AE=(CA+AC+CC+CF)/4+RMOD
            If AE<1
               AE=1
            End If 
            If AE>31
               AE=31
            End If 
            Plot X*2,Y*2,CA
            Plot X*2+1,Y*2+1,AC
            Plot X*2+1,Y*2,AD
            Plot X*2,Y*2+1,AE
         Next X
      Next Y
   Next LEVEL
   Screen Copy 0,1,1,129,129 To 0,0,0
   Ink 0
   Bar 128,0 To 130,262
   Bar 0,128 To 320,262
End Proc
Procedure MC_SMOOTH[XS,YS,XF,YF]
   '
   ' Smooth Procedure 
   '
   ' Removes Cross-Hatching effect
   '
   ' XS = Starting x Co-ord for original map
   ' YS = Starting y Co-ord for original map
   ' XF = Starting x Co-ord for layered map 
   ' YF = Starting y Co-ord for layered map 
   '
   Screen 1
   Home 
   Print "Smoothing Map                         "
   Screen 0
   For Y=YS To 127+YS
      For X=XS To 127+XS
         HT=Point(X+XS,Y+YS)
         If HT>7
            HTB=Point(X+XS+1,Y+YS)
            HTC=Point(X+XS,Y+YS+1)
            HTD=Point(X+XS+1,Y+YS+1)
            HT=(HT+HTB+HTC+HTD)/4
            If HT<8
               HT=8
            End If 
            Plot X-XS+XF,Y-YS+YF,HT
         Else 
            Plot X-XS+XF,Y-YS+YF,HT
         End If 
      Next X
   Next Y
End Proc
Procedure MC_LAYER[XS,YS,XF,YF,BAND]
   '
   ' Layer Procedure
   '
   ' Generates Topographical Map
   '
   ' XS = Starting x Co-ord for original map
   ' YS = Starting y Co-ord for original map
   ' XF = Starting x Co-ord for layered map 
   ' YF = Starting y Co-ord for layered map 
   ' BAND = Colour Reduction Parameter
   '
   Screen 1
   Home 
   Print "Layering Map - Reduction Level";BAND
   Screen 0
   For Y=YS To 127+YS
      For X=XS To 127+XS
         HT=Point(X+1+XS,Y+1+YS)
         If HT>7
            HT=HT/BAND*BAND
            If HT<8
               HT=8
            End If 
            Plot X-XS+XF,Y-YS+YF,HT
         Else 
            HT=HT/BAND*BAND
            If HT>7
               HT=7
            End If 
            If HT<1
               HT=1
            End If 
            Plot X-XS+XF,Y-YS+YF,HT
         End If 
      Next X
   Next Y
End Proc
Procedure MC_SEEDMAP
   '
   ' Seedmap Procedure
   '
   ' Generates random 4*4 starting map  
   '
   Screen 1
   Cls 0
   Home 
   Fix 0
   Print "Seed Value <Return to use existing value -";SEEDBACK#;">"
   Fix 3
   Print 
   Put Key Str$(SEEDBACK#)
   Input "Your Choice :";SD#
   Cls 0
   SEED#=SD#
   SEEDBACK#=SEED#
   Randomize(SEED#)
   Screen 0
   For Y=0 To 3
      For X=0 To 3
         HT=Rnd(-30)
         Inc HT
         Plot X,Y,HT
      Next X
   Next Y
   Ink 0
   Bar 4,0 To 320,256
   Bar 0,4 To 320,256
End Proc
Procedure MC_SHADE[XS,YS,XF,YF]
   '
   ' Shade Procedure
   '
   ' Generates Lightsourced Map. Lightsource in NW
   '
   ' XS = Starting x Co-ord for original map
   ' YS = Starting y Co-ord for original map
   ' XF = Starting x Co-ord for lightsourced map
   ' YF = Starting y Co-ord for lightsourced map
   '
   Screen 1
   Home 
   Print "Lightsourcing map                            "
   Screen 0
   For Y=YS To YS+127
      For X=XS To XS+127
         HA=Point(X,Y)
         If HA>7
            If X<126+XS
               HB=(Point(X+1,Y)+Point(X+2,Y))/2
            Else 
               HA=(Point(X-1,Y)+Point(X-2,Y))/2
               HB=Point(X,Y)
            End If 
            If Y<126+YS
               HC=(Point(X,Y+1)+Point(X,Y+2))/2
            Else 
               HA=(Point(X,Y-1)+Point(X,Y-2))/2
               HC=Point(X,Y)
            End If 
            HMED=26
            H=HMED
            If HB>HA
               Inc H
               Inc H
            End If 
            If HB<HA
               Dec H
               Dec H
            End If 
            If HC>HA
               Inc H
               Inc H
            End If 
            If HC<HA
               Dec H
               Dec H
            End If 
            If H<HMED-2
               H=HMED-2
            End If 
            If H>HMED+2
               H=HMED+2
            End If 
            Plot X-XS+XF,Y-YS+YF,H
         Else 
            Plot X-XS+XF,Y-YS+YF,HA
         End If 
      Next X
   Next Y
End Proc
Procedure MC_RIP
   '
   ' Removes Isolated Pixels from map 
   '
   ' A pixel is assumed isolated if it does not exhibit 4-connectivity
   '
   ' There are two checks, one for water and one for land pixels. If a land 
   ' pixel is isolated it is set to water. If a water pixel is isolated 
   ' it is set to the average of the surrounding 4-connectivity pixels
   '
   Screen 1
   Home 
   Print "Removing Isolated Points"
   Screen 0
   For Y=1 To 126
      For X=1 To 126
         PIXEL=Point(X,Y)
         PIX_UP=Point(X,Y-1)
         PIX_DOWN=Point(X,Y+1)
         PIX_LEFT=Point(X-1,Y)
         PIX_RIGHT=Point(X+1,Y)
         PIX_AVG=(PIX_LEFT+PIX_RIGHT+PIX_UP+PIX_DOWN)/4
         If PIXEL>7
            If PIX_UP<8 and PIX_DOWN<8 and PIX_LEFT<8 and PIX_RIGHT<8
               Plot X,Y,PIX_AVG
            End If 
         Else 
            If PIX_UP>7 and PIX_DOWN>7 and PIX_LEFT>7 and PIX_RIGHT>7
               Plot X,Y,PIX_AVG
            End If 
         End If 
      Next X
   Next Y
End Proc