Several scripts

[Lost in Nowhere]

So, I've made a bunch of scripts of varying usefulness, and I figured I might as well share them for everyone's use.

Images
Makes a chain of images from the current position to the specified cell coordinates.

ImageChain

# Author: Lost in Nowhere
# ------------------------------------------

$Image:""
$ImageWidth:1.0
$ImageHeight:1.0
$ImageZ:-0.5

$TargetX:0.0
$TargetY:0.0

once
   0 ->num
endonce

<-num ->prevnum
CurrentPixelCoords 8.0 div MapHeight sub neg ->cy 8.0 div ->cx
<-cx <-cy <-TargetX <-TargetY Distance dup ->Dist <-ImageWidth 3 mul div ceil ->num
<-TargetY <-cy sub <-TargetX <-cx sub atan2 neg ->angle
<-cy <-TargetY sub <-Dist div ->dy
<-TargetX <-cx sub <-Dist div ->dx


<-num 0 do
   I Trace
   Self "I" I concat <-Image SetImage
   Self "I" I concat <-ImageWidth <-ImageHeight SetImageScale
   Self "I" I concat <-angle SetImageRotation
   I .5 add <-ImageWidth 3 mul mul 8 mul ->l
   Self "I" I concat <-dx <-l mul <-dy <-l mul <-ImageZ SetImagePosition
loop

<-prevnum <-num gt if <-prevnum <-num do
   Self "I" I concat "NONE" Setimage
loop endif

[close]

Same as above, but stretches a single image between the points.

ImageScale

# Author: Lost in Nowhere
# ------------------------------------------

$Image:""
$ImageZ:-0.5
$ImageHeight:1.0

$TargetX:0.0
$TargetY:0.0

once
   Self "ISImage" <-Image SetImage
endonce


CurrentPixelCoords 8.0 div MapHeight sub neg ->cy 8.0 div ->cx
<-cx <-cy <-TargetX <-TargetY Distance 3 div ->Scale
<-TargetY <-cy sub <-TargetX <-cx sub atan2 neg ->angle
<-cy <-TargetY sub 4 mul ->dy
<-TargetX <-cx sub 4 mul ->dx

Self "ISImage" <-Scale <-ImageHeight SetImageScale
Self "ISImage" <-angle SetImageRotation
Self "ISImage" <-dx <-dy <-ImageZ SetImagePosition

[close]

Terrain
A rather simple algorithm for generating terrain.

RandomTerrain

# Author: Lost in Nowhere
# ------------------------------------------

$MinEffect:-0.5
$MaxEffect:1.5
$MinRadius:5
$MaxRadius:20
$Default:5.0
$Iterations:150

$Seed:12345

once
   <-Seed ->randSeed
   0 ->row
   0 ->count
   
   MapHeight 0 do
      MapWidth 0 do
          <-Default asfloat "x" I concat "y" J concat concat ->!
      loop
   loop
endonce

<-count <-Iterations lt if
   0 MapWidth @RandIntRange ->xc
   0 MapHeight @RandIntRange ->yc
   <-MinEffect <-MaxEffect @RandFloatRange ->t
   <-MinRadius <-MaxRadius @RandIntRange ->r
   <-yc <-r add 1 add <-yc <-r sub do
      <-xc <-r add 1 add <-xc <-r sub do
         I J <-xc <-yc Distance <-r lte if
            I J <-t @AddTerrain
         endif
      loop
   loop
   <-count 1 add ->count
else
   <-row MapHeight lt if
      MapWidth 0 do
         I <-row dup2 @GetTerrain 0 max 10 min SetTerrain
      loop
      <-row 1 add ->row
   endif
endif

:AddTerrain # x y t --
   ->atT ->atY ->atX
   <-atX 0 gte and (<-atX MapWidth lt) and (<-atY 0 gte and (<-atY MapHeight lt)) if
      "x" <-atX concat "y" <-atY concat concat ->atS
      <-atS <-! <-atT add <-atS ->!
   endif
   
:GetTerrain # x y -- i
   ->gtY ->gtX
   "x" <-gtX concat "y" <-gtY concat concat <-! 0 Round

:RandFloat
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div

:RandFloatRange
   ->rimax ->rimin
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div <-rimax <-rimin sub mul <-rimin add
   
:RandIntRange
   ->rimax ->rimin
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div <-rimax <-rimin sub mul <-rimin add floor

[close]

Pixellates the terrain; idea from J's map "Beam".

Pixellate

# Author: Lost in Nowhere
# ------------------------------------------

$CellSize:3

once
   0 ->row
endonce

<-row MapHeight <-CellSize div lt if
   MapWidth <-CellSize div 0 do
      0
      <-CellSize 0 do
         <-CellSize 0 do
            I K <-CellSize mul add J <-row <-CellSize mul add GetTerrain add
         loop
      loop
      <-CellSize dup mul asfloat div 0 Round asint ->t
      <-CellSize 0 do
         <-CellSize 0 do
            I K <-CellSize mul add J <-row <-CellSize mul add <-t SetTerrain
         loop
      loop
   loop
   <-row 1 add ->row
endif

[close]

Like the above, but simply generates it randomly.

RandSquares

# Author: Lost in Nowhere
# ------------------------------------------

$BoxSize:3
$Seed:182984

once
   <-Seed ->randSeed
   0 ->row
endonce

<-row MapHeight <-BoxSize div lt if
   MapWidth <-BoxSize div 0 do
      @RandTerrHeight ->t
      <-BoxSize 0 do
         <-BoxSize 0 do
            I K <-BoxSize mul add J <-BoxSize <-row mul add <-t SetTerrain
         loop
      loop
   loop
   <-row 1 add ->row
endif

:RandTerrHeight
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div 10 mul ceil asint

[close]

Same as the above, but has only the specified probability of generating a square in any given "cell".

SparseSquares

# Author: Lost in Nowhere
# ------------------------------------------

$BoxSize:3
$Seed:182984
$Chance:0.5

once
   <-Seed ->randSeed
   0 ->row
endonce

<-row MapHeight <-BoxSize div lt if
   MapWidth <-BoxSize div 0 do
      @RandFloat <-Chance lte if
         @RandTerrHeight ->t
         <-BoxSize 0 do
            <-BoxSize 0 do
               I K <-BoxSize mul add J <-BoxSize <-row mul add <-t SetTerrain
            loop
         loop
      endif
   loop
   <-row 1 add ->row
endif

:RandTerrHeight
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div 10 mul ceil asint

:RandFloat
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div

[close]

Smooths the terrain of the entire map; areas outside the map are assumed to be the specified height.

Smooth

# Author: Lost in Nowhere
# ------------------------------------------

$Passes:3
$Radius:2.0
$DefaultTerrain:1.0

once
   0 ->pass
   -1 ->row
endonce

<-pass <-Passes lt if
   <-row 0 lt if
      MapHeight 0 do
         MapWidth 0 do
            I J GetTerrain "X" I concat "Y" J concat concat ->!
         loop
      loop
   else
      <-row MapHeight lt if
         MapWidth 0 do
            I <-row I <-row @AverageNearTerrain SetTerrain
         loop
      else
         <-pass 1 add ->pass
         -2 ->row
      endif
   endif
   <-row 1 add ->row
endif

:GetOldTerr
   ->gotY ->gotX
   "X" <-gotX concat "Y" <-gotY concat concat dup -?! if <-! else pop <-DefaultTerrain endif

:AverageNearTerrain
   ->antY ->antX
   0 0
   1 <-Radius add <-Radius neg do
      1 <-Radius add <-Radius neg do
         swap <-antX I add <-antY J add @GetOldTerr add swap 1 add
      loop
   loop
   div 0 Round

[close]

Same as the above, except that it simply ignores areas off of the map.

Smooth-NoEdges

# Author: Lost in Nowhere
# ------------------------------------------

$Passes:3
$Radius:2.0

once
   0 ->pass
   -1 ->row
endonce

<-pass <-Passes lt if
   <-row 0 lt if
      MapHeight 0 do
         MapWidth 0 do
            I J GetTerrain "X" I concat "Y" J concat concat ->!
         loop
      loop
   else
      <-row MapHeight lt if
         MapWidth 0 do
            I <-row I <-row @AverageNearTerrain SetTerrain
         loop
      else
         <-pass 1 add ->pass
         -2 ->row
      endif
   endif
   <-row 1 add ->row
endif

:GetOldTerr
   ->gotY ->gotX
   "X" <-gotX concat "Y" <-gotY concat concat dup -?! if <-! else pop -10 endif

:AverageNearTerrain
   ->antY ->antX
   0 0
   1 <-Radius add <-Radius neg do
      1 <-Radius add <-Radius neg do
         swap <-antX I add <-antY J add @GetOldTerr dup -5 gt if add swap 1 add else pop swap endif
      loop
   loop
   div 0 Round

[close]

Same, but only applies to the specified portion of the map.

SmoothArea

# Author: Lost in Nowhere
# ------------------------------------------

$Passes:3
$Radius:2.0
$DefaultTerrain:1.0
$x_1:0
$y_1:0
$x_2:1
$y_2:1

once
   0 ->pass
   -1 ->row
   <-x_1 ->X1
   <-y_1 ->Y1
   <-x_2 1 add ->X2
   <-y_2 1 add ->Y2
endonce

<-pass <-Passes lt if
   <-row 0 lt if
      <-Y2 <-Radius add MapHeight min <-Y1 <-Radius sub 0 max do
         <-X2 <-Radius add MapWidth min <-X1 <-Radius sub 0 max do
            I J GetTerrain "X" I concat "Y" J concat concat ->!
         loop
      loop
   else
      <-row <-Y2 <-Y1 sub lt if
         <-X2 <-X1 do
            I <-Y1 <-row add dup2 @AverageNearTerrain SetTerrain
         loop
      else
         <-pass 1 add ->pass
         -2 ->row
      endif
   endif
   <-row 1 add ->row
endif

:GetOldTerr
   ->gotY ->gotX
   "X" <-gotX concat "Y" <-gotY concat concat dup -?! if <-! else pop <-DefaultTerrain endif

:AverageNearTerrain
   ->antY ->antX
   0 0
   1 <-Radius add <-Radius neg do
      1 <-Radius add <-Radius neg do
         swap <-antX I add <-antY J add @GetOldTerr add swap 1 add
      loop
   loop
   div 0 Round

[close]

Smooths the edges using the median (by default parameters) instead of the mean as with the above, creating smoother edges without the small areas of intermediate terrain level that frequently occur with the above scripts.

SmoothEdges

#Author: Lost in Nowhere
#--------------------

$Radius:2.0
$Weight:0.5

once
   -1 ->row
endonce

<-row 0 lt if
   MapHeight 0 do
      MapWidth 0 do
         I J GetTerrain "X" I concat "Y" J concat concat ->!
      loop
   loop
else
   <-row MapHeight lt if
      MapWidth 0 do
         I <-row dup2 @MedianNearTerrain SetTerrain
      loop
   endif
endif
<-row 1 add ->row

:GetOldTerr
   ->gotY ->gotX
   "X" <-gotX concat "Y" <-gotY concat concat dup -?! if <-! else pop -10 endif
   
:MedianNearTerrain
   ->mntY ->mntX
   0.0 ->c
   11 0 do 0 "n" I concat ->! loop
   1 <-Radius add <-Radius neg do
      1 <-Radius add <-Radius neg do
         <-mntX I add <-mntY J add @GetOldTerr dup -1 gte if 0 max ->num
            "n" <-num concat <-! 1 add "n" <-num concat ->!
            <-c <-Weight add ->c
         else
            pop
         endif
      loop
   loop
   0 ->index
   while <-c 0 gt repeat
      <-c "n" <-index concat <-! gt if
         <-c "n" <-index concat <-! sub ->c
         <-index 1 add ->index
      else
         0 ->c
      endif
   endwhile
   <-index

[close]

Same as the above, but the point used as the "median" is randomized between the parameters.

SmoothEdgesRandom

#Author: Lost in Nowhere
#--------------------

$Radius:2.0
$minWeight:0.4
$maxWeight:0.6
$Seed:12345

once
   -1 ->row
   <-Seed ->randSeed
endonce

<-row 0 lt if
   MapHeight 0 do
      MapWidth 0 do
         I J GetTerrain "X" I concat "Y" J concat concat ->!
      loop
   loop
else
   <-row MapHeight lt if
      MapWidth 0 do
         I <-row dup2 @MedianNearTerrain SetTerrain
      loop
   endif
endif
<-row 1 add ->row

:GetOldTerr
   ->gotY ->gotX
   "X" <-gotX concat "Y" <-gotY concat concat dup -?! if <-! else pop -10 endif
   
:MedianNearTerrain
   ->mntY ->mntX
   0.0 ->c
   11 0 do 0 "n" I concat ->! loop
   1 <-Radius add <-Radius neg do
      1 <-Radius add <-Radius neg do
         <-mntX I add <-mntY J add @GetOldTerr dup -1 gte if 0 max ->num
            "n" <-num concat <-! 1 add "n" <-num concat ->!
            <-c @RandWeight add ->c
         else
            pop
         endif
      loop
   loop
   0 ->index
   while <-c 0 gt repeat
      <-c "n" <-index concat <-! gt if
         <-c "n" <-index concat <-! sub ->c
         <-index 1 add ->index
      else
         0 ->c
      endif
   endwhile
   <-index
   
:RandWeight
   <-randSeed mul (7204987) mod (2147483647) ->randSeed
   <-randSeed abs 2147483647.0 div <-maxWeight <-minWeight sub mul <-minWeight add

[close]

Re-sizes the specified section of terrain to a new area. Increasing the size tends to lead to pixellation.

Resize

# Author: Lost in Nowhere
# ------------------------------------------

$OldX1:0
$OldY1:0
$OldX2:0
$OldY2:0
$NewX1:0
$NewY1:0
$NewX2:0
$NewY2:0

once
   <-OldX1 ->OX1
   <-OldY1 ->OY1
   <-NewX1 ->NX1
   <-NewY1 ->NY1
   <-OldX2 1 add ->OX2
   <-OldY2 1 add ->OY2
   <-NewX2 1 add ->NX2
   <-NewY2 1 add ->NY2
   -1 ->row
endonce

<-row 0 lt if
   <-OY2 <-OY1 do
      <-OX2 <-OX1 do
         I J GetTerrain "X" I concat "Y" J concat concat ->!
      loop
   loop
else
   <-row <-NY2 sub(<-NY1) lt if
      <-NX2 <-NX1 do
         I <-row @GetScaledPosition 0 Round ->oy 0 Round ->ox
         I <-row "X" <-ox concat "Y" <-oy concat concat <-! SetTerrain
      loop
   endif
endif
<-row 1 add ->row

:GetScaledPosition
   ->y ->x
   <-x <-NX1 sub <-OX2 <-OX1 sub mul <-NX2 <-NX1 sub div <-OX1 add ->NewX
   <-y <-NY1 sub <-OY2 <-OY1 sub mul <-NY2 <-NY1 sub div <-OY1 add ->NewY
   <-NewX <-NewY

[close]

Scales terrain values between the first pair of specified values to be between the latter pair.

ScaleTerrain

# Author: Lost in Nowhere
# ------------------------------------------

$OldMin:1.0
$OldMax:2.0
$NewMin:1.0
$NewMax:2.0

once
   0 ->row
endonce

<-row MapHeight lt if
   MapWidth 0 do
      I <-row GetTerrain ->t
      <-t <-OldMin sub <-OldMax sub(<-OldMin) asfloat div <-NewMax sub(<-NewMin) mul 0 Round asint <-NewMin add ->nt
      I <-row <-nt SetTerrain
   loop
   <-row 1 add ->row
endif

[close]

If I make any more I feel are particularly noteworthy, I'll add them here.