現在のページの位置: くろねこスクエア Labs > 未分類 > 1990年代のあみだくじ

くろねこスクエア Labs

1990年代のあみだくじ

かなり前に作ったあみだくじのプログラムは、以下のようなコードでした。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
'/for QuickBASIC
'$lang: "qb"

DIM a(20), b(10)

ta$ = RIGHT$(TIME$, 2)
RANDOMIZE (ASC(ta$))
FOR y = 1 TO 8: b(y) = INT(RND * 6) + 1: NEXT y

CLS
LOCATE 5, 10: PRINT "1 2 3 4 5 6 7 8"
LOCATE 15,10: INPUT "番号を選んでください ", k
FOR x = 1 TO 8: a(x) = x: NEXT x
FOR y = 1 TO 7
    n = b(y): GOSUB write_line
    c = a(n): a(n) = a(n + 1): a(n + 1) = c
NEXT y

LOCATE 5 + y, 10
IF c = 1 THEN PRINT "○ × × × × × × ×": z = 1
IF c = 2 THEN PRINT "× ○ × × × × × ×": z = 2
IF c = 3 THEN PRINT "× × ○ × × × × ×": z = 3
IF c = 4 THEN PRINT "× × × ○ × × × ×": z = 4
IF c = 5 THEN PRINT "× × × × ○ × × ×": z = 5
IF c = 6 THEN PRINT "× × × × × ○ × ×": z = 6
IF c = 7 THEN PRINT "× × × × × × ○ ×": z = 7
IF c = 8 THEN PRINT "× × × × × × × ○": z = 8

LOCATE 5 + y + 2, 10
IF a(z) = k THEN PRINT k; "はあたりです          ": END
PRINT k; "ははずれです          ": END

write_line:
LOCATE 5 + y, 10
IF n = 1 THEN PRINT "|---|   |   |   |   |   |   |": RETURN
IF n = 2 THEN PRINT "|   |---|   |   |   |   |   |": RETURN
IF n = 3 THEN PRINT "|   |   |---|   |   |   |   |": RETURN
IF n = 4 THEN PRINT "|   |   |   |---|   |   |   |": RETURN
IF n = 5 THEN PRINT "|   |   |   |   |---|   |   |": RETURN
IF n = 6 THEN PRINT "|   |   |   |   |   |---|   |": RETURN
IF n = 7 THEN PRINT "|   |   |   |   |   |   |---|": RETURN

今や昔のQuickBASICかと思いきや、2004年に登場したFreeBASICでは、lang指定さえすれば、このままコンパイルできるのです。マルチバイトも特に問題なし。FreeBASICならGPLでクロスプラットホームですし、過去のプログラムもそれなりに活用できますね。

さらに、FreeBASICならオブジェクト指向風にも書けます。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
'/for FreeBASIC
Type Amida
    Dim a(20) as Byte
    Dim b(10) as Byte
    Declare Constructor()
    Declare Sub wrLine (n as Byte)
    Declare Function get_result (c as Byte) as Byte
    Declare Function judge (a() as Byte, k as Byte, z as Byte) as Byte
End Type
'-----------
Constructor Amida()
    Dim ta as String
    Dim as Byte c, k, n, x, y, z
    ta = Right(Time, 2)
    Randomize (Asc(ta))
    For y = 1 To 8: b(y) = Int(Rnd * 6) + 1: Next y
    Cls
    Locate 5, 10: Print "1 2 3 4 5 6 7 8"
    Locate 15,10: Input "番号を選んでください ", k
    For x = 1 To 8: a(x) = x: Next x
    For y = 1 To 7
        n = b(y)
        Locate 5 + y, 10
        This.wrLine(n)
        c = a(n): a(n) = a(n + 1): a(n + 1) = c
    Next y

    Locate 5 + y, 10
    z = This.get_result(c)
   
    Locate 5 + y + 2, 10
    If This.judge(a(),k,z) = 1 Then
        Print k; "はあたりです          "
    Else
        Print k; "ははずれです          "
    End If
End Constructor
'-----------
Function Amida.get_result(c as Byte) as Byte
    Dim z as Byte
    If c = 1 Then Print "○ × × × × × × ×": z = 1
    If c = 2 Then Print "× ○ × × × × × ×": z = 2
    If c = 3 Then Print "× × ○ × × × × ×": z = 3
    If c = 4 Then Print "× × × ○ × × × ×": z = 4
    If c = 5 Then Print "× × × × ○ × × ×": z = 5
    If c = 6 Then Print "× × × × × ○ × ×": z = 6
    If c = 7 Then Print "× × × × × × ○ ×": z = 7
    If c = 8 Then Print "× × × × × × × ○": z = 8
    Return z
End Function
'-----------
Sub Amida.wrLine(n as Byte)
    If n = 1 Then Print "|---|   |   |   |   |   |   |"
    If n = 2 Then Print "|   |---|   |   |   |   |   |"
    If n = 3 Then Print "|   |   |---|   |   |   |   |"
    If n = 4 Then Print "|   |   |   |---|   |   |   |"
    If n = 5 Then Print "|   |   |   |   |---|   |   |"
    If n = 6 Then Print "|   |   |   |   |   |---|   |"
    If n = 7 Then Print "|   |   |   |   |   |   |---|"
End Sub
'-----------
Function Amida.judge(a() as Byte, k as Byte, z as  Byte) as Byte
    If a(z) = k Then
        Return 1
    Else
        Return 0
    End If
End Function
'-----------
Dim ObjAMD as Amida
End

なかなか登場機会の少ないBASICですが、この手軽さと生産性の高さにはやはり根強い需要があるような気がします。

コメントをどうぞ

XHTML: 次のタグを使用できます: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong> <img localsrc="" alt="">

カテゴリー

Feed

メタ情報