worlds/haxima-1.002/demon-gate.scm

   1 (kern-load "nossifer.scm")
   2
   3 ;; constants
   4 (define demon-gate-x 6)
   5 (define demon-gate-y 9)
   6
   7 ;; demon gate gob
   8 (define (mk-demon-gate-gob) (list 8 #f #f))
   9 (define (demon-gate-unlock gob) (set-car! gob (- (car gob) 1)))
  10 (define (demon-gate-completely-unlocked? gob) (= (car gob) 0))
  11 (define (demon-gate-opened? gob) (cadr gob))
  12 (define (demon-gate-opened! gob) (set-car! (cdr gob) #t))
  13 (define (end-game-played? gob) (caddr gob))
  14 (define (end-game-played! gob) (set-car! (cddr gob) #t))
  15
  16
  17 ;; demon gate procs
  18 (define (summon-nossifer kplace)
  19   (kern-log-msg "²¿¼Ô¤«¤¬»Ñ¤ò¸½¤·¤¿¡£")
  20   (let ((knpc (mk-nossifer)))
  21     (kern-obj-put-at knpc
  22                      (mk-loc kplace
  23                              demon-gate-x
  24                              demon-gate-y))
  25     (kern-map-repaint)
  26     (kern-sleep 2000)
  27     (kern-conv-begin knpc)
  28   ))
  29
  30 (define (open-demon-gate kplace)
  31   (let* ((loc (mk-loc kplace
  32                       demon-gate-x
  33                       demon-gate-y))
  34          (gate (mk-moongate nil))
  35          (stages (list (list '()                       0)
  36                        (list s_blackgate_quarter        32)
  37                        (list s_blackgate_half           64)
  38                        (list s_blackgate_three_quarters 96)
  39                        (list s_blackgate_full           128))))
  40     (kern-map-flash 100)
  41     (kern-sleep 2000)
  42     (kern-log-msg "°Å¤¤Ìç¤¬³«¤¤¤¿¡£")
  43     (kern-obj-put-at gate loc)
  44     (moongate-animate gate stages)
  45     (kern-sleep 2000)
  46     (summon-nossifer kplace)
  47     (kern-obj-remove gate)
  48     ))
  49
  50
  51 (define (demon-gate-on kgate kchar)
  52   (let ((dgate (gob kgate)))
  53     (demon-gate-unlock dgate)))
  54
  55 (define (nossifer-vanquished?)
  56   (= 0 (num-hostiles (kern-get-player))))
  57
  58 (define (end-game)
  59   (kern-map-flash 1000)
  60   (kern-map-repaint)
  61   (kern-log-msg "**************************")
  62   (kern-sleep 2000)
  63   (kern-log-msg "¥Î¥·¥Õ¥¡¡¼¤È¤½¤Î¼êÀè¤ÏÂÇ¤ÁÅÝ¤µ¤ì¤¿¡£")
  64   (kern-sleep 2000)
  65   (kern-log-msg "°Ëâ¤ÎÌç¤ÏÊÄ¤¸¤¿¡£")
  66   (kern-sleep 2000)
  67   (kern-log-msg "¤½¤ì¤ÏºÆ¤Ó³«¤«¤ì¤ë¤Î¤À¤í¤¦¤«¡©")
  68   (kern-sleep 2000)
  69   (kern-log-msg "ÌÂ¤¤¿Í¤Ï¥·¥ã¥ë¥É¤Ë±Ê±ó¤ËÊá¤é¤ï¤ì¤¿¤Þ¤Þ¤Ê¤Î¤«¡©")
  70   (kern-sleep 2000)
  71   (kern-log-msg "Èà¤Ï¡¢¤â¤·¤«¤¹¤ë¤È¡¢¤â¤Ï¤äÌÂ¤¤¿Í¤Ç¤Ï¤Ê¤¤¤Î¤«¡©")
  72   (kern-sleep 2000)
  73   (kern-log-msg "Èà¤¬¡Ä")
  74   (kern-sleep 4000)
  75   (kern-log-msg "¡ÄÀ¬Éþ¼Ô¤Ë¤Ê¤ë»þ¤¬Íè¤¿¤Î¤À¤í¤¦¤«¡©")
  76   (kern-sleep 2000)
  77   (kern-log-msg "¤½¤ÎÅú¤¨¤Ï¡¡Haxima II: À¬Éþ¼Ô¡¡¤Ë¤¢¤ë¡£")
  78   (kern-log-msg "**************************")
  79
  80   (kern-log-msg "*** ¤ª¤á¤Ç¤È¤¦ ***")
  81   (kern-log-msg "¤¢¤Ê¤¿¤Ï¤³¤Î¥²¡¼¥à¤ò´°Î»¤·¤¿¡ª")
  82   (kern-log-msg "²¿¤«¥¡¼¤ò²¡¤¹¤È½ªÎ»¤¹¤ë¡£")
  83   (kern-ui-waitkey)
  84
  85   (kern-end-game)
  86   )
  87
  88 (define (demon-gate-exec kgate)
  89         (let ((dgate (gob kgate)))
  90                 (if (and (not (end-game-played? dgate))
  91                                 (demon-gate-opened? dgate)
  92                                 (nossifer-vanquished?))
  93                         (begin
  94                                 (end-game)
  95                                 (end-game-played! dgate)
  96                         ))
  97                 (println (demon-gate-completely-unlocked? dgate) " "
  98                                         (demon-gate-opened? dgate) " " (nossifer-vanquished?))
  99                 (if (and (demon-gate-completely-unlocked? dgate)
 100                                 (not (demon-gate-opened? dgate)))
 101                         (begin
 102                                 (open-demon-gate (get-place kgate))
 103                                 (demon-gate-opened! dgate)
 104                         )
 105                 )
 106         ))
 107
 108
 109 ;; demon gate type ifc
 110 (define demon-gate-ifc
 111   (ifc '()
 112        (method 'on demon-gate-on)
 113        (method 'exec demon-gate-exec)
 114        ))
 115
 116 ;; demon gate type
 117 (mk-obj-type 't_demon_gate nil nil layer-none demon-gate-ifc)
 118
 119 ;; demon gate ctor
 120 (define (mk-demon-gate)
 121   (kern-tag 'demon-gate
 122             (bind (kern-obj-set-ignore-time-stop (kern-mk-obj t_demon_gate 1)
 123                                                  #t)
 124                   (mk-demon-gate-gob))))