[contraband-cvs] CVS: contraband spells.lisp,1.5,1.6
Status: Pre-Alpha
Brought to you by:
stig
Menu
▾
▴
[contraband-cvs] CVS: contraband spells.lisp,1.5,1.6
|
From: Stig E S. <st...@us...> - 2003-06-01 23:37:08
|
Update of /cvsroot/contraband/contraband
In directory sc8-pr-cvs1:/tmp/cvs-serv9437
Modified Files:
spells.lisp
Log Message:
removed dead code
Index: spells.lisp
===================================================================
RCS file: /cvsroot/contraband/contraband/spells.lisp,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** spells.lisp 28 May 2003 10:34:31 -0000 1.5
--- spells.lisp 1 Jun 2003 23:36:59 -0000 1.6
***************
*** 495,1065 ****
state-object)
-
-
- ;(defun teleport-creature! (dungeon player creature range)
- ; (assert (numberp range))
- ;
- ; (let* ((minimum (floor range))
- ; (cx (location-x creature))
- ; (cy (location-y creature))
- ; (tx cx)
- ; (ty cy)
- ; (cur-d range))
- ; (block find-grid
- ; (loop
- ; (when (> range 200)
- ; (setf range 200))
- ;
- ; (block legal-dist
- ; (dotimes (i 500)
- ; (setf tx (rand-spread cx range)
- ; ty (rand-spread cy range))
- ; (setf cur-d (distance cx cy tx ty))
- ; (when (and (>= cur-d minimum) (<= cur-d minimum))
- ; (return-from legal-dist))))
- ;
- ; (when (and (in-bounds-fully? dungeon tx ty)
- ; (can-place? dungeon tx ty :creature)
- ; (not (cave-icky? dungeon tx ty)))
- ; (return-from find-grid))
- ;
- ; (setf range (* 2 range)
- ; minimum (floor minimum 2))))
- ;
- ; ;; we found an ok spot!
- ; (assert (and (in-bounds-fully? dungeon tx ty)
- ; (can-place? dungeon tx ty :creature)
- ; (not (cave-icky? dungeon tx ty))))
- ;
- ; ;; sound
- ;
- ; ;; swap monster
- ; (swap-monsters! dungeon player cx cy tx ty)
- ;#||
- ; (warn "UPD: ~s (~s ~s ~a) -> (~s ~s ~a), ~s"
- ; *update* cx cy (multiple-value-bind (a b) (map-info dungeon cx cy) b)
- ; (location-x player) (location-y player)
- ; (multiple-value-bind (a b) (map-info dungeon (location-x player) (location-y player)) b)
- ; (distance cx cy tx ty))
- ; ||#
- ;;; (handle-stuff dungeon player) ;; hack
- ;
- ;;; (print-map dungeon player)
- ; ))
-
- ;(defun summon-monster (dungeon x y depth &key (type :any))
- ; "Returns T if it summoned a monster successfully."
- ; (declare (ignore type depth))
- ;;; (warn "summoning at (~s,~s) type ~s" x y type)
- ;
- ; ;; we ignore type now, and fix that later.
- ;
- ; (let ((variant *variant*)
- ; (player *player*)
- ; (retval t))
- ; (loop for i from 1 to 10
- ; do
- ; (let ((fx (+ (randint i) x))
- ; (fy (+ (randint i) y))) ;; hack
- ; (when (cave-empty-bold? dungeon fx fy)
- ; (place-monster! variant dungeon player fx fy nil nil)
- ; (setf retval t))
- ; ))
- ; retval))
-
- ;; this one uses radius, not panel
- ;; fix it to use center-x and center-y instead of using the distance flag!
- ;(defun detect-invisible! (dungeon player center-x center-y radius)
- ; (declare (ignore center-x center-y)) ;; remove ignore
- ; (let ((success nil))
- ; (dolist (mon (dungeon.monsters dungeon))
- ; (when (creature-alive? mon)
- ; (let ((mx (location-x mon))
- ; (my (location-y mon)))
- ; (when (and (< (amon.distance mon) radius)
- ; (panel-contains? player mx my))
- ; (when (has-ability? (amon.kind mon) '<invisible>)
- ; ;; skip lore
- ; ;; skip recall
- ; (bit-flag-add! (amon.vis-flag mon) #.(logior +monster-flag-mark+ +monster-flag-show+))
- ; (update-monster! *variant* mon nil)
- ; (setf success t)
- ; ))
- ; )))
- ;
- ; (when success
- ; (print-message! "You detect invisible creatures!"))
- ;
- ; success))
-
-
- ;; FIX for type '<powerful>
- ;(defun interactive-identify-object! (dungeon player &key (type '<normal>))
- ;
- ; (block id-obj
- ; (let* ((limit-from '(:backpack :floor :worn))
- ; (prompt "Identify which item? ")
- ; (variant *variant*)
- ; (selection (select-item dungeon player limit-from
- ; :prompt prompt
- ; :where (first limit-from))))
- ;
- ; (unless (and selection (consp selection))
- ; (return-from id-obj nil))
- ;
- ; (let* ((the-table (get-item-table dungeon player (car selection)))
- ; (removed-obj (item-table-remove! the-table (cdr selection))))
- ;
- ; (unless (and removed-obj (typep removed-obj 'active-object))
- ; (return-from id-obj nil))
- ;
- ; (ecase type
- ; (<normal>
- ; (possible-identify! player removed-obj))
- ; (<powerful>
- ; (possible-identify! player removed-obj)
- ; (learn-about-object! player removed-obj :fully-known)))
- ;
- ; ;; put object back where it was found
- ; (put-object-in-container! dungeon player the-table removed-obj)
- ;
- ; (format-message! "Object is ~a."
- ; (with-output-to-string (s)
- ; (write-obj-description variant removed-obj s)))
- ;
- ; t))
- ; ))
-
-
- ; (block cast-spell
- ; (when-bind (book (with-dialogue ()
- ; (interactive-book-selection dungeon player)))
- ; (let* ((okind (aobj.kind book))
- ; (book-id (get-id okind))
- ; (which-one 0))
- ; (when-bind (spell-info (gethash book-id (variant.spellbooks variant)))
- ; (with-dialogue ()
- ; (setf which-one (interactive-spell-selection player spell-info)))
- ;
- ; (cond ((eq which-one nil)
- ; (return-from cast-spell nil))
- ; ((not (and (integerp which-one) (>= which-one 0) (< which-one (spellbook.size spell-info))))
- ; (warn "Spell ~s not found." which-one)
- ; (return-from cast-spell nil)))
- ;
- ; ;; let us find the spell now.
- ; (let* ((the-spell (aref (spellbook.spells spell-info) which-one))
- ; (spell-effect (spell.effect the-spell))
- ; (spell-data (get-spell-data player the-spell))
- ; (learnt-spell (has-learnt-spell? player the-spell)))
- ;
- ; ;;(warn "Spell ~s: know (~s), learnt (~s)" the-spell spell-data learnt-spell)
- ;
- ; (unless (and spell-data learnt-spell)
- ; (format-message! "You don't know the ~a spell." (spell.name the-spell))
- ; (return-from cast-spell nil))
- ;
- ; (unless (>= (current-mana player) (spell.mana spell-data))
- ; (print-message! "You don't have enough mana to cast that spell.")
- ; (return-from cast-spell nil))
- ;
- ;
- ; (cond ((and spell-effect (functionp spell-effect))
- ; (funcall spell-effect dungeon player the-spell)
- ; ;; deduct mana, better way?
- ; (decf (current-mana player) (spell.mana spell-data))
- ; (bit-flag-add! *redraw* +print-mana+)
- ; (unless (spell.tried spell-data)
- ; ;;(warn "Tried spell ~s" (spell.id spell-data))
- ; (setf (spell.tried spell-data) t)
- ; (modify-xp! player (spell.xp spell-data)))
- ;
- ; )
- ; (t
- ; (format-message! "The ~a spell is not implemented yet." (spell.name the-spell))))
- ; ))
- ;
- ; ;; clean up some!
- ; ;; (put-coloured-line! +term-white+ "" 0 0)
- ;
- ; )))
-
- ; (unless (can-learn-more-spells? variant player)
- ; (print-message! "You cannot learn more spells at this level.")
- ; (return-from contra-learn-spell! nil))
- ;
- ;
- ; (block learn-spell
- ; (with-dialogue ()
- ; (when-bind (book (interactive-book-selection dungeon player))
- ; (let* ((okind (aobj.kind book))
- ; (book-id (get-id okind)))
- ; (when-bind (spell-info (gethash book-id (variant.spellbooks variant)))
- ; (when-bind (which-one (interactive-spell-selection player spell-info
- ; :prompt "Learn which spell? "))
- ; (unless (and (integerp which-one) (>= which-one 0)
- ; (< which-one (spellbook.size spell-info)))
- ; (warn "Illegal choice ~s" which-one)
- ; (return-from learn-spell nil))
- ;
- ; (let ((the-spell (aref (spellbook.spells spell-info) which-one)))
- ; (learn-spell! player the-spell))
- ;
- ; )))
- ; ))
- ; )
-
- ; (when (is-spellcaster? player)
- ; (let* ((pl-class (player.class player))
- ; (stats (variant.stats variant))
- ; (stat-obj (find (class.spell-stat pl-class) stats :key #'stat.symbol))
- ; )
- ; (when stat-obj
- ; (let* ((stat-val (aref (player.active-stats player) (stat.number stat-obj)))
- ; (half-spells (get-stat-info stat-obj stat-val :half-spells))
- ; (learnt-spells (class.learnt-spells pl-class))
- ; (num-learnt (length learnt-spells))
- ; (max-spells (int-/ (* (player.power-lvl player) half-spells) 2)))
- ;
- ;
- ; ;;(warn "Max spells ~s vs learnt ~s" max-spells num-learnt)
- ;
- ; (> max-spells num-learnt)))
- ; ))
-
-
-
- ;(defun light-room! (dungeon x y &key (type '<light>))
- ; "Lights the room."
- ; (let ((coords (lb-ds:make-queue)))
- ; (flet ((add-coord (bx by)
- ; (let ((flag (cave-flags dungeon bx by)))
- ; ;; no recursion
- ; ;;(warn "flag at ~s,~s is ~s" bx by flag)
- ; (when (or (bit-flag-set? flag +cave-temp+)
- ; ;; don't leave the room
- ; (not (bit-flag-set? flag +cave-room+)))
- ; (return-from add-coord))
- ;
- ; (bit-flag-add! (cave-flags dungeon bx by) +cave-temp+)
- ; ;;(warn "adding ~s ~s" bx by)
- ; (lb-ds:enqueue (cons bx by) coords))))
- ;
- ; ;; add first grid
- ; (add-coord x y)
- ;
- ; (dolist (i (lb-ds:queue-as-list coords))
- ; (let ((cx (car i))
- ; (cy (cdr i)))
- ; (when (cave-floor-bold? dungeon cx cy)
- ; ;; next to
- ; (add-coord (1+ cx) cy)
- ; (add-coord (1- cx) cy)
- ; (add-coord cx (1+ cy))
- ; (add-coord cx (1- cy))
- ;
- ; ;; diagonal
- ; (add-coord (1+ cx) (1+ cy))
- ; (add-coord (1- cx) (1- cy))
- ; (add-coord (1+ cx) (1- cy))
- ; (add-coord (1- cx) (1+ cy))
- ; ))))
- ;
- ; ;;(warn "coords ~s" coords)
- ;
- ; (dolist (i (lb-ds:queue-as-list coords))
- ; (let ((flag (cave-flags dungeon (car i) (cdr i))))
- ; (bit-flag-remove! flag +cave-temp+)
- ; ;;(warn "lighting ~s ~s" (car i) (cdr i))
- ; (ecase type
- ; (<light>
- ; (bit-flag-add! flag +cave-glow+))
- ; (<darkness>
- ; (bit-flag-remove! flag +cave-glow+)))
- ; (setf (cave-flags dungeon (car i) (cdr i)) flag)))
- ;
- ; ;; redraw things
- ; (bit-flag-add! *update* +pl-upd-forget-view+ +pl-upd-update-view+)
- ; (bit-flag-add! *redraw* +print-map+)
- ;
- ; t))
-
-
- ;(defun light-area! (dungeon player damage radius &key (type '<light>))
- ; "Lights the area."
- ;
- ; ;; unless blind
- ; (let ((blind-player nil)
- ; (px (location-x player))
- ; (py (location-y player)))
- ;
- ; (unless blind-player
- ; (ecase type
- ; (<light>
- ; (print-message! "You are surrounded by a white light."))
- ; (<darkness>
- ; (print-message! "Darkness surrounds you!"))
- ; ))
- ;
- ; (do-projection player px py (logior +project-grid+ +project-kill+)
- ; :damage damage
- ; :radius radius
- ; :effect (get-spell-effect type))
- ; (light-room! dungeon px py :type type))
- ;
- ; t)
-
-
- ;(defun enchant-item! (dungeon player &key (type '<weapon>) (bonus 1) (restrict nil))
- ;
- ; (flet ((%local-enchant (item)
- ; (let ((gvals (object.game-values item)))
- ; (warn "enchant ~s ~s ~s ~s" item type bonus restrict)
- ; ;; improve later
- ; (ecase type
- ; (<weapon>
- ; (when (< (gval.tohit-modifier gvals) +10)
- ; (incf (gval.tohit-modifier gvals) bonus)
- ; (incf (gval.dmg-modifier gvals) bonus)
- ; :used))
- ;
- ; (<armour>
- ; (when (< (gval.ac-modifier gvals) +10)
- ; (incf (gval.ac-modifier gvals) bonus)
- ; :used))))))
- ;
- ; (let ((retval :still-useful)
- ; (selection (select-item dungeon player '(:backpack :equip)
- ; :prompt "Enchant item: "
- ; :where :backpack)))
- ;
- ; (cond (selection
- ; (let* ((the-table (get-item-table dungeon player (car selection)))
- ; (removed-obj (item-table-remove! the-table (cdr selection))))
- ; (cond (removed-obj
- ; (format-message! "~a ~a glow~a brightly." "The" "[some-object, FIX]" "s")
- ; (setf retval (%local-enchant removed-obj))
- ;
- ; (item-table-add! the-table removed-obj))
- ; (t
- ; (warn "Did not find selected obj ~a" selection)))))
- ; (t
- ; (warn "Did not select anything.")))
- ;
- ;
- ; retval)))
-
- #||
- (defun define-spell (name id &key effect-type effect)
- "Defines and registers a new spell."
-
- (assert (stringp name))
- (assert (stringp id))
-
- (let ((variant *variant*)
- (spell (make-instance 'magic-spell :name name :id id)))
-
- (when (and effect (functionp effect))
- (setf (spell.effect spell) (compile nil effect)))
-
- ;; checking carefully
- (when effect-type
- (unless (is-legal-effect-type? effect-type)
- (warn "Unknown spell-type ~s for spell ~s" effect-type id))
-
- (when-bind (lookup (gethash effect-type (variant.visual-effects variant)))
- ;;(warn "spell lookup is ~s" lookup)
- (setf (spell.effect-type spell) lookup)))
-
-
- ;; register spell in variant
- (multiple-value-bind (value present-p)
- (gethash (spell.id spell) (variant.spells variant))
- (when present-p
- (warn "Replacing spell ~s in contraband variant" value))
- (setf (gethash (spell.id spell) (variant.spells variant)) spell))
-
-
- spell))
-
- (defmethod get-visual-projectile ((obj magic-spell))
- (spell.effect-type obj))
-
- (defun create-spellbook (name id spells)
- "Creates and returns a spellbook."
-
- (check-type name string)
- (assert (verify-id id))
- (assert (consp spells))
-
- (let* ((variant *variant*)
- (len (length spells))
- (book (make-instance 'spellbook :name name :id id :size len)))
-
- (setf (spellbook.spells book) (make-array len :initial-element nil))
-
- (loop for i from 0
- for spell in spells
- do
- (let ((spell-obj (gethash spell (variant.spells variant))))
- (cond ((and spell-obj (typep spell-obj 'magic-spell))
- (setf (aref (spellbook.spells book) i) spell-obj))
- (t
- (warn "Unable to find spell ~s in contraband" spell))
- )))
- book))
- ||#
-
- #||
-
- (defun get-spell-id (spell)
- (etypecase spell
- (string spell)
- (spell-classdata (spell.id spell))
- (magic-spell (spell.id spell))))
-
- (defun get-spell-data (player spell)
- (when (is-spellcaster? player)
- (let ((spell-id (get-spell-id spell))
- (spell-arr (class.spells (player.class player))))
-
- (loop for x across spell-arr
- do
- (when (equal spell-id (spell.id x))
- (return-from get-spell-data x)))
-
- nil)))
-
-
- (defun learn-spell! (player spell)
- "Tries to ensure that the player learns the given spell."
-
- (unless (is-spellcaster? player)
- (print-message! "You are not a spellcaster and cannot learn spells.")
- (return-from learn-spell! nil))
-
- ;; (warn "Trying to learn ~s" spell)
-
- (let ((spell-id (etypecase spell
- (magic-spell (spell.id spell))
- (spell-classdata (spell.id spell))
- (string spell)))
- (learnt-spells (class.learnt-spells (player.class player))))
-
- (when (find spell-id learnt-spells :test #'equal)
- (print-message! "You already know the spell.")
- (return-from learn-spell! nil))
-
- (let ((spell-data (get-spell-data player spell-id)))
- (cond ((and (typep spell-data 'spell-classdata)
- (<= (spell.level spell-data) (player.power-lvl player)))
- (vector-push-extend spell-id learnt-spells)
- (format-message! "~a learnt." (spell.name spell))
- (bit-flag-add! *redraw* +print-study+)
- (return-from learn-spell! t))
-
- ((and (typep spell-data 'spell-classdata)
- (> (spell.level spell-data) (player.power-lvl player)))
- (print-message! "You're not powerful enough to learn that spell yet."))
-
- ((eq spell-data nil)
- (print-message! "You are unable to learn that spell."))
-
- (t
- (warn "Unknown value returned ~s, ~s." spell-data spell)))
-
- nil)))
-
-
-
- (defun has-learnt-spell? (player spell)
- "Returns NIL if the player has not learnt the spell,
- returns T if the player knows the spell."
- (let* ((spell-id (get-spell-id spell))
- (learnt-spells (class.learnt-spells (player.class player)))
- (existing-spell (find spell-id learnt-spells :test #'equal)))
- ;; (warn "Checked for ~s in ~s" spell-id learnt-spells)
- (when existing-spell
- t)))
-
- (defun can-learn-more-spells? (variant player)
- "Returns T if the player can learn spells, NIL otherwise."
-
- t)
-
- (defun interactive-book-selection (dungeon player)
- "Selects a book and returns it or NIL."
- (declare (ignore dungeon))
- (block select-book
- (let ((carrying (aobj.contains (get-creature-inventory player)))
- (books '())
- ;;(variant *variant*)
- )
-
- (item-table-iterate! carrying
- #'(lambda (table num obj)
- (declare (ignore table))
- (when (typep obj 'active-object/book)
- (push (cons obj num) books))))
- (setf books (nreverse books))
-
- (unless books
- (put-coloured-line! +term-white+ "No books" 0 0)
- (return-from select-book nil))
-
- (let* ((first-num (i2a (cdar books)))
- (last-num (i2a (cdar (last books))))
- (select-string (format nil "Inven: (~a-~a), * to see, ESC) Use which book? "
- first-num last-num)))
-
- (put-coloured-line! +term-white+ select-string 0 0)
- (loop
- (let ((selection (read-one-character)))
- (cond ((eql selection +escape+)
- (return-from select-book nil))
- ((eql selection #\*)
- (warn "Show book-selection not implemented."))
- ((alpha-char-p selection)
- (let ((num (a2i selection)))
- (loop for (book . key) in books
- do
- (when (eql key num)
- (return-from select-book book)))
- (warn "Selection ~a not found, please try again." selection)
- nil))
- (t
- (warn "Fell through with book-selection ~s" selection)
- nil))
- ))
-
- ))))
-
- ||#
- #||
-
-
- (defmethod print-object ((inst magic-spell) stream)
- (print-unreadable-object
- (inst stream :identity t)
- (format stream "~:(~S~) [~S ~S]" (class-name (class-of inst))
- (spell.id inst)
- (spell.name inst)))
- inst)
-
- (defmethod print-object ((inst spellbook) stream)
- (print-unreadable-object
- (inst stream :identity t)
- (format stream "~:(~S~) [~S ~S]" (class-name (class-of inst))
- (spellbook.id inst)
- (spellbook.name inst)))
- inst)
-
- (defmethod print-object ((inst spell-classdata) stream)
- (print-unreadable-object
- (inst stream :identity t)
- (format stream "~:(~S~) [~S ~S]" (class-name (class-of inst))
- (spell.id inst)
- (spell.level inst)))
- inst)
-
- ||#
\ No newline at end of file
--- 495,496 ----
|
