Source code for resistor.kix

; Practice using E12 color codes for resistors

; Version 1.00

; (C) 1997 - 2004, Rob van der Woude

; http://www.robvanderwoude.com

; Last revision 2004/11/08

; Use this program at your own risk.

; You may copy, distribute or even modify this program, provided

; you leave a note explaining your modifications in this header.

Select

	Case InStr("@SYSLANG","Dutch") > 0

		$StrVal     = "Waarde:"

		$StrBlack   = "Zwart  "

		$StrBrown   = "Bruin  "

		$StrRed     = "Rood   "

		$StrOrange  = "Oranje "

		$StrYellow  = "Geel   "

		$StrGreen   = "Groen  "

		$StrBlue    = "Blauw  "

		$StrMagenta = "Magenta"

		$StrGrey    = "Grijs  "

		$StrWhite   = "Wit    "

		$StrGold    = "Goud   "

		$StrYourAns = "Uw antwoord:        "

		$StrCorrAns = "Correcte antwoord:  "

		$StrPressQ  = "Q om te stoppen, elke andere toets om door te gaan . . ."

		$StrCorrect = "Correct!                            "

		$StrWrong   = "Helaas . . .                        "

		$StrDelim   = ","

	Case 1

		$StrVal = "Value: "

		$StrBlack   = "Black  "

		$StrBrown   = "Brown  "

		$StrRed     = "Red    "

		$StrOrange  = "Orange "

		$StrYellow  = "Yellow "

		$StrGreen   = "Green  "

		$StrBlue    = "Blue   "

		$StrMagenta = "Magenta"

		$StrGrey    = "Grey   "

		$StrWhite   = "White  "

		$StrGold    = "Gold   "

		$StrYourAns = "Your answer:        "

		$StrCorrAns = "Correct answer:     "

		$StrPressQ  = "Press Q to quit, or any key to continue . . ."

		$StrCorrect = "Correct!                            "

		$StrWrong   = "Sorry . . .                         "

		$StrDelim   = "."

EndSelect

; Store E12 values in an array

Dim $E12[11]

$E12 = Split("10 12 15 18 22 27 33 39 47 56 68 82")

Cls

; Show the color table at the top of the screen

$RC = At(0,0)

$RC = DispColor(0)

$RC = DispColor(0)

" 0"

$RC = At(0,7)

$RC = DispColor(1)

$RC = DispColor(1)

" 1"

$RC = At(0,14)

$RC = DispColor(2)

$RC = DispColor(2)

" 2"

$RC = At(0,21)

$RC = DispColor(3)

$RC = DispColor(3)

" 3"

$RC = At(0,28)

$RC = DispColor(4)

$RC = DispColor(4)

" 4"

$RC = At(0,35)

$RC = DispColor(5)

$RC = DispColor(5)

" 5"

$RC = At(0,42)

$RC = DispColor(6)

$RC = DispColor(6)

" 6"

$RC = At(0,49)

$RC = DispColor(7)

$RC = DispColor(7)

" 7"

$RC = At(0,56)

$RC = DispColor(8)

$RC = DispColor(8)

" 8"

$RC = At(0,63)

$RC = DispColor(9)

$RC = DispColor(9)

" 9"

$RC = At(0,70)

$RC = DispColor(-1)

$RC = DispColor(-1)

" x 0,1"

$RC = At(1,0)

"$StrBlack"

"$StrBrown"

"$StrRed"

"$StrOrange"

"$StrYellow"

"$StrGreen"

"$StrBlue"

"$StrMagenta"

"$StrGrey"

"$StrWhite"

"$StrGold"

; Draw the wires at the center of the screen

$RC = At(13,20)

Color n+/n

$i = 0

$OldASCII = SetASCII( "ON" )

While $i < 40

	$i = $i + 1

	Chr(196)

Loop

; Draw the resistor's body

$Row = 12

While $Row < 15

	$Col = 29

	While $Col < 50

		$RC = At($Row,$Col)

		$RC = DispColor(20)

		$Col = $Col + 1

	Loop

	$Row = $Row + 1

Loop

$RC = SetASCII( "$OldASCII" )

Color w/n

; Randomize the randomizer's start value

$RC = SRnd(10)

:Start

; Select a random value

$Ftr = Rnd(11)

$Ftr = $E12[$Ftr]

$r1  = Val($Ftr) / 10

$r1a = $r1 * 10

$r2  = Val($Ftr) - $r1a

$r3  = Rnd(9) - 1

$Resistance = Val("$Ftr")

$i = $r3

While $i > 0

	$Resistance = $Resistance * 10

	$i = $i - 1

Loop

; Draw the coloured rings

$Row = 12

While $Row < 15

	$RC = At($Row,31)

	$RC = DispColor($r1)

	$RC = At($Row,35)

	$RC = DispColor($r2)

	$RC = At($Row,39)

	$RC = DispColor($r3)

	$Row = $Row + 1

Loop

$RC = At(23,15)

"$StrVal                 "

$RC = At(23,23)

GetS $TryVal

$Val  = Val($TryVal)

$Len1 = Len($TryVal)

$Len2 = Len("$Val")

If $r3 = -1

	$Dec = LTrim(RTrim(SubStr("$TryVal",$Len2 + 1,1)))

	If $Dec <> "," & $Dec <> "."

		$Dec = $StrDelim

	EndIf

	$Resistance = SubStr($Ftr,1,Len($Ftr) - 1) + $Dec + SubStr($Ftr,Len($Ftr))

	If SubStr($Mult,1,1) = "," | SubStr($Mult,1,1) = "."

		$Val = $TryVal

	EndIf

EndIf

If $len1 <> $Len2

	$Mult = LTrim(RTrim(SubStr("$TryVal",$Len2 + 1)))

	Select

		Case SubStr($Mult,1,1) = "," | SubStr($Mult,1,1) = "."

			If $r3 = -1

				$Val = $TryVal

				$Resistance = SubStr($Ftr,1,Len($Ftr) - 1) + SubStr($Mult,1,1) + SubStr($Ftr,Len($Ftr))

			Else

				$Val        = 0

			EndIf

		Case $Mult = "K"

			$Val = $Val * 1000

		Case $Mult = "M"

			$Val = $Val * 1000 * 1000

		Case $Mult = "G"

			$Val = $Val * 1000 * 1000 * 1000

		Case 1

			$Val = 0

	EndSelect

EndIf

$RC = At(23,15)

If $Val = $Resistance

	Color g+/n

	"$StrCorrect"

	Color w/n

Else

	Color r+/n

	"$StrWrong"

	Color w/n

EndIf

$RC = At(24,15)

If $Val = 0

	"$StrYourAns $Val (or invalid)   "

Else

	"$StrYourAns $Val                "

EndIf

$RC = At(25,15)

"$StrCorrAns $Resistance         "

$RC = At(27,15)

"$StrPressQ"

Get $PressQ

If $PressQ <> "Q"

	$RC = At(24,15)

	"                                                               "

	$RC = At(25,15)

	"                                                               "

	$RC = At(27,15)

	"                                                               "

	GoTo "Start"

EndIf

Function DispColor( $ColNum )

	$DispColor = 0

	$OldASCII = SetASCII( "ON" )

	Select

		Case $ColNum = -1

			Color y/y+

			Chr(176)

			Chr(176)

		Case $ColNum = 0

			Color n/n+

			Chr(219)

			Chr(219)

		Case $ColNum = 1

			Color y/n

			Chr(219)

			Chr(219)

		Case $ColNum = 2

			Color r+/n

			Chr(219)

			Chr(219)

		Case $ColNum = 3

			Color y+/r+

			Chr(177)

			Chr(177)

		Case $ColNum = 4

			Color y+/n

			Chr(219)

			Chr(219)

		Case $ColNum = 5

			Color g+/n

			Chr(219)

			Chr(219)

		Case $ColNum = 6

			Color b+/n

			Chr(219)

			Chr(219)

		Case $ColNum = 7

			Color m/n

			Chr(219)

			Chr(219)

		Case $ColNum = 8

			Color w/n+

			Chr(219)

			Chr(219)

		Case $ColNum = 9

			Color w+/n+

			Chr(219)

			Chr(219)

		Case $ColNum = "20"

;			Color m/y+

			Color r+/y

			Chr(177)

			Chr(177)

		Case 1

			$DispColor = 1

	EndSelect

	$RC = SetASCII( "$OldASCII" )

	Color w/n

EndFunction