home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 23 / CU Amiga - Super CD-ROM 23 (June 1998).iso / CreatingGames / Utilities / Amos / MapCreator / MapCreator.AMOS / MapCreator.amosSourceCode
Encoding:
AMOS Source Code  |  1994-10-05  |  9.4 KB  |  369 lines
  1. '
  2. ' Map Creator V1.00, 1.01 - 280992 - Basic routines, Layering Routines 
  3. '             V1.02       - 290992 - Map Trend Menu + LightSourcing
  4. '
  5. '        It's Here!!!!!, AMOS Professional!!!!!!!!!! (Arrived 161092)    
  6. '
  7. '             V1.03       - 181092 - Custom RND procedure added, allows
  8. '                                    for true seeding of maps
  9. '             V1.03a      - 211092 - A slightly tweaked version, I don't 
  10. '                                    have much time for coding at the minute 
  11. '                                    what with a report to write.
  12. '             V1.1        - 140293 - All the speed critical code has been
  13. '                                    examined and re-written where necessary 
  14. '                                    resulting in faster operation. All we 
  15. '                                    need now is the Pro Compiler! 
  16. '             V1.11       - 140593 - Quite a break there, but I'm back, with 
  17. '                                    AMOSPro1.1 and an A4000/030. Who needs
  18. '                                    compilers when you've a 68030 under 
  19. '                                    the hood?!?. Fixed that annoying palette
  20. '                                    bug in the lightsource routine. 
  21. '             V1.12       - 160593 - Fixed bug in seeding routine. Hitting   
  22. '                                    Return now passes the correct seed value. 
  23. '                                    Also tweaked code some more to shave a
  24. '                                    bit off the execution time. 
  25. '             V1.13       - 020494 - Replaced RND procedures with -ve Rnd
  26. '                                    calls. Its about 25% faster.
  27. '             V1.14       - 050494 - Added RIP routine.
  28. '             V1.15       - 090494 - Fixed nonterminal bug in seedmap. 
  29. '             V1.16       - 190594 - Changed water palette to show water 
  30. '                                    water depth, and altered layering 
  31. '                                    routine to layer water properly.  
  32. '
  33. ' From Zoom Routines extracted from 3DMapV315  
  34. '
  35. Global SEED#,SEEDBACK#
  36. Fix 15
  37. MC_INIT
  38. Do 
  39.    Screen 0
  40.    Limit Mouse 
  41.    Wait Vbl 
  42.    A$="L: L Y=YM ; P ; J L"
  43.    Channel 1 To Screen Display 1
  44.    Amal 1,A$
  45.    Amal On 1
  46.    MC_SEEDMAP
  47.    TA#=Timer
  48.    MC_BUILDMAP
  49.    MC_RIP
  50.    TB#=Timer
  51.    XS=0
  52.    YS=0
  53.    XF=160
  54.    YF=0
  55.    MC_SMOOTH[XS,YS,XF,YF]
  56.    TC#=Timer
  57.    XS=0
  58.    YS=0
  59.    XF=0
  60.    YF=130
  61.    BAND=4
  62.    MC_LAYER[XS,YS,XF,YF,BAND]
  63.    TD#=Timer
  64.    XS=160
  65.    YS=0
  66.    XF=160
  67.    YF=130
  68.    MC_SHADE[XS,YS,XF,YF]
  69.    TE#=Timer
  70.    Screen 1
  71.    TA=TB#-TA#
  72.    TB=TC#-TB#
  73.    TC=TD#-TC#
  74.    TD=TE#-TD#
  75.    TE=TE#-TA#
  76.    Print "Build Map  :";TA/3000;" :";(TA/50) mod 60
  77.    Print "Smooth Map :";TB/3000;" :";(TB/50) mod 60
  78.    Print "Layer Map  :";TC/3000;" :";(TC/50) mod 60
  79.    Print "Shadow Map :";TD/3000;" :";(TD/50) mod 60
  80.    Print "TOTAL      :";TE/3000;" :";(TE/50) mod 60
  81.    Screen 0
  82.    Do 
  83.       Exit If Mouse Key>0
  84.       Multi Wait 
  85.    Loop 
  86.    Multi Wait 
  87. Loop 
  88. Procedure MC_INIT
  89.    '
  90.    ' Initialisation Procedure 
  91.    '
  92.    ' Opens Screen 0, 320*256*5. Loads palette from binary file on disk
  93.    ' Opens Screen 1, 640*48*1.
  94.    '
  95.    Screen Open 0,320,262,32,Lowres
  96.    Curs Off 
  97.    Hide On 
  98.    Flash Off 
  99.    Bload "MapCreatePalette.ABK",Screen Base+98
  100.    Cls 0
  101.    Screen Open 1,640,48,2,Hires
  102.    Palette $0,$FFF
  103.    SEEDBACK#=200773.0
  104.    SEED#=SEEDBACK#
  105. End Proc
  106. Procedure MC_BUILDMAP
  107.    '
  108.    ' Buildmap Procedure 
  109.    '
  110.    ' Generates 128*128 map from 4*4 seed map
  111.    ' Uses Midwinter Interpolation technique 
  112.    '
  113.    TP=2
  114.    For LEVEL=1 To 5
  115.       Rol.l 1,TP
  116.       Screen Copy 0,0,0,TP+1,TP+1 To 0,128,128
  117.       Screen 1
  118.       Home 
  119.       Print "Iteration";LEVEL
  120.       Screen 0
  121.       For Y=0 To TP
  122.          For X=0 To TP
  123.             CA=Point(X+128,Y+128)
  124.             CB=Point(X+129,Y+128)
  125.             CC=Point(X+128,Y+129)
  126.             CD=Point(X+129,Y+129)
  127.             If CA<1
  128.                CA=1
  129.             End If 
  130.             Randomize(X*Y)
  131.             RMOD=Rnd(-2)
  132.             Dec RMOD
  133.             AC=(CA+CB+CC+CD)/4+RMOD
  134.             If AC<1
  135.                AC=1
  136.             End If 
  137.             If AC>31
  138.                AC=31
  139.             End If 
  140.             CE=Point(X*2+1,Y*2-1)
  141.             RMOD=Rnd(-2)
  142.             Dec RMOD
  143.             AD=(CA+CB+CE+AC)/4+RMOD
  144.             If AD<1
  145.                AD=1
  146.             End If 
  147.             If AD>31
  148.                AD=31
  149.             End If 
  150.             CF=Point(X*2-1,Y*2+1)
  151.             RMOD=Rnd(-2)
  152.             Dec RMOD
  153.             AE=(CA+AC+CC+CF)/4+RMOD
  154.             If AE<1
  155.                AE=1
  156.             End If 
  157.             If AE>31
  158.                AE=31
  159.             End If 
  160.             Plot X*2,Y*2,CA
  161.             Plot X*2+1,Y*2+1,AC
  162.             Plot X*2+1,Y*2,AD
  163.             Plot X*2,Y*2+1,AE
  164.          Next X
  165.       Next Y
  166.    Next LEVEL
  167.    Screen Copy 0,1,1,129,129 To 0,0,0
  168.    Ink 0
  169.    Bar 128,0 To 130,262
  170.    Bar 0,128 To 320,262
  171. End Proc
  172. Procedure MC_SMOOTH[XS,YS,XF,YF]
  173.    '
  174.    ' Smooth Procedure 
  175.    '
  176.    ' Removes Cross-Hatching effect
  177.    '
  178.    ' XS = Starting x Co-ord for original map
  179.    ' YS = Starting y Co-ord for original map
  180.    ' XF = Starting x Co-ord for layered map 
  181.    ' YF = Starting y Co-ord for layered map 
  182.    '
  183.    Screen 1
  184.    Home 
  185.    Print "Smoothing Map                         "
  186.    Screen 0
  187.    For Y=YS To 127+YS
  188.       For X=XS To 127+XS
  189.          HT=Point(X+XS,Y+YS)
  190.          If HT>7
  191.             HTB=Point(X+XS+1,Y+YS)
  192.             HTC=Point(X+XS,Y+YS+1)
  193.             HTD=Point(X+XS+1,Y+YS+1)
  194.             HT=(HT+HTB+HTC+HTD)/4
  195.             If HT<8
  196.                HT=8
  197.             End If 
  198.             Plot X-XS+XF,Y-YS+YF,HT
  199.          Else 
  200.             Plot X-XS+XF,Y-YS+YF,HT
  201.          End If 
  202.       Next X
  203.    Next Y
  204. End Proc
  205. Procedure MC_LAYER[XS,YS,XF,YF,BAND]
  206.    '
  207.    ' Layer Procedure
  208.    '
  209.    ' Generates Topographical Map
  210.    '
  211.    ' XS = Starting x Co-ord for original map
  212.    ' YS = Starting y Co-ord for original map
  213.    ' XF = Starting x Co-ord for layered map 
  214.    ' YF = Starting y Co-ord for layered map 
  215.    ' BAND = Colour Reduction Parameter
  216.    '
  217.    Screen 1
  218.    Home 
  219.    Print "Layering Map - Reduction Level";BAND
  220.    Screen 0
  221.    For Y=YS To 127+YS
  222.       For X=XS To 127+XS
  223.          HT=Point(X+1+XS,Y+1+YS)
  224.          If HT>7
  225.             HT=HT/BAND*BAND
  226.             If HT<8
  227.                HT=8
  228.             End If 
  229.             Plot X-XS+XF,Y-YS+YF,HT
  230.          Else 
  231.             HT=HT/BAND*BAND
  232.             If HT>7
  233.                HT=7
  234.             End If 
  235.             If HT<1
  236.                HT=1
  237.             End If 
  238.             Plot X-XS+XF,Y-YS+YF,HT
  239.          End If 
  240.       Next X
  241.    Next Y
  242. End Proc
  243. Procedure MC_SEEDMAP
  244.    '
  245.    ' Seedmap Procedure
  246.    '
  247.    ' Generates random 4*4 starting map  
  248.    '
  249.    Screen 1
  250.    Cls 0
  251.    Home 
  252.    Fix 0
  253.    Print "Seed Value <Return to use existing value -";SEEDBACK#;">"
  254.    Fix 3
  255.    Print 
  256.    Put Key Str$(SEEDBACK#)
  257.    Input "Your Choice :";SD#
  258.    Cls 0
  259.    SEED#=SD#
  260.    SEEDBACK#=SEED#
  261.    Randomize(SEED#)
  262.    Screen 0
  263.    For Y=0 To 3
  264.       For X=0 To 3
  265.          HT=Rnd(-30)
  266.          Inc HT
  267.          Plot X,Y,HT
  268.       Next X
  269.    Next Y
  270.    Ink 0
  271.    Bar 4,0 To 320,256
  272.    Bar 0,4 To 320,256
  273. End Proc
  274. Procedure MC_SHADE[XS,YS,XF,YF]
  275.    '
  276.    ' Shade Procedure
  277.    '
  278.    ' Generates Lightsourced Map. Lightsource in NW
  279.    '
  280.    ' XS = Starting x Co-ord for original map
  281.    ' YS = Starting y Co-ord for original map
  282.    ' XF = Starting x Co-ord for lightsourced map
  283.    ' YF = Starting y Co-ord for lightsourced map
  284.    '
  285.    Screen 1
  286.    Home 
  287.    Print "Lightsourcing map                            "
  288.    Screen 0
  289.    For Y=YS To YS+127
  290.       For X=XS To XS+127
  291.          HA=Point(X,Y)
  292.          If HA>7
  293.             If X<126+XS
  294.                HB=(Point(X+1,Y)+Point(X+2,Y))/2
  295.             Else 
  296.                HA=(Point(X-1,Y)+Point(X-2,Y))/2
  297.                HB=Point(X,Y)
  298.             End If 
  299.             If Y<126+YS
  300.                HC=(Point(X,Y+1)+Point(X,Y+2))/2
  301.             Else 
  302.                HA=(Point(X,Y-1)+Point(X,Y-2))/2
  303.                HC=Point(X,Y)
  304.             End If 
  305.             HMED=26
  306.             H=HMED
  307.             If HB>HA
  308.                Inc H
  309.                Inc H
  310.             End If 
  311.             If HB<HA
  312.                Dec H
  313.                Dec H
  314.             End If 
  315.             If HC>HA
  316.                Inc H
  317.                Inc H
  318.             End If 
  319.             If HC<HA
  320.                Dec H
  321.                Dec H
  322.             End If 
  323.             If H<HMED-2
  324.                H=HMED-2
  325.             End If 
  326.             If H>HMED+2
  327.                H=HMED+2
  328.             End If 
  329.             Plot X-XS+XF,Y-YS+YF,H
  330.          Else 
  331.             Plot X-XS+XF,Y-YS+YF,HA
  332.          End If 
  333.       Next X
  334.    Next Y
  335. End Proc
  336. Procedure MC_RIP
  337.    '
  338.    ' Removes Isolated Pixels from map 
  339.    '
  340.    ' A pixel is assumed isolated if it does not exhibit 4-connectivity
  341.    '
  342.    ' There are two checks, one for water and one for land pixels. If a land 
  343.    ' pixel is isolated it is set to water. If a water pixel is isolated 
  344.    ' it is set to the average of the surrounding 4-connectivity pixels
  345.    '
  346.    Screen 1
  347.    Home 
  348.    Print "Removing Isolated Points"
  349.    Screen 0
  350.    For Y=1 To 126
  351.       For X=1 To 126
  352.          PIXEL=Point(X,Y)
  353.          PIX_UP=Point(X,Y-1)
  354.          PIX_DOWN=Point(X,Y+1)
  355.          PIX_LEFT=Point(X-1,Y)
  356.          PIX_RIGHT=Point(X+1,Y)
  357.          PIX_AVG=(PIX_LEFT+PIX_RIGHT+PIX_UP+PIX_DOWN)/4
  358.          If PIXEL>7
  359.             If PIX_UP<8 and PIX_DOWN<8 and PIX_LEFT<8 and PIX_RIGHT<8
  360.                Plot X,Y,PIX_AVG
  361.             End If 
  362.          Else 
  363.             If PIX_UP>7 and PIX_DOWN>7 and PIX_LEFT>7 and PIX_RIGHT>7
  364.                Plot X,Y,PIX_AVG
  365.             End If 
  366.          End If 
  367.       Next X
  368.    Next Y
  369. End Proc