home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / general / landscape.amos / landscape.amosSourceCode
Encoding:
AMOS Source Code  |  1990-08-11  |  2.6 KB  |  117 lines
  1. Screen Close 0
  2. Screen Open 0,320,256,32,Lowres
  3. Flash Off 
  4. Curs Off 
  5. Palette $0,$FFF,$EEE,$DDD,$CCC,$CAA,$A77,$952,$741,$550,$380,$2A1,$1B1,$1F5,$1F4,$2F2,$4F0,$4F2,$4F4,$4E4,$6E3,$8E2,$AE1,$EE1,$FF1,$399,$14F,$2F,$C,$B,$A,$9
  6. Paper 0
  7. Cls 
  8. Dim A(32,32)
  9. Repeat 
  10. Input "Default landscape ruggedness (0-9) :";RUG
  11. Until RUG>0 or RUG<9
  12. For F=1 To 32
  13. For N=1 To 32
  14. A(F,N)=(32-F)-N*2+(Rnd(RUG))
  15. Next N
  16. Next F
  17. Global X,Y,MR,R,S,STX,STY,DEV,A()
  18. Do 
  19.    Cls 
  20.    Pen 9
  21.    Centre "MAIN MENU"
  22.    Print 
  23.    Print 
  24.    Pen 5
  25.    Print "          1) Load landscape"
  26.    Pen 6
  27.    Print "          2) Save landscape"
  28.    Pen 7
  29.    Print "          3) Edit landscape"
  30.    Pen 8
  31.    Print "          4) View landscape"
  32.    Repeat 
  33.       A$=Inkey$
  34.    Until Val(A$)>=1 and Val(A$)<=4
  35.    A=Val(A$)
  36.    If A=3 Then ED
  37.    If A=4 Then Cls : SCAPE
  38. Loop 
  39. Procedure ED
  40.    Cls 
  41.    For F=1 To 32
  42.       For N=1 To 30
  43.          Locate F-1,N-1
  44.          Paper 31-A(N,F)
  45.          If A(F,N)>31 Then Paper 1
  46.          Print " ";
  47.       Next N
  48.    Next F
  49.    X=0 : Y=0
  50.    Do 
  51.       Locate Y,X
  52.       Print "#"
  53.       Repeat 
  54.          A$=Inkey$
  55.          OX=X : OY=Y
  56.          If A$="8" and X>0 Then X=X-1
  57.          If A$="2" and X<29 Then X=X+1
  58.          If A$="4" and Y>0 Then Y=Y-1
  59.          If A$="6" and Y<31 Then Y=Y+1
  60.          If A$="9" and A(X+1,Y+1)<30 Then A(X+1,Y+1)=A(X+1,Y+1)+1 : Paper A(X+1,Y+1)
  61.          If A$="3" and A(X+1,Y+1)>0 Then A(X+1,Y+1)=A(X+1,Y+1)-1 : Paper A(X+1,Y+1)
  62.          If A$="(" Then A(X+1,Y+1)=0
  63.          If A$=")" Then A(X+1,Y+1)=8
  64.          If A$="/" Then A(X+1,Y+1)=16
  65.          If A$="*" Then A(X+1,Y+1)=24
  66.          If A$="q" Then Paper 0 : Pop Proc
  67.       Until A$<>""
  68.       Locate Y,X
  69.       Paper 31-A(X+1,Y+1) : Print " "
  70.       Locate OY,OX
  71.       Paper 31-A(OX+1,OY+1) : Print " "
  72.    Loop 
  73.    End 
  74. End Proc
  75. Procedure SCAPE
  76.    X=2
  77.    Y=2
  78.    MR=100
  79.    R=MR
  80.    S=100
  81.    STX=10
  82.    STY=5
  83.    DEV=-7
  84.    Do 
  85.       CONSTRUCT
  86.       Repeat 
  87.          A$=Inkey$
  88.          FLAG=0
  89.          If A$="2" and X<21 Then X=X+1 : FLAG=1
  90.          If A$="8" and X>1 Then X=X-1 : FLAG=1
  91.          If A$="4" and Y>1 Then Y=Y-1 : FLAG=1
  92.          If A$="6" and Y<21 Then Y=Y+1 : FLAG=1
  93.          If A$="q" Then Pop Proc
  94.          MR=100 : R=MR : S=100
  95.       Until FLAG=1
  96.       Cls 
  97.    Loop 
  98. End Proc
  99. Procedure CONSTRUCT
  100.    Bell 
  101.    For XX=X To X+10
  102.       For YY=Y To Y+10
  103.          R=R+STX
  104.          Ink 31-A(XX,YY)
  105.          If A(XX,YY)>30 Then Ink 1
  106.          If A(XX,YY)<1 Then Ink 31
  107.          Plot R,S-(A(XX,YY)*3)
  108.          MM=A(XX,YY+1)
  109.          Draw R,S-(A(XX,YY)*3) To R+STX,S-(MM*3)
  110.          MM=A(XX+1,YY)
  111.          Draw R,S-(A(XX,YY)*3) To R+DEV,S-(MM*3)+STY
  112.       Next YY
  113.       MR=MR+DEV
  114.       R=MR
  115.       S=S+STY
  116.    Next XX
  117. End Proc