Siegfried-et-le-dragon


This is a Gauche version of the the oo programing tutorial from

 Programmez avec Scheme 
 De la pratique a la théorie
 CHAZARAIN, Jacques
 Thomson Publishing France, 1996
 ISBN 2-84180-131-4

(pages 349-358)

 #!/usr/bin/gosh 
 (use gauche.collection) 
 (use srfi-27) 
 (define-class <element> () 
   ((name :getter name-of :init-keyword :name))) 
 (define-class <room> (<element>)  
   ((south :getter south-of :init-keyword :south) 
    (north :getter north-of :init-keyword :north) 
    (east :getter east-of :init-keyword :east) 
    (west :getter west-of :init-keyword :west))) 
 (define-class <moveable> (<element>)  
   ((location :getter location-of :setter set-location! :init-keyword :location))) 
 (define-class <thing> (<moveable>) 
   ((owner :getter owner-of :setter set-owner! :init-keyword :owner))) 
 (define-class <creature> (<moveable>) 
   ((alive :getter alive? :setter set-alive! :init-keyword :alive))) 
 (define-class <dragon> (<creature>) 
   ()) 
 (define-class <human> (<creature>) 
   ((energy :getter energy-of :setter set-energy! :init-keyword :energy))) 
  
 (define %rooms (make-vector 8)) 
  
 (define Siegfried #f) 
 (define Mime #f) 
 (define Fafner #f) 
  
 (define treasure #f) 
 (define key #f) 
 (define sword #f) 
  
 (define (init) 
   (define (make-room num name N S E W) 
     (vector-set! %rooms num (make <room> :name name :north N :south S :east E :west W))(display ".")) 
   (display "Initialisation des salles.") 
   (make-room 0 "Donjon"        #f  3  1 #f) 
   (make-room 1 "Corridor Nord"  #f  6  2  0) 
   (make-room 2 "Salle de Garde" #f  4 #f  1) 
   (make-room 3 "Corridor ouest"  0  5  4 #f) 
   (make-room 4 "Corridor est"    2  7 #f  3) 
   (make-room 5 "Armurerie"      3  #f  6  #f)   
   (make-room 6 "Corridor Sud"   1  #f  7  5)    
   (make-room 7 "Entree"        4  #f  #f 6) 
   (newline) 
   (display "Initialisation des creatures.") 
   (let ((energy (random-integer 5))) 
     (set! Siegfried (make <human> :name 'Siegfried :alive #t :location 7 :energy (+ energy 6))) 
     (display ".") 
     (set! Mime (make <human> :name 'Mime :alive #t :location 7 :energy (- 10 energy))) 
     (display ".") 
     (set! Fafner (make <dragon> :name 'Fafner :alive #t :location 0)) 
     (display ".")(newline)) 
   (display "Initialisation des objects.") 
   (set! treasure (make <thing> :name 'tresor :owner #f :location 0)) 
   (display ".") 
   (set! key (make <thing> :name 'clef :owner #f :location (random-integer 8))) 
   (display ".") 
   (set! sword (make <thing> :name 'epee :owner #f :location (random-integer 8))) 
   (display ".")(newline)) 
  
 (define-method room ((n <integer>)) (vector-ref %rooms n)) 
  
 (define-method move ((self <creature>) direction) 
   (define (find-location f) 
     (f (room (location-of self)))) 
   (let ((next-room (case direction 
                      ((n) (find-location north-of)) 
                      ((s) (find-location south-of)) 
                      ((e) (find-location east-of)) 
                      ((o) (find-location west-of))))) 
     (if next-room 
         (set-location! self next-room) 
         (display "Pas de porte dans cette direction!\n")) 
     next-room)) 
  
 (define-method room ((n <integer>)) 
   (vector-ref %rooms n)) 
  
 (define-method move ((self <dragon>) direction) 
   (if (alive? self) 
       (begin 
         (next-method) 
         (fight Siegfried) 
         (fight Mime)) 
       (display "le dragon est mort!"))) 
  
 (define-method move ((self <human>) direction) 
   (if (alive? self) 
       (let ((where-i-am (next-method))) 
         (when where-i-am 
           (energy-- self) 
           (for-each  
            (lambda (thing) 
              (if (equal? (name-of self) (owner-of thing)) 
                  (set-location! thing where-i-am))) 
            `(,treasure ,key ,sword))) 
         (fight self)))) 
              
 (define-method energy-- ((self <human>)) 
   (set-energy! self (- (energy-of self) 1)) 
   (if (<= (energy-of self) 0) 
       (die self))) 
  
 (define-method die ((self <creature>)) 
   (set-alive! self #f) 
   (format #t "Mort de ~a~%" (name-of self)) 
   (if (equal? self Siegfried) 
       (end-of-game "Vous avez perdu!"))) 
  
 (define-method fight ((self <human>)) 
   (if (alive? Fafner) 
       (let ((where-i-am (location-of self)) 
             (where-the-dragon-is (location-of Fafner))) 
         (if (equal? where-i-am where-the-dragon-is) 
             (if (eq? self Siegfried) 
                 (if (equal? (owner-of sword) (name-of self)) 
                     (begin 
                       (die Fafner) 
                       (energy-- self) 
                       (energy-- self)) 
                     (die self)) 
                 (die self)))))) 
  
 (define-method take ((self <human>) (object <thing>)) 
   (let ((where-i-am (location-of self)) 
         (where-it-is (location-of object))) 
     (if (and (eq? where-i-am where-it-is) 
              (or (not (equal? treasure object)) 
                  (equal? 'Mime (owner-of object)) 
                  (equal? (name-of self) (owner-of key)))) 
         (begin (set-owner! object (name-of self)) 
                (format #t "~a en posession de ~a~%" (name-of object)(name-of self)) 
                (if (and (equal? treasure object) 
                         (equal? Siegfried self)) 
                    (end-of-game "Vous avez gagne!"))) 
         (energy-- self)))) 
                     
 (define-method display-location-of ((self <creature>)) 
   (format #t "Emplacement de ~a: ~a~%"  
           (name-of self)(name-of (room (location-of self))))) 
 (define-method display-energy-of ((self <human>)) 
   (format #t "Il reste a ~a ~a point~a d'energie~%" 
           (name-of self) 
           (energy-of self) 
           (if (> (energy-of self) 1) "s" ""))) 
  
 (define-method display-inventory-of ((self <human>)) 
   (for-each 
    (lambda(o) 
      (if (eq? (name-of self)  
               (owner-of o)) 
          (format #t "~a en possesion de ~a~%" 
                  (name-of o)(name-of self)))) 
    `(,key ,sword ,treasure))) 
  
 (define (dragon-turn) 
   (if (alive? Fafner) 
       (let ((n (random-integer 5))) 
         (if (= 4 n) 
             (begin (display "Le dragon dort.")(newline)) 
             (move Fafner (vector-ref #(n s e o) n))) 
         (display-location-of Fafner)))) 
                 
 (define (player-turn) 
   (format #t "Personnage qui agit: [S]iegfried ~a~%" 
           (if (alive? Mime) "ou [M]ime" "")) 
   (let* ((k (read)) 
          (perso (if (or (equal? 'S k)(equal? 's k)) Siegfried Mime))) 
     (display "Action: [N]ord [S]ud [E]st [O]uest [C]lef [T]resor e[P]ee [V]oir [Q]uitter")(newline) 
     (let ((action (read))) 
       (case action 
         ((n N) (move perso 'n)) 
         ((s S) (move perso 's)) 
         ((e E) (move perso 'e)) 
         ((o O) (move perso 'o)) 
         ((c C) (take perso key)) 
         ((t T) (take perso treasure)) 
         ((p P) (take perso sword)) 
         ((v V) (let ((where-i-am (location-of perso))) 
                      (for-each 
                       (lambda (o) 
                         (format #t "~a: ~a dans cette salle~%" 
                                 (name-of o) 
                                 (if (= (location-of o)(location-of perso)) 
                                     "est" "n'est pas"))) 
                       `(,key ,treasure ,sword)))) 
         ((q Q) (end-of-game "Bye!")) 
         (else "Action inconue"))))) 
          
  
 (define-method status ((self <human>)) 
   (if (alive? self) 
       (begin 
         (display-location-of self) 
         (display-energy-of self) 
         (display-inventory-of self)))) 
  
 (define (end-of-game message) 
   (display message)(newline) 
   (display "[R]ejouer ou [Q]uitter le programme.")(newline) 
   (let ((action (read))) 
     (case action 
       ((r R) (main)) 
       ((q Q) (exit)) 
       (else (end-of-game "Commande invalide"))))) 
    
 (define (main . args) 
   (define turn-number 0) 
   (define (new-turn) 
     (inc! turn-number) 
     (format #t "** Coup #~a~%" turn-number) 
     (dragon-turn) 
     (status Siegfried) 
     (status Mime) 
     (player-turn) 
     (newline) 
     (new-turn)) 
   (init) 
   (display "Debut de la partie") 
   (newline) 
   (new-turn))