home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / prolog68 / worm.pl < prev    next >
Encoding:
Text File  |  1993-10-23  |  5.3 KB  |  206 lines
  1. %         Demonstrationsprogramm für Prolog-68
  2. %
  3. %         Copyright © 1990,91,92 Jens Kilian.
  4. %
  5. %
  6. %         Start mit      | ?- worm.
  7. %
  8. %         Steuerung über Tasten 2, 4, 6, 8; Abbruch mit Taste 'q'
  9.  
  10. worm :-
  11.    recorda(score, 0, _),
  12.    randomize,
  13.    screen_init,
  14.    display_frame,
  15.    make_worm(Worm\End),
  16.    display_worm(Worm),
  17.    make_cookie(Cookie, Worm),
  18.    display_cookie(Cookie),
  19.    initial_delay(Delay),
  20.    get_initial_direction(Dir),
  21.    if_exception(Tag,
  22.                 worm(Worm\End, Delay, 0, Cookie, Dir),
  23.                 stop_action(Tag)
  24.                ).
  25.  
  26. stop_action(Message) :-
  27.    revon,
  28.    display(Message),
  29.    revoff,
  30.    wait_for_space,
  31.    screen_exit,
  32.    recorded(score, Score, Ref),
  33.    erase(Ref),
  34.    display('Ihre Punktzahl war '),
  35.    display(Score),
  36.    nl.
  37.  
  38. worm(Worm, Delay, Grow, Cookie, Dir) :-
  39.    delay(Delay),
  40.    new_direction(Dir, NewDir),
  41.    move_worm(NewDir, Grow, Worm, Grow1, NewWorm),
  42.    check_collision(NewWorm,
  43.                    Cookie, Delay, Grow1,
  44.                    NewCookie, NewDelay, NewGrow
  45.                   ), !,
  46.    worm(NewWorm, NewDelay, NewGrow, NewCookie, NewDir).
  47.  
  48. move_worm(Dir, 0, [(X, Y) | Worm]\[(XH, YH) | NewHead], 0, Worm\NewHead) :- !,
  49.    move(Dir, XH, YH, XH1, YH1, HC),
  50.    NewHead = [(XH1, YH1) | NewEnd],
  51.    put_at(X, Y, 0' ),
  52.    put_at(XH, YH, 0'O),
  53.    put_at(XH1, YH1, HC).
  54. move_worm(Dir, N, Worm\[(XH, YH) | NewHead], N1, Worm\NewHead) :-
  55.    move(Dir, XH, YH, XH1, YH1, HC),
  56.    NewHead = [(XH1, YH1) | NewEnd],
  57.    N1 is N - 1,
  58.    put_at(XH, YH, 0'O),
  59.    put_at(XH1, YH1, HC).
  60.  
  61. move(0'8, XH, YH, XH, YH1, 0'^) :- YH1 is YH - 1.
  62. move(0'6, XH, YH, XH1, YH, 0'>) :- XH1 is XH + 1.
  63. move(0'4, XH, YH, XH1, YH, 0'<) :- XH1 is XH - 1.
  64. move(0'2, XH, YH, XH, YH1, 0'V) :- YH1 is YH + 1.
  65.  
  66. %  Collision detection
  67.  
  68. check_collision(Worm\[(XH, YH) | End],
  69.                 Cookie, Delay, Grow,
  70.                 NewCookie, NewDelay, NewGrow
  71.                ) :-
  72.    check_cookie_collision(XH, YH, Worm,
  73.                           Cookie, Delay, Grow,
  74.                           NewCookie, NewDelay, NewGrow
  75.                          ),
  76.    check_frame_collision(XH, YH),
  77.    check_body_collision(Worm, XH, YH).
  78.  
  79. check_cookie_collision(X, Y, Worm,
  80.                        cookie(X, Y, N), Delay, Grow,
  81.                        NewCookie, NewDelay, NewGrow
  82.                       ) :- !,
  83.    update_score(N),
  84.    NewGrow is Grow + N,
  85.    make_cookie(NewCookie, Worm),
  86.    display_cookie(NewCookie),
  87.    speedup(Delay, N, NewDelay).
  88. check_cookie_collision(_, _, _, Cookie, Delay, Grow, Cookie, Delay, Grow).
  89.  
  90. check_frame_collision(XH, YH) :- 0 < XH, XH < 79, 0 < YH, YH < 24, !.
  91. check_frame_collision(XH, YH) :- signal_exception('Crash !').
  92.  
  93. check_body_collision([(XH, YH) | End], XH, YH) :-
  94.    var(End), !.
  95. check_body_collision([(XH, YH) | _], XH, YH) :-
  96.    signal_exception('Ouch !').
  97. check_body_collision([_ | Worm], XH, YH) :-
  98.    check_body_collision(Worm, XH, YH).
  99.  
  100. %  Input routines
  101.  
  102. get_initial_direction(Dir) :-
  103.    biosget0(Dir),
  104.    legal_direction(Dir), !.
  105. get_initial_direction(Dir) :-
  106.    get_initial_direction(Dir).
  107.  
  108. new_direction(Dir, NewDir) :-
  109.    biosstat,
  110.    biosget0(NewDir),
  111.    legal_direction(NewDir), !.
  112. new_direction(Dir, Dir).
  113.  
  114. legal_direction(0'2).
  115. legal_direction(0'4).
  116. legal_direction(0'6).
  117. legal_direction(0'8).
  118. legal_direction(0'q) :- signal_exception('Quit.').
  119.  
  120. wait_for_space :- biosget0(0' ), !.
  121. wait_for_space :- wait_for_space.
  122.  
  123. %  Output routines
  124.  
  125. screen_init :-
  126.    biosput(27), biosput(0'E),
  127.    biosput(27), biosput(0'f),
  128.    biosput(27), biosput(0'w).
  129.  
  130. screen_exit :-
  131.    biosput(27), biosput(0'E),
  132.    biosput(27), biosput(0'e),
  133.    biosput(27), biosput(0'v).
  134.  
  135. revon :-  biosput(27), biosput(0'p).
  136. revoff :- biosput(27), biosput(0'q).
  137.  
  138. display_frame :-
  139.    display_h(0),
  140.    display_v(0).
  141.  
  142. display_h(80) :- !.
  143. display_h(N) :-
  144.    put_at(N, 0, 0'*),
  145.    put_at(N, 24, 0'*),
  146.    N1 is N + 1,
  147.    display_h(N1).
  148.  
  149. display_v(25) :- !.
  150. display_v(N) :-
  151.    put_at(0, N, 0'*),
  152.    put_at(79, N, 0'*),
  153.    N1 is N + 1,
  154.    display_v(N1).
  155.  
  156. display_worm([(X, Y) | End]) :- var(End), !, put_at(X, Y, 0'#).
  157. display_worm([(X, Y) | W]) :- put_at(X, Y, 0'O), display_worm(W).
  158.  
  159. display_cookie(cookie(X, Y, N)) :-
  160.    C is N + 48,
  161.    put_at(X, Y, C).
  162.  
  163. put_at(X, Y, C) :-
  164.    X1 is X + 32, Y1 is Y + 32,
  165.    biosput(27), biosput(0'Y), biosput(Y1), biosput(X1), biosput(C).
  166.  
  167. update_score(N) :-
  168.    recorded(score, Score, Ref),
  169.    erase(Ref),
  170.    NewScore is Score + N,
  171.    recorda(score, NewScore, _),
  172.    put_at(0, 0, 0'*),
  173.    revon,
  174.    display(NewScore),
  175.    revoff,
  176.    fail.                      % get rid of references ...
  177. update_score(_).
  178.  
  179. %  Initialization
  180.  
  181. make_worm([(5, 5), (5, 6), (5, 7), (5, 8), (5, 9) | Head]\Head) :-
  182.    Head = [(5, 10) | WormEnd].
  183.  
  184. make_cookie(cookie(X, Y, N), Worm) :-
  185.    random(1, 78, X),
  186.    random(1, 23, Y),
  187.    check_cookie_position(Worm, X, Y), !,
  188.    random(1, 9, N).
  189. make_cookie(Cookie, Worm) :- make_cookie(Cookie, Worm).
  190.  
  191. check_cookie_position(End, _, _) :- var(End), !.
  192. check_cookie_position([(X, Y) | Worm], X, Y) :- !, fail.
  193. check_cookie_position([(X, Y) | Worm], XC, YC) :-
  194.    check_cookie_position(Worm, XC, YC).
  195.  
  196. initial_delay(160).
  197.  
  198. %  Game speed
  199.  
  200. delay(0) :- !.
  201. delay(N) :- N1 is N - 1, delay(N1).
  202.  
  203. speedup(Delay, N, 0)    :- Delay =< 3 * N, !.
  204. speedup(Slow,  N, Fast) :- Fast is Slow - 3 * N.
  205.  
  206.