Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;; ----- Basics, Attributes ------------
- ;; print - method on Objects, prints the object
- ;; space - object, contains the space character
- (class Element
- [subclass-of Object]
- [ivars tag atts]
- (class-method new: (t)
- ((super new) init: t))
- (method init: (t)
- (set tag t)
- (set atts (Dictionary new))
- self)
- (method attribute:put: (k v)
- (atts at:put: k v)
- self)
- (method print ()
- ('< print)
- (tag print)
- (atts associationsDo:
- [block (assoc)
- (space print)
- ((assoc key) print)
- ('=" print)
- ((assoc value) print)
- ('=" print)])
- ('/> print)
- self)
- )
- ;; ----- An SVG canvas -----------------
- ;; A placeholder class that helps us define a helper-method
- ;; we use in SVGCanvas.
- (class X [subclass-of Object]
- (method printElems ()
- (self do: [block (part) (part print) (space print)])))
- (SequenceableCollection addAllMethodsFrom: X)
- ;; A String is an ordered collection that prints its elements in order
- ;; (i.e. like a string!)
- (class String
- [subclass-of List]
- (method print ()
- (self do: [block (x) (x print)])))
- (class SVGCanvas
- [subclass-of Object]
- (method startDrawing ()
- ('(<svg viewBox="-5 -5 11 10"
- width="300px" height="300px"
- transform="scale(1 -1)">) printElems)
- (newline print))
- (method stopDrawing ()
- ('</svg> println))
- (method drawPolygon: (coord-list)
- (self LeftAsExercise))
- (method drawEllipseAt:width:height: (center w h) [locals elem]
- (set elem (Element new: 'elipse))
- (elem attribute:put: 'cx (center x))
- (elem attribute:put: 'cy (center y))
- (elem attribute:put: 'rx w)
- (elem attribute:put: 'ry h)
- (elem print))
- )
- ;; ----- Integration test -----------------
- ;; Uncomment the integration test below to try drawing one of the
- ;; pictures in the book.
- ; (use /comp/105/build-prove-compare/examples/usmalltalk/shapes.smt)
- ; (val c (Circle new))
- ; (val s (Square new))
- ; (s adjustPoint:to: 'West (c location: 'East))
- ; (class Triangle
- ; [subclass-of Shape]
- ; ;; no additional representation
- ; (method drawOn: (canvas)
- ; (canvas drawPolygon: (self locations: '(North Southwest Southeast)))))
- ; (val t ((Triangle new) adjustPoint:to: 'Southwest (s location: 'East)))
- ; (val pic (Picture empty))
- ; (pic add: c)
- ; (pic add: s)
- ; (pic add: t)
- ; (val canvas (SVGCanvas new))
- ; '-------------------
- ; (begin (pic renderUsing: canvas)
- ; '-------------------)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement