From c0a68242757529dac0b344d3b214a93ec157359e Mon Sep 17 00:00:00 2001 From: Peter Kofler Date: Mon, 3 Dec 2018 01:15:24 +0100 Subject: [PATCH] First draft of Scheme port. --- scheme/gilded-rose.scm | 46 +++++++++++++++++++++++++++++++++++++ scheme/texttest-feature.scm | 29 +++++++++++++++++++++++ 2 files changed, 75 insertions(+) create mode 100644 scheme/gilded-rose.scm create mode 100644 scheme/texttest-feature.scm diff --git a/scheme/gilded-rose.scm b/scheme/gilded-rose.scm new file mode 100644 index 00000000..28dc326d --- /dev/null +++ b/scheme/gilded-rose.scm @@ -0,0 +1,46 @@ +;;; Class ITEM + +(define-structure item + (name sell-in quality)) +;; defines make-item, item?, item-name, item-sell-in, item-quality, set-item-name!, set-item-sell-in!, set-item-quality! + +(define (item-to-string item) + (string-append (item-name item) + ", " + (number->string (item-sell-in item)) + ", " + (number->string (item-quality item)))) + +;;; Class GILDED-ROSE + +(define (update-quality items) + (for-each + (lambda (item) + (if (and (not (string-= (item-name item) "Aged Brie")) + (not (string-= (item-name item) "Backstage passes to a TAFKAL80ETC concert"))) + (if (> (item-quality item) 0) + (if (not (string-= (item-name item) "Sulfuras, Hand of Ragnaros")) + (set-item-quality! item (- (item-quality item) 1)))) + (cond ((< (item-quality item) 50) + (set-item-quality! item (+ (item-quality item) 1)) + (if (string-= (item-name item) "Backstage passes to a TAFKAL80ETC concert") + (if (< sell-in 11) + (if (< (item-quality item) 50) + (set-item-quality! item (+ (item-quality item) 1)))) + (if (< sell-in 6) + (if (< (item-quality item) 50) + (set-item-quality! item (+ (item-quality item) 1)))))))) + + (if (not (string-= (item-name item) "Sulfuras, Hand of Ragnaros")) + (set-item-sell-in! item (- (item-sell-in item) 1))) + + (if (< (item-sell-in item) 0) + (if (not (string-= (item-name item) "Aged Brie")) + (if (not (string-= (item-name item) "Backstage passes to a TAFKAL80ETC concert")) + (if (> (item-quality item) 0) + (if (not (string-= (item-name item) "Sulfuras, Hand of Ragnaros")) + (set-item-quality! item (- (item-quality item) 1)))) + (set-item-quality! item (- (item-quality item) (item-quality item)))) + (if (< (item-quality item) 50) + (set-item-quality! item (+ (item-quality item) 1)))))) + items)) diff --git a/scheme/texttest-feature.scm b/scheme/texttest-feature.scm new file mode 100644 index 00000000..8b9b4740 --- /dev/null +++ b/scheme/texttest-feature.scm @@ -0,0 +1,29 @@ +(include "gilded-rose.scm") + +(display "OMGHAI!") +(newline) +(let ((items (list (make-item "+5 Dexterity Vest" 10 20) + (make-item "Aged Brie" 2 0) + (make-item "Elixir of the Mongoose" 5 7) + (make-item "Sulfuras, Hand of Ragnaros" 0 80) + (make-item "Sulfuras, Hand of Ragnaros" -1 80) + (make-item "Backstage passes to a TAFKAL80ETC concert" 15 20) + (make-item "Backstage passes to a TAFKAL80ETC concert" 10 49) + (make-item "Backstage passes to a TAFKAL80ETC concert" 5 49) + ;; this conjured item does not work properly yet + (make-item "Conjured Mana Cake" 3 6))) + (days 2)) + + (define (x day) + (cond ((<= day days) + (display "-------- day ~a --------~%" i) + (newline) + (display "name, sell-in, quality") + (newline) + (for-each (lambda (item) + (display (item-to-string item)) + (newline)) + items) + (update-quality items) + (x (- day 1))))) + (x 0))