Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-10 of 14 total  RSS 

Java Cons class

Very simple Cons class for Java

public class Cons<T,U>
{
    private T car;
    private U cdr;

    public Cons( T carArg, U cdrArg )
    {
        car = carArg;
        cdr = cdrArg;
    }

    public T getCar(){ return car; }
    public U getCdr(){ return cdr; }
}
to template java lisp cons by frost137 on Apr 21, 2008

pairlis

// common LISP compatible pairlis for newLISP

;; 
;;(pairlis '(1 2 3) '("one" "two" "three") '((4 "four"))) 
;;

 
(define (pairlis keys data alist) 
  (setq data2 data) 
  (setq newlist '()) 
  (dolist (x keys) 
          (push (list x (pop data2)) newlist -1)) 
  (append newlist alist)) 

;; newLISPy way

(define (pairlis keys data alist) 
  (append (map (lambda (x y) (list x y)) keys data) alist))
to compatibility lisp newlisp pairlis by frontera000 on Oct 14, 2006

Amazon REST API for newLISP

;; (amazon-op "Operation=ItemSearch&SearchIndex=Books&ItemPage=1&Keywords=Cloud+Atlas&Respon\
seGroup=Request,Small")
;;
;; (amazon-op "Operation=SimilarityLookup&ItemId=1400063795,0812966929&SimilarityType=Random\
&ResponseGroup=Request,Large")
;; (amazon-op "Operation=SimilarityLookup&ItemId=1400063795,061873516X,0812966929&Similarity\
Type=Random&ResponseGroup=Request,Small")

;;  (setq x (xml-digest (amazon-op "Operation=ItemLookup&ItemId=0375507256&ResponseGroup=Req\
uest,Similarities,ListmaniaLists")))
;; Using x get a list of listmanias for an item
;;  (map (lambda (x) (x 1 2 2)) (1 -1 (x (chop (ref 'ListmaniaLists  x)))))

;; (setq y (amazon-op "Operation=ListLookup&ListType=Listmania&ListId=R21LV6VJEZ794O&Respons\
eGroup=ListFull"))
;; Using y get a list of ISBNs from a listmania
;; (map (lambda(x) (x 4 1 2 )) (8 -1 ( (y (chop (ref 'Lists y)) ) 2))) ; gives list of ISBNs\
 from the listmania

;; get a list of listmania details from a list of listmanias.
;;  (setq z   (map (lambda (x) (xml-digest (amazon-op (append "Operation=ListLookup&ListType\
=Listmania&ListId=" x "&ResponseGroup=ListFull"))))  (map (lambda (x) (x 1 2 2)) (1 -1 (x (c\
hop (ref 'ListmaniaLists  x))))))  )
;;
;; get a list of ISBNs from all of the listmanias for the item
;; (setq z (flat (map (lambda(y) (map (lambda(x) (x 4 1 2 )) (8 -1 ( (y (chop (ref 'Lists y)\
) ) 2))) ) z)))
;;

;; get item info for all the ISBNs from all listmanias related to the original item
;; (setq w (map (lambda (x) (xml-digest (amazon-op (append "Operation=ItemLookup&ItemId=" x)\
)))  (unique z)))

;; get a list of pair (title,author) from w above.
;; (map (lambda (x) (list ((x (chop (ref 'Title x))) 1)  (if (ref 'Author x)((x (chop (ref '\
Author x)))1) "???"))) w)

(define (amazon-op params)
  (get-url (append 
"http://webservices.amazon.com/onca/xml?Service=AWSECommerceService&&AWSAccessKeyId=YOUROWNKEY&" params)))

(define (xml-digest result)
  (xml-type-tags nil nil nil nil)
  (setq xresult (xml-parse result (+ 1 2 4 8 16))))
to xml Amazon rest lisp api newlisp by frontera000 on Oct 13, 2006

infinite loop or stack overflow

// description of your code here

(define (x x) (x x))

(x x)

;; Or

((lambda (x) (x x)) (lambda (x) (x x)))
to lisp by frontera000 on Oct 05, 2006 1 Comments

library mashup

// description of your code here

;; combine APIs and other web available bibliographic data.
;; Use amazon, LibraryThing, and OCLC Worldcat.
;; Get ISBN numbers for a book by searching author and title.
;; Get the list of available ISBNs from different sources.
;; Get "tags" available for a book from LibraryThing for
;; a given book.
;; etc.
;;
;; N.B. A person from LibraryThing.com posted a comment
;; regarding this program, indicating that the tag cloud data
;; is copyrighted. 
;;
;; Here's the quoted message:
;;
;; Tim's message: "And it's fine here, as a test, and probably in other 
;; contexts where it could be considered "fair use" under copyright. 
;; But--unlike the thingISBN service and some other LibraryThing 
;; APIs--LibraryThing's tag clouds are not free for public use, 
;; outside of the RSS feeds and widgets we provide. 
;; We're not sure how and under what license to 
;; release them when we do."
;;
;; So, I wrote this for fun.  If I were you I wouldn't run it, just read
;; the code.  :-)
;;


(define (search-worldcat title author)
  (setq title (replace " " title "+"))
  (setq author (replace " " author "+"))
  (get-url (append "http://worldcatlibraries.org/search?q=ti:" title "+au:" author "&qt=advanced")))

(setq oclc-url-1-pattern {<div class="name"><a href=})

(define (oclc-url-1 str)
  (setq loc (find oclc-url-1-pattern str))
  (setq loc (+ loc (length oclc-url-1-pattern)))
  (setq loc (+ 1 loc))
  (setq loc-end (find ">" (loc -1 str)))
  (setq loc-end (- loc-end 1))
  (setq loc-url (loc loc-end str))
  (println (append "http://worldcatlibraries.org" loc-url))
  (get-url (append "http://worldcatlibraries.org" loc-url)))

(setq oclc-isbn-pattern "<strong>ISBN: </strong>")

(define (find-isbn str)
  (setq loc (find oclc-isbn-pattern str))
  (setq loc (+ loc (length oclc-isbn-pattern)))
  (setq loc-end (find "</li>" (loc -1 str)))
  (loc loc-end str))

(define (thing-isbn isbn)
  (xml-type-tags nil nil nil nil)
  (setq isbn-data 
      (xml-parse (get-url  
          (append "http://www.librarything.com/api/thingISBN/" isbn)))))

(define (get-isbn-list isbn-data)
  (setq indexer (ref "isbn" isbn-data))
  (nth-set 2 indexer 2)
  (setq num-isbns (length  (isbn-data 0)))
  (setq isbn-list '())
  (for (idx (first (1 indexer))  (- num-isbns 1))
        (push (isbn-data (first (0 indexer)) idx (first (2 indexer))) isbn-list -1))
   isbn-list)

(define (add-explorer-path)
   (env "PATH" (append (env "PATH" ) ";c:\\program files\\internet explorer")))

(define (show-amazon-isbn isbn)
   (process (append "iexplore " "http://www.amazon.com/exec/obidos/ASIN/"
           isbn )))


(define (get-librarything-isbn isbn)
    (get-url (append "http://librarything.com/isbn/" isbn)))

(define (get-librarything-tagsection str)
    (setq loc (find "Tags used" str ))
    (setq mystr (loc -1 str))
    (setq loc-end (find "</div>" mystr))
     (0 loc-end mystr))

(define (get-librarything-taglist mystr)
    (setq tags-list '())
    (while (setq tag-loc (find "/tag/" mystr))
        (setq tag-loc-end (find "target=" (tag-loc -1 mystr)))
        (push ((+ tag-loc 5) (- tag-loc-end 7) mystr) tags-list -1)
        (setq mystr ((+ tag-loc tag-loc-end ) -1 mystr)))
    tags-list)

(define (show-librarything-tag tag)
   (process (append "iexplore " "http://www.librarything.com/tag/"
           tag )))
to Amazon lisp api oclc librarything worldcat by frontera000 on Sep 29, 2006

car cdr cons from little LISPer

// description of your code here

(define cons
 (lambda (u v)
   (lambda (b)
     (cond (b u)
     (#t v)))))
(define lunch (cons 'apple '()))
(define car (lambda (l) (l #t)))
(define cdr (lambda (l) (l #f)))
to lisp scheme car cdr cons by frontera000 on Sep 29, 2006

the applicative-order Y-combinator

// description of your code here

(define Y
  (lambda (f)
    (let ((future
            (lambda (future)
              (f (lambda (arg) 
                   ((future future) arg))))))
      (future future))))

((Y (lambda (factorial)
      (lambda (n)
        (if (= n 0)
            1
            (* n (factorial (- n 1)))))))
 42)
to lisp scheme Y-combinator by frontera000 on Sep 29, 2006

factorials in many incarnations

// http://www.cs.indiana.edu/~sganz/publications/icfp99/paper.pdf

;; simple definition of factorial:
;; this will run into trouble due to precision

(define (factorial-1  num)
  (if (= num 0)
      1
      (* num (factorial-1 (- num 1)))))

;; factorial using imported GMP package:
;; it works better but runs into trouble with too deep call stack

(load "gmp.lsp")

(define (factorial-gmp num)
  (if (= num 0)
      "1"
      (GMP:* (string num) (factorial-gmp (- num 1)))))

;; Finally, a trampoline style recursive definition of
;; factorial which simulates tail recursive implementation
;; avoiding call stack overflow

(define (factorial-acc num acc)
  (if (= num 0)
      (land (string acc))
      (bounce factorial-acc (- num 1) (GMP:* (string num) (string acc)))))

(define (factorial-trampoline num)
  (trampoline factorial-acc num 1))

(define (trampoline func num acc)
  (set 'bouncer (bounce func num acc))
  (catch (while 1
		(set 'bouncer (bouncer))
		(if (not (lambda? bouncer))
		    (throw bouncer)))))

(define (bounce)
  (letex (func (args 0) num (args 1) acc (args 2))
	(lambda() (func num acc))))

(define (land val)  val)
to lisp Factorial precision newlisp gmp recursion trampoline by frontera000 on Sep 25, 2006

md5 digest hash in newLISP

;;; md5 in newLISP

;;
;; based on RFC 1321
;;


(define (F x y z)
  (| (& x y) (& (& 0xffffffff (~ x)) z)))

(define (G x y z)
  (| (& x z) (& y (& 0xffffffff (~ z)))))

(define (H x y z)
  (^ x y z))

(define (I x y z)
  (^ y (| x (& 0xffffffff (~ z)))))

(define (rotate-left x n)
  (| (& 0xffffffff (<< x n)) (& 0xffffffff (>> x (- 32 n)))))

(define (FF a b c d x s ac)
  (set 'a (& 0xffffffff (+ a (F b c d) x ac)))
  (set 'a (rotate-left a s))
  (set 'a (& 0xffffffff (+ a b))))

(define (GG a b c d x s ac)
  (set 'a (& 0xffffffff (+ a (G b c d) x ac)))
  (set 'a (rotate-left a s))
  (set 'a (& 0xffffffff (+ a b))))

(define (HH a b c d x s ac)
  (set 'a (& 0xffffffff (+ a (H b c d) x ac)))
  (set 'a (rotate-left a s))
  (set 'a (& 0xffffffff (+ a b))))

(define (II a b c d x s ac)
  (set 'a (& 0xffffffff (+ a (I b c d) x ac)))
  (set 'a (rotate-left a s))
  (set 'a (& 0xffffffff (+ a b))))

(define (md5-init )
  (set 'md5-i '(0 0))
  (set 'md5-in (dup 0 64))
  (set 'md5-digest (dup 0 16))
  (set 'md5-buf '(0x67452301 0xefcdab89 0x98badcfe 0x10325476)))

(define (md5-update inbuf inlen)
  ;; compute number of bytes mod 64
  (set 'mdi (& (>> (md5-i 0) 3) 0x3f))

  ;; update number of bits
  (if (< (+ (md5-i 0)  (<< inlen 3)) (md5-i 0))
      (nth-set (md5-i 1) (+ 1 (md5-i 1))))

  (nth-set (md5-i 0) (+ (md5-i 0) (<< inlen 3)))
  (nth-set (md5-i 1) (+ (md5-i 1) (>> inlen 29)))

  (set 'inbuf-index 0)
  (while (> inlen 0)
	 ;; add new character to buffer, increment mdi
	 (nth-set (md5-in mdi) (inbuf inbuf-index))
	 (set 'mdi (+ mdi 1))
	 (set 'inbuf-index (+ inbuf-index 1))

	 ;; transform if necessary
	 (if (= mdi 0x40)
	     (begin
	       (set 'ii 0)
	       (set 'in (dup 0 16))
	       (for (i 0 15 1)
		    (nth-set (in i) (| (<< (char->int (md5-in (+ ii 3))) 24)
				       (<< (char->int (md5-in (+ ii 2))) 16)
				       (<< (char->int (md5-in (+ ii 1))) 8)
				       (char->int (md5-in ii))))
		    (set 'ii (+ ii 4)))
	       (transform  in)
	       (set 'mdi 0)))
	 (set 'inlen (- inlen 1))))

(define (char->int x)
  (if (integer? x) x (char x)))

(define (md5-final)
  (set 'in (dup 0 16))

  ;; save number of bits
  (nth-set (in 14) (md5-i 0))
  (nth-set (in 15) (md5-i 1))

  ;; compute number of bytse mod 64
  (set 'mdi (& (>> (md5-i 0) 3) 0x3f))

  ;; pad out to 56 mod 64
  (if (< mdi 56)
      (set 'padlen (- 56 mdi))
      (set 'padlen (- 120 mdi)))

  (set 'padding (dup 0 64))
  (nth-set (padding 0) 0x80)
  (md5-update padding padlen)

  ;; append lenth in bits and transform
  (set 'ii 0)
  (for (i 0 13 1)
       (nth-set (in i) (| (<< (char->int (md5-in (+ ii 3))) 24)
			  (<< (char->int (md5-in (+ ii 2))) 16)
			  (<< (char->int (md5-in (+ ii 1))) 8) (char->int (md5-in ii))))
       (set 'ii (+ ii 4)))
  (transform in)

  ;; store buffer in digest
  (set 'ii 0)
  (for (i 0 3 1)
       (nth-set (md5-digest ii) (& (md5-buf i) 0xff))
       (nth-set (md5-digest (+ ii 1)) (& (>> (md5-buf i) 8) 0xff))
       (nth-set (md5-digest (+ ii 2)) (& (>> (md5-buf i) 16)  0xff))
       (nth-set (md5-digest (+ ii 3)) (& (>> (md5-buf i) 24)  0xff))
       (set 'ii (+ ii 4))))

(define (transform  in)
  (set 'a (md5-buf 0))
  (set 'b (md5-buf 1))
  (set 'c (md5-buf 2))
  (set 'd (md5-buf 3))

  ;; Round 1
  (set 'S11 7)
  (set 'S12 12)
  (set 'S13 17)
  (set 'S14 22)
  (set 'a (FF a b c d (in 0) S11 3614090360)) 
  (set 'd (FF d a b c (in 1) S12 3905402710)) 
  (set 'c (FF c d a b (in 2) S13  606105819)) 
  (set 'b (FF b c d a (in 3) S14 3250441966)) 
  (set 'a (FF a b c d (in 4) S11 4118548399)) 
  (set 'd (FF d a b c (in 5) S12 1200080426)) 
  (set 'c (FF c d a b (in 6) S13 2821735955)) 
  (set 'b (FF b c d a (in 7) S14 4249261313)) 
  (set 'a (FF a b c d (in 8) S11 1770035416)) 
  (set 'd (FF d a b c (in 9) S12 2336552879)) 
  (set 'c (FF c d a b (in 10) S13 4294925233))
  (set 'b (FF b c d a (in 11) S14 2304563134))
  (set 'a (FF a b c d (in 12) S11 1804603682))
  (set 'd (FF d a b c (in 13) S12 4254626195))
  (set 'c (FF c d a b (in 14) S13 2792965006))
  (set 'b (FF b c d a (in 15) S14 1236535329))

  ;; Round 2 
  (set 'S21 5)
  (set 'S22 9)
  (set 'S23 14)
  (set 'S24 20)
  (set 'a (GG a b c d (in 1) S21 4129170786)) 
  (set 'd (GG d a b c (in 6) S22 3225465664)) 
  (set 'c (GG c d a b (in 11) S23  643717713))
  (set 'b (GG b c d a (in 0) S24 3921069994)) 
  (set 'a (GG a b c d (in 5) S21 3593408605)) 
  (set 'd (GG d a b c (in 10) S22   38016083))
  (set 'c (GG c d a b (in 15) S23 3634488961))
  (set 'b (GG b c d a (in 4) S24 3889429448)) 
  (set 'a (GG a b c d (in 9) S21  568446438)) 
  (set 'd (GG d a b c (in 14) S22 3275163606))
  (set 'c (GG c d a b (in 3) S23 4107603335)) 
  (set 'b (GG b c d a (in 8) S24 1163531501)) 
  (set 'a (GG a b c d (in 13) S21 2850285829))
  (set 'd (GG d a b c (in 2) S22 4243563512)) 
  (set 'c (GG c d a b (in 7) S23 1735328473)) 
  (set 'b (GG b c d a (in 12) S24 2368359562))

  ;; Round 3 
  (set 'S31 4)
  (set 'S32 11)
  (set 'S33 16)
  (set 'S34 23)
  (set 'a (HH a b c d (in 5) S31 4294588738)) 
  (set 'd (HH d a b c (in 8) S32 2272392833)) 
  (set 'c (HH c d a b (in 11) S33 1839030562))
  (set 'b (HH b c d a (in 14) S34 4259657740))
  (set 'a (HH a b c d (in 1) S31 2763975236)) 
  (set 'd (HH d a b c (in 4) S32 1272893353)) 
  (set 'c (HH c d a b (in 7) S33 4139469664)) 
  (set 'b (HH b c d a (in 10) S34 3200236656))
  (set 'a (HH a b c d (in 13) S31  681279174))
  (set 'd (HH d a b c (in 0) S32 3936430074)) 
  (set 'c (HH c d a b (in 3) S33 3572445317)) 
  (set 'b (HH b c d a (in 6) S34   76029189)) 
  (set 'a (HH a b c d (in 9) S31 3654602809)) 
  (set 'd (HH d a b c (in 12) S32 3873151461))
  (set 'c (HH c d a b (in 15) S33  530742520))
  (set 'b (HH b c d a (in 2) S34 3299628645)) 

  ;; Round 4 
  (set 'S41 6)
  (set 'S42 10)
  (set 'S43 15)
  (set 'S44 21)
  (set 'a (II a b c d (in 0) S41 4096336452)) 
  (set 'd (II d a b c (in 7) S42 1126891415)) 
  (set 'c (II c d a b (in 14) S43 2878612391))
  (set 'b (II b c d a (in 5) S44 4237533241)) 
  (set 'a (II a b c d (in 12) S41 1700485571))
  (set 'd (II d a b c (in 3) S42 2399980690)) 
  (set 'c (II c d a b (in 10) S43 4293915773))
  (set 'b (II b c d a (in 1) S44 2240044497)) 
  (set 'a (II a b c d (in 8) S41 1873313359)) 
  (set 'd (II d a b c (in 15) S42 4264355552))
  (set 'c (II c d a b (in 6) S43 2734768916)) 
  (set 'b (II b c d a (in 13) S44 1309151649))
  (set 'a (II a b c d (in 4) S41 4149444226)) 
  (set 'd (II d a b c (in 11) S42 3174756917))
  (set 'c (II c d a b (in 2) S43  718787259)) 
  (set 'b (II b c d a (in 9) S44 3951481745)) 

  (nth-set (md5-buf 0) (+ a (md5-buf 0)))
  (nth-set (md5-buf 1) (+ b (md5-buf 1)))
  (nth-set (md5-buf 2) (+ c (md5-buf 2)))
  (nth-set (md5-buf 3) (+ d (md5-buf 3))))

(define (md5-string str)
  (md5-init)
  (md5-update str (length str))
  (md5-final)
  (set 'result "")
  (for (i 0 15 1)
       (set 'result (append result (format "%02x" (md5-digest i)))))
  result)
to hash md5 lisp newlisp digest by frontera000 on Sep 14, 2006

Haiku generator in newLISP

; newLISP CGI code to generate a random Haiku
; in the style of Matsuo Basho, Japanese poet of the 17th century.
; fashioned after an old FORTH program 

#!/usr/bin/newlisp

(print "Content-type: text/html\n\n")

(print "<html><head><title>Random Haiku</title>")
(print "</HEAD>")
(print "<BODY>")
(print "<br><br><br><br><br><table border=0 cellpadding=0 cellspacing=0 width=600><tr><td><br>")

(println {<font face='verdana' size="2">})
(print "<blockquote><p><p>RANDOM HAIKU<p></p><p></p>")

(seed (time-of-day))

(set 'adjs '( "autumn" "hidden" "bitter" "misty" "silent"
	"empty" "dry" "dark" "summer" "icy"
	"delicate" "quiet" "white" "cool" "spring"
	"winter" "patient" "twilight" "dawn" "crimson"
	"wispy" "weathered" "blue" "billowing" "broken"
	"cold" "damp" "falling" "frosty" "green"
	"long" "late" "lingering" "bold" "little"
	"morning" "muddy" "old" "red" "rough"
	"still" "small" "sparkling" "throbbing" "shy"
	"wandering" "withered" "wild" "black" "young"
	"holy" "solitary" "fragrant" "aged" "snowy"
	"proud" "floral" "restless" "divine" "polished"
	"ancient" "purple" "lively" "nameless" ))

(set 'nouns '( "waterfall" "river" "breeze" "moon" "rain"
	"wind" "sea" "morning" "snow" "lake"
	"sunset" "pine" "shadow" "leaf" "dawn"
	"glitter" "forest" "hill" "cloud" "meadow"
	"sun" "glade" "bird" "brook" "butterfly"
	"bush" "dew" "dust" "field" "fire"
	"flower" "firefly" "feather" "grass" "haze"
	"mountain" "night" "pond" "darkness" "snowflake"
	"silence" "sound" "sky" "shape" "surf"
	"thunder" "violet" "water" "wildflower" "wave"
	"water" "resonance" "sun" "wood" "dream"
	"cherry" "tree" "fog" "frost" "voice"
	"paper" "frog" "smoke" "star"))

(set 'verbs '( "shakes" "drifts" "has stopped" "struggles" "hears"
	"has passed" "sleeps" "creeps" "flutters" "fades"
	"is falling" "trickles" "murmurs" "warms" "hides"
	"jumps" "is dreaming" "sleeps" "falls" "wanders"
	"waits" "has risen" "stands" "dying" "is drawing"
	"singing" "rises" "paints" "capturing" "flying"
	"lies" "picked up" "gathers in" "invites" "separates"
	"eats" "plants" "digs into" "has fallen" "weeping"
	"facing" "mourns" "tastes" "breaking" "shaking"
	"walks" "builds" "reveals" "piercing" "craves"
	"departing" "opens" "falling" "confronts" "keeps"
	"breaking" "is floating" "settles" "reaches" "illuminates"
	"closes" "leaves" "explodes" "drawing"))

(set 'preps '( "on" "beside" "in" "beneath" "of" "above" "under" "by"
	"over" "against" "near" ))


(define (get-word word-list)
	(set 'word-list-size (length word-list))
	(set 'word-list-index (rand word-list-size))
	(set 'selected-word (nth word-list-index word-list))
	(print " " selected-word " " ))

(define (get-adjective)
	(get-word adjs))

(define (get-noun)
	(get-word nouns))

(define (get-verb)
	(get-word verbs))

(define (get-prep)
	(get-word preps))

(define (style-one)
	(get-adjective)
	(get-noun)
	(print "<br>\n")
	(get-noun)
	(get-verb)
	(get-prep)
	(get-noun)
	(print "<br>\n")
	(get-adjective)
	(get-adjective)
	(get-noun)
	(print "<br>\n"))

(define (style-two)
	(get-adjective)
	(get-noun)
	(get-verb)
	(print "<br>\n")
	(get-adjective)
	(get-adjective)
	(get-noun)
	(print "<br>\n")
	(get-verb)
	(get-adjective)
	(get-noun)
	(print "<br>\n"))

(define (style-three)
	(get-adjective)
	(get-adjective)
	(get-noun)
	(print "<br>\n")
	(get-prep)
	(get-adjective)
	(get-noun)
	(print "<br>\n")
	(get-noun)
	(get-verb)
	(print "<br>\n"))

(define (style-four)
	(get-noun)
	(get-prep)
	(get-noun)
	(print "<br>\n")
	(get-adjective)
	(get-noun)
	(get-prep)
	(get-noun)
	(print "<br>\n")
	(get-adjective)
	(get-noun)
	(print "<br>\n"))

(define (print-haiku)
	(set 'which (rand 4))
	(if (= which 0)
	(style-one))
	(if (= which 1)
	(style-two))
	(if (= which 2)
	(style-three))
	(if (= which 3)
	(style-four)))

(print-haiku)

(print "<p></p>")
(print "<font size=1>")
(println {<p>You can click <a href="haiku.cgi">HERE</a> to see a new poem.})
(print "<p> Haiku generated in the style of Matsuo Basho, the Japanese poet of the 17th century.<br>
This haiku program originally written in pygmy <b>FORTH</b> by Kent Peterson.<br>Translated into <b>lisp</b>.")
(print "</blockquote> </table> </font> </body>\n</html>\n")

(exit)
to lisp newlisp haiku forth by frontera000 on Sep 11, 2006
« Newer Snippets
Older Snippets »
Showing 1-10 of 14 total  RSS