Basics of Janet
Descripción del contenido de la página
Conversión de antiguos programas de BASIC a Janet para aprender los rudimentos de este lenguaje.
Etiquetas:
3D Plot
# 3D Plot
# Original version in BASIC:
# 3-D Plot (by Mark Bramhall), 1978.
# Creative Computing (Morristown, New Jersey, USA), ca. 1980.
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-23.
#
# Last modified: 20251225T1944+0100.
(defn move-cursor-home []
(prin "\e[H"))
(defn clear-screen []
(prin "\e[2J")
(move-cursor-home))
(defn display-credits []
(print "3D Plot\n")
(print "Original version in BASIC:")
(print " Mark Bramhall, 1978.")
(print " Creative computing (Morristown, New Jersey, USA), ca. 1980.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(prin "Press Enter to start the program. ")
(flush)
(getline))
(defn a [z]
(* 30 (math/exp (/ (* (- z) z) 100))))
(defn draw []
(def line-width 56)
(def space (chr " "))
(def asterisk (chr "*"))
(def line (buffer/new-filled line-width space))
(var l 0)
(var z 0)
(var y1 0)
(var y 0)
(loop [x :range [-30 30.5 1.5]]
(set l 0)
(set y1 (* 5 (math/floor (/ (math/sqrt (- 900 (* x x))) 5))))
(loop [y :down [y1 (+ (- y1) -5) 5]]
(set z (math/floor (- (+ 25 (a (math/sqrt (+ (* x x) (* y y))))) (* 0.7 y))))
(when (> z l)
(set l z)
(buffer/push-at line z asterisk)))
(print line)
(buffer/fill line space)))
(defn main [& args]
(clear-screen)
(display-credits)
(clear-screen)
(draw))
Bagels
# Bagels
# Original version in BASIC:
# D. Resek, P. Rowe, 1978.
# Creative Computing (Morristown, New Jersey, USA), 1978.
# This version in Janet:
# Copyright (c) 2023, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2025-12-26/27.
#
# Last modified: 20251227T1413+0100.
(defn move-cursor-home []
(prin "\e[H"))
(defn clear-screen []
(prin "\e[2J")
(move-cursor-home))
(defn command [&opt prompt-text]
(default prompt-text "> ")
(prin prompt-text)
(string/trim (getline)))
(defn press-enter [prompt-text]
(while (not= (command prompt-text) "")) (break))
(defn is-yes? [word]
(index-of (string/ascii-lower word) ["ok" "y" "yeah" "yes"]))
(defn is-no? [word]
(index-of (string/ascii-lower word) ["n" "no" "nope"]))
(defn yes? [question]
(var answer "")
(while (not (or (is-yes? answer) (is-no? answer)))
(set answer (command question)))
(is-yes? answer))
(defn print-credits []
(clear-screen)
(print "Bagels")
(print "Number guessing game\n")
(print "Original source unknown but suspected to be:")
(print " Lawrence Hall of Science, U.C. Berkely.\n")
(print "Original version in BASIC:")
(print " D. Resek, P. Rowe, 1978.")
(print " Creative computing (Morristown, New Jersey, USA), 1978.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(press-enter "Press Enter to read the instructions. "))
(defn print-instructions []
(clear-screen)
(print "Bagels")
(print "Number guessing game\n")
(print "I am thinking of a three-digit number that has no two digits the same.")
(print "Try to guess it and I will give you clues as follows:\n")
(print " PICO - one digit correct but in the wrong position")
(print " FERMI - one digit correct and in the right position")
(print " BAGELS - no digits correct\n")
(press-enter "Press Enter to start. "))
(def digits 3)
(def random-number-generator (math/rng (os/time)))
(defn random-digits
"Return an array containing `digits` random integer numbers in range [0, 9]"
[]
(var result @[])
(while (< (length result) digits)
(var digit (math/rng-int random-number-generator 10))
(when (not (has-value? result digit))
(array/push result digit)))
result)
(defn digit?
"Is the string a digit?"
[s]
(and
(= (length s) 1)
(scan-number s)))
(defn only-digits? [s]
(string/check-set "0123456789" s))
(defn input [prompt-text]
`Return an array containing three random integer numbers in range [0, 9],
out of the string typed in by the user.`
(var user-digit @[])
(forever
(def raw-input (command prompt-text))
(cond
(not= (length raw-input) digits)
(print "Remember it's a " digits "-digit number.")
(not (only-digits? raw-input))
(print "What?")
(not= digits (length (distinct raw-input)))
(print "Remember my number has no two digits the same.")
(do
(for c 0 digits
(put user-digit c (scan-number (string/slice raw-input c (+ c 1)))))
(break))))
user-digit)
(defn play []
(def tries 20)
(var computer-number (array/new digits))
(var user-number (array/new digits))
(var score 0)
(var fermi 0) # counter
(var pico 0) # counter
(forever
(clear-screen)
(set computer-number (random-digits))
(print "O.K. I have a number in mind.")
(for guess 0 tries
(set user-number
(input (string "Guess #" (string/format "%02d" guess) ": ")))
(set fermi 0)
(set pico 0)
(for i 0 digits
(for j 0 digits
(when (= (get computer-number i) (get user-number j))
(if (= i j)
(+= fermi 1)
(+= pico 1)))))
(if (= (+ pico fermi) 0)
(prin "BAGELS")
(do
(prin (string/repeat "PICO " pico))
(prin (string/repeat "FERMI " fermi))))
(print)
(when (= fermi digits)
(break)))
(if (= fermi digits)
(do
(print "You got it!!!")
(+= score 1))
(do
(print "Oh well.")
(print "That's " tries " guesses. My number was ")
(print (get computer-number 0) (get computer-number 1) (get computer-number 2) "\n")))
(when (not (yes? "Play again? "))
(break)))
(when (not= score 0)
(print "A " score "-point bagels, buff!!"))
(print "Hope you had fun. Bye."))
(defn main [& args]
(print-credits)
(print-instructions)
(play))
Bug
# Bug
# Original version in BASIC:
# Brian Leibowitz, 1978.
# Creative Computing (Morristown, New Jersey, USA), 1978.
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written in 2025-12-27/30.
# Last modified: 20251230T1346+0100.
(def player-model
@{:pronoun ""
:possesive ""
:body false
:neck false
:head false
:feelers 0
:feeler-type "|"
:tail false
:legs 0})
(def player
@{:human
(table/setproto
@{:pronoun "you"
:possessive "your"
:feeler-type "A"}
player-model)
:computer
(table/setproto
@{:pronoun "I"
:possessive "my"
:feeler-type "F"}
player-model)})
(def body 1)
(def neck 2)
(def head 3)
(def feeler 4)
(def tail 5)
(def leg 6)
(def first-part body)
(def last-part leg)
(def part-name ["body" "neck" "head" "feeler" "tail" "leg"])
(def part-quantity [1 1 1 2 1 6])
(def body-height 2)
(def feeler-length 4)
(def leg-length 2)
(def max-feelers 2)
(def max-legs 6)
(def neck-length 2)
(defn move-cursor-home []
(prin "\e[H"))
(defn clear-screen []
(prin "\e[2J")
(move-cursor-home))
(defn move-cursor-up [&opt rows]
(default rows 1)
(prin "\e[" rows "A"))
(defn erase-line []
(prin "\e[2K"))
(defn erase-previous-line []
(move-cursor-up)
(erase-line))
(defn command [&opt prompt-text]
(default prompt-text "> ")
(prin prompt-text)
(flush)
(string/trim (getline)))
(defn press-enter [prompt-text]
(unless (= (length (command prompt-text)) 0)) (break))
(defn print-credits []
(clear-screen)
(print "Bug\n")
(print "Original version in BASIC:")
(print " Brian Leibowitz, 1978.")
(print " Creative computing (Morristown, New Jersey, USA), 1978.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(press-enter "Press Enter to read the instructions. "))
(def columns 3)
(def column-width 8)
(def column-separation 2)
(defn capitalized [s]
(string (string/ascii-upper (string/slice s 0 1)) (string/slice s 1)))
(defn left-justified [s n]
(string/format (string "%-" n "s") s))
(defn print-parts-table []
(def width (+ column-width column-separation))
# Headers
(def header ["Number" "Part" "Quantity"])
(for i 0 columns
(prin (left-justified (get header i) width)))
(print)
# Rulers
(for i 0 columns
(prin
(string/repeat "-" column-width)
(unless (= i (- columns 1))
(string/repeat " " column-separation))))
(print)
# Data
(for n first-part (+ last-part 1)
(print
(left-justified (string n) width)
(left-justified (capitalized (get part-name (- n 1))) width)
(get part-quantity (- n 1)))))
(defn print-instructions []
(clear-screen)
(print "Bug\n")
(print
`The object is to finish your bug before I finish mine. Each number
stands for a part of the bug body.
I will roll the die for you, tell you what I rolled for you, what the
number stands for, and if you can get the part. If you can get the
part I will give it to you. The same will happen on my turn.
If there is a change in either bug I will give you the option of
seeing the pictures of the bugs. The numbers stand for parts as
follows:`)
(print)
(print-parts-table)
(press-enter "\nPress Enter to start. "))
(defn print-head []
(print " HHHHHHH")
(print " H H")
(print " H O O H")
(print " H H")
(print " H V H")
(print " HHHHHHH"))
(defn print-bug [player]
(when (> (get player :feelers) 0)
(for i 0 feeler-length
(prin " ")
(for j 0 (get player :feelers)
(prin " " (get player :feeler-type)))
(print)))
(when (get player :head)
(print-head))
(when (get player :neck)
(for i 0 neck-length
(print " N N")))
(when (get player :body)
(print " BBBBBBBBBBBB")
(for i 0 body-height
(print " B B"))
(when (get player :tail)
(print "TTTTTB B"))
(print " BBBBBBBBBBBB"))
(when (> (get player :legs) 0)
(for i 0 leg-length
(prin " ")
(for j 0 (get player :legs)
(prin " L"))
(print))))
(def as-text ["no" "a" "two" "three" "four" "five" "six"])
(defn plural [number noun]
(string (get as-text number) " " noun (when (> number 1) "s")))
(defn add-part [part player]
(var changed false)
(case part
body
(if (get player :body)
(print ", but " (get player :pronoun) " already have a body.")
(do
(print "; " (get player :pronoun) " now have a body:")
(put player :body true)
(set changed true)))
neck
(cond
(get player :neck)
(print ", but " (get player :pronoun) " already have a neck.")
(not (get player :body))
(print ", but " (get player :pronoun) " need a body first.")
(do
(print "; " (get player :pronoun) " now have a neck:")
(put player :neck true)
(set changed true)))
head
(cond
(get player :head)
(print ", but " (get player :pronoun) " already have a head.")
(not (get player :neck))
(print ", but " (get player :pronoun) " need a a neck first.")
(do
(print "; " (get player :pronoun) " now have a head:")
(put player :head true)
(set changed true)))
feeler
(cond
(= (get player :feelers) max-feelers)
(print ", but " (get player :pronoun) " have two feelers already.")
(not (get player :head))
(print ", but " (get player :pronoun) " need a head first.")
(do
(+= (player :feelers) 1)
(prin
"; " (get player :pronoun) " now have "
(plural (get player :feelers) "feeler"))
(print ":")
(set changed true)))
tail
(cond
(get player :tail)
(print ", but " (get player :pronoun) " already have a tail.")
(not (get player :body))
(print ", but " (get player :pronoun) " need a body first.")
(do
(print "; " (get player :pronoun) " now have a tail:")
(put player :tail true)
(set changed true)))
leg
(cond
(= (get player :legs) max-legs)
(prin
", but " (get player :pronoun)
" have " (get as-text max-legs) " feet already.")
(not (get player :body))
(print ", but " (get player :pronoun) " need a body first.")
(do
(+= (player :legs) 1)
(prin
"; " (get player :pronoun)
" now have " (plural (get player :legs) "leg"))
(print ":")
(set changed true))))
changed)
(defn prompt-player []
(press-enter "Press Enter to roll the dice. ")
(erase-previous-line))
(defn random-int-in-range [minimum maximum]
(def random-number-generator (math/rng (os/cryptorand 16)))
(+ (math/rng-int random-number-generator (- maximum minimum)) minimum))
(defn dice []
(random-int-in-range first-part (+ 1 last-part)))
(defn turn [player]
(prompt-player)
(def part (dice))
(prin
(capitalized (get player :pronoun))
" rolled a " part " (" (get part-name (- part 1)) ")")
(when (add-part part player)
(print)
(print-bug player))
(print))
(defn finished? [player-id]
(and
(= max-feelers (get (get player player-id) :feelers))
(get (get player player-id) :tail)
(= max-legs (get (get player player-id) :legs))))
(defn print-finished [player-id]
(print (capitalized (get (get player player-id) :possessive)) " bug is finished."))
(defn print-winner []
(cond
(and (finished? :human) (finished? :computer))
(print "Both of our bugs are finished in the same number of turns!")
(finished? :human)
(print-finished :human)
(finished? :computer)
(print-finished :computer)))
(defn play []
(clear-screen)
(while (not (or (finished? :human) (finished? :computer)))
(turn (get player :human))
(turn (get player :computer)))
(print-winner))
(defn main [& args]
(print-credits)
(print-instructions)
(play)
(print "I hope you enjoyed the game, play it again soon!!"))
Bunny
# Bunny
# Original version in BASIC:
# Anonymous, 1978.
# Creative Computing (Morristown, New Jersey, USA), ca. 1980.
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-23.
#
# Last modified 20251225T1944+0100.
(defn move-cursor-home []
(prin "\x1B[H"))
(defn clear-screen []
(prin "\x1B[2J")
(move-cursor-home))
(defn print-credits []
(print "Bunny\n")
(print "Original version in BASIC:")
(print " Anonymous, 1978.")
(print " Creative Computing (Morristown, New Jersey, USA), 1978.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(prin "Press Enter to start the program. ")
(getline))
(def width 53)
(def space (chr " "))
(def line (buffer/new-filled width space))
(def EOL 127) # end of line identifier
(def data
[1 2 EOL 0 2 45 50 EOL 0 5 43 52 EOL 0 7 41 52 EOL
1 9 37 50 EOL 2 11 36 50 EOL 3 13 34 49 EOL 4 14
32 48 EOL 5 15 31 47 EOL 6 16 30 45 EOL 7 17 29 44
EOL 8 19 28 43 EOL 9 20 27 41 EOL 10 21 26 40 EOL
11 22 25 38 EOL 12 22 24 36 EOL 13 34 EOL 14 33 EOL
15 31 EOL 17 29 EOL 18 27 EOL 19 26 EOL 16 28 EOL
13 30 EOL 11 31 EOL 10 32 EOL 8 33 EOL 7 34 EOL 6
13 16 34 EOL 5 12 16 35 EOL 4 12 16 35 EOL 3 12 15
35 EOL 2 35 EOL 1 35 EOL 2 34 EOL 3 34 EOL 4 33
EOL 6 33 EOL 10 32 34 34 EOL 14 17 19 25 28 31 35
35 EOL 15 19 23 30 36 36 EOL 14 18 21 21 24 30 37 37
EOL 13 18 23 29 33 38 EOL 12 29 31 33 EOL 11 13 17
17 19 19 22 22 24 31 EOL 10 11 17 18 22 22 24 24 29
29 EOL 22 23 26 29 EOL 27 29 EOL 28 29 EOL])
(defn letter [column]
(def letters ["B" "U" "N" "N" "Y"])
(get letters (% column (length letters))))
(defn print-line []
(print line)
(buffer/fill line space))
(defn draw []
(var data-index 0)
(var first-column 0)
(while (< data-index (length data))
(set first-column (get data data-index))
(if (= first-column EOL)
(print-line)
(do
(+= data-index 1)
(def last-column (get data data-index))
(for column first-column (+ last-column 1)
(buffer/push-at line column (letter column)))))
(+= data-index 1)))
(defn main [& args]
(clear-screen)
(print-credits)
(clear-screen)
(draw))
Diamond
# Diamond
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-22.
#
# Last modified 20251223T1903+0100.
(defn main [& args]
(def lines 17)
(for i 1 (+ (/ lines 2) 1)
(for j 1 (+ (- (/ (+ lines 1) 2) i) 2)
(prin " "))
(for j 1 (* i 2)
(prin "*"))
(print))
(for i 1 (/ lines 2)
(for j 1 (+ i 2)
(prin " "))
(for j 1 (* (- (/ (+ lines 1) 2) i) 2)
(prin "*"))
(print)))
Math
# Math
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-24.
#
# Last modified 20251225T1945+0100.
(defn accept-string [prompt-text]
(prin prompt-text)
(string/trim (getline)))
(defn accept-number [prompt-text]
(def input (accept-string prompt-text))
(def number (scan-number input))
(if number
number
(do
(print "Number expected.")
(accept-number prompt-text))))
(defn show [basic-function scheme-procedure n result]
(print basic-function "(" n ") -> (" scheme-procedure " " n ") -> " result))
(defn sign [n]
(cond
(< n 0) -1
(> n 0) 1
0))
(defn main [& args]
(def n (accept-number "Enter a number: "))
(show "ABS" "math/abs" n (math/abs n))
(show "ATN" "math/atan" n (math/atan n))
(show "COS" "math/cos" n (math/cos n))
(show "EXP" "math/exp" n (math/exp n))
(show "INT" "math/trunc" n (math/trunc n))
(show "LOG" "math/log" n (math/log n))
(show "SGN" "ad-hoc/sign" n (sign n))
(show "SQR" "math/sqrt" n (math/sqrt n))
(show "TAN" "math/tan" n (math/tan n)))
Name
# Name
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-24.
#
# Last modified 20251225T1945+0100.
(defn accept-string [prompt-text]
(prin prompt-text)
(string/trim (getline)))
(defn accept-integer [prompt-text]
(def input (accept-string prompt-text))
(def number (scan-number input))
(if number
(math/trunc number)
(do
(print "Number expected.")
(accept-integer prompt-text))))
(defn main [& args]
(def name (accept-string "What is your name? "))
(def times (accept-integer "Enter a number: "))
(for i 0 times
(print "Hello, " name "!")))
Poetry
# Poetry
# Original version in BASIC:
# Unknown author.
# Modified and reworked by Jim Bailey, Peggy Ewing, and Dave Ahl at DEC.
# Published in "BASIC Computer Games", Creative Computing (Morristown, New Jersey, USA), 1978.
# https://archive.org/details/Basic_Computer_Games_Microcomputer_Edition_1978_Creative_Computing
# https://github.com/chaosotter/basic-games/tree/master/games/BASIC%20Computer%20Games/Poetry
# http://vintage-basic.net/games.html
# This improved remake in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-26.
#
# Last modified: 20251227T1213+0100.
# Terminal {{{1
# =============================================================================
(def black 0)
(def red 1)
(def green 2)
(def yellow 3)
(def blue 4)
(def magenta 5)
(def cyan 6)
(def white 7)
(def default-color 9)
(def style-off 20)
(def foreground 30)
(def background 40)
(def bright 60)
(def normal-style 0)
(defn move-cursor-home []
(prin "\x1B[H"))
(defn set-style [style]
(prin (string/format "\x1B[%dm" style)))
(defn reset-attributes []
(set-style normal-style))
(defn erase-screen []
(prin "\x1B[2J"))
(defn clear-screen []
(erase-screen)
(move-cursor-home)
(reset-attributes))
(def default-ink (+ foreground white))
(def input-ink (+ foreground bright green))
(def title-ink (+ foreground bright red))
# Input {{{1
# =============================================================
(defn input-string [&opt prompt-text]
(default prompt-text "> ")
(set-style input-ink)
(defer (set-style default-ink)
(do
(prin prompt-text)
(flush)
(string/trim (getline)))))
# Title and credits {{{1
# =============================================================
(defn print-title []
(set-style title-ink)
(print "Poetry")
(set-style default-ink))
(defn print-credits []
(print-title)
(print "\nOriginal version in BASIC:")
(print " Unknown author.")
(print " Published in \"BASIC Computer Games\",")
(print " Creative Computing (Morristown, New Jersey, USA), 1978.\n")
(print "This improved remake in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair"))
# Main {{{1
# =============================================================
(defn play []
(def max-phrases-and-verses 20)
(var action 0)
(var phrase 0)
(var phrases-and-verses 0)
(var verse-chunks 0)
(def random-number-generator (math/rng (os/time)))
(defn action-0 []
(case phrase
0 (prin "MIDNIGHT DREARY")
1 (prin "FIERY EYES")
2 (prin "BIRD OR FIEND")
3 (prin "THING OF EVIL")
4 (prin "PROPHET")))
(while true
(prompt :top
(var manage-the-verse-continuation true)
(var maybe-add-comma true)
(case action
0 (action-0)
1 (action-0)
2
(case phrase
0 (do (prin "BEGUILING ME") (set verse-chunks 2))
1 (prin "THRILLED ME")
2 (do (prin "STILL SITTING…") (set maybe-add-comma false))
3 (do (prin "NEVER FLITTING") (set verse-chunks 2))
4 (prin "BURNED"))
3
(case phrase
0 (prin "AND MY SOUL")
1 (prin "DARKNESS THERE")
2 (prin "SHALL BE LIFTED")
3 (prin "QUOTH THE RAVEN")
4 (when (not= verse-chunks 0) (prin "SIGN OF PARTING")))
4
(case phrase
0 (prin "NOTHING MORE")
1 (prin "YET AGAIN")
2 (prin "SLOWLY CREEPING")
3 (prin "…EVERMORE")
4 (prin "NEVERMORE"))
5
(do
(set action 0)
(print)
(if (> phrases-and-verses max-phrases-and-verses)
(do
(print)
(set verse-chunks 0)
(set phrases-and-verses 0)
(set action 2)
(return :top))
(set manage-the-verse-continuation false))))
(when manage-the-verse-continuation
(os/sleep 0.250)
(when (and maybe-add-comma (not (or (= verse-chunks 0) (> (math/random) 0.19))))
(prin ",")
(set verse-chunks 2))
(if (> (math/random) 0.65)
(do
(print)
(set verse-chunks 0))
(do
(prin " ")
(+= verse-chunks 1))))
(+= action 1)
(set phrase (math/rng-int random-number-generator 5))
(+= phrases-and-verses 1)
(when (not (or (> verse-chunks 0) (even? action)))
(prin " ")))))
(defn main [& args]
(clear-screen)
(print-credits)
(input-string "\nPress the Enter key to start. ")
(clear-screen)
(play))
Russian Roulette
# Russion Roulette
# Original version in BASIC:
# By Tom Adametx, 1978.
# Creative Computing's BASIC Games.
# - https://www.atariarchives.org/basicgames/showpage.php?page=141
# - http://vintage-basic.net/games.html
# - http://vintage-basic.net/bcg/russianroulette.bas
# - http://www.retroarchive.org/cpm/games/ccgames.zip
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-24.
#
# Last modified 20251225T1331+0100.
(def normal-style 0)
(defn move-cursor-home []
(prin "\x1B[H"))
(defn set-style [style]
(prin (string/format "\x1B[%dm" style)))
(defn reset-attributes []
(set-style normal-style))
(defn erase-screen []
(prin "\x1B[2J"))
(defn clear-screen []
(erase-screen)
(reset-attributes)
(move-cursor-home))
(defn accept-string [&opt prompt-text]
(default prompt-text "> ")
(prin prompt-text)
(string/trim (getline)))
(defn press-enter-to-start []
(accept-string "Press Enter to start. "))
(defn print-credits []
(clear-screen)
(print "Russian Roulette\n")
(print "Original version in BASIC:")
(print " By Tom Adametx, 1978.\n")
(print " Creative Computing's BASIC Games.")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(press-enter-to-start))
(defn print-instructions []
(clear-screen)
(print "Here is a revolver.")
(print "Type 'f' to spin chamber and pull trigger.")
(print "Type 'g' to give up, and play again.")
(print "Type 'q' to quit.\n"))
(defn deadly []
(> (math/random) 0.83))
(var times 0)
(defn last-shoot []
(if (deadly)
(do
(print "Bang! You're dead!")
(print "Condolences will be sent to your relatives.")
true)
(do
(+= times 1)
(def max-times 10)
(if (> times max-times)
(do
(print "You win!")
(print "Let someone else blow his brains out.")
true)
(do
(print "Click.")
false)))))
(defn play []
(set times 0)
(var more true)
(forever
(case (accept-string)
"f"
(do
(if (last-shoot)
(break)))
"g"
(do
(print "Chicken!")
(break))
"q"
(do
(set more false)
(break))))
more)
(defn play-game []
(forever
(print-instructions)
(if (not (play))
(break))
(press-enter-to-start)))
(defn main [& args]
(print-credits)
(play-game)
(print "Bye!"))
Sine Wave
# Sine Wave
# Original version in BASIC:
# Anonymous, 1978.
# Creative Computing's BASIC Games.
# - https://www.atariarchives.org/basicgames/showpage.php?page=146
# - http://vintage-basic.net/games.html
# - http://vintage-basic.net/bcg/sinewave.bas
# - http://www.retroarchive.org/cpm/games/ccgames.zip
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-23.
#
# Last modified 20260215T1957+0100.
(defn move-cursor-home []
(prin "\x1B[H"))
(defn clear-screen []
(prin "\x1B[2J")
(move-cursor-home))
(defn print-credits []
(clear-screen)
(print "Sine Wave\n")
(print "Original version in BASIC:")
(print " Anonymous, 1978.")
(print " Creative Computing (Morristown, New Jersey, USA), ca. 1980.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(prin "Press Enter to start the program. ")
(getline))
(def word @["" ""])
(defn get-words []
(def order @["first" "second"])
(clear-screen)
(for w 0 2
(prin "Enter the " (get order w) " word: ")
(put word w (string/trim (getline)))))
(defn boolean->integer [b]
(if b 1 0))
(defn draw []
(var even false)
(loop [a :range [0 40.25 0.25]]
(prin (string/repeat " " (math/floor (+ (* (math/sin a) 25) 26))))
(print (get word (boolean->integer even)))
(set even (not even))))
(defn main [& args]
(clear-screen)
(print-credits)
(get-words)
(print)
(draw))
Slots
# Slots
# A slot machine simulation.
# Original version in BASIC:
# Creative Computing (Morristown, New Jersey, USA).
# Produced by Fred Mirabelle and Bob Harper on 1973-01-29.
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-27.
#
# Last modified: 20251227T2048+0100.
# Terminal {{{1
# ==============================================================================
# Screen colors
(def black 0)
(def red 1)
(def green 2)
(def yellow 3)
(def blue 4)
(def magenta 5)
(def cyan 6)
(def white 7)
(def default-color 9)
# Screen attributes
(def normal 0)
# Screen color offsets
(def foreground +30)
(def bright +60)
(defn move-cursor-home []
(prin "\e[H"))
(defn clear-screen []
(prin "\e[2J")
(move-cursor-home))
(defn set-color [color]
(prin "\e[" color "m")
)
(defn set-attribute [attr]
(prin "\e[0;" attr "m")
)
(defn hide-cursor []
(prin "\e[?25l"))
(defn show-cursor []
(prin "\e[?25h"))
# Config {{{1
# ==============================================================================
(def reels 3)
(def image [" BAR " " BELL " "ORANGE" "LEMON " " PLUM " "CHERRY"])
(def images (length image))
(def bar 0) # position of "BAR" in `image`.
(def min-bet 1)
(def max-bet 100)
(def input-color (+ green foreground))
(def ordinary-color (+ default-color foreground))
# User Input {{{1
# ==============================================================================
(defn command [&opt prompt-text]
(default prompt-text "> ")
(set-color input-color)
(defer (set-color ordinary-color)
(do
(prin prompt-text)
(flush)
(string/trim (getline)))))
(defn get-integer-or-0 [prompt-text]
(def number (scan-number (command prompt-text)))
(if number
(math/trunc number)
0))
(defn press-enter [prompt-text]
(while (not= (command prompt-text) "")) (break))
# Credits and instructions {{{1
# ==============================================================================
(defn print-credits []
(clear-screen)
(print "Slots")
(print "A slot machine simulation.\n")
(print "Original version in BASIC:")
(print " Creative computing (Morristown, New Jersey, USA).")
(print " Produced by Fred Mirabelle and Bob Harper on 1973-01-29.\n")
(print "This version in Janet:")
(print " Copyright (c) 2025, Marcos Cruz (programandala.net)")
(print " SPDX-License-Identifier: Fair\n")
(press-enter "Press Enter for instructions. "))
(defn print-instructions []
(clear-screen)
(print "You are in the H&M casino, in front of one of our")
(print "one-arm bandits. Bet from " min-bet " to " max-bet " USD (or 0 to quit).\n")
(press-enter "Press Enter to start. "))
# Main {{{1
# ==============================================================================
(defn won [prize bet]
(case prize
2 (print "DOUBLE!")
5 (print "*DOUBLE BAR*")
10 (print "**TOP DOLLAR**")
100 (print "***JACKPOT***"))
(print "You won!")
(* bet (+ prize 1)))
(defn show-standings [usd]
(print "Your standings are " usd " USD."))
(def image-color [
(+ foreground white)
(+ foreground cyan)
(+ foreground yellow)
(+ foreground bright yellow)
(+ foreground bright white)
(+ foreground bright red)])
(defn print-reels [reel]
(move-cursor-home)
(each r reel
(set-color (image-color r))
(prin "[" (get image r) "] "))
(set-attribute normal)
(print))
(def random-number-generator (math/rng (os/time)))
(defn random-image []
(math/rng-int random-number-generator images))
(defn init-reels [reel]
(eachk i reel
(put reel i (random-image))))
(defn spin-reels [reel]
(def spins 24000)
(hide-cursor)
(for _ 0 spins
(eachk i reel
(put reel i (random-image)))
(print-reels reel))
(show-cursor))
(defn prize [reel]
(def duplicates (- (length reel) (length (distinct reel))))
(def equals
(if (= duplicates 0)
duplicates
(+ 1 duplicates)))
(def bars (length (filter |(= $ bar) reel)))
[equals bars])
(defn play []
(var standings 0)
(var reel @[0 0 0])
(init-reels reel)
(var betting true)
(var playing true)
(while playing
(var bet 0)
(while (and playing betting)
(clear-screen)
(print-reels reel)
(set bet (get-integer-or-0 "Your bet (or 0 to quit): "))
(cond
(> bet max-bet)
(do
(print "House limits are " max-bet " USD.")
(press-enter "Press Enter to try again. "))
(< bet min-bet)
(when (= "q" (command "Type \"q\" to confirm you want to quit: "))
(set playing false)
(set betting false))
(set betting false)))
(when playing
(clear-screen)
(spin-reels reel)
(def [equals bars] (prize reel))
(cond
(= equals reels)
(if (= bars reels)
(+= standings (won 100 bet))
(+= standings (won 10 bet)))
(= equals 2)
(if (= bars 2)
(+= standings (won 5 bet))
(+= standings (won 2 bet)))
(do
(print "You lost.")
(-= standings bet)))
(show-standings standings)
(press-enter "Press Enter to continue. ")
(set betting true)))
(show-standings standings)
(cond
(< standings 0)
(print "Pay up! Please leave your money on the terminal.")
(= standings 0)
(print "Hey, you broke even.")
(> standings 0)
(print "Collect your winnings from the H&M cashier.")))
(defn main [& args]
(print-credits)
(print-instructions)
(play))
Stars
# Stars
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-24.
#
# Last modified 20251225T1946+0100.
(defn accept-string [prompt-text]
(prin prompt-text)
(string/trim (getline)))
(defn accept-integer [prompt-text]
(def input (accept-string prompt-text))
(def number (scan-number input))
(if number
(math/trunc number)
(do
(print "Number expected.")
(accept-integer prompt-text))))
(defn yes? [question]
(let [input (accept-string question)]
(index-of (string/ascii-lower input) ["ok" "y" "yeah" "yes"])))
(defn main [& args]
(def name (accept-string "What is your name? "))
(print "Hello, " (string/trim name) ".")
(forever
(def number (accept-integer "How many stars do you want? "))
(print (string/repeat "*" number))
(if (not (yes? "Do you want more stars? "))
(break))))
Strings
# Strings
# Original version in BASIC:
# Example included in Vintage BASIC 1.0.3.
# http://www.vintage-basic.net
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-24.
#
# Last modified 20251225T1946+0100.
(defn accept-string [prompt-text]
(prin prompt-text)
(string/trim (getline)))
(defn accept-integer [prompt-text-text]
(def input (accept-string prompt-text-text))
(def number (scan-number input))
(if number
(math/trunc number)
(do
(print "Number expected.")
(accept-integer prompt-text-text))))
(defn main [& args]
(def s (accept-string "Enter a string: "))
(def n (accept-integer "Enter a number: "))
(print
(string/format
"ASC(\"%s\") --> (get (string/bytes \"%s\") 0) --> %d"
s s (get (string/bytes s) 0)))
(print
(string/format
"CHR$(%d) --> (string/from-bytes %d) --> \"%s\""
n n (string/from-bytes n)))
(print
(string/format
"LEFT$(\"%s\", %d) --> (string/slice \"%s\" 0 (min %d (length \"%s\"))) --> \"%s\""
s n s n s (string/slice s 0 (min n (length s)))))
(print
(string/format
"MID$(\"%s\", %d) --> (string/slice \"%s\" (min (- %d 1) (length \"%s\"))) --> \"%s\""
s n s n s (string/slice s (min (- n 1) (length s)))))
(print
(string/format
"MID$(\"%s\", %d, 3) --> (string/slice \"%s\" (min (- %d 1) (length \"%s\")) (min (+ (- %d 1 ) 3) (length \"%s\"))) --> \"%s\""
s n s n s n s (string/slice s (min (- n 1) (length s)) (min (+ (- n 1) 3) (length s)))))
(print
(string/format
"RIGHT$(\"%s\", %d) --> (string/slice \"%s\" (max (- (+ 1 (length \"%s\"))) (- (+ 1 %d)))) --> \"%s\""
s n s s n (string/slice s (max (- (+ 1 (length s))) (- (+ 1 n))))))
(print
(string/format
"LEN(\"%s\") --> (length \"%s\") --> %d"
s s (length s)))
(print
(string/format
"VAL(\"%s\") --> (or (scan-number \"%s\") 0) --> %d"
s s (or (scan-number s) 0)))
(print
(string/format
"STR$(%d) --> (string %d) --> \"%s\""
n n (string n)))
(print
(string/format
"SPC(%d) --> (string/repeat \" \" %d) --> \"%s\""
n n (string/repeat " " n))))
Z-End
# Z-End
# Original version in BASIC:
# A to Z Book of Computer Games, by Thomas C. McIntire, 1979.
# - https://archive.org/details/A_to_Z_Book_of_Computer_Games_1979_Thomas_C_McIntire/page/n293/mode/2up
# - https://github.com/chaosotter/basic-games/tree/master/games/A%20to%20Z%20Book%20of%20Computer%20Games/Z-End
# This version in Janet:
# Copyright (c) 2025, Marcos Cruz (programandala.net)
# SPDX-License-Identifier: Fair
#
# Written on 2025-12-25.
#
# Last modified: 20251227T1413+0100.
# Terminal {{{1
# =============================================================================
(def black 0)
(def red 1)
(def green 2)
(def yellow 3)
(def blue 4)
(def magenta 5)
(def cyan 6)
(def white 7)
(def default-color 9)
(def style-off 20)
(def foreground 30)
(def background 40)
(def bright 60)
(def NORMAL_STYLE 0)
(defn move-cursor-home []
(prin "\x1B[H"))
(defn set-style [style]
(prin (string/format "\x1B[%dm" style)))
(defn color [n]
(set-style (+ n foreground)))
(defn reset-attributes []
(set-style NORMAL_STYLE))
(defn erase-screen []
(prin "\x1B[2J"))
(defn clear-screen []
(erase-screen)
(move-cursor-home)
(reset-attributes))
# Input {{{1
# =============================================================================
(defn accept-string [&opt prompt-text]
(default prompt-text "> ")
(color green)
(defer (color white)
(do
(prin prompt-text)
(flush)
(string/trim (getline)))))
(defn accept-integer [prompt-text]
(def input (accept-string prompt-text))
(def number (scan-number input))
(if number
(math/trunc number)
(do
(print "Number expected.")
(accept-integer prompt-text))))
(defn yes? [question]
(def input (accept-string question))
(index-of (string/ascii-lower input) ["ok" "y" "yeah" "yes"]))
# Main {{{1
# =============================================================================
(defn print-rules []
(clear-screen)
(color red)
(print "Z-End\n")
(when (not (yes? "Skip the rules? (Y/N) "))
(color yellow)
(print "\nI'll print the alphabet, and you're first. You type the number of letters")
(print "that I should omit next time. We take turns, and the limit per turn is five.")
(print "The one that gets the 'Z' is the loser, and that's Z-End!\n")
(print "Good luck, cuz I'm clever..."))
(print)
(color white))
(def random-number-generator (math/rng (os/time)))
(defn uniform
"Return a random integer in the range [minimum maximum)."
[minimum maximum]
(+ (math/rng-int random-number-generator (- maximum minimum)) minimum))
(def alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(var first-letter 0)
(var remaining-letters (- (length alphabet) first-letter))
(def minimum-pick 1)
(def maximum-pick 5)
(defn computer-pick []
(var pick 0)
(set remaining-letters (- (length alphabet) first-letter))
(cond
(< remaining-letters 6) (set pick (- remaining-letters 1))
(> remaining-letters > 10) (set pick (uniform minimum-pick (+ maximum-pick 1)))
(set pick 1))
(print "My pick is " pick ".")
pick)
(defn human-pick []
(var pick 0)
(forever
(set
pick
(accept-integer
(string/format "Your turn (%d-%d) " minimum-pick maximum-pick)))
(if (or (< pick minimum-pick) (> pick maximum-pick))
(print "Illegal entry -- must be in range 1 to 5!")
(break)))
pick)
(defn game-over []
(= first-letter (- (length alphabet) 1)))
(defn print-alphabet [&opt omitted-letters]
(default omitted-letters 0)
(+= first-letter omitted-letters)
(color magenta)
(print (string/slice alphabet first-letter))
(print)
(color white))
(defn print-result [player]
(prin "Z-End -- ")
(case player
:computer
(do
(print "Ha ha!")
(break))
:human
(do
(print "Oops!")
(break))))
(defn pick-of [player]
(case player
:computer (computer-pick)
:human (human-pick)))
(defn playing [player]
(print-alphabet (pick-of player))
(when (game-over)
(print-result player))
(not (game-over)))
(defn play []
(set first-letter 0)
(print-alphabet)
(while (and (playing :human) (playing :computer)) ()))
(defn again []
(print)
(yes? "Do it again (Y/N) "))
(defn main [& args]
(print-rules)
(forever
(play)
(when (not (again)) (break)))
(print "\nGoodbye."))