Paste number 1463: tedious test function that created it

Paste number 1463: tedious test function that created it
Pasted by: Xach
When:12 years, 9 months ago
Share:Tweet this! | http://paste.lisp.org/+14N
Channel:#lisp
Paste contents:
Raw Source | XML | Display As
(defun xach-flash-file-2 (file)
  (let* ((movie (make-instance 'movie
                               :height (twips 550)
                               :width (twips 550)))
         (shape (make-instance 'shape
                               :shape-id 1))
         (line-style (make-instance 'line-style
                                    :color (make-instance 'rgb
                                                          :red 0
                                                          :green 0
                                                          :blue 0)
                                    :width 20)))
    (setf (frame-rate movie) 4)
    (add-tag (make-setbackgroundcolor-tag #xFF #xFF #xFF) movie)
    (add-tag (make-instance 'defineshape-tag
                            :shape shape)
             movie)
    (add-line-style line-style shape)
    ;; define a square
    (add-shape-record (make-instance 'style-change-record
                                     :delta-x 20
                                     :delta-y 20
                                     :line-style 1)
                      shape)
    (add-shape-record (make-instance 'straight-edge-record
                                     :delta-y (twips 10))
                      shape)
    (add-shape-record (make-instance 'straight-edge-record
                                     :delta-x (twips -10))
                      shape)
    (add-shape-record (make-instance 'straight-edge-record
                                     :delta-y (twips -10))
                      shape)
    (add-shape-record (make-instance 'straight-edge-record
                                     :delta-x (twips 10))
                      shape)
    (flet ((box-in-cell (x y)
             (let ((real-x (twips (* x 12)))
                   (real-y (twips (* y 12))))
               (add-tag (make-instance 'placeobject2-tag
                                       :depth 2
                                       :character-id 1
                                       :matrix (make-instance 'matrix
                                                              :translatex real-x
                                                              :translatey real-y))
                        movie)
               (add-tag *showframe-tag* movie))))
      ;; GIMME AN "L"
      (dolist (i '(1 2 3 4 5))
        (box-in-cell 1 i))
      (dolist (i '(2 3))
        (box-in-cell i 5))
      ;; GIMME AN "I"
      (dolist (i '(1 2 3 4 5))
        (box-in-cell 5 i))
      ;; GIMME AN "S"
      (dolist (i '(1 2 3 4 5))
        (box-in-cell 8 i))
      (box-in-cell 7 5)
      (box-in-cell 9 1)
      ;; GIMME A "P"
      (dolist (i '(1 2 3 4 5))
        (box-in-cell 11 i))
      (box-in-cell 12 1)
      (box-in-cell 13 1)
      (box-in-cell 13 2)
      (box-in-cell 13 3)
      (box-in-cell 12 3)
      
      (write-movie movie file))))

This paste has no annotations.

Colorize as:
Show Line Numbers

Lisppaste pastes can be made by anyone at any time. Imagine a fearsomely comprehensive disclaimer of liability. Now fear, comprehensively.