ADVSYS

Contributed by Scott Anderson

This one is somewhat silly.

The ADVenture SYStem, by David Betz, is a lisp-like system used for creating stand-alone adventure games. I found it a bit frustrating to work with because it does not correctly treat integers as integers, and there is no way to coerce a string into an integer form.

To use the example, compile the adventure system and perform the following command:

advcom shapes

This will create a file named "shapes.dat". Run the example with the interpreter like this:

advint shapes

ADVSYS supports single inheritance, inheritance of implementation and properties, and a host of nifty game-specific features like command parsing and the like.

FILE: shapes.adv

; shapes polymorphism example
; November 14, 1999 - Scott Anderson

(adventure shapes 1)

(define welcome "Welcome to the shape adventure!\n\n")

; include the object library
@objects.adi

; the player's object
(actor adventurer
  (noun me)
  (property
    initial-location shaperoom))

; a place for all the action
(location shaperoom
	(property
		description "This is an oddly bland room, totally devoid of any markings.\n"
		short-description "You are in the bland room.\n"
	)
)

; base shape class
(thing shape
	; answers to 'shape'
	(noun shape)

	; inheritable properties
	(class-property
		origin-x 0
		origin-y 0
		definite-description nil
	)

	; inheritable methods

	; move the shape to a new origin
	(method (move x y)
		(print "You grunt and strain, and move ")
		(print (getp self definite-description))
		(print " to another spot on the floor.\n")

		(setp self origin-x x)
		(setp self origin-y y)
	)

	; Theoretically, move the shape relative to current origin.
	; Integer arithmetic seems to be strangely absent in this
	; system, despite documentation claims to the contrary.
	; This method is *supposed* to add the arguments to the
	; origin but instead it adds the *object numbers* of the
	; origin properties to the arguments.
	(method (rel-move delta-x delta-y)
		(print "You grunt and strain, and move ")
		(print (getp self definite-description))
		(print " across the floor.\n")

		(setp self origin-x (+ origin-x delta-x))
		(setp self origin-y (+ origin-y delta-y))
	)

	; draw the origin of a shape
	(method (draw-origin)
		(print "(")
		(print-number (getp self origin-x))
		(print ", ")
		(print-number (getp self origin-y))
		(print ")")
	)
)
	
; the rectangle object
(shape rectangle
	; answers to 'rectangle'
	(noun rectangle)

	; class properties for the rectangles
	(class-property
		width 0
		height 0
	)

	; draw the rectangle
	(method (draw)
		(print "You trace the rectangle on the floor at ")
		(send self draw-origin)
		(print ". The width is ")
		(print-number (getp self width))
		(print ", and the height is ")
		(print-number (getp self height))
		(print ".\n")
	)

	; stretch the rectangle
	(method (stretch i)
		(print "You hook your foot in ")
		(print (getp %dobject definite-description))
		(print ", and stretch it.\n")
	
		(setp self width i)
	)

)

; the circle object
(shape circle
	; answers to 'circle'
	(noun circle)

	; class property for circles
	(class-property radius 0)

	; draw the circle
	(method (draw)
		(print "You trace the circle on the floor at ")
		(send self draw-origin)
		(print ". The radius is ")
		(print-number (getp self radius))
		(print ".\n")
	)
)

; a specific rectangle
(rectangle blue-rectangle
	; answers to 'rectangle' or 'blue rectangle'
	(adjective blue)

	; set the properties of the rectangle
	(property
		origin-x 10
		origin-y 20
		width 5
		height 6
		description "A blue rectangle is lying on the floor.\n"
		short-description "a blue rectangle"
		definite-description "the blue rectangle"
	)
)
		
; a specific rectangle
(rectangle green-rectangle
	; answers to 'rectangle' or 'green rectangle'
	(adjective green)

	; set the properties of the rectangle
	(property
		width 15
		height 15
		description "A green rectangle is lying on the floor.\n"
		short-description "a green rectangle"
		definite-description "the green rectangle"
	)
)

; a specific circle
(circle red-circle
	; answers to 'circle' or 'red circle'
	(adjective red)

	; set the properties of the circle
	(property
		origin-x 15
		origin-y 25
		radius 8
		description "A red circle is lying on the floor.\n"
		short-description "a red circle"
		definite-description "the red circle"
	)
)

; define a lever as something that can't be taken
(stationary-thing lever
	; answers to 'lever'
	(noun lever)

	(class-property
		; thing created by the lever when pulled
		thing-to-get nil
		; only pull once
		pulled nil
		pulled-description nil
	)

	; pull thelever
	(method (pull)
		(if (not (getp self pulled))
			; if it hasn't been pulled
			(progn
				(print "You pull ")
				(print (getp self definite-description))
				(print ", and ")
				(print (getp (getp self thing-to-get) short-description))
				(print " pops out of a chute in the wall!\n")

				; send the 'thing-to-get' object to the current location
				(send shaperoom enter (getp self thing-to-get))

				; mark it as pulled
				(setp self pulled T)
				(setp self description (getp self pulled-description))
			T)

			; otherwise complain
			(print "The lever has already been pulled.\n")
		)
	)
)

; a specific lever
(lever blue-lever
	; answers to 'lever' or 'blue lever'
	(adjective blue)

	(property
		description "There is a blue lever, sticking out of the wall.\n"
		pulled-description "There is a blue lever, sticking out of the wall. It has been pulled down.\n"
		short-description "a blue lever"
		definite-description "the blue lever"
		initial-location shaperoom
		thing-to-get blue-rectangle
		pulled nil
	)
)

; second verse, same as the first
(lever red-lever
	(adjective red)
	(property
		description "There is a red lever, sticking out of the wall.\n"
		pulled-description "There is a red lever, sticking out of the wall. It has been pulled down.\n"
		short-description "a red lever"
		definite-description "the red lever"
		initial-location shaperoom
		thing-to-get red-circle
		pulled nil
	)
)

; third verse, same as the first
(lever green-lever
	(adjective green)
	(property
		description "There is a green lever, sticking out of the wall.\n"
		pulled-description "There is a green lever, sticking out of the wall. It has been pulled down.\n"
		short-description "a green lever"
		definite-description "the green lever"
		initial-location shaperoom
		thing-to-get green-rectangle
		pulled nil
	)
)


; define a player verb
(action a-pull
	(verb pull)

	; needs a direct object
	(direct-object)

	; code to execute
	(code
		; locate the referred-to object
		(setq %dobject (in-location $dobject))
		; call the pull method on the object
		(send %dobject pull)
	)
)

; define a player verb
(action a-draw
	(verb draw)

	; needs a direct object
	(direct-object)

	; code to execute
	(code
		; locate the referred-to object
		(setq %dobject (in-location $dobject))
		; call the draw method on the object
		(send %dobject draw)
	)
)

(action a-move-rel
	(verb move)

	; needs a direct object
	(direct-object)

	; code to execute
	(code
		; locate the referred-to object
		(setq %dobject (in-location $dobject))
		; call the move method on the object with 100, 100
		(send %dobject move 100 100)
	)
)

(action a-stretch
	(verb stretch)

	; needs a direct object
	(direct-object)

	; code to execute
	(code
		; locate the referred-to object
		(setq %dobject (in-location $dobject))
		; call the stretch method on the object with 30
		(send %dobject stretch 30)
	)
)

Jim Weirich / jweirich@one.net