Sebenarnya ini bukanlah hal yang baru, tetapi masih saja asyik untuk dibahas. Seperti kita ketahui, MySQL adalah database yang sangat populer saat ini dan umumnya digunakan untuk database web. Jika kita biasa menggunakan Access atau MS SQL untuk database program VB kita, sekarang kita akan coba menggunakan MySQL sebagai salah satu alternatif database.

Pertama2 yang harus kita siapkan adalah program MySQL ODBC
Untuk MySQLnya versi 4, disarankan menggunakan MyODBC versi 3.51 yang dapat didownload di http://dev.mysql.com/downloads/connector/odbc/3.51.html
Jika MySQLnya versi 5 keatas, disarankan menggunakan MyODBC versi 5.1 http://dev.mysql.com/downloads/connector/odbc/5.1.html
Berikutnya kita akan menginstall MyODBC yang sesuai
jalankan Service MySQL dan dari Control Panel buat koneksi ke MySQL

Setelah itu kita buka VB dan mulailah bercoding...

Public conn As New ADODB.Connection
Public rs As ADODB.Recordset

Private Sub Form_Load()
Set rs = New ADODB.Recordset
serverIP = "127.0.0.1"
username = "aku"
passwd = "apaaja"
db = "dataku"
conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=" & serverIP & ";UID=" & username & ";PWD=" & passwd & ";DATABASE=" & db & ""
conn.Open
rs.Open "SELECT * FROM coba ", conn, adOpenDynamic, adLockOptimistic
End Sub

[ add comment ] ( 103 views )   |  permalink  |   ( 0 / 0 )

---

Game ini dibikin pakai Quick Basic. Tapi karena ini dibuatnya tahun 1998, jadi grafiknya kurang bagus, gamenya juga cuma jalan 256 color, animasi objectnya juga kacau dan gambarnya juga kurang bagus. Tapi untuk menggambar semua object yang ada, saya menggunakan program yang ditulis dalam Quick Basic juga. Tapi dari sisi algoritma program, kurang baik karena banyak lompatan di dalamnya. Jadi program ini tidak bisa dicompile jadi EXE karena disamping baris programnya yang panjang, manajemen memori yang ngga diatur dan compiler Quick Basic yang saya gunakan adalah versi 4.5.
Untuk mereka yang baru belajar algoritma dan pemrograman, lumayanlah buat referensi. bisa dilihat sourcenya di sini. Dan silakan dimodifikasi, tapi kalo sudah dimodifikasi tolong saya dikasihtahu...
Game ini sangat mudah, bahkan dapat anda selesaikan dengan cepat. Menceritakan petualangan Rosetta yang mengumpulkan barang-barang sihir dan mantra sihir untuk menghadapi musuh terakhirnya. Hanya sayangnya karena tidak ada unsur arcadenya, game jadi keliatan monoton. Saya sempat membuat sekuel dari game ini, hanya saja belum selesai. Berikut adalah source codenya...

'*************************************************
'
' QUEST of ROSETTA ( Demo Version )
' Programmed by Yulius Candra Wahyu Kurniawan
' An Experiment Program Logic Adventures Game
'
'*************************************************

DECLARE FUNCTION Pilihan% (x.pos%, y.pos%, y.awal%, y.akhir%, y.ofset%)
DECLARE SUB Peace ()
DECLARE SUB Inventory ()
DECLARE SUB Cek17 ()
DECLARE SUB Cek19 ()
DECLARE SUB Cek22 ()
DECLARE SUB Cek28kiri ()
DECLARE SUB Cek28kanan ()
DECLARE SUB Final ()
DECLARE SUB Tyverra ()
DECLARE SUB HouseNol ()
DECLARE SUB HouseOne ()
DECLARE SUB HouseTwo ()
DECLARE SUB Box (x1%, y1%, x2%, y2%, c1%, c2%, c3%)
DECLARE SUB PutFont (col%, row%, delay%, text$)
DECLARE SUB Waitkey (keys%)
DECLARE SUB Winkle ()
DECLARE SUB Camiria ()

COMMON SHARED house AS INTEGER, house1 AS INTEGER, shouse AS INTEGER, shouse1 AS INTEGER, shouse2 AS INTEGER
COMMON SHARED hut AS INTEGER, cave AS INTEGER, gold AS INTEGER
COMMON SHARED protect AS INTEGER, satana AS INTEGER, akylla AS INTEGER
COMMON SHARED ceksound AS INTEGER

CLEAR

CONST item1$ = "Magic Book"
CONST item2$ = "Magic Candle"
CONST item3$ = "Magic Horn"
CONST item4$ = "Magic Potion"
CONST item5$ = "Magic Key"
CONST item6$ = "Magic Bow"
CONST item7$ = "Magic Arrow"
CONST item8$ = "Magic Shield"
CONST item9$ = "Magic Rod"
CONST item10$ = "Magic Ring"
CONST item11$ = "Protect"
CONST item12$ = "Flame"
CONST item13$ = "Thunder"
CONST d = 10000
CONST x1 = 5, y1 = 120, x2 = 315, y2 = 190
CONST x3 = 5, y3 = 10, x4 = 100, y4 = 110
CONST x.awal = 210, y.awal = 50
CONST x.ofset = 2, y.ofset = 2
CONST batas1 = 30, batas2 = 140, batas3 = 260, batas4 = 70

DEFINT A-Z

PRINT "QUEST of ROSETTA ( Demo Version )"
PRINT "Created on December 1998 by Yulius Candra Wahyu Kurniawan"
PRINT "Copyright (C) 1998 MagicTouch Software Inc."
PRINT "Kind of language : "
PRINT "1. Indonesian"
PRINT "2. English"
INPUT "Input Language do you wish to use ( Default. English ) : ", language
IF language = 1 THEN filetext$ = "indones.dat" ELSE filetext$ = "english.dat"
PRINT "Loading Text ";
OPEN filetext$ FOR INPUT AS #1
DIM SHARED t$(475)
FOR i = 0 TO 475
INPUT #1, t$(i)
IF i MOD 50 = 0 THEN PRINT ".";
NEXT
CLOSE #1
PRINT

PRINT "Loading Font ";

OPEN "gothic.dat" FOR INPUT AS #1
DIM SHARED sa(33): FOR i = 0 TO 33: INPUT #1, sa(i): NEXT: PRINT ".";
DIM SHARED sb(29): FOR i = 0 TO 29: INPUT #1, sb(i): NEXT: PRINT ".";
DIM SHARED sc(29): FOR i = 0 TO 29: INPUT #1, sc(i): NEXT: PRINT ".";
DIM SHARED sd(33): FOR i = 0 TO 33: INPUT #1, sd(i): NEXT: PRINT ".";
DIM SHARED se(29): FOR i = 0 TO 29: INPUT #1, se(i): NEXT: PRINT ".";
DIM SHARED sf(29): FOR i = 0 TO 29: INPUT #1, sf(i): NEXT: PRINT ".";
DIM SHARED sg(33): FOR i = 0 TO 33: INPUT #1, sg(i): NEXT: PRINT ".";
DIM SHARED sh(29): FOR i = 0 TO 29: INPUT #1, sh(i): NEXT: PRINT ".";
DIM SHARED si(20): FOR i = 0 TO 20: INPUT #1, si(i): NEXT: PRINT ".";
DIM SHARED sj(20): FOR i = 0 TO 20: INPUT #1, sj(i): NEXT: PRINT ".";
DIM SHARED sk(33): FOR i = 0 TO 33: INPUT #1, sk(i): NEXT: PRINT ".";
DIM SHARED sl(20): FOR i = 0 TO 20: INPUT #1, sl(i): NEXT: PRINT ".";
DIM SHARED sm(51): FOR i = 0 TO 51: INPUT #1, sm(i): NEXT: PRINT ".";
DIM SHARED sn(38): FOR i = 0 TO 38: INPUT #1, sn(i): NEXT: PRINT ".";
DIM SHARED so(29): FOR i = 0 TO 29: INPUT #1, so(i): NEXT: PRINT ".";
DIM SHARED sp(33): FOR i = 0 TO 33: INPUT #1, sp(i): NEXT: PRINT ".";
DIM SHARED sq(33): FOR i = 0 TO 33: INPUT #1, sq(i): NEXT: PRINT ".";
DIM SHARED sr(33): FOR i = 0 TO 33: INPUT #1, sr(i): NEXT: PRINT ".";
DIM SHARED ss(29): FOR i = 0 TO 29: INPUT #1, ss(i): NEXT: PRINT ".";
DIM SHARED st(24): FOR i = 0 TO 24: INPUT #1, st(i): NEXT: PRINT ".";
DIM SHARED su(38): FOR i = 0 TO 38: INPUT #1, su(i): NEXT: PRINT ".";
DIM SHARED sv(33): FOR i = 0 TO 33: INPUT #1, sv(i): NEXT: PRINT ".";
DIM SHARED sw(47): FOR i = 0 TO 47: INPUT #1, sw(i): NEXT: PRINT ".";
DIM SHARED sx(38): FOR i = 0 TO 38: INPUT #1, sx(i): NEXT: PRINT ".";
DIM SHARED sy(33): FOR i = 0 TO 33: INPUT #1, sy(i): NEXT: PRINT ".";
DIM SHARED sz(24): FOR i = 0 TO 24: INPUT #1, sz(i): NEXT: PRINT ".";
DIM SHARED ba(42): FOR i = 0 TO 42: INPUT #1, ba(i): NEXT: PRINT ".";
DIM SHARED bb(38): FOR i = 0 TO 38: INPUT #1, bb(i): NEXT: PRINT ".";
DIM SHARED bc(29): FOR i = 0 TO 29: INPUT #1, bc(i): NEXT: PRINT ".";
DIM SHARED bd(42): FOR i = 0 TO 42: INPUT #1, bd(i): NEXT: PRINT ".";
DIM SHARED be(42): FOR i = 0 TO 42: INPUT #1, be(i): NEXT: PRINT ".";
DIM SHARED BF(38): FOR i = 0 TO 38: INPUT #1, BF(i): NEXT: PRINT ".";
DIM SHARED bg(38): FOR i = 0 TO 38: INPUT #1, bg(i): NEXT: PRINT ".";
DIM SHARED bh(42): FOR i = 0 TO 42: INPUT #1, bh(i): NEXT: PRINT ".";
DIM SHARED bi(29): FOR i = 0 TO 29: INPUT #1, bi(i): NEXT: PRINT ".";
DIM SHARED bj(29): FOR i = 0 TO 29: INPUT #1, bj(i): NEXT: PRINT ".";
DIM SHARED bk(42): FOR i = 0 TO 42: INPUT #1, bk(i): NEXT: PRINT ".";
DIM SHARED bl(33): FOR i = 0 TO 33: INPUT #1, bl(i): NEXT: PRINT ".";
DIM SHARED bm(51): FOR i = 0 TO 51: INPUT #1, bm(i): NEXT: PRINT ".";
DIM SHARED bn(42): FOR i = 0 TO 42: INPUT #1, bn(i): NEXT: PRINT ".";
DIM SHARED bo(38): FOR i = 0 TO 38: INPUT #1, bo(i): NEXT: PRINT ".";
DIM SHARED bp(38): FOR i = 0 TO 38: INPUT #1, bp(i): NEXT: PRINT ".";
DIM SHARED bq(42): FOR i = 0 TO 42: INPUT #1, bq(i): NEXT: PRINT ".";
DIM SHARED br(42): FOR i = 0 TO 42: INPUT #1, br(i): NEXT: PRINT ".";
DIM SHARED bs(33): FOR i = 0 TO 33: INPUT #1, bs(i): NEXT: PRINT ".";
DIM SHARED bt(38): FOR i = 0 TO 38: INPUT #1, bt(i): NEXT: PRINT ".";
DIM SHARED bu(38): FOR i = 0 TO 38: INPUT #1, bu(i): NEXT: PRINT ".";
DIM SHARED bv(38): FOR i = 0 TO 38: INPUT #1, bv(i): NEXT: PRINT ".";
DIM SHARED bw(51): FOR i = 0 TO 51: INPUT #1, bw(i): NEXT: PRINT ".";
DIM SHARED bx(42): FOR i = 0 TO 42: INPUT #1, bx(i): NEXT: PRINT ".";
DIM SHARED by(38): FOR i = 0 TO 38: INPUT #1, by(i): NEXT: PRINT ".";
DIM SHARED bz(38): FOR i = 0 TO 38: INPUT #1, bz(i): NEXT: PRINT ".";
DIM SHARED f0(33): FOR i = 0 TO 33: INPUT #1, f0(i): NEXT: PRINT ".";
DIM SHARED f1(24): FOR i = 0 TO 24: INPUT #1, f1(i): NEXT: PRINT ".";
DIM SHARED f2(33): FOR i = 0 TO 33: INPUT #1, f2(i): NEXT: PRINT ".";
DIM SHARED f3(33): FOR i = 0 TO 33: INPUT #1, f3(i): NEXT: PRINT ".";
DIM SHARED f4(33): FOR i = 0 TO 33: INPUT #1, f4(i): NEXT: PRINT ".";
DIM SHARED f5(33): FOR i = 0 TO 33: INPUT #1, f5(i): NEXT: PRINT ".";
DIM SHARED f6(33): FOR i = 0 TO 33: INPUT #1, f6(i): NEXT: PRINT ".";
DIM SHARED f7(33): FOR i = 0 TO 33: INPUT #1, f7(i): NEXT: PRINT ".";
DIM SHARED f8(29): FOR i = 0 TO 29: INPUT #1, f8(i): NEXT: PRINT ".";
DIM SHARED f9(33): FOR i = 0 TO 33: INPUT #1, f9(i): NEXT: PRINT ".";
DIM SHARED tanya(33): FOR i = 0 TO 33: INPUT #1, tanya(i): NEXT: PRINT ".";
DIM SHARED seru(20): FOR i = 0 TO 20: INPUT #1, seru(i): NEXT: PRINT ".";
DIM SHARED titik(20): FOR i = 0 TO 20: INPUT #1, titik(i): NEXT: PRINT ".";
DIM SHARED koma(20): FOR i = 0 TO 20: INPUT #1, koma(i): NEXT: PRINT ".";
DIM SHARED petik1(20): FOR i = 0 TO 20: INPUT #1, petik1(i): NEXT: PRINT ".";
DIM SHARED petik2(20): FOR i = 0 TO 20: INPUT #1, petik2(i): NEXT: PRINT ".";
DIM SHARED buka(20): FOR i = 0 TO 20: INPUT #1, buka(i): NEXT: PRINT ".";
DIM SHARED tutup(20): FOR i = 0 TO 20: INPUT #1, tutup(i): NEXT: PRINT ".";
DIM SHARED ttkdua(20): FOR i = 0 TO 20: INPUT #1, ttkdua(i): NEXT: PRINT ".";
DIM SHARED ttkoma(20): FOR i = 0 TO 20: INPUT #1, ttkoma(i): NEXT: PRINT "."
CLOSE #1

PRINT "Loading Sprite ";
OPEN "sprite.dat" FOR INPUT AS #1
DIM SHARED spru1(222): FOR i = 0 TO 222: INPUT #1, spru1(i): NEXT: PRINT ".";
DIM SHARED spru2(222): FOR i = 0 TO 222: INPUT #1, spru2(i): NEXT: PRINT ".";
DIM SHARED sprl1(222): FOR i = 0 TO 222: INPUT #1, sprl1(i): NEXT: PRINT ".";
DIM SHARED sprl2(222): FOR i = 0 TO 222: INPUT #1, sprl2(i): NEXT: PRINT ".";
DIM SHARED sprr1(222): FOR i = 0 TO 222: INPUT #1, sprr1(i): NEXT: PRINT ".";
DIM SHARED sprr2(222): FOR i = 0 TO 222: INPUT #1, sprr2(i): NEXT: PRINT ".";
DIM SHARED sprd1(222): FOR i = 0 TO 222: INPUT #1, sprd1(i): NEXT: PRINT ".";
DIM SHARED sprd2(222): FOR i = 0 TO 222: INPUT #1, sprd2(i): NEXT: PRINT "."
CLOSE #1

PRINT "Loading Object ";
OPEN "object.dat" FOR INPUT AS #1
DIM SHARED pointer(34): FOR i = 0 TO 34: INPUT #1, pointer(i): NEXT: PRINT ".";
DIM SHARED book(172): FOR i = 0 TO 172: INPUT #1, book(i): NEXT: PRINT ".";
DIM SHARED candle(189): FOR i = 0 TO 189: INPUT #1, candle(i): NEXT: PRINT ".";
DIM SHARED horn(117): FOR i = 0 TO 117: INPUT #1, horn(i): NEXT: PRINT ".";
DIM SHARED potion(145): FOR i = 0 TO 145: INPUT #1, potion(i): NEXT: PRINT ".";
DIM SHARED keys(78): FOR i = 0 TO 78: INPUT #1, keys(i): NEXT: PRINT ".";
DIM SHARED bow(114): FOR i = 0 TO 114: INPUT #1, bow(i): NEXT: PRINT ".";
DIM SHARED arrow(77): FOR i = 0 TO 77: INPUT #1, arrow(i): NEXT: PRINT ".";
DIM SHARED shield(189): FOR i = 0 TO 189: INPUT #1, shield(i): NEXT: PRINT ".";
DIM SHARED rod(77): FOR i = 0 TO 77: INPUT #1, rod(i): NEXT: PRINT ".";
DIM SHARED ring(42): FOR i = 0 TO 42: INPUT #1, ring(i): NEXT: PRINT ".";
DIM SHARED rock1(222): FOR i = 0 TO 222: INPUT #1, rock1(i): NEXT: PRINT ".";
DIM SHARED rock2(222): FOR i = 0 TO 222: INPUT #1, rock2(i): NEXT: PRINT ".";
DIM SHARED tree(222): FOR i = 0 TO 222: INPUT #1, tree(i): NEXT: PRINT ".";
DIM SHARED town(222): FOR i = 0 TO 222: INPUT #1, town(i): NEXT: PRINT ".";
DIM SHARED home(222): FOR i = 0 TO 222: INPUT #1, home(i): NEXT: PRINT ".";
DIM SHARED river(222): FOR i = 0 TO 222: INPUT #1, river(i): NEXT: PRINT "."
CLOSE #1

PRINT "Loading Character ";
OPEN "face.dat" FOR INPUT AS #1
DIM SHARED man1(340): FOR i = 0 TO 340: INPUT #1, man1(i): NEXT: PRINT ".";
DIM SHARED man2(340): FOR i = 0 TO 340: INPUT #1, man2(i): NEXT: PRINT ".";
DIM SHARED oldman1(340): FOR i = 0 TO 340: INPUT #1, oldman1(i): NEXT: PRINT ".";
DIM SHARED oldman2(340): FOR i = 0 TO 340: INPUT #1, oldman2(i): NEXT: PRINT ".";
DIM SHARED oldman3(340): FOR i = 0 TO 340: INPUT #1, oldman3(i): NEXT: PRINT ".";
DIM SHARED girl1(340): FOR i = 0 TO 340: INPUT #1, girl1(i): NEXT: PRINT ".";
CLOSE #1

CLS
SCREEN 13

ON KEY(1) GOSUB toggle

DIM SHARED item$(13)
FOR i = 1 TO 13
item$(i) = ""
NEXT
house = 0: house1 = 0: shouse = 0: shouse1 = 0: shouse2 = 0
hut = 0: cave = 0: gold = 0
protect = 0: satana = 0: akylla = 0
ceksound = 0

PutFont 80, 80, 1, t$(0)
PutFont 50, 100, 1, t$(1)
a$ = INPUT$(1)

CLS

KEY(1) ON
Box 5, 10, 100, 110, 15, 9, 12
Box 5, 120, 315, 190, 15, 9, 12
GOSUB sc10
Peace

x.pos = x.awal: y.pos = y.awal
x.old = x.pos: y.old = y.pos
y.atas = batas1: x.kiri = batas2: x.kanan = batas3: y.bawah = batas4
md = 0: mu = 0: ml = 0: mr = 0
c = 4
cek = 1
GOSUB sc1
Inventory
FOR z = 1 TO 10
PUT (x.pos, y.pos), sprd1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprd1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprl1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprl1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), spru1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), spru1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprr1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprr1: FOR delay = 1 TO 25000: NEXT
NEXT
PUT (x.pos, y.pos), sprd1

main:
DO WHILE NOT Salah
a$ = INKEY$
IF a$ = CHR$(27) THEN GOTO ending
IF a$ = "" THEN n = 0
IF LEN(a$) = 2 THEN n = ASC(MID$(a$, 2, 1)) ELSE n = 0
IF n = 72 THEN GOSUB atas
IF n = 75 THEN GOSUB kiri
IF n = 77 THEN GOSUB kanan
IF n = 80 THEN GOSUB bawah
LOOP

atas:
SELECT CASE c
CASE 1
IF mu = 0 THEN PUT (x.old, y.old), spru1 ELSE PUT (x.old, y.old), spru2
CASE 2
IF ml = 0 THEN PUT (x.old, y.old), sprl1 ELSE PUT (x.old, y.old), sprl2
CASE 3
IF mr = 0 THEN PUT (x.old, y.old), sprr1 ELSE PUT (x.old, y.old), sprr2
CASE 4
IF md = 0 THEN PUT (x.old, y.old), sprd1 ELSE PUT (x.old, y.old), sprd2
END SELECT
c = 1
SELECT CASE cek
CASE 0
y.bawah = y.atas
CASE 1
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.atas
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Camiria: GOSUB Initsprite: GOTO main
CASE 2, 3, 4, 14
y.bawah = y.atas
CASE 5
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.atas
CASE 6, 8, 15, 17, 18, 19, 22, 23, 24
y.atas = y.atas + 20
y.bawah = y.atas
CASE 7, 9, 28, 29
IF x.pos <= 170 OR x.pos >= 230 THEN y.atas = y.atas + 20: y.bawah = y.atas
CASE 10
y.bawah = y.atas
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseNol: GOSUB Initsprite: GOTO main
CASE 11, 20, 25, 33, 34
IF x.pos <= 170 OR x.pos >= 230 THEN y.atas = y.atas + 20: y.bawah = y.atas
CASE 13
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Tyverra: GOSUB Initsprite: GOTO main
y.bawah = y.atas
CASE 21
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseOne: GOSUB Initsprite: GOTO main
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.atas
CASE 31
y.bawah = y.atas
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Winkle: GOSUB Initsprite: GOTO main
CASE 37
y.bawah = y.atas
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseTwo: GOSUB Initsprite: GOTO main
END SELECT
IF mu = 0 THEN
IF y.pos <= y.atas THEN
IF cek = 1 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 0: GOSUB sc0
IF cek = 5 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 2: GOSUB sc2
IF cek = 7 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 4: GOSUB sc4
IF cek = 9 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 10: GOSUB sc10
IF cek = 12 THEN cek = 13: GOSUB sc13
IF cek = 11 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 12: GOSUB sc12
IF cek = 16 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 6: GOSUB sc6
IF cek = 20 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 11: GOSUB sc11
IF cek = 21 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 16: GOSUB sc16
IF cek = 25 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 20: GOSUB sc11
IF cek = 26 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 15: GOSUB sc15
IF cek = 27 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 26: GOSUB sc16
IF cek = 28 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 27: GOSUB sc16
IF cek = 30 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 31: GOSUB sc31
IF cek = 29 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 30: GOSUB sc16
IF cek = 32 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 28: GOSUB sc28
IF cek = 36 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 37: GOSUB sc10
IF cek = 35 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 36: GOSUB sc35
IF cek = 34 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 35: GOSUB sc35
IF cek = 33 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 34: GOSUB sc34
y.pos = y.bawah
ELSE
y.pos = y.pos - y.ofset
END IF
PUT (x.pos, y.pos), spru2
x.old = x.pos: y.old = y.pos
mu = 1
ELSE
IF y.pos <= y.atas THEN
IF cek = 1 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 0: GOSUB sc0
IF cek = 5 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 2: GOSUB sc2
IF cek = 7 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 4: GOSUB sc4
IF cek = 9 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 10: GOSUB sc10
IF cek = 12 THEN cek = 13: GOSUB sc13
IF cek = 11 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 12: GOSUB sc12
IF cek = 16 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 6: GOSUB sc6
IF cek = 20 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 11: GOSUB sc11
IF cek = 21 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 16: GOSUB sc16
IF cek = 25 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 20: GOSUB sc11
IF cek = 26 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 15: GOSUB sc15
IF cek = 27 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 26: GOSUB sc16
IF cek = 28 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 27: GOSUB sc16
IF cek = 30 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 31: GOSUB sc31
IF cek = 29 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 30: GOSUB sc16
IF cek = 32 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 28: GOSUB sc28
IF cek = 36 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 37: GOSUB sc10
IF cek = 35 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 36: GOSUB sc35
IF cek = 34 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 35: GOSUB sc35
IF cek = 33 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 34: GOSUB sc34
y.pos = y.bawah
ELSE
y.pos = y.pos - y.ofset
END IF
PUT (x.pos, y.pos), spru1
x.old = x.pos: y.old = y.pos
mu = 0
END IF
y.atas = batas1
x.kiri = batas2
x.kanan = batas3
y.bawah = batas4
RETURN

kiri:
SELECT CASE c
CASE 1
IF mu = 0 THEN PUT (x.old, y.old), spru1 ELSE PUT (x.old, y.old), spru2
CASE 2
IF ml = 0 THEN PUT (x.old, y.old), sprl1 ELSE PUT (x.old, y.old), sprl2
CASE 3
IF mr = 0 THEN PUT (x.old, y.old), sprr1 ELSE PUT (x.old, y.old), sprr2
CASE 4
IF md = 0 THEN PUT (x.old, y.old), sprd1 ELSE PUT (x.old, y.old), sprd2
END SELECT
c = 2
SELECT CASE cek
CASE 0, 4, 16, 26, 27, 29, 30, 33, 35, 36
x.kiri = x.kiri + 40
x.kanan = x.kiri
CASE 1
x.kanan = x.kiri
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Camiria: GOSUB Initsprite: GOTO main
CASE 6, 12
x.kanan = x.kiri
CASE 7, 9, 25, 32
IF y.pos >= 25 AND y.pos <= 48 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
CASE 10
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
x.kanan = x.kiri
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseNol: GOSUB Initsprite: GOTO main
CASE 11, 20, 34
IF y.pos >= 25 AND y.pos <= 48 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
CASE 13
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Tyverra: GOSUB Initsprite: GOTO main
x.kanan = x.kiri
CASE 15
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
CASE 17
IF (x.pos >= 240 AND y.pos >= 50) AND (x.pos <= 260 AND y.pos <= 70) THEN Cek17: cek = 19: GOSUB sc8: GOSUB Initsprite: GOTO main
x.kiri = x.kiri + 100
x.kanan = x.kiri
CASE 19
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN
Cek19
IF protect = 0 THEN
cek = 19: GOSUB sc8: GOSUB Initsprite: GOTO main
ELSE
cek = 18: GOSUB sc8: GOSUB Initsprite: GOTO main
END IF
END IF
CASE 21
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseOne: GOSUB Initsprite: GOTO main
x.kanan = x.kiri
CASE 22
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Cek22: GOSUB Initsprite: GOTO main
CASE 28
IF y.pos >= 25 AND y.pos <= 48 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN
Cek28kiri
IF satana = 0 THEN
cek = 28: GOSUB sc28: GOSUB Initsprite: GOTO main
ELSE
cek = 29: GOSUB sc29: GOSUB Initsprite: GOTO main
END IF
END IF
CASE 31
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
x.kanan = x.kiri
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Winkle: GOSUB Initsprite: GOTO main
CASE 37
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kiri + 40: x.kanan = x.kiri
x.kanan = x.kiri
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseTwo: GOSUB Initsprite: GOTO main
END SELECT
IF ml = 0 THEN
IF x.pos <= x.kiri THEN
IF cek = 2 THEN cek = 1: GOSUB sc1
IF cek = 3 THEN cek = 2: GOSUB sc2
IF cek = 5 THEN cek = 4: GOSUB sc4
IF cek = 7 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 6: GOSUB sc6
IF cek = 8 THEN cek = 7: GOSUB sc7
IF cek = 9 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 8: GOSUB sc8
IF cek = 11 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 9: GOSUB sc7
IF cek = 14 THEN cek = 13: GOSUB sc13
IF cek = 15 THEN cek = 14: GOSUB sc14
IF cek = 18 THEN cek = 17: GOSUB sc17
IF cek = 19 THEN cek = 18: GOSUB sc8
IF cek = 20 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 19: GOSUB sc8
IF cek = 23 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 22: GOSUB sc22
IF cek = 24 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 23: GOSUB sc23
IF cek = 25 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 24: GOSUB sc23
IF cek = 28 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 29: GOSUB sc29
IF cek = 34 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 28: GOSUB sc28
x.pos = x.kanan
ELSE
x.pos = x.pos - x.ofset
END IF
PUT (x.pos, y.pos), sprl2
x.old = x.pos: y.old = y.pos
ml = 1
ELSE
IF x.pos <= x.kiri THEN
IF cek = 2 THEN cek = 1: GOSUB sc1
IF cek = 3 THEN cek = 2: GOSUB sc2
IF cek = 5 THEN cek = 4: GOSUB sc4
IF cek = 7 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 6: GOSUB sc6
IF cek = 8 THEN cek = 7: GOSUB sc7
IF cek = 9 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 8: GOSUB sc8
IF cek = 11 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 9: GOSUB sc7
IF cek = 14 THEN cek = 13: GOSUB sc13
IF cek = 15 THEN cek = 14: GOSUB sc14
IF cek = 18 THEN cek = 17: GOSUB sc17
IF cek = 19 THEN cek = 18: GOSUB sc8
IF cek = 20 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 19: GOSUB sc8
IF cek = 23 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 22: GOSUB sc22
IF cek = 24 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 23: GOSUB sc23
IF cek = 25 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 24: GOSUB sc23
IF cek = 28 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 29: GOSUB sc29
IF cek = 34 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 28: GOSUB sc28
x.pos = x.kanan
ELSE
x.pos = x.pos - x.ofset
END IF
PUT (x.pos, y.pos), sprl1
x.old = x.pos: y.old = y.pos
ml = 0
END IF
y.atas = batas1
x.kiri = batas2
x.kanan = batas3
y.bawah = batas4
RETURN

kanan:
SELECT CASE c
CASE 1
IF mu = 0 THEN PUT (x.old, y.old), spru1 ELSE PUT (x.old, y.old), spru2
CASE 2
IF ml = 0 THEN PUT (x.old, y.old), sprl1 ELSE PUT (x.old, y.old), sprl2
CASE 3
IF mr = 0 THEN PUT (x.old, y.old), sprr1 ELSE PUT (x.old, y.old), sprr2
CASE 4
IF md = 0 THEN PUT (x.old, y.old), sprd1 ELSE PUT (x.old, y.old), sprd2
END SELECT
c = 3
SELECT CASE cek
CASE 0, 11, 15, 16, 20, 25, 26, 27, 30, 33, 34, 35, 36
x.kanan = x.kanan - 40
x.kiri = x.kanan
CASE 1
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Camiria: GOSUB Initsprite: GOTO main
CASE 3, 5, 12
x.kiri = x.kanan
CASE 6
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kanan
CASE 7, 9, 29, 32
IF y.pos >= 25 AND y.pos <= 48 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
CASE 10
IF y.pos >= 57 AND y.pos <= 100 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
x.kiri = x.kanan
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseNol: GOSUB Initsprite: GOTO main
CASE 13
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Tyverra: GOSUB Initsprite: GOTO main
CASE 14
IF y.pos >= 25 AND y.pos <= 48 THEN x.kiri = x.kanan
IF y.pos >= 57 AND y.pos <= 100 THEN x.kiri = x.kanan
CASE 21
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseOne: GOSUB Initsprite: GOTO main
x.kiri = x.kanan
CASE 28
IF y.pos >= 25 AND y.pos <= 48 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
IF y.pos >= 57 AND y.pos <= 100 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
IF (x.pos >= 240 AND y.pos >= 50) AND (x.pos <= 260 AND y.pos <= 70) THEN
Cek28kanan
IF akylla = 0 THEN
cek = 28: GOSUB sc28: GOSUB Initsprite: GOTO main
ELSE
cek = 34: GOSUB sc34: GOSUB Initsprite: GOTO main
END IF
END IF
CASE 31
IF y.pos >= 57 AND y.pos <= 100 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
x.kiri = x.kanan
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Winkle: GOSUB Initsprite: GOTO main
CASE 37
IF y.pos >= 57 AND y.pos <= 100 THEN x.kanan = x.kanan - 40: x.kiri = x.kanan
x.kiri = x.kanan
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseTwo: GOSUB Initsprite: GOTO main
END SELECT
IF mr = 0 THEN
IF x.pos >= x.kanan THEN
IF cek = 28 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 34: GOSUB sc34
IF cek = 29 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 28: GOSUB sc28
IF cek = 24 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 25: GOSUB sc25
IF cek = 23 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 24: GOSUB sc23
IF cek = 22 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 23: GOSUB sc23
IF cek = 19 THEN cek = 20: GOSUB sc11
IF cek = 18 THEN cek = 19: GOSUB sc8
IF cek = 17 THEN cek = 18: GOSUB sc8
IF cek = 14 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 15: GOSUB sc15
IF cek = 13 THEN cek = 14: GOSUB sc14
IF cek = 9 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 11: GOSUB sc11
IF cek = 8 THEN cek = 9: GOSUB sc7
IF cek = 7 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 8: GOSUB sc8
IF cek = 6 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 7: GOSUB sc7
IF cek = 4 THEN cek = 5: GOSUB sc5
IF cek = 2 THEN cek = 3: GOSUB sc3
IF cek = 1 THEN cek = 2: GOSUB sc2
x.pos = x.kiri
ELSE
x.pos = x.pos + x.ofset
END IF
PUT (x.pos, y.pos), sprr2
x.old = x.pos: y.old = y.pos
mr = 1
ELSE
IF x.pos >= x.kanan THEN
IF cek = 28 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 34: GOSUB sc34
IF cek = 29 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 28: GOSUB sc28
IF cek = 24 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 25: GOSUB sc25
IF cek = 23 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 24: GOSUB sc23
IF cek = 22 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 23: GOSUB sc23
IF cek = 19 THEN cek = 20: GOSUB sc11
IF cek = 18 THEN cek = 19: GOSUB sc8
IF cek = 17 THEN cek = 18: GOSUB sc8
IF cek = 14 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 15: GOSUB sc15
IF cek = 13 THEN cek = 14: GOSUB sc14
IF cek = 9 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 11: GOSUB sc11
IF cek = 8 THEN cek = 9: GOSUB sc7
IF cek = 7 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 8: GOSUB sc8
IF cek = 6 THEN IF y.pos >= 49 AND y.pos <= 56 THEN cek = 7: GOSUB sc7
IF cek = 4 THEN cek = 5: GOSUB sc5
IF cek = 2 THEN cek = 3: GOSUB sc3
IF cek = 1 THEN cek = 2: GOSUB sc2
x.pos = x.kiri
ELSE
x.pos = x.pos + x.ofset
END IF
PUT (x.pos, y.pos), sprr1
x.old = x.pos: y.old = y.pos
mr = 0
END IF
y.atas = batas1
x.kiri = batas2
x.kanan = batas3
y.bawah = batas4
RETURN

bawah:
SELECT CASE c
CASE 1
IF mu = 0 THEN PUT (x.old, y.old), spru1 ELSE PUT (x.old, y.old), spru2
CASE 2
IF ml = 0 THEN PUT (x.old, y.old), sprl1 ELSE PUT (x.old, y.old), sprl2
CASE 3
IF mr = 0 THEN PUT (x.old, y.old), sprr1 ELSE PUT (x.old, y.old), sprr2
CASE 4
IF md = 0 THEN PUT (x.old, y.old), sprd1 ELSE PUT (x.old, y.old), sprd2
END SELECT
c = 4
SELECT CASE cek
CASE 1
y.atas = y.bawah
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Camiria: GOSUB Initsprite: GOTO main
CASE 3, 5, 14
y.atas = y.bawah
CASE 2, 4, 6, 15
IF x.pos <= 170 OR x.pos >= 230 THEN y.atas = y.bawah
CASE 7, 8, 9, 17, 18, 19, 22, 23, 24, 25, 29, 33
y.bawah = y.bawah - 20
y.atas = y.bawah
CASE 10
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.bawah - 20: y.atas = y.bawah
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseNol: GOSUB Initsprite: GOTO main
CASE 11, 20, 28, 34
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.bawah - 20: y.atas = y.bawah
CASE 12
IF x.pos <= 170 OR x.pos >= 230 THEN y.atas = y.bawah
CASE 13
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Tyverra: GOSUB Initsprite: GOTO main
CASE 21
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseOne: GOSUB Initsprite: GOTO main
y.bawah = y.bawah - 20: y.atas = y.bawah
CASE 31
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.bawah - 20: y.atas = y.bawah
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN Winkle: GOSUB Initsprite: GOTO main
CASE 32
y.bawah = y.bawah - 40
y.atas = y.bawah
CASE 37
IF x.pos <= 170 OR x.pos >= 230 THEN y.bawah = y.bawah - 20: y.atas = y.bawah
IF (x.pos >= 160 AND y.pos >= 50) AND (x.pos <= 180 AND y.pos <= 70) THEN HouseTwo: GOSUB Initsprite: GOTO main
END SELECT
IF md = 0 THEN
IF y.pos >= y.bawah THEN
IF cek = 0 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 1: GOSUB sc1
IF cek = 2 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 5: GOSUB sc5
IF cek = 4 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 7: GOSUB sc7
IF cek = 16 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 21: GOSUB sc21
IF cek = 6 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 16: GOSUB sc16
IF cek = 10 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 9: GOSUB sc7
IF cek = 34 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 33: GOSUB sc33
IF cek = 35 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 34: GOSUB sc34
IF cek = 36 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 35: GOSUB sc35
IF cek = 37 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 36: GOSUB sc35
IF cek = 28 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 32: GOSUB sc32
IF cek = 27 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 28: GOSUB sc28
IF cek = 30 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 29: GOSUB sc29
IF cek = 31 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 30: GOSUB sc16
IF cek = 26 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 27: GOSUB sc16
IF cek = 15 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 26: GOSUB sc16
IF cek = 20 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 25: GOSUB sc25
IF cek = 11 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 20: GOSUB sc11
IF cek = 12 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 11: GOSUB sc11
IF cek = 13 THEN cek = 12: GOSUB sc12
y.pos = y.atas
ELSE
y.pos = y.pos + y.ofset
END IF
PUT (x.pos, y.pos), sprd2
x.old = x.pos: y.old = y.pos
md = 1
ELSE
IF y.pos >= y.bawah THEN
IF cek = 0 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 1: GOSUB sc1
IF cek = 2 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 5: GOSUB sc5
IF cek = 4 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 7: GOSUB sc7
IF cek = 16 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 21: GOSUB sc21
IF cek = 6 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 16: GOSUB sc16
IF cek = 10 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 9: GOSUB sc7
IF cek = 34 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 33: GOSUB sc33
IF cek = 35 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 34: GOSUB sc34
IF cek = 36 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 35: GOSUB sc35
IF cek = 37 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 36: GOSUB sc35
IF cek = 28 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 32: GOSUB sc32
IF cek = 27 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 28: GOSUB sc28
IF cek = 30 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 29: GOSUB sc29
IF cek = 31 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 30: GOSUB sc16
IF cek = 26 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 27: GOSUB sc16
IF cek = 15 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 26: GOSUB sc16
IF cek = 20 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 25: GOSUB sc25
IF cek = 11 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 20: GOSUB sc11
IF cek = 12 THEN IF x.pos > 170 AND x.pos < 230 THEN cek = 11: GOSUB sc11
IF cek = 13 THEN cek = 12: GOSUB sc12
y.pos = y.atas
ELSE
y.pos = y.pos + y.ofset
END IF
PUT (x.pos, y.pos), sprd1
x.old = x.pos: y.old = y.pos
md = 0
END IF
y.atas = batas1
x.kiri = batas2
x.kanan = batas3
y.bawah = batas4
RETURN

sc0:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (160 + 20 * i, 10), rock1
NEXT
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (100 + 20 * j, 10 + 20 * i), rock2
PUT (220 + 20 * j, 10 + 20 * i), rock2
NEXT
NEXT
RETURN

sc1:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), rock2
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 10), rock2
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 90), rock2
NEXT
FOR i = 1 TO 3
PUT (120, 10 + 20 * i), rock2
NEXT
PUT (160, 50), town
RETURN

sc2:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), rock2
NEXT
FOR i = 1 TO 3
PUT (100 + 20 * i, 90), rock2
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 90), rock2
NEXT
RETURN

sc3:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), rock2
PUT (100 + 20 * i, 90), rock2
NEXT
FOR i = 1 TO 3
PUT (280, 10 + 20 * i), rock2
NEXT
RETURN

sc4:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 90), tree
NEXT
FOR i = 1 TO 3
FOR j = 1 TO 4
PUT (100 + 20 * i, 10 + 20 * j), tree
NEXT
NEXT
RETURN

sc5:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), rock2
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 10), rock2
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 90), rock2
NEXT
FOR i = 1 TO 3
PUT (280, 10 + 20 * i), rock2
NEXT
RETURN

sc6:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 90), tree
NEXT
PUT (120, 50), tree
PUT (120, 70), tree
PUT (280, 70), tree
RETURN

sc7:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
FOR j = 0 TO 1
PUT (100 + 20 * i, 10 + 20 * j), tree
PUT (220 + 20 * i, 10 + 20 * j), tree
NEXT
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
NEXT
RETURN

sc8:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
NEXT
RETURN

sc10:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
NEXT
FOR i = 1 TO 2
PUT (120, 10 + 20 * i), tree
PUT (280, 10 + 20 * i), tree
NEXT
FOR i = 1 TO 3
PUT (100 + 20 * i, 70), tree
PUT (220 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
PUT (220 + 20 * i, 90), tree
NEXT
PUT (160, 50), home
RETURN

sc11:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
NEXT
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
RETURN

sc12:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 90), tree
PUT (220 + 20 * i, 90), tree
NEXT
FOR i = 0 TO 3
PUT (120, 10 + 20 * i), tree
PUT (280, 10 + 20 * i), tree
NEXT
RETURN

sc13:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
NEXT
FOR i = 1 TO 4
PUT (120, 10 + 20 * i), tree
NEXT
PUT (160, 50), town
RETURN

sc14:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 90), tree
NEXT
PUT (280, 30), tree
PUT (280, 70), tree
RETURN

sc15:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
FOR i = 1 TO 3
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
NEXT
FOR i = 1 TO 6
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
NEXT
RETURN

sc16:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), tree
PUT (100 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
RETURN

sc17:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 8
PUT (120 + 20 * i, 10), tree
PUT (120 + 20 * i, 90), tree
NEXT
FOR i = 0 TO 4
PUT (120, 10 + 20 * i), tree
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 30), tree
PUT (220 + 20 * i, 70), tree
NEXT
FOR i = 1 TO 5
FOR j = 1 TO 3
PUT (120 + 20 * i, 10 + 20 * j), river
NEXT
NEXT
RETURN

sc21:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (220 + 20 * i, 10), tree
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
PUT (120, 30), tree
PUT (120, 50), tree
PUT (160, 50), home
PUT (280, 30), tree
PUT (280, 50), tree
RETURN

sc22:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
PUT (160, 50), rock1
PUT (120, 50), tree
LINE (165, 60)-(175, 69), 0, BF
RETURN

sc23:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
RETURN

sc25:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
FOR i = 0 TO 2
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
RETURN

sc28:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
PUT (220 + 20 * i, 10), tree
PUT (220 + 20 * i, 30), tree
PUT (220 + 20 * i, 70), tree
PUT (220 + 20 * i, 90), tree
NEXT
RETURN

sc29:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (100 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
FOR i = 1 TO 3
PUT (220 + 20 * i, 10), tree
PUT (220 + 20 * i, 30), tree
NEXT
FOR i = 1 TO 6
PUT (160 + 20 * i, 70), tree
PUT (160 + 20 * i, 90), tree
NEXT
RETURN

sc31:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 9
PUT (100 + 20 * i, 10), tree
NEXT
FOR i = 1 TO 2
PUT (120, 10 + 20 * i), tree
PUT (280, 10 + 20 * i), tree
NEXT
FOR i = 1 TO 3
PUT (100 + 20 * i, 70), tree
PUT (220 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
PUT (220 + 20 * i, 90), tree
NEXT
PUT (160, 50), town
RETURN

sc32:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (220 + 20 * i, 10), tree
PUT (220 + 20 * i, 30), tree
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 50), tree
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
RETURN

sc33:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 50), tree
PUT (220 + 20 * i, 10), river
PUT (220 + 20 * i, 30), river
PUT (220 + 20 * i, 50), river
NEXT
FOR i = 1 TO 9
PUT (100 + 20 * i, 70), river
PUT (100 + 20 * i, 90), river
NEXT
RETURN

sc34:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (100 + 20 * i, 10), tree
PUT (100 + 20 * i, 30), tree
PUT (100 + 20 * i, 70), tree
PUT (100 + 20 * i, 90), tree
NEXT
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), river
NEXT
NEXT
RETURN

sc35:
LINE (120, 10)-(300, 110), 0, BF
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), river
PUT (100 + 20 * j, 10 + 20 * i), tree
NEXT
NEXT
RETURN

ending:
SCREEN 0
WIDTH 80
CLS
PRINT "QUEST of ROSETTA ( Demo Version )"
PRINT "Created on December 1998 by Yulius Candra Wahyu Kurniawan"
PRINT "Copyright (C) 1998 MagicTouch Software Inc."
PRINT "Thank you for testing..."
END

Initsprite:
x.pos = x.awal: y.pos = y.awal
x.old = x.pos: y.old = y.pos
y.atas = batas1: x.kiri = batas2: x.kanan = batas3: y.bawah = batas4
md = 0
c = 4
PUT (x.pos, y.pos), sprd1
RETURN

toggle:
IF ceksound = 1 THEN ceksound = 0 ELSE ceksound = 1
RETURN

SUB Box (x1%, y1%, x2%, y2%, c1%, c2%, c3%)

LINE (x1 - 1, y1 - 1)-(x1 + 3, y1 + 3), c1, B
LINE (x1, y1)-(x1 + 2, y1 + 2), c3, BF
LINE (x2 - 1, y1 - 1)-(x2 + 3, y1 + 3), c1, B
LINE (x2, y1)-(x2 + 2, y1 + 2), c3, BF
LINE (x1 + 5, y1)-(x2 - 3, y1), c1
LINE (x1 + 5, y1 + 1)-(x2 - 3, y1 + 1), c2
LINE (x1 + 5, y1 + 2)-(x2 - 3, y1 + 2), c1
FOR i = y1 + 5 TO y2 - 3
LINE (x1, y1 + 5)-(x1, i), c1
LINE (x1 + 1, y1 + 5)-(x1 + 1, i), c2
LINE (x1 + 2, y1 + 5)-(x1 + 2, i), c1
LINE (x2, y1 + 5)-(x2, i), c1
LINE (x2 + 1, y1 + 5)-(x2 + 1, i), c2
LINE (x2 + 2, y1 + 5)-(x2 + 2, i), c1
NEXT
LINE (x1 - 1, y2 - 1)-(x1 + 3, y2 + 3), c1, B
LINE (x1, y2)-(x1 + 2, y2 + 2), c3, BF
LINE (x2 - 1, y2 - 1)-(x2 + 3, y2 + 3), c1, B
LINE (x2, y2)-(x2 + 2, y2 + 2), c3, BF
LINE (x1 + 5, y2)-(x2 - 3, y2), c1
LINE (x1 + 5, y2 + 1)-(x2 - 3, y2 + 1), c2
LINE (x1 + 5, y2 + 2)-(x2 - 3, y2 + 2), c1

END SUB

SUB Camiria
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
PutFont 100, 155, d, t$(8)
Waitkey 13
PutFont 30, 25, 1, t$(9)
PutFont 30, 40, 1, t$(10)
PutFont 30, 55, 1, t$(11)
PutFont 30, 70, 1, t$(12)
PutFont 30, 85, 1, t$(13)

DO WHILE NOT False
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(14)
a = Pilihan(15, 25, 25, 85, 15)

SELECT CASE a

CASE 1
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(15)
PutFont 50, 160, d, t$(16)
PutFont 50, 170, d, t$(17)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 150, 1, t$(18)
PutFont 50, 160, 1, t$(19)
PutFont 150, 150, 1, t$(20)
PutFont 150, 160, 1, t$(21)
a = Pilihan(50, 150, 150, 160, 10)
IF a = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(2) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(22)
END IF
IF gold < 50 THEN
IF item$(2) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(23)
PutFont 50, 160, d, t$(24)
END IF
ELSE
IF item$(2) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(25)
PutFont 50, 160, d, t$(26)
PutFont 50, 170, d, t$(27)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), candle
PutFont 100, 170, 1, t$(28)
gold = gold - 50
item$(2) = item2$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
IF a = 2 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(3) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(29)
END IF
IF gold < 150 THEN
IF item$(3) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(30)
PutFont 50, 160, d, t$(31)
END IF
ELSE
IF item$(3) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(32)
PutFont 50, 160, d, t$(33)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), horn
PutFont 100, 170, 1, t$(34)
gold = gold - 150
item$(3) = item3$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
Waitkey 13

CASE 2
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF house = 3 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(35)
PutFont 50, 160, d, t$(36)
END IF
IF house = 2 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(37)
PutFont 50, 160, d, t$(38)
PutFont 50, 170, d, t$(39)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(40)
PutFont 50, 150, d, t$(41)
PutFont 50, 160, d, t$(42)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(43)
item$(11) = item11$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
house = 3
END IF
IF house = 1 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(44)
PutFont 50, 160, d, t$(45)
PutFont 50, 170, d, t$(46)
END IF
IF house = 0 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(47)
PutFont 50, 160, d, t$(48)
PutFont 50, 170, d, t$(49)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(50)
PutFont 50, 160, d, t$(51)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(52)
PutFont 50, 160, d, t$(53)
PutFont 50, 170, d, t$(54)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(55)
PutFont 50, 150, d, t$(56)
PutFont 50, 160, d, t$(57)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(58)
PutFont 50, 160, d, t$(59)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(60)
PutFont 50, 160, d, t$(61)
PutFont 50, 170, d, t$(62)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(63)
PutFont 50, 150, d, t$(64)
PutFont 50, 160, d, t$(65)
PutFont 50, 170, d, t$(66)
house = 1
END IF
Waitkey 13

CASE 3
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF hut = 6 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(67)
PutFont 50, 160, d, t$(68)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(69)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 25
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
hut = 4
END IF
IF hut = 5 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(70)
PutFont 50, 160, d, t$(71)
END IF
IF hut = 4 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(72)
PutFont 50, 160, d, t$(73)
PutFont 50, 170, d, t$(74)
hut = 5
END IF
IF hut = 3 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(75)
PutFont 50, 160, d, t$(76)
PutFont 50, 170, d, t$(77)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(78)
PutFont 50, 150, d, t$(79)
PutFont 50, 160, d, t$(80)
PutFont 50, 170, d, t$(81)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(82)
PutFont 50, 150, d, t$(83)
PutFont 50, 160, d, t$(84)
a = Pilihan(50, 150, 150, 160, 10)
IF a = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(85)
PutFont 50, 160, d, t$(86)
hut = 4
END IF
IF a = 2 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(87)
END IF
END IF
IF hut = 2 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(88)
PutFont 50, 160, d, t$(89)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(90)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 50
hut = 3
END IF
IF hut = 1 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(91)
PutFont 50, 160, d, t$(92)
PutFont 50, 170, d, t$(93)
END IF
IF hut = 0 THEN
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(94)
PutFont 50, 160, d, t$(95)
PutFont 50, 170, d, t$(96)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(97)
PutFont 50, 150, d, t$(98)
PutFont 50, 160, d, t$(99)
PutFont 50, 170, d, t$(100)
a = Pilihan(50, 160, 160, 170, 10)
IF a = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(101)
PutFont 50, 160, d, t$(102)
hut = 1
END IF
IF a = 2 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(103)
hut = 0
END IF
END IF
Waitkey 13

CASE 4
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(6)
PutFont 50, 150, d, t$(104)
PutFont 50, 160, d, t$(105)
PutFont 50, 170, d, t$(106)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(107)
PutFont 50, 150, d, t$(108)
PutFont 50, 160, d, t$(109)
PutFont 50, 170, d, t$(110)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(111)
PutFont 50, 150, d, t$(112)
PutFont 50, 160, d, t$(113)
PutFont 50, 170, d, t$(114)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(115)
PutFont 50, 150, d, t$(116)
PutFont 50, 160, d, t$(117)
PutFont 50, 170, d, t$(118)
Waitkey 13

CASE 5
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory
EXIT SUB

END SELECT

LOOP

END SUB

SUB Cek17
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(119)
PutFont 50, 160, d, t$(120)
Waitkey 13
RANDOMIZE TIMER
luck! = INT(RND * 2)
IF luck! = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(121)
PutFont 50, 160, d, t$(122)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(123)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 100
Waitkey 13
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(124)
PutFont 50, 160, d, t$(125)
Waitkey 13
END IF
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory

END SUB

SUB Cek19
IF item$(11) = "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(126)
PutFont 50, 160, d, t$(127)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
protect = 0
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(128)
PutFont 50, 160, d, t$(129)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, d, t$(130)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(131)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
protect = 1
END IF

END SUB

SUB Cek22
IF item$(5) <> "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(132)
PutFont 50, 160, d, t$(133)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
ELSE
IF item$(2) = "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(134)
PutFont 50, 160, d, t$(135)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
ELSE
IF cave = 0 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(136)
PutFont 50, 160, d, t$(137)
PutFont 50, 170, d, t$(138)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(139)
PutFont 50, 150, d, t$(140)
PutFont 50, 160, d, t$(141)
PutFont 50, 170, d, t$(142)
Waitkey 13
cave = 1
END IF
IF cave = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
PutFont 100, 155, 1, t$(143)
Waitkey 13
PutFont 30, 25, 1, t$(144)
PutFont 30, 40, 1, t$(145)
PutFont 30, 55, 1, t$(146)
PutFont 30, 70, 1, t$(147)
PutFont 30, 85, 1, t$(148)
RANDOMIZE TIMER
luck! = INT(RND * 5)

a = Pilihan(15, 25, 25, 85, 15)

SELECT CASE a

CASE 1
IF luck! = 1 THEN GOSUB FoundIt ELSE GOSUB NoFound
CASE 2
IF luck! = 2 THEN GOSUB FoundIt ELSE GOSUB NoFound
CASE 3
IF luck! = 3 THEN GOSUB FoundIt ELSE GOSUB NoFound
CASE 4
IF luck! = 4 THEN GOSUB FoundIt ELSE GOSUB NoFound
CASE 5
IF luck! = 5 THEN GOSUB FoundIt ELSE GOSUB NoFound

END SELECT

END IF
END IF
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory
END IF
EXIT SUB

FoundIt:
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(149)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), keys
PutFont 100, 170, 1, t$(150)
item$(5) = item5$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
Waitkey 13
RETURN

NoFound:
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(151)
Waitkey 13
RETURN

END SUB

SUB Cek28kanan
IF akylla = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(152)
PutFont 50, 160, d, t$(153)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
END IF
IF akylla = 0 THEN
IF item$(8) <> "" AND item$(9) <> "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(154)
PutFont 50, 160, d, t$(155)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(156)
PutFont 50, 160, d, t$(157)
PutFont 50, 170, d, t$(158)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 150), ring
PutFont 100, 170, 1, t$(159)
item$(10) = item10$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
akylla = 1
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(160)
PutFont 50, 160, d, t$(161)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
akylla = 0
END IF
END IF

END SUB

SUB Cek28kiri
IF satana = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(162)
PutFont 50, 160, d, t$(163)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
END IF
IF satana = 0 THEN
IF item$(6) <> "" AND item$(7) <> "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(164)
PutFont 50, 160, d, t$(165)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(166)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
satana = 1
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(167)
PutFont 50, 160, d, t$(168)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
Inventory
satana = 0
END IF
END IF
END SUB

SUB Final
LINE (120, 10)-(300, 110), 0, BF
FOR i = 1 TO 3
PUT (160 + 20 * i, 10), river
PUT (160 + 20 * i, 90), river
NEXT
FOR i = 0 TO 4
FOR j = 1 TO 3
PUT (220 + 20 * j, 10 + 20 * i), river
PUT (100 + 20 * j, 10 + 20 * i), river
NEXT
NEXT
PUT (180, 30), tree: PUT (180, 70), tree
PUT (220, 30), tree: PUT (220, 70), tree
Inventory
x.pos = 200: y.pos = 50
FOR z = 1 TO 10
PUT (x.pos, y.pos), sprd1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprd1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprl1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprl1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), spru1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), spru1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprr1: FOR delay = 1 TO 25000: NEXT
PUT (x.pos, y.pos), sprr1: FOR delay = 1 TO 25000: NEXT
NEXT
PUT (x.pos, y.pos), sprd1
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(169)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(170)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(171)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(172)
PutFont 50, 160, d, t$(173)
PutFont 50, 170, d, t$(174)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(175)
PutFont 50, 150, d, t$(176)
PutFont 50, 160, d, t$(177)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(178)
PutFont 50, 160, d, t$(179)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(180)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(181)
PutFont 50, 160, d, t$(182)
PutFont 50, 170, d, t$(183)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(184)
PutFont 50, 160, d, t$(185)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(186)
PutFont 50, 160, d, t$(187)
PutFont 50, 170, d, t$(188)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(189)
PutFont 50, 160, d, t$(190)
PutFont 50, 170, d, t$(191)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(192)
PutFont 50, 150, d, t$(193)
PutFont 50, 160, d, t$(194)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(195)
PutFont 50, 160, d, t$(196)
PutFont 50, 170, d, t$(197)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(198)
PutFont 50, 160, d, t$(199)
PutFont 50, 170, d, t$(200)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(201)
PutFont 50, 160, d, t$(202)
PutFont 50, 170, d, t$(203)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(204)
PutFont 50, 160, d, t$(205)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(206)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(207)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, d, t$(208)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(7)
PutFont 50, 150, d, t$(209)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(210)
PutFont 50, 160, d, t$(211)
PutFont 50, 170, d, t$(212)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(213)
PutFont 50, 160, d, t$(214)
PutFont 50, 170, d, t$(215)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, d, t$(216)
Waitkey 13
SCREEN 0
WIDTH 80
CLS
PRINT "QUEST of ROSETTA ( Demo Version )"
PRINT "Created on December 1998 by Yulius Candra Wahyu Kurniawan"
PRINT "Copyright (C) 1998 MagicTouch Software Inc."
PRINT "Thank you for testing..."
END

END SUB

SUB HouseNol
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF shouse = 3 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(217)
Waitkey 13
END IF
IF shouse = 2 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(218)
PutFont 50, 160, d, t$(219)
PutFont 50, 170, d, t$(220)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(221)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 500
shouse = 3
Waitkey 13
END IF
IF shouse = 1 THEN
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(222)
PutFont 50, 160, d, t$(223)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(224)
PutFont 50, 160, d, t$(225)
PutFont 50, 170, d, t$(226)
Waitkey 13
END IF
IF shouse = 0 THEN
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(227)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(228)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF hut = 0 THEN
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(229)
PutFont 50, 160, d, t$(230)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(231)
PutFont 50, 160, d, t$(232)
PutFont 50, 170, d, t$(233)
Waitkey 13
END IF
IF hut = 1 THEN
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(234)
PutFont 50, 160, d, t$(235)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(236)
PutFont 50, 160, d, t$(237)
PutFont 50, 170, d, t$(238)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(239)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 25
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(240)
PutFont 50, 160, d, t$(241)
PutFont 50, 170, d, t$(242)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(243)
Waitkey 13
shouse = 1
hut = 2
END IF
END IF
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory

END SUB

SUB HouseOne
IF shouse1 = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(244)
Waitkey 13
END IF
IF shouse1 = 0 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(245)
PutFont 50, 160, d, t$(246)
Waitkey 13
IF item$(5) <> "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(247)
PutFont 50, 160, d, t$(248)
PutFont 50, 170, d, t$(249)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(250)
PutFont 50, 160, d, t$(251)
PutFont 50, 170, d, t$(252)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(253)
PutFont 50, 150, d, t$(254)
PutFont 50, 160, d, t$(255)
PutFont 50, 170, d, t$(256)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(257)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(258)
PutFont 50, 160, d, t$(259)
PutFont 50, 170, d, t$(260)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), bow
PutFont 100, 170, 1, t$(261)
item$(6) = item6$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(262)
PutFont 50, 160, d, t$(263)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(264)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(265)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 75
Waitkey 13
shouse1 = 1
END IF
END IF
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory

END SUB

SUB HouseTwo
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF shouse2 = 1 THEN
IF item$(12) = "" THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(266)
PutFont 50, 160, d, t$(267)
Waitkey 13
ELSE
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(268)
PutFont 50, 160, d, t$(269)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(270)
item$(13) = item13$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(271)
PutFont 50, 160, d, t$(272)
Waitkey 13
Final
END IF
END IF
IF shouse2 = 0 THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(273)
PutFont 50, 160, d, t$(274)
PutFont 50, 170, d, t$(275)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(276)
PutFont 50, 150, d, t$(277)
PutFont 50, 160, d, t$(278)
PutFont 50, 170, d, t$(279)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(280)
PutFont 50, 150, d, t$(281)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(3) = "" THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(282)
PutFont 50, 160, d, t$(283)
PutFont 50, 170, d, t$(284)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory
EXIT SUB
ELSE
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(285)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(286)
END IF
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(4) = "" THEN
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(287)
PutFont 50, 160, d, t$(288)
Waitkey 13
ELSE
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(289)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(290)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(291)
PutFont 50, 160, d, t$(292)
PutFont 50, 170, d, t$(293)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(294)
PutFont 50, 150, d, t$(295)
PutFont 50, 160, d, t$(296)
shouse = 2
shouse2 = 1
Waitkey 13
END IF
END IF

LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory

END SUB

SUB Inventory
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
PutFont 100, 140, 1, t$(469)
PutFont 40, 155, 1, t$(470)
PutFont 95, 170, 1, t$(471) + STR$(gold) + t$(472)
IF item$(1) <> "" THEN PUT (18, 53), book
IF item$(2) <> "" THEN PUT (38, 50), candle
IF item$(3) <> "" THEN PUT (55, 60), horn
IF item$(4) <> "" THEN PUT (78, 52), potion
IF item$(5) <> "" THEN PUT (83, 80), keys
IF item$(6) <> "" THEN PUT (28, 75), bow
IF item$(7) <> "" THEN PUT (18, 75), arrow
IF item$(8) <> "" THEN PUT (44, 75), shield
IF item$(9) <> "" THEN PUT (64, 75), rod
IF item$(10) <> "" THEN PUT (74, 85), ring
IF item$(11) <> "" THEN PutFont 20, 20, 1, t$(473)
IF item$(12) <> "" THEN PutFont 20, 30, 1, t$(474)
IF item$(13) <> "" THEN PutFont 20, 40, 1, t$(475)

END SUB

SUB Peace
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 155, d, t$(297)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(298)
PutFont 50, 160, d, t$(299)
PutFont 50, 170, d, t$(300)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(301)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(302)
PutFont 50, 160, d, t$(303)
PutFont 50, 170, d, t$(304)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(305)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(306)
PutFont 50, 160, d, t$(307)
PutFont 50, 170, d, t$(308)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(309)
PutFont 50, 150, d, t$(310)
PutFont 50, 160, d, t$(311)
PutFont 50, 170, d, t$(312)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(313)
PutFont 50, 160, d, t$(314)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(315)
PutFont 50, 160, d, t$(316)
PutFont 50, 170, d, t$(317)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(318)
PutFont 50, 150, d, t$(319)
PutFont 50, 160, d, t$(320)
PutFont 50, 170, d, t$(321)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), book
PutFont 100, 170, 1, t$(322)
item$(1) = item1$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(323)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(324)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 25
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(325)
PutFont 50, 160, d, t$(326)
PutFont 50, 170, d, t$(327)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman1
PutFont 50, 140, d, t$(328)
PutFont 50, 150, d, t$(329)
PutFont 50, 160, d, t$(330)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF

END SUB

FUNCTION Pilihan (x.pos%, y.pos%, y.awal%, y.akhir%, y.ofset%)
s = 1
x.old = x.pos: y.old = y.pos
PUT (x.pos, y.pos), pointer
DO WHILE a$ <> CHR$(13)
a$ = INKEY$
IF LEN(a$) > 1 THEN a$ = RIGHT$(a$, 1)
IF a$ = "H" THEN
SOUND 5000, 2 * ceksound
SOUND 5500, 1 * ceksound
PUT (x.old, y.old), pointer
IF y.pos <= y.awal THEN
y.pos = y.awal
ELSE
y.pos = y.pos - y.ofset
s = s - 1
END IF
PUT (x.pos, y.pos), pointer
x.old = x.pos: y.old = y.pos
END IF
IF a$ = "P" THEN
SOUND 5000, 2 * ceksound
SOUND 5500, 1 * ceksound
PUT (x.old, y.old), pointer
IF y.pos >= y.akhir THEN
y.pos = y.akhir
ELSE
y.pos = y.pos + y.ofset
s = s + 1
END IF
PUT (x.pos, y.pos), pointer
x.old = x.pos: y.old = y.pos
END IF
LOOP
PUT (x.old, y.old), pointer
Pilihan = s

END FUNCTION

SUB PutFont (col%, row%, delay%, text$)
spasi = 1
GOSUB cetak
EXIT SUB

cetak:
FOR xx = 1 TO LEN(text$)
num = ASC(MID$(text$, xx, 1))
IF delay% > 1 THEN SOUND 9000, .1 * ceksound
IF num > 47 AND num < 58 THEN
ON num - 47 GOSUB 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
END IF
IF num > 96 AND num < 123 THEN
ON num - 96 GOSUB sa, sb, sc, sd, se, sf, sg, sh, si, sj, sk, sl, sm, sn, so, sp, sq, sr, ss, st, su, sv, sw, sx, sy, sz
END IF
IF num > 64 AND num < 91 THEN
ON num - 64 GOSUB ba, bb, bc, bd, be, BF, bg, bh, bi, bj, bk, bl, bm, bn, bo, bp, bq, br, bs, bt, bu, bv, bw, bx, by, bz
END IF
IF num = 33 THEN GOSUB seru
IF num = 34 THEN GOSUB petik2
IF num = 39 THEN GOSUB petik1
IF num = 40 THEN GOSUB buka
IF num = 41 THEN GOSUB tutup
IF num = 44 THEN GOSUB koma
IF num = 46 THEN GOSUB titik
IF num = 58 THEN GOSUB ttkdua
IF num = 59 THEN GOSUB ttkoma
IF num = 63 THEN GOSUB tanya

'dimension 3 x 8 s/d 10 x 8
SELECT CASE num
CASE 33, 34, 39, 40, 41, 44, 46, 58, 59, 105, 106, 108
col = col + 3 + spasi
CASE 49, 116, 122
col = col + 4 + spasi
CASE 56, 67, 73, 74, 98, 99, 101, 102, 104, 111, 115
col = col + 5 + spasi
CASE 48, 50, 51, 52, 53, 54, 55, 57, 63, 76, 83, 97, 100, 103, 107, 112, 113, 114, 118, 121
col = col + 6 + spasi
CASE 66, 70, 79, 80, 71, 110, 117, 120, 84, 85, 86, 89, 90
col = col + 7 + spasi
CASE 65, 68, 69, 72, 75, 78, 81, 82, 88
col = col + 8 + spasi
CASE 119
col = col + 9 + spasi
CASE 77, 87, 109
col = col + 10 + spasi
CASE ELSE
col = col + 3
END SELECT
FOR z = 1 TO delay%: NEXT
NEXT
RETURN

sa: PUT (col, row), sa: RETURN
sb: PUT (col, row), sb: RETURN
sc: PUT (col, row), sc: RETURN
sd: PUT (col, row), sd: RETURN
se: PUT (col, row), se: RETURN
sf: PUT (col, row), sf: RETURN
sg: PUT (col, row), sg: RETURN
sh: PUT (col, row), sh: RETURN
si: PUT (col, row), si: RETURN
sj: PUT (col, row), sj: RETURN
sk: PUT (col, row), sk: RETURN
sl: PUT (col, row), sl: RETURN
sm: PUT (col, row), sm: RETURN
sn: PUT (col, row), sn: RETURN
so: PUT (col, row), so: RETURN
sp: PUT (col, row), sp: RETURN
sq: PUT (col, row), sq: RETURN
sr: PUT (col, row), sr: RETURN
ss: PUT (col, row), ss: RETURN
st: PUT (col, row), st: RETURN
su: PUT (col, row), su: RETURN
sv: PUT (col, row), sv: RETURN
sw: PUT (col, row), sw: RETURN
sx: PUT (col, row), sx: RETURN
sy: PUT (col, row), sy: RETURN
sz: PUT (col, row), sz: RETURN
ba: PUT (col, row), ba: RETURN
bb: PUT (col, row), bb: RETURN
bc: PUT (col, row), bc: RETURN
bd: PUT (col, row), bd: RETURN
be: PUT (col, row), be: RETURN
BF: PUT (col, row), BF: RETURN
bg: PUT (col, row), bg: RETURN
bh: PUT (col, row), bh: RETURN
bi: PUT (col, row), bi: RETURN
bj: PUT (col, row), bj: RETURN
bk: PUT (col, row), bk: RETURN
bl: PUT (col, row), bl: RETURN
bm: PUT (col, row), bm: RETURN
bn: PUT (col, row), bn: RETURN
bo: PUT (col, row), bo: RETURN
bp: PUT (col, row), bp: RETURN
bq: PUT (col, row), bq: RETURN
br: PUT (col, row), br: RETURN
bs: PUT (col, row), bs: RETURN
bt: PUT (col, row), bt: RETURN
bu: PUT (col, row), bu: RETURN
bv: PUT (col, row), bv: RETURN
bw: PUT (col, row), bw: RETURN
bx: PUT (col, row), bx: RETURN
by: PUT (col, row), by: RETURN
bz: PUT (col, row), bz: RETURN
0 : PUT (col, row), f0: RETURN
1 : PUT (col, row), f1: RETURN
2 : PUT (col, row), f2: RETURN
3 : PUT (col, row), f3: RETURN
4 : PUT (col, row), f4: RETURN
5 : PUT (col, row), f5: RETURN
6 : PUT (col, row), f6: RETURN
7 : PUT (col, row), f7: RETURN
8 : PUT (col, row), f8: RETURN
9 : PUT (col, row), f9: RETURN
tanya: PUT (col, row), tanya: RETURN
seru: PUT (col, row), seru: RETURN
titik: PUT (col, row), titik: RETURN
koma: PUT (col, row), koma: RETURN
petik1: PUT (col, row), petik1: RETURN
petik2: PUT (col, row), petik2: RETURN
buka: PUT (col, row), buka: RETURN
tutup: PUT (col, row), tutup: RETURN
ttkdua: PUT (col, row), ttkdua: RETURN
ttkoma: PUT (col, row), ttkoma: RETURN

END SUB

SUB Tyverra
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
PutFont 100, 155, d, t$(331)
Waitkey 13
PutFont 30, 25, 1, t$(332)
PutFont 30, 40, 1, t$(333)
PutFont 30, 55, 1, t$(334)
PutFont 30, 70, 1, t$(335)
PutFont 30, 85, 1, t$(336)

DO WHILE NOT False
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(337)
a = Pilihan(15, 25, 25, 85, 15)

SELECT CASE a

CASE 1
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(338)
PutFont 50, 160, d, t$(339)
PutFont 50, 170, d, t$(340)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 150, 1, t$(341)
PutFont 50, 160, 1, t$(342)
PutFont 150, 150, 1, t$(343)
PutFont 150, 160, 1, t$(344)
a = Pilihan(50, 150, 150, 160, 10)
IF a = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(7) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(345)
PutFont 50, 160, d, t$(346)
END IF
IF gold < 100 THEN
IF item$(7) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(347)
PutFont 50, 160, d, t$(348)
END IF
ELSE
IF item$(7) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(349)
PutFont 50, 160, d, t$(350)
PutFont 50, 170, d, t$(351)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man2
PutFont 50, 140, d, t$(352)
PutFont 50, 150, d, t$(353)
PutFont 50, 160, d, t$(354)
PutFont 50, 170, d, t$(355)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), arrow
PutFont 100, 170, 1, t$(356)
gold = gold - 100
item$(7) = item7$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
IF a = 2 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(8) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(357)
END IF
IF gold < 250 THEN
IF item$(8) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(358)
END IF
ELSE
IF item$(8) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(359)
PutFont 50, 160, d, t$(360)
PutFont 50, 170, d, t$(361)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), shield
PutFont 100, 170, 1, t$(362)
gold = gold - 250
item$(8) = item8$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
Waitkey 13

CASE 2
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(363)
PutFont 50, 160, d, t$(364)
PutFont 50, 170, d, t$(365)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(366)
PutFont 50, 150, d, t$(367)
PutFont 50, 160, d, t$(368)
PutFont 50, 170, d, t$(369)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(370)
PutFont 50, 150, d, t$(371)
PutFont 50, 160, d, t$(372)
PutFont 50, 170, d, t$(373)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(374)
PutFont 50, 150, d, t$(375)
PutFont 50, 160, d, t$(376)
PutFont 50, 170, d, t$(377)
Waitkey 13

CASE 3
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(378)
Waitkey 13
IF hut = 5 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(379)
PutFont 50, 160, d, t$(380)
hut = 6
Waitkey 13
END IF

CASE 4
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(6)
PutFont 50, 150, d, t$(381)
PutFont 50, 160, d, t$(382)
PutFont 50, 170, d, t$(383)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(384)
PutFont 50, 150, d, t$(385)
PutFont 50, 160, d, t$(386)
PutFont 50, 170, d, t$(387)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(388)
PutFont 50, 150, d, t$(389)
PutFont 50, 160, d, t$(390)
PutFont 50, 170, d, t$(391)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(392)
PutFont 50, 150, d, t$(393)
PutFont 50, 160, d, t$(394)
PutFont 50, 170, d, t$(395)
Waitkey 13

CASE 5
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory
EXIT SUB
END SELECT

LOOP

END SUB

SUB Waitkey (keys%)
DO
LOOP UNTIL INKEY$ = CHR$(keys%)
END SUB

SUB Winkle
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
PutFont 100, 155, d, t$(396)
Waitkey 13
PutFont 30, 25, 1, t$(397)
PutFont 30, 40, 1, t$(398)
PutFont 30, 55, 1, t$(399)
PutFont 30, 70, 1, t$(400)
PutFont 30, 85, 1, t$(401)

DO WHILE NOT False
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(402)
a = Pilihan(15, 25, 25, 85, 15)

SELECT CASE a

CASE 1
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(403)
PutFont 50, 160, d, t$(404)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 150, 1, t$(405)
PutFont 50, 160, 1, t$(406)
PutFont 150, 150, 1, t$(407)
PutFont 150, 160, 1, t$(408)
a = Pilihan(50, 150, 150, 160, 10)
IF a = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(4) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(409)
END IF
IF gold < 300 THEN
IF item$(4) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(410)
PutFont 50, 160, d, t$(411)
PutFont 50, 170, d, t$(412)
END IF
ELSE
IF item$(4) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(413)
PutFont 50, 160, d, t$(414)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), potion
PutFont 100, 170, 1, t$(415)
gold = gold - 300
item$(4) = item4$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
IF a = 2 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
IF item$(9) <> "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(416)
END IF
IF gold < 500 THEN
IF item$(9) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(417)
END IF
ELSE
IF item$(9) = "" THEN
PUT (20, 125), man2
PutFont 50, 140, d, t$(3)
PutFont 50, 150, d, t$(418)
PutFont 50, 160, d, t$(419)
PutFont 50, 170, d, t$(420)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man2
PutFont 50, 140, d, t$(421)
PutFont 50, 150, d, t$(422)
PutFont 50, 160, d, t$(423)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (150, 140), rod
PutFont 100, 170, 1, t$(424)
gold = gold - 500
item$(9) = item9$
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF
END IF
Waitkey 13

CASE 2
IF house1 = 1 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(425)
Waitkey 13
END IF
IF house1 = 0 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(426)
PutFont 50, 160, d, t$(427)
PutFont 50, 170, d, t$(428)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(429)
PutFont 50, 160, d, t$(430)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(431)
PutFont 50, 160, d, t$(432)
PutFont 50, 170, d, t$(433)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(434)
PutFont 50, 160, d, t$(435)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(4)
PutFont 50, 150, d, t$(436)
PutFont 50, 160, d, t$(437)
PutFont 50, 170, d, t$(438)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman2
PutFont 50, 140, d, t$(439)
PutFont 50, 150, d, t$(440)
PutFont 50, 160, d, t$(441)
PutFont 50, 170, d, t$(442)
house = 2
house1 = 1
Waitkey 13
END IF

CASE 3
IF gold < 20 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(443)
Waitkey 13
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(444)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(445)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 150, 1, t$(446)
PutFont 50, 160, 1, t$(447)
a = Pilihan(50, 150, 150, 160, 10)

SELECT CASE a

CASE 1
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(448)
PutFont 50, 160, d, t$(449)
PutFont 50, 170, d, t$(450)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(451)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 50, 145, 1, t$(452)
PutFont 50, 155, 1, t$(453)
PutFont 50, 165, 1, t$(454)
RANDOMIZE TIMER
luck! = INT(RND * 3)

a = Pilihan(50, 145, 145, 165, 10)

SELECT CASE a

CASE 1
IF luck! = 1 THEN GOSUB Dapat ELSE GOSUB Gagal

CASE 2
IF luck! = 2 THEN GOSUB Dapat ELSE GOSUB Gagal

CASE 3
IF luck! = 3 THEN GOSUB Dapat ELSE GOSUB Gagal

END SELECT

CASE 2
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(458)
Waitkey 13
END SELECT
END IF

CASE 4
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(6)
PutFont 50, 150, d, t$(459)
Waitkey 13
IF item$(12) = "" THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(460)
PutFont 50, 150, d, t$(461)
PutFont 50, 160, d, t$(462)
PutFont 50, 170, d, t$(463)
Waitkey 13
IF gold < 1000 THEN
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), man1
PutFont 50, 140, d, t$(464)
PutFont 50, 150, d, t$(465)
PutFont 50, 160, d, t$(466)
Waitkey 13
ELSE
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), girl1
PutFont 50, 140, d, t$(2)
PutFont 50, 150, d, t$(467)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(468)
item$(12) = item12$
gold = gold - 1000
IF ceksound = 1 THEN
FOR i = 1 TO 5
PLAY "l64 t255 cc#dd#eff#gg#aa#bc"
NEXT
END IF
END IF
END IF

CASE 5
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
LINE (x3 + 5, y3 + 5)-(x4 - 5, y4 - 5), 0, BF
Inventory
EXIT SUB
END SELECT

LOOP

Dapat:
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(455)
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PutFont 100, 155, 1, t$(456)
SOUND 1000, 2 * ceksound
SOUND 3000, 2 * ceksound
gold = gold + 100
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
RETURN

Gagal:
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
PUT (20, 125), oldman3
PutFont 50, 140, d, t$(5)
PutFont 50, 150, d, t$(457)
SOUND 100, 3 * ceksound
gold = gold - 20
Waitkey 13
LINE (x1 + 5, y1 + 5)-(x2 - 5, y2 - 5), 0, BF
RETURN

END SUB

[ add comment ] ( 14 views )   |  permalink  |   ( 0 / 0 )

---

Program Sprite Editor adalah program utility untuk menghasilkan gambar-gambar sprite yang dapat digunakan dalam program kita. Program game yang pernah saya buat, sprite-spritenya saya gambar dengan program ini. Program ini pada awalnya bernama program Shape Editor yang ditulisa oleh Sdr. Hendra dalam bukunya terbitan Elex Media dan didesain hanya untuk mode Screen 1 dengan ukuran maksimum 20x20 pixel, tetapi telah saya modifikasi sedikit agar dapat digunakan untuk mode Screen 13 (256 color), dengan ukuran sprite maksimum 45x45 pixel. Tanpa basa-basi lagi berikut ini adalah source codenya;

'*****************************************************'
'
' Program SPRITE EDITOR Version 2.00
' Dikembangkan dari Program Shape Editor oleh Sdr. Hendra
' dari Buku Program Permainan dengan Basic terbitan Elex Media
' Support 45 x 45 Pixel
' Support in 320 x 200 x 256 Colors
'
'*****************************************************'
'$DYNAMIC
DEFINT A-Z

CONST pixel = 4
CONST max.row.len = 45
CONST max.col.len = 45
CONST xawal = 185
CONST yawal = 10
CONST xakhir = 315
CONST yakhir = 175

COMMON SHARED col.len AS INTEGER, row.len AS INTEGER
COMMON SHARED move.draw AS INTEGER, c AS INTEGER, edit AS INTEGER
COMMON SHARED help.init AS INTEGER, palet AS INTEGER
COMMON SHARED x AS INTEGER, y AS INTEGER, oldx AS INTEGER, oldy AS INTEGER

DECLARE SUB box (x1%, y1%, x2%, y2%, c1%, c2%, c3%, c4%)
DECLARE SUB draw.cel.frame ()
DECLARE SUB draw.ima.frame ()
DECLARE SUB draw.edit.area ()
DECLARE SUB writeln (rloc AS INTEGER, cloc AS INTEGER, stm$)
DECLARE SUB putfont (col, row, text$)
DECLARE SUB delln (bar!)
DECLARE SUB wait.time ()
DECLARE SUB set.cel.frame (celnum AS INTEGER, switch AS INTEGER)
DECLARE SUB msg (rl AS INTEGER, cl AS INTEGER, message$)
DECLARE FUNCTION get.filename$ (rowloc AS INTEGER, colloc AS INTEGER, length AS INTEGER)

ON ERROR GOTO ErrorProc

size% = 4 + INT((((xakhir + 5) - (xawal - 5) + 1) * 8 + 7) / 8) * 1 * ((yakhir + 5) - (yawal - 5) + 1)
DIM save.screen%(size%)
DIM main.ima(222) AS INTEGER
DIM image(222), ima(max.row.len, max.col.len), Cel(2), Pal(9)
DIM SHARED ba(42): FOR i = 0 TO 42: READ ba(i): NEXT
DIM SHARED bb(42): FOR i = 0 TO 42: READ bb(i): NEXT
DIM SHARED bc(42): FOR i = 0 TO 42: READ bc(i): NEXT
DIM SHARED bd(42): FOR i = 0 TO 42: READ bd(i): NEXT
DIM SHARED be(42): FOR i = 0 TO 42: READ be(i): NEXT
DIM SHARED BF(42): FOR i = 0 TO 42: READ BF(i): NEXT
DIM SHARED bg(42): FOR i = 0 TO 42: READ bg(i): NEXT
DIM SHARED bh(42): FOR i = 0 TO 42: READ bh(i): NEXT
DIM SHARED bi(38): FOR i = 0 TO 38: READ bi(i): NEXT
DIM SHARED bj(42): FOR i = 0 TO 42: READ bj(i): NEXT
DIM SHARED bk(42): FOR i = 0 TO 42: READ bk(i): NEXT
DIM SHARED bl(38): FOR i = 0 TO 38: READ bl(i): NEXT
DIM SHARED bm(42): FOR i = 0 TO 42: READ bm(i): NEXT
DIM SHARED bn(42): FOR i = 0 TO 42: READ bn(i): NEXT
DIM SHARED bo(42): FOR i = 0 TO 42: READ bo(i): NEXT
DIM SHARED bp(42): FOR i = 0 TO 42: READ bp(i): NEXT
DIM SHARED bq(42): FOR i = 0 TO 42: READ bq(i): NEXT
DIM SHARED br(42): FOR i = 0 TO 42: READ br(i): NEXT
DIM SHARED bs(42): FOR i = 0 TO 42: READ bs(i): NEXT
DIM SHARED bt(38): FOR i = 0 TO 38: READ bt(i): NEXT
DIM SHARED bu(42): FOR i = 0 TO 42: READ bu(i): NEXT
DIM SHARED bv(42): FOR i = 0 TO 42: READ bv(i): NEXT
DIM SHARED bw(42): FOR i = 0 TO 42: READ bw(i): NEXT
DIM SHARED bx(42): FOR i = 0 TO 42: READ bx(i): NEXT
DIM SHARED by(38): FOR i = 0 TO 38: READ by(i): NEXT
DIM SHARED bz(42): FOR i = 0 TO 42: READ bz(i): NEXT
DIM SHARED f0(42): FOR i = 0 TO 42: READ f0(i): NEXT
DIM SHARED f1(38): FOR i = 0 TO 38: READ f1(i): NEXT
DIM SHARED f2(42): FOR i = 0 TO 42: READ f2(i): NEXT
DIM SHARED f3(42): FOR i = 0 TO 42: READ f3(i): NEXT
DIM SHARED f4(42): FOR i = 0 TO 42: READ f4(i): NEXT
DIM SHARED f5(42): FOR i = 0 TO 42: READ f5(i): NEXT
DIM SHARED f6(42): FOR i = 0 TO 42: READ f6(i): NEXT
DIM SHARED f7(42): FOR i = 0 TO 42: READ f7(i): NEXT
DIM SHARED f8(42): FOR i = 0 TO 42: READ f8(i): NEXT
DIM SHARED f9(42): FOR i = 0 TO 42: READ f9(i): NEXT
DIM SHARED titik(20): FOR i = 0 TO 20: READ titik(i): NEXT
DIM SHARED seru(20): FOR i = 0 TO 20: READ seru(i): NEXT
CLOSE #1

status.awal = 0
yes = 1
No = 0
move.draw = -1
c = 1
x = 1
y = 1
oldx = 1
oldy = 1
edit = 0
edt = 0
help.init = 0
palet = 0
FOR i = 1 TO 2
Cel(i) = 0
NEXT
FOR i = 0 TO 9
Pal(i) = 0
NEXT
col.len = 20
row.len = 20

SCREEN 13
CLS
COLOR 15
CALL putfont(30, 185, "COPYRIGHT BY MAGICTOUCH SOFTWARE INC.")
CALL putfont(192, 0, "SPRITE EDITOR")
CALL putfont(192, 63, "SIZE.")
CALL putfont(192, 71, "X. . ")
CALL putfont(192, 79, "Y. . ")
CALL putfont(192, 88, "COLOR.")
CALL putfont(192, 96, "STATUS.")
CALL putfont(250, 96, "MOVING.")
CALL draw.edit.area
CALL draw.cel.frame
CALL draw.ima.frame
GOTO help

edit:
'Redraw edit.area
LINE ((x - 1) * pixel, (y - 1) * pixel)-((x - 1) * pixel + pixel, (y - 1) * pixel + pixel), 0, B

e1:
LOCATE 9, 30
PRINT ; col.len; "x"; row.len
LOCATE 10, 27
PRINT USING "###"; x
LOCATE 11, 27
PRINT USING "###"; y
LOCATE 12, 33
PRINT ; c
IF move.draw = 1 THEN
LINE (250, 96)-(310, 104), 0, BF
CALL putfont(250, 96, "DRAWING.")
ELSE
LINE (250, 96)-(310, 104), 0, BF
CALL putfont(250, 96, "MOVING.")
END IF

e2:
t$ = INKEY$
IF t$ = "" THEN GOTO e2
IF t$ = CHR$(13) THEN move.draw = move.draw * -1: GOTO e1
IF t$ = "H" OR t$ = "h" THEN GOTO help
IF t$ = "P" OR t$ = "p" THEN GOTO set.palet
IF t$ = "C" OR t$ = "c" THEN GOTO colors
IF t$ = "R" OR t$ = "r" THEN GOTO clearing
IF t$ = "S" OR t$ = "s" THEN GOTO save
IF t$ = "L" OR t$ = "l" THEN GOTO load
IF t$ = "Q" OR t$ = "q" THEN GOTO quit
IF t$ = "W" OR t$ = "w" THEN GOTO mirror
IF t$ = "D" OR t$ = "d" THEN GOTO del
IF t$ = "T" OR t$ = "t" THEN GOTO transfer
IF t$ = "G" OR t$ = "g" THEN GOTO resize.grid
IF t$ = "O" OR t$ = "o" THEN GOTO cropping
IF t$ = "0" THEN c = Pal(0): GOTO e1
IF t$ = "1" THEN c = Pal(1): GOTO e1
IF t$ = "2" THEN c = Pal(2): GOTO e1
IF t$ = "3" THEN c = Pal(3): GOTO e1
IF t$ = "4" THEN c = Pal(4): GOTO e1
IF t$ = "5" THEN c = Pal(5): GOTO e1
IF t$ = "6" THEN c = Pal(6): GOTO e1
IF t$ = "7" THEN c = Pal(7): GOTO e1
IF t$ = "8" THEN c = Pal(8): GOTO e1
IF t$ = "9" THEN c = Pal(9): GOTO e1
IF LEN(t$) = 1 THEN GOTO e2 ELSE t$ = RIGHT$(t$, 1)
IF t$ = "H" THEN y = y - 1: IF y = 0 THEN y = row.len 'Kursor atas
IF t$ = "K" THEN x = x - 1: IF x = 0 THEN x = col.len 'Kursor kiri
IF t$ = "P" THEN y = y + 1: IF y > row.len THEN y = 1 'Kursor bawah
IF t$ = "M" THEN x = x + 1: IF x > col.len THEN x = 1 'Kursor kanan
IF t$ = "G" THEN
x = x - 1
y = y - 1
IF x = 0 THEN x = 1
IF y = 0 THEN y = 1
END IF
IF t$ = "I" THEN
x = x + 1
y = y - 1
IF x > col.len THEN x = col.len
IF y = 0 THEN y = 1
END IF
IF t$ = "O" THEN
x = x - 1
y = y + 1
IF x = 0 THEN x = 1
IF y > row.len THEN y = row.len
END IF
IF t$ = "Q" THEN
x = x + 1
y = y + 1
IF x > col.len THEN x = col.len
IF y > row.len THEN y = row.len
END IF

IF x = oldx AND y = oldy THEN GOTO e2

LINE ((oldx - 1) * pixel, (oldy - 1) * pixel)-((oldx - 1) * pixel + pixel, (oldy - 1) * pixel + pixel), 7, B
'Kerjakan proses menggambar
IF move.draw = 1 THEN
FOR i = (oldx - 1) * pixel + 1 TO (oldx - 1) * pixel + (pixel - 1)
FOR j = (oldy - 1) * pixel + 1 TO (oldy - 1) * pixel + (pixel - 1)
PSET (i, j), c 'Hidupkan pixel pada edit.area
NEXT
NEXT
PSET (194 + oldx, 11 + oldy), c 'Hidupkan pixel pada frame
ima(oldx, oldy) = c 'Simpan data warna pada array ima
edit = 1
END IF
oldx = x
oldy = y
GOTO edit

help:
GET (xawal, yawal)-(xakhir, yakhir), save.screen%
CALL box(xawal, yawal, xakhir, yakhir, 15, 9, 12, 1)
CALL putfont(200, 17, "FUNCTION KEYS.")
CALL putfont(195, 30, "C . . . . . . SET COLOR")
CALL putfont(195, 40, "D . . . . . . . . . DELETE")
CALL putfont(195, 50, "G . . . RESIZE AREA")
CALL putfont(195, 60, "H . . . . . . . . . . . . HELP")
CALL putfont(195, 70, "L . . . . LOAD IMAGE")
CALL putfont(195, 80, "P . . . SET PALETTE")
CALL putfont(195, 90, "Q . . . . . . . . . . . . QUIT")
CALL putfont(195, 100, "R . . . . CLEAR AREA")
CALL putfont(195, 110, "S . . . . SAVE IMAGE")
CALL putfont(195, 120, "T . . . . . . . TRANSFER")
CALL putfont(195, 130, "W . . . . SWAP IMAGE")
CALL putfont(195, 140, "0...9 FILL PALETTE")
CALL putfont(195, 150, "CR. TOGGLE STATUS")
CALL putfont(195, 160, "ARR. MOVE CURSOR")
a$ = INPUT$(1)
IF status.awal = 0 THEN
LINE (2, 87)-(178, 178), 0, BF
status.awal = 1
END IF
LINE (xawal - 3, yawal - 3)-(xakhir + 3, yakhir + 3), 0, BF
PUT (xawal, yawal), save.screen%
GOTO edit

colors:
CALL putfont(192, 160, "COLOR . . .")
c = oldc
LINE (290, 161)-(295, 166), c, BF
c1:
DO
LOCATE 21, 33: PRINT USING "###"; c;
t$ = INKEY$
IF t$ = "" THEN GOTO c1
IF LEN(t$) <> 1 THEN t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN
IF c = 0 THEN c = 250 ELSE c = c - 1
LINE (290, 161)-(295, 166), c, BF
END IF
IF t$ = "M" THEN
IF c = 250 THEN c = 0 ELSE c = c + 1
LINE (290, 161)-(295, 166), c, BF
END IF
LOOP UNTIL t$ = CHR$(13)
oldc = c
CALL delln(21)
GOTO e1

set.palet:
CALL putfont(192, 160, "PALET 0 . . . 9")
Pal$ = INPUT$(1)
Pal = VAL(Pal$)
CALL delln(21)
IF Pal < 0 OR Pal > 9 THEN GOTO set.palet
CALL delln(21)
CALL putfont(192, 160, "COLOR . . .")
c = oldc
LINE (290, 161)-(295, 166), c, BF
sp1:
DO
LOCATE 21, 33: PRINT USING "###"; c;
t$ = INKEY$
IF t$ = "" THEN GOTO sp1
IF LEN(t$) <> 1 THEN t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN
IF c = 0 THEN c = 250 ELSE c = c - 1
LINE (290, 161)-(295, 166), c, BF
END IF
IF t$ = "M" THEN
IF c = 250 THEN c = 0 ELSE c = c + 1
LINE (290, 161)-(295, 166), c, BF
END IF
LOOP UNTIL t$ = CHR$(13)
Pal(Pal) = c
CALL delln(21)
GOTO e1

quit:
CALL putfont(192, 160, "QUIT . . . Y N")
t$ = INPUT$(1)
IF t$ = "Y" OR t$ = "y" THEN SCREEN 0, 0: WIDTH 80: END
CALL delln(21)
GOTO e2

clearing:
CALL putfont(192, 160, "CLEARING . . .")
FOR i = 1 TO col.len
FOR i1 = 1 TO row.len
ima(i, i1) = 0
FOR j = (i - 1) * pixel + 1 TO (i - 1) * pixel + (pixel - 1)
FOR k = (i1 - 1) * pixel + 1 TO (i1 - 1) * pixel + (pixel - 1)
PSET (j, k), 0 'Ganti warna dengan 0 pada edit.area
NEXT
NEXT
PSET (194 + i, 11 + i1), 0 'Ganti warna dengan 0 pada frame
NEXT
NEXT
edit = 0
CALL delln(21)
GOTO e2

transfer:
CALL putfont(192, 160, "TO OR FROM CEL")
t$ = INPUT$(1)
CALL delln(21)

IF t$ = "t" OR t$ = "T" THEN
CALL putfont(192, 160, "CEL NO . . . 1 2")
Cel$ = INPUT$(1)
Cel = VAL(Cel$)
CALL delln(21)
IF Cel < 1 OR Cel > 2 THEN GOTO transfer
IF Cel(Cel) = 1 THEN
CALL putfont(192, 160, "CANNOT TRANSFER !")
CALL wait.time
CALL delln(21)
GOTO transfer
END IF
GET (195, 12)-(194 + col.len, 11 + row.len), image 'Simpan image
PUT ((Cel - 1) * 50 + 193 + 2, 107), image 'Put image di cel
CALL set.cel.frame(Cel, yes)
Cel(Cel) = 1
END IF

IF t$ = "F" OR t$ = "f" THEN
IF edit = 1 THEN
CALL putfont(192, 160, "CANNOT TRANSFER !")
CALL wait.time
CALL delln(21)
GOTO e2
END IF
CALL putfont(192, 160, "CEL NO . . . 1 2")
Cel$ = INPUT$(1)
Cel = VAL(Cel$)
CALL delln(21)
IF Cel < 1 OR Cel > 2 THEN GOTO transfer
IF Cel(Cel) = 0 THEN
CALL putfont(192, 160, "CANNOT TRANSFER !")
CALL wait.time
CALL delln(21)
GOTO transfer
END IF

LINE ((x - 1) * pixel, (y - 1) * pixel)-((x - 1) * pixel + pixel, (y - 1) * pixel + pixel), 3, B
FOR i = 107 TO 106 + row.len
FOR j = (Cel - 1) * 50 + 193 + 2 TO (Cel - 1) * 50 + 193 + 1 + col.len
y1 = (i - 106)
x1 = (j - ((Cel - 1) * 50 + 193 + 2) + 1)
a = POINT(j, i)
ima(x1, y1) = a
FOR i1 = (x1 - 1) * pixel + 1 TO (x1 - 1) * pixel + (pixel - 1)
FOR j1 = (y1 - 1) * pixel + 1 TO (y1 - 1) * pixel + (pixel - 1)
PRESET (i1, j1), a
NEXT
NEXT
PRESET (194 + x1, 11 + y1), a
NEXT
NEXT
LINE ((x - 1) * pixel, (y - 1) * pixel)-((x - 1) * pixel + pixel, (y - 1) * pixel + pixel), 0, B
edit = 1
END IF
CALL delln(21)
GOTO e2

del:
CALL putfont(192, 160, "DELETE . . . Y N")
t$ = INPUT$(1)
CALL delln(21)
IF t$ = "Y" OR t$ = "y" THEN GOTO d1
GOTO e2

d1:
CALL putfont(192, 160, "CEL NO . . . 1 2")
Cel$ = INPUT$(1)
Cel = VAL(Cel$)
CALL delln(21)
IF Cel < 1 OR Cel > 2 THEN GOTO del
IF Cel(Cel) = 0 THEN
CALL putfont(192, 160, "CANNOT DELETE !")
CALL wait.time
CALL delln(21)
GOTO del
END IF

GET ((Cel - 1) * 50 + 193 + 2, 107)-((Cel - 1) * 50 + 193 + 1 + col.len, 106 + row.len), image
PUT ((Cel - 1) * 50 + 193 + 2, 107), image
CALL set.cel.frame(Cel, No)
Cel(Cel) = 0
GOTO e2

mirror:
CALL putfont(192, 160, "SWAP . . . H V")
t$ = INPUT$(1)
CALL delln(21)

IF t$ = "H" OR t$ = "h" THEN
CALL putfont(192, 160, "SWAPING . . .")
FOR i = 1 TO col.len
FOR j = 1 TO (row.len + 1) / 2
SWAP ima(i, j), ima(i, row.len + 1 - j)
NEXT
NEXT
END IF

IF t$ = "V" OR t$ = "v" THEN
CALL putfont(192, 160, "SWAPING . . .")
FOR i = 1 TO (col.len + 1) / 2
FOR j = 1 TO row.len
SWAP ima(i, j), ima(col.len + 1 - i, j)
NEXT
NEXT
END IF

FOR i = 1 TO col.len
FOR j = 1 TO row.len
FOR i1 = (i - 1) * pixel + 1 TO (i - 1) * pixel + (pixel - 1)
FOR j1 = (j - 1) * pixel + 1 TO (j - 1) * pixel + (pixel - 1)
PRESET (i1, j1), ima(i, j)
NEXT
NEXT
PRESET (194 + i, 11 + j), ima(i, j)
NEXT
NEXT
CALL delln(21)
GOTO e2

resize.grid:
FOR i = 1 TO 2
IF Cel(i) = 1 THEN edt = 1
NEXT
FOR i = 1 TO col.len
FOR j = 1 TO row.len
IF ima(i, j) <> 0 THEN edt = 1
NEXT
NEXT
IF edt = 1 THEN
CALL putfont(192, 160, "CLEAR ALL FIRST !")
CALL wait.time
CALL delln(21)
edt = 0
GOTO e2
END IF

r1:
CALL delln(21)
CALL putfont(192, 160, "RESIZE . . . Y N")
t$ = INPUT$(1)
CALL delln(21)
IF t$ = "Y" OR t$ = "y" THEN GOTO r2
GOTO e2

r2:
CALL delln(21)
yg = col.len
CALL putfont(192, 160, "COL.")
LOCATE 21, 29
PRINT yg
xg = row.len
CALL putfont(260, 160, "ROW.")
LOCATE 21, 37
PRINT xg

r3:
t$ = INKEY$
IF t$ = "" THEN GOTO r3
IF t$ = CHR$(27) THEN CALL delln(21): GOTO r1
IF t$ = CHR$(13) THEN GOTO r4
IF LEN(t$) = 1 THEN GOTO r3 ELSE t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN yg = yg - 1: IF yg = 2 THEN yg = max.col.len
IF t$ = "M" THEN yg = yg + 1: IF yg = max.col.len + 1 THEN yg = 3
LOCATE 21, 29
PRINT yg
GOTO r3

r4:
t$ = INKEY$
IF t$ = "" THEN GOTO r4
IF t$ = CHR$(27) THEN CALL delln(21): GOTO r1
IF t$ = CHR$(13) THEN GOTO r5
IF LEN(t$) = 1 THEN GOTO r4 ELSE t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN xg = xg - 1: IF xg = 2 THEN xg = max.row.len
IF t$ = "M" THEN xg = xg + 1: IF xg = max.row.len + 1 THEN xg = 3
LOCATE 21, 37
PRINT xg
GOTO r4

r5:
new.col = yg
new.row = xg
GOSUB change.grid
CALL delln(21)
GOTO edit

change.grid:
CALL delln(21)
CALL putfont(192, 160, "RESIZING AREA")
old.col = col.len
old.row = row.len
col.len = new.col
row.len = new.row
x = 1
y = 1
oldx = 1
oldy = 1
total.byte = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.byte / 2)
ERASE image
REDIM image(ima.dim)
FOR i = 1 TO 2
LINE ((i - 1) * 50 + 193, 105)-((i - 1) * 50 + 193 + old.col + 3, 108 + old.row), 0, B
NEXT
CALL draw.cel.frame
LINE (193, 10)-(196 + old.col, 13 + old.row), 0, B
CALL draw.ima.frame
LINE (0, 0)-((old.col - 1) * pixel + pixel, (old.row - 1) * pixel + pixel), 0, BF
CALL draw.edit.area
LINE ((x - 1) * pixel, (y - 1) * pixel)-((x - 1) * pixel + pixel, (y - 1) * pixel + pixel), 0, B
CALL delln(21)
RETURN

refresh.grid:
CALL delln(21)
CALL putfont(192, 160, "RESIZING AREA")
x = 1
y = 1
oldx = 1
oldy = 1

Cel(1) = 0: Cel(2) = 0
'Refresh Draw Cell Frame
LINE (190, 105)-(300, 180), 0, BF
'Refresh Draw Image Frame
LINE (190, 10)-(300, 60), 0, BF
'Refresh Edit Area
LINE (0, 0)-(180, 180), 0, BF
FOR i = 1 TO 2
LINE ((i - 1) * 50 + 193, 105)-((i - 1) * 50 + 193 + col.len + 3, 108 + row.len), 0, B
NEXT
CALL draw.cel.frame
LINE (193, 10)-(196 + col.len, 13 + row.len), 0, B
CALL draw.ima.frame
LINE (0, 0)-((col.len - 1) * pixel + pixel, (row.len - 1) * pixel + pixel), 0, BF
CALL draw.edit.area
LINE ((x - 1) * pixel, (y - 1) * pixel)-((x - 1) * pixel + pixel, (y - 1) * pixel + pixel), 0, B
'Put Image on Active Cell
PUT (195, 12), image
'Draw Image on Edit Area
FOR i = 12 TO 11 + row.len
FOR j = 193 + 2 TO 193 + 1 + col.len
y1 = (i - 11)
x1 = (j - (193 + 2) + 1)
a = POINT(j, i)
ima(x1, y1) = a
FOR i1 = (x1 - 1) * pixel + 1 TO (x1 - 1) * pixel + (pixel - 1)
FOR j1 = (y1 - 1) * pixel + 1 TO (y1 - 1) * pixel + (pixel - 1)
PRESET (i1, j1), a
NEXT
NEXT
NEXT
NEXT
CALL delln(21)
RETURN

cropping:
FOR i = 1 TO col.len
FOR j = 1 TO row.len
IF ima(i, j) <> 0 THEN edt = 1
NEXT
NEXT
IF edt = 0 THEN
CALL putfont(192, 160, "LOAD TO EDIT AREA")
CALL wait.time
CALL delln(21)
GOTO e2
END IF

CALL delln(21)
CALL putfont(192, 160, "UP LFT RGT DWN")
k$ = INPUT$(1)
CALL delln(21)
IF k$ = "U" OR k$ = "u" THEN GOTO o1
IF k$ = "L" OR k$ = "l" THEN GOTO o2
IF k$ = "R" OR k$ = "r" THEN GOTO o3
IF k$ = "D" OR k$ = "d" THEN GOTO o4
GOTO e2

o1:
CALL delln(21)
CALL putfont(192, 160, "TOTAL ROWS")
o11:
DO
LOCATE 21, 35: PRINT USING "###"; pix;
t1$ = INKEY$
IF t1$ = "" THEN GOTO o11
IF LEN(t1$) <> 1 THEN t1$ = RIGHT$(t1$, 1)
IF t1$ = "K" THEN
IF pix = 0 THEN pix = 3 ELSE pix = pix - 1
END IF
IF t1$ = "M" THEN
IF pix = 3 THEN pix = 0 ELSE pix = pix + 1
END IF
LOOP UNTIL t1$ = CHR$(13)
CALL delln(21)
'Ambil Gambar di cell aktif
row.len = row.len - pix
total.byte = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.byte / 2)
ERASE image
REDIM image(ima.dim)
GET (195, 12 + pix)-(194 + col.len, 11 + row.len + pix), image
GOSUB refresh.grid
GOTO edit

o2:
CALL delln(21)
CALL putfont(192, 160, "TOTAL COLS")
o21:
DO
LOCATE 21, 35: PRINT USING "###"; pix;
t$ = INKEY$
IF t$ = "" THEN GOTO o21
IF LEN(t$) <> 1 THEN t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN
IF pix = 0 THEN pix = 3 ELSE pix = pix - 1
END IF
IF t$ = "M" THEN
IF pix = 3 THEN pix = 0 ELSE pix = pix + 1
END IF
LOOP UNTIL t$ = CHR$(13)
CALL delln(21)
'Ambil Gambar di cell aktif
col.len = col.len - pix
total.byte = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.byte / 2)
ERASE image
REDIM image(ima.dim)
GET (195 + pix, 12)-(194 + col.len + pix, 11 + row.len), image
GOSUB refresh.grid
GOTO edit

o3:
CALL delln(21)
CALL putfont(192, 160, "TOTAL COLS")
o31:
DO
LOCATE 21, 35: PRINT USING "###"; pix;
t$ = INKEY$
IF t$ = "" THEN GOTO o31
IF LEN(t$) <> 1 THEN t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN
IF pix = 0 THEN pix = 3 ELSE pix = pix - 1
END IF
IF t$ = "M" THEN
IF pix = 3 THEN pix = 0 ELSE pix = pix + 1
END IF
LOOP UNTIL t$ = CHR$(13)
CALL delln(21)
'Ambil Gambar di cell aktif
col.len = col.len - pix
total.byte = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.byte / 2)
ERASE image
REDIM image(ima.dim)
GET (195, 12)-(194 + col.len, 11 + row.len), image
GOSUB refresh.grid
GOTO edit

o4:
CALL delln(21)
CALL putfont(192, 160, "TOTAL ROWS")
o41:
DO
LOCATE 21, 35: PRINT USING "###"; pix;
t$ = INKEY$
IF t$ = "" THEN GOTO o41
IF LEN(t$) <> 1 THEN t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN
IF pix = 0 THEN pix = 3 ELSE pix = pix - 1
END IF
IF t$ = "M" THEN
IF pix = 3 THEN pix = 0 ELSE pix = pix + 1
END IF
LOOP UNTIL t$ = CHR$(13)
CALL delln(21)
'Ambil Gambar di cell aktif
row.len = row.len - pix
total.byte = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.byte / 2)
ERASE image
REDIM image(ima.dim)
GET (195, 12)-(194 + col.len, 11 + row.len), image
GOSUB refresh.grid
GOTO edit

save:
CALL putfont(192, 160, "SAVE . . . Y N")
t$ = INPUT$(1)
CALL delln(21)
IF t$ = "Y" OR t$ = "y" THEN GOTO s0 ELSE GOTO e2

s0:
cn = 1
CALL putfont(192, 160, "SAVE CEL NO. ")
LOCATE 21, 37
PRINT cn

s1:
t$ = INKEY$
IF t$ = "" THEN GOTO s1
IF t$ = CHR$(27) THEN CALL delln(21): GOTO save
IF t$ = CHR$(13) THEN CALL delln(21): GOTO s2
IF LEN(t$) = 1 THEN GOTO s1 ELSE t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN cn = cn - 1: IF cn = 0 THEN cn = 2
IF t$ = "M" THEN cn = cn + 1: IF cn = 3 THEN cn = 1
LOCATE 21, 37
PRINT cn
GOTO s1

s2:
IF Cel(cn) = 1 THEN GOTO s3
CALL putfont(192, 160, "CANNOT SAVE")
CALL wait.time
CALL delln(21)
GOTO save

s3:
total.bytes = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.bytes / 2)
ERASE main.ima
REDIM main.ima(ima.dim) AS INTEGER
GET ((cn - 1) * 50 + 193 + 2, 107)-((cn - 1) * 50 + 193 + 1 + col.len, 106 + row.len), main.ima
file.name$ = get.filename(21, 25, 15)
CALL delln(21)
file.shp$ = file.name$ + ".SHP"
CALL putfont(192, 160, "SAVING . . .")
OPEN file.shp$ FOR OUTPUT AS #1
FOR init = 0 TO ima.dim
WRITE #1, main.ima(init)
NEXT
CLOSE #1
CALL delln(21)
GOTO e2

load:
CALL putfont(192, 160, "LOAD . . . Y N")
t$ = INPUT$(1)
CALL delln(21)
IF t$ = "Y" OR t$ = "y" THEN GOTO l0 ELSE GOTO e2

l0:
cn = 1
CALL putfont(192, 160, "INTO CEL NO. ")
LOCATE 21, 37
PRINT cn

l1:
t$ = INKEY$
IF t$ = "" THEN GOTO l1
IF t$ = CHR$(27) THEN CALL delln(21): GOTO load
IF t$ = CHR$(13) THEN CALL delln(21): GOTO l2
IF LEN(t$) = 1 THEN GOTO l1 ELSE t$ = RIGHT$(t$, 1)
IF t$ = "K" THEN cn = cn - 1: IF cn = 0 THEN cn = 2
IF t$ = "M" THEN cn = cn + 1: IF cn = 3 THEN cn = 1
LOCATE 21, 37
PRINT cn
GOTO l1

l2:
IF Cel(cn) = 0 THEN GOTO l3
CALL putfont(192, 160, "CANNOT LOAD")
CALL wait.time
CALL delln(21)
GOTO load

l3:
total.bytes = 4 + INT(((col.len + 1) * 8 + 7) / 8) * (row.len + 1)
ima.dim = INT(total.bytes / 2)
ERASE main.ima
REDIM main.ima(ima.dim) AS INTEGER
file.name$ = get.filename(21, 25, 15)
CALL delln(21)
file.shp$ = file.name$ + ".SHP"
CALL putfont(192, 160, "LOADING. . .")
OPEN file.shp$ FOR INPUT AS #1
INPUT #1, col.load
INPUT #1, row.load
IF (col.load = col.len * 8) AND (row.load = row.len) THEN
main.ima(0) = col.load
main.ima(1) = row.load
FOR init = 2 TO ima.dim
INPUT #1, buffers%
main.ima(init) = buffers%
NEXT
CLOSE #1
PUT ((cn - 1) * 50 + 193 + 2, 107), main.ima
Cel(cn) = 1
CALL set.cel.frame(cn, yes)
CALL delln(21)
GOTO load
END IF
CALL delln(21)
CALL putfont(192, 160, "CANNOT LOAD")
CALL wait.time
CALL delln(21)
CALL putfont(192, 160, "SIZE ")
LOCATE 21, 30
PRINT STR$(col.load / 8); " x"; STR$(row.load)
CALL wait.time
CALL delln(21)
CLOSE #1
GOTO load

ErrorProc:
CALL delln(21)
CALL putfont(192, 160, "ERROR.")
LOCATE 21, 35
PRINT ; ERR
CALL wait.time
CALL delln(21)
RESUME e2
CALL delln(21)
GOTO e2

'Huruf A
DATA 64 , 8 , 0 , 3855 , 2319 , 0 , 3840 , 2319 , 3855 , 9
DATA 3855 , 2313 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 3855
DATA 3855 , 2319 , 3855 , 2313 , 3849 , 2319 , 3855 , 9 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf B
DATA 64 , 8 , 3855 , 3855 , 3855 , 9 , 3855 , 2313 , 3849 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 3855 , 3855 , 9 , 3855 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 3855 , 3855 , 2313
DATA 2313 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf C
DATA 64 , 8 , 0 , 3855 , 3855 , 0 , 3840 , 2319 , 3849 , 2319
DATA 3855 , 2313 , 2304 , 2313 , 3855 , 9 , 0 , 0 , 3855 , 9
DATA 0 , 0 , 3840 , 2319 , 3840 , 2319 , 0 , 3855 , 3855 , 2313
DATA 0 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf D
DATA 64 , 8 , 3855 , 3855 , 2319 , 0 , 3855 , 2313 , 3855 , 9
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 9
DATA 3840 , 2319 , 3855 , 9 , 3855 , 2313 , 3855 , 3855 , 2319 , 9
DATA 2313 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf E
DATA 64 , 8 , 3855 , 3855 , 3855 , 2319 , 3855 , 2313 , 2313 , 2313
DATA 3855 , 9 , 0 , 0 , 3855 , 3855 , 3855 , 9 , 3855 , 2313
DATA 2313 , 9 , 3855 , 9 , 0 , 0 , 3855 , 3855 , 3855 , 2319
DATA 2313 , 2313 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf F
DATA 64 , 8 , 3855 , 3855 , 3855 , 2319 , 3855 , 2313 , 2313 , 2313
DATA 3855 , 9 , 0 , 0 , 3855 , 3855 , 3855 , 9 , 3855 , 2313
DATA 2313 , 9 , 3855 , 9 , 0 , 0 , 3855 , 9 , 0 , 0
DATA 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf G
DATA 64 , 8 , 0 , 3855 , 3855 , 2319 , 3840 , 2319 , 2313 , 2313
DATA 3855 , 9 , 0 , 0 , 3855 , 9 , 3855 , 2319 , 3855 , 9
DATA 3849 , 2319 , 3840 , 2319 , 3840 , 2319 , 0 , 3855 , 3855 , 2319
DATA 0 , 2313 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf H
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 3855 , 3855 , 2319 , 3855 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf I
DATA 56 , 8 , 3855 , 3855 , 3855 , 2313 , 3849 , 2319 , 2313 , 0
DATA 3855 , 9 , 0 , 3840 , 2319 , 0 , 0 , 3855 , 9 , 0
DATA 3840 , 2319 , 0 , 3855 , 3855 , 3855 , 2313 , 2313 , 2313 , 2313
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
'Huruf J
DATA 64 , 8 , 0 , 3840 , 3855 , 2319 , 0 , 2304 , 3849 , 2319
DATA 0 , 0 , 3840 , 2319 , 0 , 0 , 3840 , 2319 , 3855 , 9
DATA 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf K
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3855 , 2313
DATA 3855 , 3849 , 2319 , 9 , 3855 , 3855 , 2313 , 0 , 3855 , 3855
DATA 15 , 0 , 3855 , 3849 , 3855 , 0 , 3855 , 9 , 3855 , 2319
DATA 2313 , 9 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf L
DATA 56 , 8 , 3855 , 9 , 0 , 3840 , 2319 , 0 , 0 , 3855
DATA 9 , 0 , 3840 , 2319 , 0 , 0 , 3855 , 9 , 0 , 3840
DATA 2319 , 0 , 0 , 3855 , 3855 , 3855 , 2313 , 2313 , 2313 , 2313
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
'Huruf M
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 2319 , 3855 , 2319
DATA 3855 , 3855 , 3855 , 2319 , 3855 , 3855 , 3855 , 2319 , 3855 , 3849
DATA 3849 , 2319 , 3855 , 2313 , 3849 , 2319 , 3855 , 9 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf N
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 2319 , 3840 , 2319
DATA 3855 , 3855 , 3849 , 2319 , 3855 , 3855 , 3855 , 2319 , 3855 , 3849
DATA 3855 , 2319 , 3855 , 9 , 3855 , 2319 , 3855 , 9 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf O
DATA 64 , 8 , 3840 , 3855 , 3855 , 9 , 3855 , 2313 , 3849 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 9
DATA 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 9
DATA 2304 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf P
DATA 64 , 8 , 3855 , 3855 , 3855 , 9 , 3855 , 2313 , 3849 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 3855
DATA 3855 , 2313 , 3855 , 2313 , 2313 , 9 , 3855 , 9 , 0 , 0
DATA 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf Q
DATA 64 , 8 , 3840 , 3855 , 3855 , 9 , 3855 , 2313 , 3849 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 3849
DATA 3855 , 2319 , 3855 , 2313 , 3855 , 2313 , 3840 , 3855 , 2319 , 2319
DATA 2304 , 2313 , 9 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf R
DATA 64 , 8 , 3855 , 3855 , 3855 , 9 , 3855 , 2313 , 3849 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3855 , 2319 , 3855 , 3855
DATA 2319 , 2313 , 3855 , 3849 , 3855 , 0 , 3855 , 9 , 3855 , 2319
DATA 2313 , 9 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf S
DATA 64 , 8 , 3840 , 3855 , 2319 , 0 , 3855 , 2313 , 3855 , 9
DATA 3855 , 9 , 2313 , 9 , 3840 , 3855 , 3855 , 9 , 2304 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf T
DATA 56 , 8 , 3855 , 3855 , 3855 , 2313 , 3849 , 2319 , 2313 , 0
DATA 3855 , 9 , 0 , 3840 , 2319 , 0 , 0 , 3855 , 9 , 0
DATA 3840 , 2319 , 0 , 0 , 3855 , 9 , 0 , 2304 , 2313 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
'Huruf U
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 9
DATA 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf V
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319
DATA 3855 , 9 , 3840 , 2319 , 3855 , 2319 , 3855 , 2319 , 3840 , 3855
DATA 3855 , 2313 , 0 , 3855 , 2319 , 9 , 0 , 3840 , 2313 , 0
DATA 0 , 2304 , 9 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf W
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3840 , 2319
DATA 3855 , 3849 , 3849 , 2319 , 3855 , 3855 , 3855 , 2319 , 3855 , 3855
DATA 3855 , 2319 , 3855 , 2319 , 3855 , 2319 , 3855 , 2313 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf X
DATA 64 , 8 , 3855 , 9 , 3840 , 2319 , 3855 , 2319 , 3855 , 2319
DATA 3840 , 3855 , 3855 , 2313 , 0 , 3855 , 2319 , 9 , 3840 , 3855
DATA 3855 , 0 , 3855 , 2319 , 3855 , 2319 , 3855 , 2313 , 3840 , 2319
DATA 2313 , 9 , 2304 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Huruf Y
DATA 56 , 8 , 3855 , 9 , 3855 , 3849 , 2319 , 3840 , 2319 , 3855
DATA 9 , 3855 , 9 , 3855 , 3855 , 2313 , 0 , 3855 , 2313 , 0
DATA 3840 , 2319 , 0 , 0 , 3855 , 9 , 0 , 2304 , 2313 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
'Huruf Z
DATA 64 , 8 , 3855 , 3855 , 3855 , 2319 , 2313 , 2313 , 3855 , 2319
DATA 0 , 3840 , 3855 , 2313 , 0 , 3855 , 2319 , 9 , 3840 , 3855
DATA 2313 , 0 , 3855 , 2319 , 9 , 0 , 3855 , 3855 , 3855 , 2319
DATA 2313 , 2313 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Nol
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 9
DATA 3855 , 2313 , 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3855 , 9
DATA 3840 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 9
DATA 0 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Satu
DATA 56 , 8 , 0 , 0 , 0 , 0 , 3840 , 2319 , 0 , 3840
DATA 3855 , 9 , 0 , 3840 , 2319 , 0 , 0 , 3855 , 9 , 0
DATA 3840 , 2319 , 0 , 3855 , 3855 , 3855 , 2313 , 2313 , 2313 , 2313
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
'Dua
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 9
DATA 3855 , 9 , 3840 , 2319 , 0 , 3840 , 3855 , 2313 , 3840 , 3855
DATA 2319 , 9 , 3855 , 2319 , 2313 , 0 , 3855 , 3855 , 3855 , 2319
DATA 2313 , 2313 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Tiga
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 2319
DATA 0 , 3840 , 2319 , 9 , 0 , 3855 , 3855 , 0 , 0 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Empat
DATA 64 , 8 , 0 , 0 , 0 , 0 , 0 , 3840 , 3855 , 9
DATA 0 , 3855 , 3855 , 9 , 3840 , 2319 , 3855 , 9 , 3855 , 2313
DATA 3855 , 9 , 3855 , 3855 , 3855 , 2319 , 2313 , 2313 , 3855 , 2313
DATA 0 , 0 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Lima
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3855 , 3855 , 3855 , 9
DATA 3855 , 2313 , 2313 , 9 , 3855 , 3855 , 3855 , 0 , 2313 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Enam
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 9
DATA 3855 , 2313 , 0 , 0 , 3855 , 3855 , 3855 , 9 , 3855 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Tujuh
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3855 , 3855 , 3855 , 2319
DATA 3855 , 2313 , 3849 , 2319 , 2313 , 9 , 3855 , 2313 , 0 , 3840
DATA 2319 , 9 , 0 , 3855 , 2313 , 0 , 0 , 3855 , 9 , 0
DATA 0 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Delapan
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 9
DATA 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 9 , 3855 , 2313
DATA 3849 , 2319 , 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2313
DATA 2304 , 2313 , 2313 , 9 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Sembilan
DATA 64 , 8 , 0 , 0 , 0 , 0 , 3840 , 3855 , 3855 , 9
DATA 3855 , 9 , 3840 , 2319 , 3840 , 3855 , 3855 , 2319 , 2304 , 2313
DATA 3849 , 2319 , 0 , 0 , 3855 , 2313 , 3840 , 3855 , 2319 , 9
DATA 2304 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0
'Titik
DATA 24 , 8 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 3840
DATA 2319 , 3855 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0
'Tanda Seru
DATA 24 , 8 , 3855 , 3849 , 2319 , 3855 , 3849 , 2319 , 3855 , 2313
DATA 9 , 3855 , 2313 , 2313 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0

REM $STATIC
SUB box (x1%, y1%, x2%, y2%, c1%, c2%, c3%, c4%)
LINE (x1 - 1, y1 - 1)-(x1 + 3, y1 + 3), c1, B
LINE (x1, y1)-(x1 + 2, y1 + 2), c3, BF
LINE (x2 - 1, y1 - 1)-(x2 + 3, y1 + 3), c1, B
LINE (x2, y1)-(x2 + 2, y1 + 2), c3, BF
LINE (x1 + 4, y1)-(x2 - 2, y1), c1
LINE (x1 + 4, y1 + 1)-(x2 - 2, y1 + 1), c2
LINE (x1 + 4, y1 + 2)-(x2 - 2, y1 + 2), c1
LINE (x1 + 4, y1 + 3)-(x2 - 4, y1 + 3), 0
LINE (x1 + 3, y1 + 4)-(x2 - 3, y1 + 4), 0
FOR i = y1 + 4 TO y2 - 2
LINE (x1 - 1, y1 + 4)-(x1 - 1, i), 0
LINE (x1, y1 + 4)-(x1, i), c1
LINE (x1 + 1, y1 + 4)-(x1 + 1, i), c2
LINE (x1 + 2, y1 + 4)-(x1 + 2, i), c1
LINE (x1 + 3, y1 + 4)-(x1 + 3, i), 0
LINE (x2 - 1, y1 + 4)-(x2 - 1, i), 0
LINE (x2, y1 + 4)-(x2, i), c1
LINE (x2 + 1, y1 + 4)-(x2 + 1, i), c2
LINE (x2 + 2, y1 + 4)-(x2 + 2, i), c1
LINE (x2 + 3, y1 + 4)-(x2 + 3, i), 0
FOR z = 1 TO 3000: NEXT
LINE (x1 - 1, (i + 1) - 1)-(x1 + 3, (i + 1) + 3), c1, B
LINE (x1, (i + 1))-(x1 + 2, (i + 1) + 2), c3, BF
LINE (x2 - 1, (i + 1) - 1)-(x2 + 3, (i + 1) + 3), c1, B
LINE (x2, (i + 1))-(x2 + 2, (i + 1) + 2), c3, BF
LINE (x1 + 4, (i + 1))-(x2 - 2, (i + 1)), c1
LINE (x1 + 4, (i + 1))-(x2 - 2, (i + 1)), 0
LINE (x1 + 4, (i + 1) + 1)-(x2 - 2, (i + 1) + 1), c2
LINE (x1 + 4, (i + 1) + 2)-(x2 - 2, (i + 1) + 2), c1
NEXT
LINE (x1 + 4, i)-(x2 - 2, i), c1
PAINT (INT((x2 - x1) / 2) + x1, INT((y2 - y1) / 2) + y1), c4, c1
END SUB

DEFSNG A-Z
SUB delln (bar!)
LOCATE bar, 25
PRINT STRING$(15, 32)
END SUB

SUB draw.cel.frame
FOR i = 1 TO 2
LINE ((i - 1) * 50 + 193, 105)-((i - 1) * 50 + 193 + col.len + 3, 108 + row.len), 7, B
NEXT
END SUB

SUB draw.edit.area
FOR i = 1 TO row.len
FOR j = 1 TO col.len
LINE ((j - 1) * pixel, (i - 1) * pixel)-((j - 1) * pixel + pixel, (i - 1) * pixel + pixel), 7, B
NEXT
NEXT
END SUB

SUB draw.ima.frame
LINE (193, 10)-(196 + col.len, 13 + row.len), 3, B, &HAAAA
END SUB

FUNCTION get.filename$ (rowloc AS INTEGER, colloc AS INTEGER, length AS INTEGER)
buff$ = ""
LOCATE rowloc, colloc
GOTO get.it

cursor.cont:
colloct = (colloc - 1) * 8
rowloct = (rowloc - 1) * 8

cc1:
w$ = INKEY$
IF w$ <> "" THEN RETURN
ca = ca + 1
IF ca < 150 THEN GOTO cc1
ca = 0
fl = NOT fl
IF fl THEN
LINE (colloct, rowloct)-(colloct + 7, rowloct + 7), 3, BF: GOTO cc1
ELSE
LINE (colloct, rowloct)-(colloct + 7, rowloct + 7), 0, BF: GOTO cc1
END IF
RETURN

get.it:
GOSUB cursor.cont
IF LEN(w$) = 2 THEN GOTO get.it
IF w$ = CHR$(13) THEN GOTO ending
IF w$ = CHR$(8) THEN
IF buff$ = "" THEN
GOTO get.it
ELSE
PRINT " "; CHR$(29); CHR$(29); : colloc = colloc - 1
buff$ = LEFT$(buff$, LEN(buff$) - 1): GOTO get.it
END IF
END IF
IF w$ < "" OR w$ > CHR$(127) THEN GOTO get.it
IF LEN(buff$) = length THEN
GOTO get.it
ELSE
PRINT w$; : buff$ = buff$ + w$: colloc = colloc + 1: GOTO get.it
END IF

ending:
get.filename$ = buff$
END FUNCTION

SUB msg (rl AS INTEGER, cl AS INTEGER, message$)
CALL writeln(rl, cl, message$)
CALL wait.time
CALL delln(21)
END SUB

DEFINT A-Z
SUB putfont (col, row, text$)
spasi = 0
GOSUB cetak
EXIT SUB

cetak:
FOR xx = 1 TO LEN(text$)
num = ASC(MID$(text$, xx, 1))
IF num > 47 AND num < 58 THEN
ON num - 47 GOSUB 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
END IF
IF num > 64 AND num < 91 THEN
ON num - 64 GOSUB ba, bb, bc, bd, be, BF, bg, bh, bi, bj, bk, bl, bm, bn, bo, bp, bq, br, bs, bt, bu, bv, bw, bx, by, bz
END IF
IF num = 33 THEN GOSUB seru
IF num = 46 THEN GOSUB titik

'dimension 3 x 8, 7 x 8, 8 x 8
SELECT CASE num
CASE 32, 33, 46
col = col + 3 + spasi
CASE 49, 73, 76, 84, 89
col = col + 7 + spasi
CASE ELSE
col = col + 8 + spasi
END SELECT
NEXT
RETURN

0 : PUT (col, row), f0: RETURN
1 : PUT (col, row), f1: RETURN
2 : PUT (col, row), f2: RETURN
3 : PUT (col, row), f3: RETURN
4 : PUT (col, row), f4: RETURN
5 : PUT (col, row), f5: RETURN
6 : PUT (col, row), f6: RETURN
7 : PUT (col, row), f7: RETURN
8 : PUT (col, row), f8: RETURN
9 : PUT (col, row), f9: RETURN

ba: PUT (col, row), ba: RETURN
bb: PUT (col, row), bb: RETURN
bc: PUT (col, row), bc: RETURN
bd: PUT (col, row), bd: RETURN
be: PUT (col, row), be: RETURN
BF: PUT (col, row), BF: RETURN
bg: PUT (col, row), bg: RETURN
bh: PUT (col, row), bh: RETURN
bi: PUT (col, row), bi: RETURN
bj: PUT (col, row), bj: RETURN
bk: PUT (col, row), bk: RETURN
bl: PUT (col, row), bl: RETURN
bm: PUT (col, row), bm: RETURN
bn: PUT (col, row), bn: RETURN
bo: PUT (col, row), bo: RETURN
bp: PUT (col, row), bp: RETURN
bq: PUT (col, row), bq: RETURN
br: PUT (col, row), br: RETURN
bs: PUT (col, row), bs: RETURN
bt: PUT (col, row), bt: RETURN
bu: PUT (col, row), bu: RETURN
bv: PUT (col, row), bv: RETURN
bw: PUT (col, row), bw: RETURN
bx: PUT (col, row), bx: RETURN
by: PUT (col, row), by: RETURN
bz: PUT (col, row), bz: RETURN

titik: PUT (col, row), titik: RETURN
seru: PUT (col, row), seru: RETURN

END SUB

DEFSNG A-Z
SUB set.cel.frame (celnum AS INTEGER, switch AS INTEGER)
SELECT CASE switch
CASE 0
LINE ((celnum - 1) * 50 + 193, 105)-((celnum - 1) * 50 + 193 + col.len + 3, 108 + row.len), 7, B
CASE 1
LINE ((celnum - 1) * 50 + 193, 105)-((celnum - 1) * 50 + 193 + col.len + 3, 108 + row.len), 0, B
LINE ((celnum - 1) * 50 + 193, 105)-((celnum - 1) * 50 + 193 + col.len + 3, 108 + row.len), 3, B, &HAAAA
END SELECT
END SUB

SUB wait.time

again:
r$ = INKEY$
IF r$ = "" THEN GOTO again
END SUB

SUB writeln (rloc AS INTEGER, cloc AS INTEGER, stm$)
LOCATE rloc, cloc
PRINT stm$
END SUB

Program Sprite Editor diatas ditulis dalam bahasa Quick Basic. Jika kita perhatikan sekilas, banyak sekali lompatan-lompatan GOTO dan GOSUB yang digunakan, disamping ada juga beberapa subrutin yang digunakan. Program Sprite Editor terbagi menjadi area menggambar, lalu sebuah cell (kotak kecil) untuk memantau hasil gambar di bagian kanan atas, lalu disediakan dua buah cell lagi untuk menampung hasil akhir sprite yang dapat disimpan menjadi file. Gunakan tombol ENTER untuk berpindah antara mode menggambar dan menggerakkan kursor. Jika pada mode menggambar, menggerakkan kursor akan mewarnai gambar sprite kita. Ubah warna yang digunakan dengan tombol C, pilih warna dengan menggerakkan tombol panah kanan dan kiri. Tombol T digunakan untuk mentransfer sprite dari area menggambar ke cell di bawah, lalu kita dapat simpan dengan menekan tombol S. Penamaan file masih mengikuti aturan DOS, yaitu tidak boleh lebih dari 8 karakter dan tanpa ekstension.
Cobalah anda buat dan desain bentuk-bentuk sprite sesuai desain dan kreatifitas anda sendiri. Yang perlu diingat adalah dimensi sprite maksimum adalah 45x45 pixel dengan maksimum warna sebanyak 256 warna.

[ add comment ] ( 45 views )   |  permalink  |   ( 0 / 0 )

---

PENGANTAR

Penggambaran grafik garis lurus dan kurva memerlukan waktu komputasi yang tinggi, untuk mereduksi waktu komputasi yang tinggi tersebut dapat dilakukan dengan peningkatan kemampuan komputasi prosesor dan peningkatan efisiensi algoritma. Algoritma Midpoint merupakan Algoritma dengan dasar operasi bilangan integer, sehingga memerlukan waktu operasi yang lebih sedikit dibandingkan dengan algoritma yang menggunakan operasi bilangan real. Implementasi ke dalam bahasa pemrograman C dari kedua macam algoritma diatas, menunjukkan bahwa waktu komputasi algoritma midpoint lebih cepat sebesar 8 kali pada pembuatan garis lurus, dan lebih cepat sebesar 15 kali pada penggambaran lingkaran, dibandingkan dengan waktu komputasi algoritma yang menggunakan dasar operasi bilangan
riel. Dan waktu komputasi algoritma midpoint lebih cepat sebesar 6 kali pada pembuatan garis lurus, dibandingkan dengan waktu komputasi algoritma yang Breserham telah menggunakan dasar operasi bilangan integer juga.

Algoritma DDA

1. Start at first endpoint.
2. Draw pixel.
3. Step right by one pixel and up by m*change_in_x
1. (But change_in_x is 1 pixel!
2. so just step up by m pixels)
4. Draw pixel.
5. Repeat from step 3, until we reach second endpoint

Pseudo code:
1. Let x = x1; y = y1; m = (y2-y1)/(x2- x1);
2. Draw pixel (x, y)
3. WHILE (x < x2) //i.e. we reached the second endpoint
{
x = x + 1; //step right by one pixel
y = y + m; //step up by m pixels
Draw pixel (ROUND(x), ROUND(y));
}

Banyak yang menganggap bahwa algoritma DDA sangat lambat didalam menggambarkan suatu titik, garis maupun kurva. Berikut ini adalah function untuk menggambar garis dengan algoritma DDA

int line_dda(int x1,int y1,int x2,int y2,int color)
// Algorithm digital differential analyzer
{ int dx,dy,step,k;
float x_increment,y_increment,x,y;
dx = x2-x1; dy = y2-y1;
// determine maximum step
if (abs(dx) > abs(dy)) step=abs(dx); else step=abs(dy);
x_increment = float(dx) / float(step);
y_increment = float(dy) / float(step);
x = x1; y = y1;
putpixel(int (x+0.5),int(y+0.5),color);
for (k=1;k<=step;k++)
{ x = x+x_increment;
y = y+y_increment;
putpixel(int(x+0.5),int(y+0.5),color);
}
return(0);
}

Garis lurus dinyatakan dinyatakan dalam persamaan :
y = mx + c (1)
dimana : m : gradient dan c : konstanta.
Untuk menggambarkan pixel-pixel dalam garis lurus, parameter yang digunakan tergantung dari gradient, jika besarnya gradient diantara 0 dan 1, maka digunakan sumbu x sebagai parameter dan sumbu y sebagai hasil dari fungsi, sebaliknya, bila gradient melebihi 1, maka sumbu y digunakan sebagai parameter dan sumbu x sebagai hasil dari fungsi, hal ini bertujuan untuk menghindari terjadinya gaps karena adanya pixel yang terlewatkan. Hasil dari fungsi biasanya merupakan bilangan real, sedangkan koordinat pixel dinyatakan dalam bilangan integer (x,y), maka diperlukan operasi pembulatan kedalam bentuk integer terdekat. Penggambaran garis lurus dengan metode diatas dimulai dengan operasi bilangan real untuk menghitung gradient m dan konstanta c.
m = (y2 - y1 ) / (x2-x1) (2)
c = y1 – m* x1 (3)
Operasi bilangan real berikutnya adalah menghitung nilai y dengan persamaan (1) untuk mendapatkan koordinat piksel (x,y), untuk setiap nilai x, dari =x1 sampai x=x2, operasi inilah yang perlu dihindari, karena operasi ini memerlukan waktu operasi yang besar.

Algoritma Bresenham

Bresenham pada tahun 1965, melakukan perbaikan dari algoritma perhitungan koordinat piksel yang menggunakan persamaan (1), dengan cara menggantikan operasi bilangan riel perkalian dengan operasi penjumlahan, yang kemudian dikenal dengan Algoritma Bresenham. Pada algoritma bresenham, nilai y kedua dan seterusnya, dihitung dari nilai y sebelumnya, sehingga hanya titik y pertama yang perlu dilakukan operasi secara lengkap. Perbaikan algoritma ini ternyata tidak menghasilkan perbaikan yang cukup siginifikan. Perbaikan berikutnya dilakukan dengan cara menghilangkan operasi bilangan real
dengan operasi bilangan integer. Operasi bilangan integer jauh lebih cepat dibandingkan dengan operasi bilangan real, terutama pada penambahan dan pengurangan.

int line_bre(int x1,int y1,int x2,int y2,int color)
// Algorithm Bresenham
{ int dx,dy,x,y,x_end;
int p,const1,const2;
dx = x2-x1; dy = y2-y1;
p = 2*dy-dx; y = y1;
const1 = 2*dy; const2 = 2*(dy-dx);
// determine which point to use as start, which as end
if (x1 > x2)
{ x = x2; y = y2; x_end = x1; }
else
{ x = x1; y = y1; x_end = x2; }
putpixel(x,int(y+0.5),color);
while ( x < x_end )
{ x++;
if ( p < 0 )
p = p+const1;
else
{ y = y+1;
p = p+const2;
}
putpixel(x,int(y+0.5),color);
}
return(0);
}

KOMPUTER GRAFIK DENGAN QUICK BASIC

Quick Basic adalah bahasa pemrograman high level yang cukup terstruktur, walaupun mengijinkan beberapa lompatan didalam struktur programnya. Untuk komputer grafik, Quick Basic menyediakan perintah-perintah yang cukup mudah dan sederhana, tentunya untuk menghasilkan output grafik yang sederhana. Quick Basic adalah compiler, sama seperti Turbo Pascal ataupun Borland C++, jadi jika memang diperlukan, Quick Basic mampu mengkompilasi program Basic menjadi program executable.

Mode Grafis di dalam Quick Basic

Di dalam Quick Basic, inisialisasi mode grafis, cukup dengan memberikan sebuah perintah SCREEN yang diikuti dengan bilangan integer. Berikut ini adalah mode SCREEN yang sering digunakan dalam pemrograman grafis

SCREEN 0 : mode teks, dipanggil untuk mengakhiri mode grafis

SCREEN 1 : mode grafis resolusi rendah 320x200 pixel, maksimum 4 warna

SCREEN 12 : mode grafis resolusi tinggi 640x480 pixel, maksimum 16 warna

SCREEN 13 : mode grafis resolusi rendah 300x200 pixel, maksimum 256 warna. Mode grafis ini yang sering digunakan dalam pemrograman animasi ataupun game pada era DOS


' ACAX Experiment Program

SCREEN 12
CLS
LINE (1, 1)-(640, 480), 1, BF
LINE (30, 30)-(610, 450), 0, BF

Ulang:
x1 = RND * 575 + 35
x2 = RND * 550 + 35
x2 = (x1 - x2) / 3 + x2
y1 = RND * 350 + 55
y2 = 450
LINE (x1, y1)-(x2, y2), RND * 6 + 1, BF
LINE (x1, y1)-(x2, y2), 0, B
FOR Delay = 1 TO 800
NEXT
IF INKEY$ = CHR$(13) THEN
SCREEN 0
END
END IF
GOTO Ulang
Program diatas akan menggambar kotak dengan warna dan posisi serta ukuran random. Jika anda lihat program Quick Basic diatas, akan terlihat bahwa program tersebut akan diulang terus dengan adanya perintah GOTO Ulang. Program akan berhenti jika kita menekan tombol keyboard ENTER sebagaimana diberikan dari perintah IF INKEY$=CHR$(13) adalah pengecekan terhadap penekanan tombol ENTER

Perintah-perintah grafik Quick Basic

Perintah-perintah dasar di dalam komputer grafik pada dasarnya hampir sama antara bahasa pemrograman yang satu dengan lainnya.
Apa yang dimaksud dengan pixel? Pixel adalah satu titik yang ada di layar monitor, sedangkan resolusi adalah kumpulan pixel yang membentuk suatu gambar atau dapat juga dikatakan kumpulan total dari pixel-pixel.
Perintah PSET dan PRESET, berfungsi menghidupkan / mematikan pixel pada posisi koordinat tertentu.
Perintah LINE akan menggambar garis diawali dari posisi x1,y1 sampai dengan x2,y2. Berikut adalah Rumus Perintah LINE;
LINE (x1,y1) - (x2,y2), color
dimana color atau warna akan sangat bergantung pada mode grafik yang anda gunakan. Pada mode grafis tertentu, dikenal sistem palette dimana kita dapat mencampur warna dan menghasilkan variasi warna yang sangat banyak.
Perintah CIRCLE, dapat digunakan untuk menggambar lingkaran ataupun kurva sesuai dengan nilai yang kita masukkan.
Beberapa perintah dasar grafik yang lainnya akan dapat dengan mudah dipelajari di dalam Help Quick Basic.

' Gambar Kuas Cat

SCREEN 1
CLS
x = 200
y = 175
COLOR 0, 1
CIRCLE (x - 122, y - 118), 3, 3, , , 1
CIRCLE (x - 135, y - 25), 100, 3, .9, 1.6, 1
CIRCLE (x - 66, y - 193), 100, 3, 3.9, 4.68, 1
CIRCLE (x - 80, y - 64), 30, 3, , 1.4, 1
CIRCLE (x - 51, y - 124), 30, 3, 3.9, 5.5, 1
PSET (x - 50, y - 63), 3
DRAW "m+6,+2m+20,-40nm-6,-2m+18,+6m-20,+40m-18,-6"
DRAW "m+60,+20m+20,-40m-60,-20"
PAINT (x - 47, y - 65), 3
PAINT (x - 37, y - 65), 1, 3
CIRCLE (x - 66, y - 193), 100, 2, 3.9, 4.68, 1
CIRCLE (x - 80, y - 64), 30, 2, , 1.4, 1
PSET (x - 44, y - 61), 0
DRAW "nm+20,-40br14bd6nm+22,-44bl4m+22,-44"
a$ = INPUT$(1)
WIDTH 80
SCREEN 0
END
Program diatas akan menggambar sebuah kuas cat di layar. Yang perlu diperhatikan adalah perintah DRAW sangat bermanfaat dalam menggambar suatu object dengan bentuk yang tidak beraturan. Bandingkanlah dengan program berikut:


' Candle Picture using Statement DRAW

SCREEN 1
CLS
x = 160
y = 148
COLOR 0, 0
CIRCLE (x + 15, y - 26), 20, 3, , , 1
CIRCLE (x + 15, y - 26), 14, 3, , , 1
PAINT (x + 15, y - 10), 2, 3
CIRCLE (x - 53, y - 20), 20, 3, 4.8, .3, .6
CIRCLE (x + 9, y - 20), 20, 3, 2.84, 4.6, .6
PRESET (x - 35, y - 24), 3
DRAW "l2h2u2e2r30f2d2g2l3"
PRESET (x - 56, y - 1), 3
DRAW "h2u2e2r5br60r5f2d2g2l70"
PAINT (x - 48, y - 3), 2, 3
DRAW "bu5c3r52bu15bl15l22"
PRESET (x - 32, y - 31), 1
DRAW "nr20u35g2l1u2e2u14m+22,-5f2d13f1d2g1l1h1d38"
PAINT (x - 30, y - 35), 1
PRESET (x - 32, y - 65), 0
DRAW "e1u5e1u3f2d8g1d1f1r3u7e2u1e1u6e1f1r2e1u1h1r2f2r2d7"
PRESET (x - 22, y - 88), 3
DRAW "u4"
a$ = INPUT$(1)
WIDTH 80
SCREEN 0
END

Program diatas akan menggambarkan sebuah lilin. Jika kita perhatikan, kedua program tersebut menggunakan mode screen 1, yang hanya dapat menampilkan 4 warna, tetapi karena sistem palette yang didapat dari perintah COLOR, maka warna yang dihasilkan dari program pertama berbeda dengan program kedua. Sedangkan perintah PAINT, digunakan untuk mengisi ruang yang kosong dengan warna tertentu. Bereksperimen dengan perintah-perintah grafik akan dapat membantu untuk menghasilkan bentuk-bentuk gambar yang menarik.

Rumus perintah DRAW
DRAW commandstring$
dimana commandstring$ adalah ekspresi yang berisi kumpulan perintah DRAW sbb;
Perintah menggambar garis dan memindah kursor
D[n%] Memindah kursor ke arah selatan sebanyak n% units.
E[n%] Memindah kursor ke arah timur laut sebanyak n% units.
F[n%] Memindah kursor ke arah tenggara sebanyak n% units.
G[n%] Memindah kursor ke arah barat daya sebanyak n% units.
H[n%] Memindah kursor ke arah barat laut sebanyak n% units.
L[n%] Memindah kursor ke arah barat sebanyak n% units.
M[{+|-}]x%,y% Memindah kursor ke koordinat (x%,y%).
R[n%] Memindah kursor ke arah barat sebanyak n% units.
U[n%] Memindah kursor ke arah utara sebanyak n% units.

Setelah mempelajari beberapa perintah dasar komputer grafik pada Quick Basic, anda dapat mempraktekkan dengan menggambar bentuk-bentuk sesuai keinginan anda.

TEORI DASAR ANIMASI

Apa yang dimaksud dengan Animasi? Tentunya kita sering mendengar istilah animasi yang biasa dikaitkan dengan film kartun. Secara gampang, animasi adalah object yang bergerak. Jika kita belajar komputer grafik, kita tidak hanya belajar menciptakan gambar-gambar object yang statis, tetapi kita juga belajar bagaimana membuat object-object tersebut bergerak. Hal inilah yang disebut dengan animasi.

Animasi di dalam Quick Basic ataupun pada program lainnya secara umum dapat dilihat dari algoritma sebagai berikut:

1. Gambar object yang akan dianimasikan
2. Simpan ke dalam variabel
3. Letakkan pada posisi awal
4. Hapus object
5. Letakkan pada posisi baru
6. Ulangi langkah no. 4 sampai selesai

Jadi pada dasarnya animasi pada komputer grafik adalah menghapus gambar pada posisi lama dan menggambar di posisi baru, demikian seterusnya. Karena kecepatan proses komputer, maka semuanya akan terlihat seolah-olah bergerak. Yang perlu diperhatikan adalah object yang dianimasikan harus benar-benar sama, jika tidak maka animasinya tidak akan terlihat bagus.

Berikut adalah contoh program animasi dengan kontrol keyboard

'Mendefiniskan Tipe Integer untuk semua variabel yang digunakan
DEFINT A-Z
'Membersihkan layar
CLS
'Inisialisasi Grafik, Screen 1 = CGA 320x200 4 warna
SCREEN 1
'Mengeset Warna
COLOR 0, 0

'Memesan array untuk Sprites
DIM nob(39)
'Looping untuk membaca data-data gambar
FOR i = 0 TO 39
READ nob(i)
NEXT
'Data-data gambar Sprite
DATA 32
DATA 14,20481,16389,22277,20693,1797,4308,1797,4308,24321
DATA 16629,-256,255,15360,60,-29694,-32718,3850,-24336,778,-24384,10
DATA -24576,10,-24576,-32726,-22526,-24406,-22006,0,0,0,0,0,0,0,0,0,0

'Posisi Koordinat Awal Sprite
xpos = 150: ypos = 150
'Gerakan Sprite per pixel
xofset = 2: yofset = 2
'Munculkan Sprite di Layar
PUT (xpos, ypos), nob

main.loop:
'Simpan nilai xpos dan ypos
old.xpos = xpos
old.ypos = ypos
'Baca Keyboard Buffer
keyb$ = INKEY$
'Jika tidak ada yang ditekan, lompat ke main.loop
IF keyb$ = "" THEN GOTO main.loop
'Jika ada yang ditekan, lompat ke subrutin cek.button
GOSUB cek.button
'Rutin berikut ini untuk pengecekan batas layar
GOSUB cek.batas
'Letakkan Sprite di posisi lama untuk menghapus sprite
PUT (old.xpos, old.ypos), nob, XOR
'Gambar lagi Sprite di posisi koordinat baru
PUT (xpos, ypos), nob, XOR
'lompat lagi ke main.loop
GOTO main.loop

'Rutin pengecekan batas layar agar tidak ERROR
cek.batas:
IF xpos < 1 THEN xpos = 300
IF xpos > 300 THEN xpos = 1
IF ypos > 185 THEN ypos = 5
IF ypos < 5 THEN ypos = 185
RETURN

'Rutin pengecekan tombol keyboard
cek.button:
'Jika panjang keyboard code tidak sama dengan 2, artinya bukan arrowkey
'lompat ke not.arrow
IF LEN(keyb$) <> 2 THEN GOSUB not.arrow
'Ambil karakter yang kedua
keyb = ASC(RIGHT$(keyb$, 1))
'cek tombol atas
IF keyb = 72 THEN ypos = ypos - yofset
'cek tombol kiri
IF keyb = 75 THEN xpos = xpos - xofset
'cek tombol kanan
IF keyb = 77 THEN xpos = xpos + xofset
'cek tombol bawah
IF keyb = 80 THEN ypos = ypos + yofset

not.arrow:
'Jika ditekan tombol q maka program akan berhenti
IF keyb$ = "q" THEN
WIDTH 80
SCREEN 0
COLOR 7, 0
CLS
END
END IF
RETURN

Contoh program animasi diatas cukup rumit dengan adanya tambahan rutin untuk menggerakkan object dengan tombol keyboard, yang umumnya adalah tombol arrow key, disamping itu kita juga harus mengecek dan memeriksa penekanan tombol q dimana program akan berhenti apabila tombol q ditekan. Dan akhirnya, penambahan rutin untuk mendeteksi batas layar, yaitu batas atas, bawah, kiri dan kanan. Jika kita perhatikan, untuk gambar objectnya menggunakan perintah READ dan DATA yang diikuti sekumpulan angka dan bilangan. Pada pertemuan berikutnya akan dibahas tentang program untuk menggambar bentuk-bentuk object secara mudah, dimana output dari program tersebut berupa file dengan kumpulan bilangan-bilangan seperti pada program diatas.

Pengertian Sprite di dalam Komputer Grafik

Jika anda mendengar istilah sprite dalam komputer grafik, yang dimaksud adalah object untuk animasi. Agar dapat dianimasikan, sprite harus disimpan di dalam suatu variabel array, yang di dalam Quick Basic dideklarasikan dengan perintah DIM.

Menghitung ukuran sprite yang disimpan

Ukuran sprite yang disimpan akan memakan tempat di memory. Oleh karena itu, kita harus dapat menghitung dengan tepat, ukuran variabel array yang digunakan untuk menyimpan sprite tersebut. Sebelum kita dapat menghitung, kita perlu mengetahui bahwa beberapa parameter untuk setiap mode grafik memiliki nilai yang berbeda. Dalam hal ini kita akan membandingkan mode grafik SCREEN 1, 12 dan 13
Mode Grafik Bits-per-pixel-per-plane Planes Resolusi
SCREEN 1 2 1 320x200
SCREEN 12 1 4 640x480
SCREEN 13 8 1 320x200

Adapun formula atau rumusnya adalah sebagai berikut;
size% = 4 + INT(((PMAP (x2!, 0) - PMAP (x1!, 0) + 1) *
(bits-per-pixel-per-plane%) + 7) / 8) * planes% *
(PMAP (y2!, 1) - PMAP (y1!, 1) + 1)

Setelah kita dapatkan nilai size / ukurannya, maka kita langsung masukkan nilai tersebut dengan menggunakan perintah DIM, contoh:
DIM sprite(size%)
Sedangkan looping pembacaan data gambarnya, haruslah diawali dari 0 sampai dengan nilai size% yang sudah didapatkan.

COLLISION DETECTION

Disebut juga Deteksi Tubrukan. Yang dimaksud dengan tubrukan disini adalah pertemuan antara sprite yang satu dengan lainnya. Jika kita sudah mampu membuat animasi sprite, tentunya kita akan mencoba memasukkan lebih dari satu sprite ke layar. Collision Detection digunakan untuk mendeteksi apa yang harus dikerjakan jika sprite-sprite bertemu atau bertubrukan. Suatu contoh, apabila kita memiliki 3 buah sprite A, B dan C. Keadaan yang terjadi pada saat sprite A menubruk sprite B mungkin akan berbeda dengan keadaan yang terjadi apabila sprite B menubruk sprite C. Collision Detection akan memberi signal kepada kita dan dapat memilah-milah sprite mana yang sedang bertubrukan. Collision Detection akan sangat bermanfaat dalam Teknik Simulasi ataupun dalam aplikasi program permainan.

Metode Deteksi Tubrukan

Sebenarnya ada beberapa metode, tetapi yang akan dibahas disini ada tiga yaitu;

Metode Posisi Absolut
Metode ini akan menentukan satu atau beberapa posisi koordinat absolut pada layar, sehingga apabila ada sprite yang menubruk posisi ini, akan dijalankan rutin tubrukan.
Kelemahan:
* Memboroskan memory apabila menggunakan multi-screen, karena kita akan mengecek berulang-ulang
* Sulit membedakan sprite yang menubruk posisinya

Metode Pengecekan Warna
Metode ini akan mengecek, jika warna di sekelilingnya masih 0 (hitam), maka tubrukan belum terjadi. Sebaliknya jika tidak sama dengan 0, maka tubrukan terjadi.
Kelemahan:
* Hanya bisa digunakan untuk layar dengan latar belakang gelap

Metode Target Index
Metode ini akan membagi satu layar menjadi beberapa cell atau komponen. Untuk beberapa program permainan arcade sederhana, metode ini cukup akurat digunakan untuk mendeteksi tubrukan, dan metode ini juga bisa membedakan jenis-jenis sprite yang mengalami tubrukan dan rutin tubrukan yang akan dijalankan apabila terjadi tubrukan.

Mode Grafik 13 Heksa

Pada era DOS tahun 90-an, mode grafik ini sangat populer digunakan dalam program permainan yang populer saat itu. Perusahaan Game berlomba-lomba meluncurkan game-game 2 Dimensi dengan latar belakang yang bagus (pada saat itu) karena mampu menampilkan variasi warna sebanyak 256 warna. Hal ini tentunya sangat menyenangkan dan merupakan terobosan pada saat itu setelah Nintendo yang juga sukses meluncurkan game 16 warnanya. Mode Grafik ini dipilih karena bagus dan cepat. Game-game animasi saat itu ditulis dengan menggunakan bahasa pemrograman C yang terkenal dengan bahasa pemrograman tingkat menengah, masih dekat dengan bahasa manusia, tetapi memiliki kemampuan berinteraksi langsung dengan mesin yang cukup canggih.
Mode Grafis 13 Heksa dimulai pada alamat segmen memory A000:0000, sedangkan pada Quick Basic, anda cukup menginisialisasi mode grafik ini dengan memberikan satu perintah sederhana SCREEN 13. Dengan Mode Grafik ini, kita dapat menghasilkan gambar yang cukup bagus. Program berikut akan menampilkan gambar tengkorak yang cukup bagus;

DEFINT A-Z
SCREEN 13
CLS
DIM Face4(715)
FOR i = 0 TO 715
READ Face4(i)
NEXT
LINE (88, 8)-(121, 56), 15, B
PUT (90, 10), Face4
a$ = INPUT$(1)
WIDTH 80
COLOR 7, 0
CLS

'Data IV
DATA 240 , 45 , 0 , 0 , 0 , 2305 , 1 , 0 , 0 , 0
DATA 0 , 256 , 2357 , 2313 , 1 , 0 , 0 , 0 , 0 , 257
DATA 2305 , 0 , 0 , 0 , 0 , 0 , 0 , 13577 , 265 , 257
DATA 0 , 0 , 0 , 0 , 257 , 309 , 0 , 0 , 1542 , 1542
DATA 6 , 0 , 13569 , 2305 , 1 , 1 , 0 , 0 , 0 , 2305
DATA 9 , 0 , 1542 , 1542 , 1542 , 1542 , 0 , 13568 , 257 , 265
DATA 0 , 0 , 0 , 256 , 13569 , 1 , 1536 , 1542 , 16646 , 16961
DATA 1601 , 6 , 2304 , 265 , 2305 , 0 , 0 , 0 , 256 , 13577
DATA 0 , 1542 , 16961 , 16706 , 16963 , 16706 , 6 , 256 , 309 , 257
DATA 1 , 0 , 0 , 256 , 2357 , 0 , 16646 , 16962 , 16962 , 17218
DATA 16963 , 1601 , 0 , 2357 , 1 , 1 , 0 , 0 , 2304 , 309
DATA 1536 , 16961 , 16962 , 16962 , 3855 , 17219 , 1601 , 0 , 13577 , 257
DATA 256 , 0 , 0 , 13569 , 9 , 1536 , 1601 , 16902 , 16706 , 3855
DATA 17217 , 16707 , 6 , 13569 , 265 , 1 , 0 , 256 , 2305 , 1
DATA 16646 , 16646 , 1602 , 3846 , 16911 , 3855 , 16963 , 6 , 2304 , 309
DATA 257 , 0 , 256 , 265 , 0 , 16902 , 16705 , 3855 , 1551 , 1551
DATA 16911 , 16963 , 1601 , 256 , 2357 , 257 , 0 , 2305 , 257 , 0
DATA 1542 , 16962 , 17219 , 16963 , 3905 , 17167 , 17217 , 1602 , 256 , 13569
DATA 257 , 1 , 265 , 0 , 1536 , 6 , 17218 , 17219 , 16707 , 3855
DATA 17219 , 16707 , 1542 , 0 , 13569 , 265 , 257 , 309 , 0 , 1536
DATA 6 , 3906 , 3855 , 16655 , 3855 , 3855 , 17217 , 1603 , 0 , 2304
DATA 2357 , 257 , 309 , 0 , 0 , 1536 , 17217 , 3855 , 3855 , 3906
DATA 3855 , 3907 , 66 , 0 , 256 , 13577 , 265 , 309 , 0 , 1536
DATA 16705 , 16961 , 3855 , 3855 , 3906 , 3907 , 17167 , 66 , 0 , 0
DATA 2305 , 2313 , 2313 , 0 , 16902 , 16963 , 16962 , 17219 , 3907 , 16911
DATA 3855 , 16963 , 1601 , 0 , 0 , 256 , 265 , 13569 , 0 , 16705
DATA 16646 , 16705 , 16962 , 17218 , 3906 , 16961 , 16962 , 16706 , 6 , 0
DATA 0 , 257 , 2305 , 1536 , 65 , 0 , 16902 , 16705 , 17218 , 16705
DATA 16961 , 17219 , 17219 , 1601 , 0 , 0 , 257 , 2305 , 1536 , 6
DATA 0 , 1536 , 1601 , 16962 , 16646 , 16707 , 1542 , 16646 , 16707 , 0
DATA 256 , 0 , 265 , 1536 , 6 , 0 , 0 , 16646 , 16646 , 17217
DATA 1601 , 0 , 0 , 16646 , 0 , 0 , 0 , 9 , 1536 , 65
DATA 0 , 0 , 16896 , 1542 , 16646 , 6 , 0 , 0 , 1536 , 0
DATA 1 , 0 , 1 , 1536 , 1602 , 0 , 0 , 16640 , 16902 , 1542
DATA 0 , 0 , 0 , 1536 , 0 , 1 , 0 , 0 , 1536 , 16706
DATA 0 , 0 , 16646 , 16705 , 1601 , 0 , 0 , 0 , 1542 , 0
DATA 1 , 0 , 0 , 1536 , 17217 , 1602 , 1542 , 16705 , 17217 , 1601
DATA 6 , 0 , 1536 , 16646 , 6 , 1 , 0 , 0 , 1536 , 16902
DATA 17167 , 16962 , 16706 , 16963 , 16963 , 1601 , 1542 , 1542 , 1602 , 6
DATA 257 , 0 , 0 , 1536 , 16646 , 1601 , 16705 , 16962 , 66 , 16962
DATA 17219 , 3907 , 17167 , 1601 , 0 , 256 , 257 , 0 , 0 , 1601
DATA 1542 , 1542 , 16961 , 6 , 17158 , 16705 , 16962 , 16706 , 1542 , 0
DATA 256 , 2313 , 0 , 0 , 16640 , 16706 , 1542 , 16961 , 0 , 17152
DATA 1542 , 1542 , 1542 , 65 , 0 , 0 , 13569 , 0 , 0 , 0
DATA 0 , 1601 , 16961 , 0 , 16896 , 1601 , 16646 , 16706 , 0 , 0
DATA 0 , 256 , 0 , 0 , 0 , 0 , 1542 , 16962 , 16646 , 16902
DATA 1602 , 1601 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 6 , 1536 , 16961 , 16705 , 16961 , 1601 , 6 , 1536 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 6 , 1536 , 16705 , 16962 , 16706
DATA 1601 , 6 , 1536 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 65 , 1536 , 1542 , 1542 , 1542 , 1542 , 6 , 1536 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 1601 , 1536 , 1602 , 1601 , 1601
DATA 1601 , 65 , 16640 , 6 , 0 , 0 , 0 , 0 , 0 , 0
DATA 16902 , 1536 , 1542 , 1603 , 1603 , 1602 , 6 , 16646 , 1542 , 0
DATA 0 , 0 , 0 , 0 , 0 , 16896 , 16646 , 1542 , 1542 , 1542
DATA 16646 , 6 , 1542 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 1536 , 1602 , 16706 , 16655 , 16655 , 16706 , 1536 , 6 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 16705 , 1542 , 1602 , 1602
DATA 6 , 1542 , 0 , 0 , 0 , 0 , 256 , 0 , 0 , 0
DATA 0 , 16902 , 1601 , 0 , 6 , 16646 , 1542 , 0 , 0 , 0
DATA 0 , 256 , 1 , 0 , 0 , 0 , 16640 , 17218 , 17167 , 16963
DATA 16705 , 6 , 0 , 0 , 0 , 0 , 256 , 265 , 0 , 0
DATA 0 , 1536 , 16961 , 17219 , 16706 , 6 , 0 , 0 , 0 , 0
DATA 0 , 256 , 2357 , 1 , 0 , 0 , 0 , 1542 , 16705 , 6
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 13621 , 257 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 13621 , 265 , 1 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0
DATA 0 , 0 , 0 , 0 , 0 , 0

Mengenal Format Gambar Quick Basic

Format Gambar Quick Basic dipetakan ke dalam sekumpulan bilangan integer. File-file gambar dapat dijadikan satu di dalam program utama atau kita letakkan di dalam file eksternal yang dapat dipanggil. Berikut ini adalah contoh perintah untuk membaca file teks dari program QuickBasic:

OPEN "box.shp" FOR INPUT AS #1
DIM SHARED box(95): FOR i = 0 TO 95: INPUT #1, box(i): NEXT: CLOSE #1

Misalnya kita telah membuat file box.shp yang berisi sekumpulan bilangan integer untuk gambar kita, maka dapat kita buka dengan perintah OPEN untuk selanjutnya kita gunakan looping untuk membaca data-data gambar kita.

Palette

Jika anda perhatikan seorang pelukis yang hendak melukis. Terkadang, dia mencampurkan beberapa cat sehingga menjadi variasi warna yang bermacam-macam. Kira-kira gambaran seperti ini jugalah yang dikenal dalam Palette Komputer Grafik. Dengan Sistem Palette, kita dapat menghasilkan variasi warna yang tidak monoton.

Ini adalah penggalan program untuk menyimpan palette
Saving:
DIM pal&(255)
DEF SEG = VARSEG(pal&(0))
FOR col% = 0 to 255
OUT &h3c7, col%
POKE VARPTR(pal&(col%)), INP(&h3c9)
POKE VARPTR(pal&(col%)) + 1, INP(&h3c9)
POKE VARPTR(pal&(col%)) + 2, INP(&h3c9)
NEXT
BSAVE "FileName.pal", VARPTR(pal&(0)), 1023

sedangkan berikut ini adalah penggalan program untuk memanggil sistem palette yang sudah disimpan
Loading:
DIM pal&(255)
DEF SEG = VARSEG(pal&(0))
BLOAD "FileName.pal", VARPTR(pal&(0))
FOR col% = 0 to 255
OUT &h3c8, col%
OUT &h3c9, PEEK VARPTR(pal&(col%))
OUT &h3c9, PEEK VARPTR(pal&(col%)) + 1
OUT &h3c9, PEEK VARPTR(pal&(col%)) + 2
NEXT

Sistem Palette akan menyimpan warna RGB (Red, Green, Blue), dimana masing-masing dapat menyimpan nilai 0 sampai dengan 255.
Perintah diatas langsung mengakses hardware port (perintah OUT) sehingga menghasilkan kecepatan yang 100x lebih cepat dibandingkan perintah PALETTE dari QuickBasic sendiri.

Struktur File Bitmap .BMP 256 Color

File Gambar ada bermacam-macam. Yang paling sering digunakan adalah JPEG, karena sistem kompresinya sehingga menghasilkan gambar yang bagus dengan ukuran yang sangat kecil. Dalam kesempatan ini kita akan mempelajari struktur file BMP 256 warna yang sangat sederhana, karena tidak dikompresi. Secara umum struktur file .BMP adalah sebagai berikut:

54 Bytes awal digunakan untuk menyimpan Header File BMP
1024 Bytes berikutnya digunakan untuk menyimpan informasi palette, yang disusun BGR (Blue, Green, Red)
Sisa Bytes berikutnya adalah informasi gambar

Berikut adalah program untuk menampilkan file .BMP 256 warna

TYPE BMPHeaderType
id AS STRING * 2 'Should be "BM"
size AS LONG 'Size of the data
rr1 AS INTEGER '
rr2 AS INTEGER '
offset AS LONG 'Position of start of pixel data
horz AS LONG '
wid AS LONG 'Image width
hei AS LONG 'Image height
planes AS INTEGER '
bpp AS INTEGER 'Should read 8 for a 256 colour image
pakbyte AS LONG '
imagebytes AS LONG 'Width*Height
xres AS LONG '
yres AS LONG '
colch AS LONG '
ic AS LONG '
pal AS STRING * 1024 'Stored as <Blue, Green, Red, 0>
END TYPE

DIM BmpHeader AS BMPHeaderType

OPEN "marlex.bmp" FOR BINARY AS #1

GET #1, , BmpHeader

SCREEN 13 ' Set graphics mode

a$ = BmpHeader.pal ' Pal is stored in a 1024 character string

OUT &H3C8, 0 ' Start writing from Colour 0
FOR I% = 1 TO 1024 STEP 4
b% = ASC(MID$(a$, I%, 1)) \ 4 'blue
g% = ASC(MID$(a$, I% + 1, 1)) \ 4 'green
r% = ASC(MID$(a$, I% + 2, 1)) \ 4 'red
' I% + 3 is set to zero.
OUT &H3C9, r% ' Set the colour.
OUT &H3C9, g%
OUT &H3C9, b%
NEXT

DIM pixel AS STRING * 1 ' Our pixel "byte".

iHeight% = BmpHeader.hei - 1 ' Subtract 1 for actual screen position
iWidth% = BmpHeader.wid - 1 '

'Check Bytes
Byte.Remind = BmpHeader.imagebytes - (BmpHeader.wid * BmpHeader.hei)
IF Byte.Remind > 0 THEN
'This will applied if there is unused bytes
'we have to make modification on image width
iWidth% = iWidth% + (Byte.Remind / BmpHeader.hei)
END IF

key$ = INPUT$(1)

FOR y% = iHeight% TO 0 STEP -1 ' Countdown for upsidedown image
FOR x% = 0 TO iWidth%

GET #1, , pixel ' read pixel ' Read one pixel (byte)
PSET (x%, y%), ASC(pixel) ' Pixel is actually a string so we get the pixel
' number by requesting the "ASC" value
NEXT x%, y%

CLOSE #1

Kita dapat melewatkan 54 bytes pertama yang digunakan untuk menyimpan informasi header. 1024 bytes selanjutnya digunakan untuk menyimpan informasi palette. Yang menarik adalah informasi palette disusun terbalik menurut aturan BGR (Blue Green Red) yang biasanya kita mengenal RGB (Red, Green, Blue). Dan byte-byte selanjutnya adalah informasi gambar yang disusun dari bawah ke atas, jadi kalau kita perhatikan jika membuka file .BMP adalah dari bawah ke atas. Beberapa file bitmap .BMP mengabaikan beberapa byte yang ada di dalam filenya, sehingga penggunaan program LoadBmp terkadang tidak akan menghasilkan gambar yang diharapkan.

Contoh: kita akan mencoba membaca informasi header dari file .BMP

TYPE BMPHeaderType
ID AS STRING * 2 'Should be "BM"
size AS LONG 'Size of the data
rr1 AS INTEGER '
rr2 AS INTEGER '
Offset AS LONG 'Position of start of pixel data
horz AS LONG '
wid AS LONG 'Image width
hei AS LONG 'Image height
Planes AS INTEGER '
bpp AS INTEGER 'Should read 8 for a 256 colour image
pakbyte AS LONG '
imagebytes AS LONG 'Width*Height
xres AS LONG '
yres AS LONG '
colch AS LONG '
ic AS LONG '
pal AS STRING * 1024 'Stored as <Blue, Green, Red, 0>
END TYPE

DIM BmpHeader AS BMPHeaderType

filename$ = "marlex.bmp"
OPEN filename$ FOR BINARY AS #1

GET #1, , BmpHeader

COLOR 15, 0
SCREEN 0
CLS

PRINT "File .BMP Information"
PRINT "Filename : ", filename$
PRINT "BMP ID : ", BmpHeader.ID
PRINT "Size in bytes : ", BmpHeader.size
PRINT "RR1 : ", BmpHeader.rr1
PRINT "RR2 : ", BmpHeader.rr2
PRINT "Horz : ", BmpHeader.horz
PRINT "Start Offset : ", BmpHeader.Offset
PRINT "Total Planes : ", BmpHeader.Planes
PRINT "BitPerPlanes : ", BmpHeader.bpp
PRINT "X-Res : ", BmpHeader.xres
PRINT "Y-Res : ", BmpHeader.yres
PRINT "Width : ", BmpHeader.wid
PRINT "Height : ", BmpHeader.hei
PRINT "Image Bytes : ", BmpHeader.imagebytes
PRINT "Pak Bytes : ", BmpHeader.pakbyte
PRINT "Colch : ", BmpHeader.colch
PRINT "IC : ", BmpHeader.ic

key$ = INPUT$(1)

Outputnya adalah sbb:
Filename : marlex.bmp
BMP ID : BM
Size in bytes : 1590
RR1 : 0
RR2 : 0
Horz : 40
Start Offset : 1078
Total Planes : 1
BitPerPlanes : 8
X-Res : 0
Y-Res : 0
Width : 15
Height : 32
Image Bytes : 512
Pak Bytes : 0
Colch : 0
IC : 0

Jika kita lihat ukuran file bmpnya adalah 1590 bytes , sedangkan ukuran imagenya sendiri adalah 512 bytes. Kalau kita jumlahkan, 54 +1024+512 = 1590 bytes!!! Ini artinya semua byte yang ada di dalam file digunakan untuk menampilkan gambar.

Sumber:
dikembangkan dari "Pemrograman Grafik dengan Basic"

[ add comment ] ( 5 views )   |  permalink  |  related link  |   ( 0 / 0 )

---

<<First <Back | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 |

Copyright (C) 2009 - Wahyu Kurniawan - Page Generated in 110.9264 seconds | Site Views: 13815