home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / authors / stephan_scholz / party.amos / party.amosSourceCode
AMOS Source Code  |  1986-08-03  |  7KB  |  204 lines
  1. '
  2. '  ************************************************************  
  3. '  * LA OROYA                           Stephan Scholz - 1993 *  
  4. '  *                     >>> PARTY <<<                        *    
  5. '  *                                                          *
  6. '  * Different affinity factors determine the behaviour of    *
  7. '  * members in a group. They move around seeking the least   *    
  8. '  * uncomfortable position, i.e. the closest to their ideal  *  
  9. '  * situation with regard to everyone else in the group (and *
  10. '  * to a food table in the middle of a room).                *  
  11. '  *                                                          *
  12. '  * Alter the preference settings at the bottom right of the *  
  13. '  * screen with the left or right mouse buttons, and watch   *    
  14. '  * the effects on the behaviour of the pieces.              *
  15. '  *                                                          *
  16. '  * The bottom left numbers are the (un)happiness values for *
  17. '  * the pieces' position and N,S,E,W surrounding squares.    *
  18. '  *                                                          *
  19. '  * Pieces A, B and C can also be placed manually while the  *
  20. '  * programme is running.                                    *
  21. '  *                                                          *
  22. '  ************************************************************
  23. '
  24. Set Buffer 50
  25. Screen Open 1,640,350,16,Hires
  26. Limit Mouse 130,56 To 440,279
  27. Curs Off : Paper 0 : Cls 0
  28. '80 chars wide (0 to 79) 
  29. '32 chars high (0 to 31) 
  30. QUAN=7
  31. Dim PERSON$(QUAN)
  32. Dim XPOS(QUAN)
  33. Dim YPOS(QUAN)
  34. Dim PREF(QUAN,QUAN)
  35. Dim DIST(QUAN,QUAN)
  36. Dim DIFF(QUAN,QUAN)
  37. 'this leaves room for data bottomscreen. 
  38. YY=22
  39. XX=79
  40. 'matrix for happiness in 1-actual position, or one square
  41. '2-North,3-South,4-East,5-West, and 6-movement decision  
  42. Dim HAPPY(QUAN,6)
  43. '
  44. 'this sets default distance preferences to other pieces  
  45. Restore DATOS
  46. For N=1 To QUAN-1
  47.    For M=1 To QUAN
  48.       Read A
  49.       PREF(N,M)=A
  50.    Next M
  51. Next N
  52. DATOS:
  53. Data 0,1,1,1,1,1,1
  54. Data 20,0,20,20,20,20,3
  55. Data 1,20,0,20,20,20,9
  56. Data 1,20,1,0,9,15,11
  57. Data 1,20,1,9,0,1,13
  58. Data 1,20,1,15,1,0,2
  59. '
  60. 'Las value in each line is the affinity to the food table in 
  61. 'the centre of the room. 
  62. 'These default settings make A like everyone, and everyone   
  63. 'but everyone likes A except B, who hates everyone.
  64. 'Also, everyone hates B. 
  65. 'Then, everyone loves C but C doesn't like anyone except A.          
  66. '
  67. 'The following gives random starting positions leaving a one 
  68. 'square fringe free for calculations to stay in matrix when      
  69. 'program looks at squares around a piece.
  70. For N=1 To QUAN-1
  71.    XPOS(N)=Rnd(XX-1)+1
  72.    YPOS(N)=Rnd(YY-1)+1
  73. Next N
  74. 'Table:
  75. XPOS(7)=32
  76. YPOS(7)=10
  77. Locate 0,23
  78. Paper 7 : Pen 4
  79. Print "Who? Pos N   S   E   W  To?   A   B   C   D   E   F   T "
  80. Paper 0 : Pen 2
  81. '
  82. Do 
  83. Pen 2
  84.    'measurese distances from each piece, (except table)   
  85.    For N=1 To QUAN-1
  86.       'and from positions surrounding each piece,  
  87.       For P=1 To 5
  88.          HAPPY(N,P)=0
  89.          'to every other piece (including table).   
  90.          For M=1 To QUAN
  91.             If N=M Then Goto PAP
  92.             X=XPOS(N)
  93.             If P=4 Then X=XPOS(N)-1
  94.             If P=5 Then X=XPOS(N)+1
  95.             X1=XPOS(M)
  96.             X2=Abs(X-X1)
  97.             Y=YPOS(N)
  98.             If P=2 Then Y=YPOS(N)-1
  99.             If P=3 Then Y=YPOS(N)+1
  100.             Y1=YPOS(M)
  101.             Y2=Abs(Y-Y1)
  102.             DIST(N,M)=Sqr(X2*X2+Y2*Y2)
  103.             'compare this real distance with the preferred distance  
  104.             DIFF(N,M)=Abs(DIST(N,M)-PREF(N,M))
  105.             'and add it to the overall (un)happiness account of current position 
  106.             Add HAPPY(N,P),DIFF(N,M)
  107.             PAP:
  108.          Next M
  109.       Next P
  110.       '
  111.       'decide whether to move and where: 
  112.       'Happy(n,6) registers: 1=Stay put; 2=N; 3=S; 4=W; 5=E. 
  113.       SEE=400
  114.       HAPPY(N,6)=1
  115.       For S=1 To 5
  116.          'if cornered, seek other movement or stay put. 
  117.          If S=2 and YPOS(N)=0 Then Goto UU
  118.          If S=3 and YPOS(N)=YY Then Goto UU
  119.          If S=4 and XPOS(N)=0 Then Goto UU
  120.          If S=5 and XPOS(N)=XX Then Goto UU
  121.          'if the same value, random one in two chance to movement decision  
  122.          If SEE=HAPPY(N,S) and Rnd(1)=0 Then HAPPY(N,6)=S
  123.          'choose the lowest value 
  124.          If SEE>HAPPY(N,S) Then SEE=HAPPY(N,S) : HAPPY(N,6)=S
  125.          UU:
  126.       Next S
  127.       '
  128.       'erase previous on screen position 
  129.       Locate XPOS(N),YPOS(N)
  130.       Print " "
  131.       If HAPPY(N,6)=2 Then If YPOS(N)>0 Then YPOS(N)=YPOS(N)-1 : Goto TT
  132.       If HAPPY(N,6)=3 Then If YPOS(N)<YY Then YPOS(N)=YPOS(N)+1 : Goto TT
  133.       If HAPPY(N,6)=4 Then If XPOS(N)>0 Then XPOS(N)=XPOS(N)-1 : Goto TT
  134.       If HAPPY(N,6)=5 Then If XPOS(N)<XX Then XPOS(N)=XPOS(N)+1
  135.       TT:
  136.       'print new on screen position
  137.       Locate XPOS(N),YPOS(N)
  138.       Print Chr$(N+64)
  139.    Next N
  140.       'print table 
  141.       Locate XPOS(7),YPOS(7)
  142.       Print Chr$(155);Chr$(156)
  143.    '
  144.    'print happiness index of actual, N, S, E and W  
  145.    'positions and decision taken. 
  146.    For N=1 To QUAN-1
  147. Pen 4
  148.       Locate 1,23+N
  149.       Print Chr$(N+64)
  150.       'the following four lines can be removed to gain speed   
  151.       'if you aren't interested in watching the (un)happiness
  152.       'values change as pieces move around.
  153. Pen 11
  154.       For M=1 To 6
  155.         Locate M*4,23+N
  156.         Print HAPPY(N,M);" "
  157.       Next M
  158.    Next N
  159.    '
  160.    'print preferred distances from each piece (except table)  
  161.    'to each other piece (including table).  
  162.    Pen 15
  163.    For N=1 To QUAN-1
  164.       For M=1 To QUAN
  165.          Locate 25+M*4,23+N
  166.          Print PREF(N,M);" "
  167.       Next M
  168.    Next N
  169.    '
  170.    'The following allows manual intervention to change    
  171.    'preferred distances (by clicking the right or left  
  172.    'mousebutton over the desired value).  
  173.    If Mouse Key<>0
  174.       MX=2*X Text(X Mouse)-32
  175.       MY=Y Text(Y Mouse)-6
  176.       If MY>22
  177.          IY=MY-22
  178.          IX=(MX-25)/4
  179.          If IX<0 : IX=0 : End If 
  180.          If IX>7 : IX=7 : End If 
  181.          If IY<0 : IY=0 : End If 
  182.          If IY>7 : IY=7 : End If 
  183.          If Mouse Key=1
  184.             If PREF(IY,IX)>1 : Dec PREF(IY,IX) : End If 
  185.          End If 
  186.          If Mouse Key=2
  187.             If PREF(IY,IX)=0 : Goto RR : End If 
  188.             If PREF(IY,IX)<85 : Inc PREF(IY,IX) : End If 
  189.          End If 
  190.       RR:
  191.       End If 
  192.       '
  193.       'The following allows the positioning of the pieces A, B and C   
  194.       'while program is running. Just click where on the screen you wish   
  195.       'to put A (left button), B (right button) and C (both buttons).  
  196.       If MY<23
  197.          MK=Mouse Key
  198.          Locate XPOS(MK),YPOS(MK) : Print " "
  199.          XPOS(MK)=MX
  200.          YPOS(MK)=MY
  201.          Locate XPOS(MK),YPOS(MK) : Print Chr$(MK+64)
  202.       End If 
  203.    End If 
  204. Loop