;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.projectional-editor.test) ;;;;;; ;;; Graphics (def function make-test-content/graphics/empty () (make-graphics/canvas nil (make-2d 0 0))) (def function make-test-content/graphics () (make-graphics/viewport (make-graphics/canvas (list (make-graphics/point (make-2d 50 150) :stroke-color sdl:*red*) (make-graphics/line (make-2d 150 300) (make-2d 50 400) :stroke-color sdl:*blue*) (make-graphics/rectangle (make-2d 200 200) (make-2d 100 100) :stroke-color sdl:*green*) (make-graphics/polygon (list (make-2d 150 100) (make-2d 160 160) (make-2d 100 150)) :stroke-color sdl:*black*) (make-graphics/circle (make-2d 50 250) 50 :stroke-color sdl:*black*) (make-graphics/ellipse (make-2d 50 50) (make-2d 100 50) :stroke-color sdl:*red*) (make-graphics/text (make-2d 200 150) "hello world" :color sdl:*default-color* :font sdl:*default-font*) (make-graphics/image (make-2d 300 0) "/home/levy/workspace/hu.dwim.wui/www/image/about/lisp-logo.trace-amounts-warning.256.png")) (make-2d 0 0)) (make-2d 50 50) (make-2d 400 400))) ;;;;;; ;;; String (def function make-test-content/string/empty () "") (def function make-test-content/string () "just a simple string") ;;;;;; ;;; Text (def function make-test-content/text/empty () (make-text/document (list (make-text/paragraph (list (make-styled-string/string "")))))) (def function make-test-content/text () (make-text/document (list (make-text/paragraph (list (make-styled-string/string "first paragraph in a text document"))) (make-text/paragraph (list (make-styled-string/string "second paragraph in a text document")))))) ;;;;;; ;;; List (def function make-test-content/list/empty () (list/list ())) (def function make-test-content/list () (list/list () (list/element () "first element in a list") (list/element () "second element in a list"))) ;;;;;; ;;; Table (def function make-test-content/table/empty () (table/table ())) (def function make-test-content/table () (table/table () (table/row () (table/cell () "first cell of first row in a table") (table/cell () "second cell of first row in a table")) (table/row () (table/cell () "first cell of second row in a table (padding)") (table/cell () "second cell of second row in a table")))) ;;;;;; ;;; Tree (def function make-test-content/tree/empty () nil) (def function make-test-content/tree () (make-tree/node (list "Hello" (make-tree/node (list "head" "tail")) "World" (make-tree/node (list "This" (make-tree/node (list "is" "deep")) "nesting"))))) ;;;;;; ;;; Book (def function make-test-content/book/empty () (make-book/book "" nil nil)) (def function make-test-content/book () (make-book/book "Lorem ipsum" (list "Levente Mészáros") (list (make-book/chapter "Chapter 1" (list "Lorem ipsum dolor sit amet, consectetur adipiscing elit. Cras eu nunc nibh. Cras imperdiet faucibus tortor ac dictum. Aliquam sit amet justo nec ligula lobortis ornare. Aenean a odio id dolor adipiscing interdum. Maecenas nec nisl neque. Suspendisse interdum rutrum neque, in volutpat orci varius in. Praesent a ipsum ac erat pulvinar adipiscing quis sit amet magna. Etiam semper vulputate mi ac interdum. Nunc a tortor non purus fringilla aliquam.")) (make-book/chapter "Chapter 2" (list "Morbi scelerisque, felis a viverra pharetra, arcu enim aliquet urna, mollis suscipit felis elit in neque. Aenean vel tempus nulla. Vestibulum magna nisi, cursus vel auctor eu, suscipit sit amet purus. Donec ligula purus, pulvinar id tristique ut, suscipit ornare diam. Maecenas sed justo turpis. Vivamus eu scelerisque dui. Pellentesque mollis rutrum est ac tempus. Sed venenatis, erat id elementum semper, nisl tortor malesuada orci, ac venenatis elit ipsum non augue. Praesent blandit purus est, id venenatis eros. Phasellus non dui dolor. Duis magna erat, pulvinar sed aliquam vitae, porta vel quam."))))) ;;;;;; ;;; XML (def function make-test-content/xml/empty () nil) (def function make-test-content/xml () (make-xml/element "person" (list (make-xml/attribute "name" "levy") (make-xml/attribute "sex" "male")) (list (make-xml/element "children" nil (list (make-xml/element "person" (list (make-xml/attribute "name" "John") (make-xml/attribute "sex" "female")) nil) (make-xml/element "person" (list (make-xml/attribute "name" "Mary") (make-xml/attribute "sex" "male")) nil))) (make-xml/element "pets" nil nil)))) ;;;;;; ;;; JSON (def function make-test-content/json/empty () nil) (def function make-test-content/json () (make-json/array (list (make-json/null) (make-json/boolean #f) (make-json/boolean #t) (make-json/number 42) (make-json/string "Hello World") (make-json/object (prog1-bind key-value-map (make-hash-table) (setf (gethash "foo" key-value-map) (make-json/number 43)) (setf (gethash "bar" key-value-map) (make-json/string "Hello World")) (setf (gethash "baz" key-value-map) (make-json/array (list (make-json/number 44) (make-json/string "Welcome Home"))))))))) ;;;;;; ;;; Java (def function make-test-content/java/empty () nil) (def function make-test-content/java () (make-java/declaration/method (make-java/declaration/qualifier "public") (make-java/declaration/type "int") "factorial" (list (make-java/declaration/argument "n" (make-java/declaration/type "int"))) (make-java/statement/block (list (make-java/statement/if (make-java/expression/infix-operator "==" (list (make-java/expression/variable-reference "n") (make-java/literal/number 1))) (make-java/statement/return (make-java/literal/number 1)) (make-java/statement/return (make-java/expression/infix-operator "*" (list (make-java/expression/variable-reference "n") (make-java/expression/method-invocation "factorial" (list (make-java/expression/infix-operator "-" (list (make-java/expression/variable-reference "n") (make-java/literal/number 1))))))))))))) ;;;;;; ;;; Lisp form (def function make-test-content/lisp-form/function (&optional (name 'factorial)) (ecase name (factorial '(defun factorial (n) "Computes the factorial of N" (if (= n 0) 1 (* n (factorial (- n 1)))))) (fibonacci '(defun fibonacci (n) "Compute the Nth Fibonacci number" (if (< n 1) 1 (+ (fibonacci (- n 1)) (fibonacci (- n 2)))))) (quine '(funcall (lambda (lambda) `(,lambda ',lambda)) '(lambda (lambda) `(,lambda ',lambda)))))) (def function make-test-content/lisp-form/empty () nil) (def function make-test-content/lisp-form () `("quoted list" 3.1315 (sub (deep list) 42 43) ,(make-string-output-stream))) ;;;;;; ;;; Walked lisp form (def function make-test-content/walked-lisp-form/empty () nil) (def function make-test-content/walked-lisp-form () (hu.dwim.walker:walk-form (make-test-content/lisp-form/function))) ;;;;;; ;;; T (def function make-test-content/t/empty () nil) (def function make-test-content/t () (elt (children-of (make-test-content/xml)) 0)) ;;;;;; ;;; Nested (def function make-test-content/nested () (bind ((walked-lisp-form (hu.dwim.walker:walk-form '(lambda (name) (if (string= "json" name) nil nil)))) (if-form (elt (hu.dwim.walker:body-of walked-lisp-form) 0))) (setf (hu.dwim.walker:then-of if-form) (make-test-content/json)) (setf (hu.dwim.walker:else-of if-form) (make-test-content/xml)) walked-lisp-form)) ;;;;;; ;;; Complex (def function make-test-content/complex () (make-table/table (list (make-table/row (list (make-table/cell (make-test-content/xml)) (make-table/cell (make-test-content/json)))) (make-table/row (list (make-table/cell (make-test-content/java)) (make-table/cell (make-test-content/walked-lisp-form))))))) ;;;;;; ;;; Wow (def function make-test-content/wow () (make-book/book "Lorem ipsum" (list "Levente Mészáros") (list (make-book/chapter "Graphics Domain" (list "Some graphics" #+nil (make-test-content/graphics))) (make-book/chapter "Text Domain" (list "Some text" (make-test-content/text))) (make-book/chapter "List Domain" (list "Some list" (make-test-content/list))) (make-book/chapter "Tree Domain" (list "Some tree" (make-test-content/tree))) (make-book/chapter "Table Domain" (list "Some table" (make-test-content/table))) (make-book/chapter "JSON Domain" (list "Some JSON" (make-test-content/json))) (make-book/chapter "XML Domain" (list "Some XML" (make-test-content/xml))) (make-book/chapter "Java code Domain" (list "Some Java code" (make-test-content/java))) (make-book/chapter "S-expression Domain" (list "Some Lisp S-expression" (make-test-content/lisp-form))) (make-book/chapter "Common Lisp code Domain" (list "Some Common Lisp code" (make-test-content/walked-lisp-form))) (make-book/chapter "Object Domain" (list "Some object" #+nil (make-test-content/t))))))